1;;; pascal.el --- major mode for editing pascal source in Emacs 2 3;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 4;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Espen Skoglund <esk@gnu.org> 7;; Keywords: languages 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to 23;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; USAGE 29;; ===== 30 31;; Emacs should enter Pascal mode when you find a Pascal source file. 32;; When you have entered Pascal mode, you may get more info by pressing 33;; C-h m. You may also get online help describing various functions by: 34;; C-h f <Name of function you want described> 35 36;; If you want to customize Pascal mode to fit you better, you may add 37;; these lines (the values of the variables presented here are the defaults): 38;; 39;; ;; User customization for Pascal mode 40;; (setq pascal-indent-level 3 41;; pascal-case-indent 2 42;; pascal-auto-newline nil 43;; pascal-tab-always-indent t 44;; pascal-auto-endcomments t 45;; pascal-auto-lineup '(all) 46;; pascal-toggle-completions nil 47;; pascal-type-keywords '("array" "file" "packed" "char" 48;; "integer" "real" "string" "record") 49;; pascal-start-keywords '("begin" "end" "function" "procedure" 50;; "repeat" "until" "while" "read" "readln" 51;; "reset" "rewrite" "write" "writeln") 52;; pascal-separator-keywords '("downto" "else" "mod" "div" "then")) 53 54;; KNOWN BUGS / BUGREPORTS 55;; ======================= 56;; As far as I know, there are no bugs in the current version of this 57;; package. This may not be true however, since I never use this mode 58;; myself and therefore would never notice them anyway. If you do 59;; find any bugs, you may submit them to: esk@gnu.org as well as to 60;; bug-gnu-emacs@gnu.org. 61 62;;; Code: 63 64(defgroup pascal nil 65 "Major mode for editing Pascal source in Emacs." 66 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) 67 :group 'languages) 68 69(defvar pascal-mode-abbrev-table nil 70 "Abbrev table in use in Pascal-mode buffers.") 71(define-abbrev-table 'pascal-mode-abbrev-table ()) 72 73(defvar pascal-mode-map 74 (let ((map (make-sparse-keymap))) 75 (define-key map ";" 'electric-pascal-semi-or-dot) 76 (define-key map "." 'electric-pascal-semi-or-dot) 77 (define-key map ":" 'electric-pascal-colon) 78 (define-key map "=" 'electric-pascal-equal) 79 (define-key map "#" 'electric-pascal-hash) 80 (define-key map "\r" 'electric-pascal-terminate-line) 81 (define-key map "\t" 'electric-pascal-tab) 82 (define-key map "\M-\t" 'pascal-complete-word) 83 (define-key map "\M-?" 'pascal-show-completions) 84 (define-key map "\177" 'backward-delete-char-untabify) 85 (define-key map "\M-\C-h" 'pascal-mark-defun) 86 (define-key map "\C-c\C-b" 'pascal-insert-block) 87 (define-key map "\M-*" 'pascal-star-comment) 88 (define-key map "\C-c\C-c" 'pascal-comment-area) 89 (define-key map "\C-c\C-u" 'pascal-uncomment-area) 90 (define-key map "\M-\C-a" 'pascal-beg-of-defun) 91 (define-key map "\M-\C-e" 'pascal-end-of-defun) 92 (define-key map "\C-c\C-d" 'pascal-goto-defun) 93 (define-key map "\C-c\C-o" 'pascal-outline-mode) 94 ;; A command to change the whole buffer won't be used terribly 95 ;; often, so no need for a key binding. 96 ;; (define-key map "\C-cd" 'pascal-downcase-keywords) 97 ;; (define-key map "\C-cu" 'pascal-upcase-keywords) 98 ;; (define-key map "\C-cc" 'pascal-capitalize-keywords) 99 map) 100 "Keymap used in Pascal mode.") 101 102(defvar pascal-imenu-generic-expression 103 '((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2)) 104 "Imenu expression for Pascal-mode. See `imenu-generic-expression'.") 105 106(defvar pascal-keywords 107 '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end" 108 "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of" 109 "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to" 110 "type" "until" "var" "while" "with" 111 ;; The following are not standard in pascal, but widely used. 112 "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write" 113 "writeln")) 114 115;;; 116;;; Regular expressions used to calculate indent, etc. 117;;; 118(defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>") 119(defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>") 120(defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>") 121(defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>") 122(defconst pascal-progbeg-re "\\<\\program\\>") 123(defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>") 124(defconst pascal-sub-block-re "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>") 125(defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\|else\\)\\>") 126(defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>") 127(defconst pascal-autoindent-lines-re 128 "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>") 129 130;;; Strings used to mark beginning and end of excluded text 131(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----") 132(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}") 133 134(defvar pascal-mode-syntax-table 135 (let ((st (make-syntax-table))) 136 (modify-syntax-entry ?\\ "." st) 137 (modify-syntax-entry ?\( "()1" st) 138 (modify-syntax-entry ?\) ")(4" st) 139 ;; This used to use comment-syntax `b'. But the only document I could 140 ;; find about the syntax of Pascal's comments said that (* ... } is 141 ;; a valid comment, just as { ... *) or (* ... *) or { ... }. 142 (modify-syntax-entry ?* ". 23" st) 143 (modify-syntax-entry ?{ "<" st) 144 (modify-syntax-entry ?} ">" st) 145 (modify-syntax-entry ?+ "." st) 146 (modify-syntax-entry ?- "." st) 147 (modify-syntax-entry ?= "." st) 148 (modify-syntax-entry ?% "." st) 149 (modify-syntax-entry ?< "." st) 150 (modify-syntax-entry ?> "." st) 151 (modify-syntax-entry ?& "." st) 152 (modify-syntax-entry ?| "." st) 153 (modify-syntax-entry ?_ "_" st) 154 (modify-syntax-entry ?\' "\"" st) 155 st) 156 "Syntax table in use in Pascal-mode buffers.") 157 158 159 160(defconst pascal-font-lock-keywords (purecopy 161 (list 162 '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)" 163 1 font-lock-keyword-face) 164 '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)" 165 3 font-lock-function-name-face t) 166; ("type" "const" "real" "integer" "char" "boolean" "var" 167; "record" "array" "file") 168 (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" 169 "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") 170 'font-lock-type-face) 171 '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face) 172 '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face) 173; ("of" "to" "for" "if" "then" "else" "case" "while" 174; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") 175 (concat "\\<\\(" 176 "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|" 177 "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" 178 "\\)\\>") 179 '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" 180 1 font-lock-keyword-face) 181 '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" 182 2 font-lock-keyword-face t))) 183 "Additional expressions to highlight in Pascal mode.") 184(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t)) 185 186(defcustom pascal-indent-level 3 187 "*Indentation of Pascal statements with respect to containing block." 188 :type 'integer 189 :group 'pascal) 190 191(defcustom pascal-case-indent 2 192 "*Indentation for case statements." 193 :type 'integer 194 :group 'pascal) 195 196(defcustom pascal-auto-newline nil 197 "*Non-nil means automatically insert newlines in certain cases. 198These include after semicolons and after the punctuation mark after an `end'." 199 :type 'boolean 200 :group 'pascal) 201 202(defcustom pascal-indent-nested-functions t 203 "*Non-nil means nested functions are indented." 204 :type 'boolean 205 :group 'pascal) 206 207(defcustom pascal-tab-always-indent t 208 "*Non-nil means TAB in Pascal mode should always reindent the current line. 209If this is nil, TAB inserts a tab if it is at the end of the line 210and follows non-whitespace text." 211 :type 'boolean 212 :group 'pascal) 213 214(defcustom pascal-auto-endcomments t 215 "*Non-nil means automatically insert comments after certain `end's. 216Specifically, this is done after the ends of cases statements and functions. 217The name of the function or case is included between the braces." 218 :type 'boolean 219 :group 'pascal) 220 221(defcustom pascal-auto-lineup '(all) 222 "*List of contexts where auto lineup of :'s or ='s should be done. 223Elements can be of type: 'paramlist', 'declaration' or 'case', which will 224do auto lineup in parameterlist, declarations or case-statements 225respectively. The word 'all' will do all lineups. '(case paramlist) for 226instance will do lineup in case-statements and parameterlist, while '(all) 227will do all lineups." 228 :type '(set :extra-offset 8 229 (const :tag "Everything" all) 230 (const :tag "Parameter lists" paramlist) 231 (const :tag "Decalrations" declaration) 232 (const :tag "Case statements" case)) 233 :group 'pascal) 234 235(defcustom pascal-toggle-completions nil 236 "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one. 237Repeated use of \\[pascal-complete-word] will show you all of them. 238Normally, when there is more than one possible completion, 239it displays a list of all possible completions." 240 :type 'boolean 241 :group 'pascal) 242 243(defcustom pascal-type-keywords 244 '("array" "file" "packed" "char" "integer" "real" "string" "record") 245 "*Keywords for types used when completing a word in a declaration or parmlist. 246These include integer, real, char, etc. 247The types defined within the Pascal program 248are handled in another way, and should not be added to this list." 249 :type '(repeat (string :tag "Keyword")) 250 :group 'pascal) 251 252(defcustom pascal-start-keywords 253 '("begin" "end" "function" "procedure" "repeat" "until" "while" 254 "read" "readln" "reset" "rewrite" "write" "writeln") 255 "*Keywords to complete when standing at the first word of a statement. 256These are keywords such as begin, repeat, until, readln. 257The procedures and variables defined within the Pascal program 258are handled in another way, and should not be added to this list." 259 :type '(repeat (string :tag "Keyword")) 260 :group 'pascal) 261 262(defcustom pascal-separator-keywords 263 '("downto" "else" "mod" "div" "then") 264 "*Keywords to complete when NOT standing at the first word of a statement. 265These are keywords such as downto, else, mod, then. 266Variables and function names defined within the Pascal program 267are handled in another way, and should not be added to this list." 268 :type '(repeat (string :tag "Keyword")) 269 :group 'pascal) 270 271 272;;; 273;;; Macros 274;;; 275 276(defsubst pascal-get-beg-of-line (&optional arg) 277 (save-excursion 278 (beginning-of-line arg) 279 (point))) 280 281(defsubst pascal-get-end-of-line (&optional arg) 282 (save-excursion 283 (end-of-line arg) 284 (point))) 285 286(defun pascal-declaration-end () 287 (let ((nest 1)) 288 (while (and (> nest 0) 289 (re-search-forward 290 "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" 291 (save-excursion (end-of-line 2) (point)) t)) 292 (cond ((match-beginning 1) (setq nest (1+ nest))) 293 ((match-beginning 2) (setq nest (1- nest))) 294 ((looking-at "[^(\n]+)") (setq nest 0)))))) 295 296 297(defun pascal-declaration-beg () 298 (let ((nest 1)) 299 (while (and (> nest 0) 300 (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line 0) t)) 301 (cond ((match-beginning 1) (setq nest 0)) 302 ((match-beginning 2) (setq nest (1- nest))) 303 ((match-beginning 3) (setq nest (1+ nest))))) 304 (= nest 0))) 305 306 307(defsubst pascal-within-string () 308 (save-excursion 309 (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point))))) 310 311 312;;;###autoload 313(defun pascal-mode () 314 "Major mode for editing Pascal code. \\<pascal-mode-map> 315TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. 316 317\\[pascal-complete-word] completes the word around current point with respect \ 318to position in code 319\\[pascal-show-completions] shows all possible completions at this point. 320 321Other useful functions are: 322 323\\[pascal-mark-defun]\t- Mark function. 324\\[pascal-insert-block]\t- insert begin ... end; 325\\[pascal-star-comment]\t- insert (* ... *) 326\\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments. 327\\[pascal-uncomment-area]\t- Uncomment an area commented with \ 328\\[pascal-comment-area]. 329\\[pascal-beg-of-defun]\t- Move to beginning of current function. 330\\[pascal-end-of-defun]\t- Move to end of current function. 331\\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer. 332\\[pascal-outline-mode]\t- Enter `pascal-outline-mode'. 333 334Variables controlling indentation/edit style: 335 336 pascal-indent-level (default 3) 337 Indentation of Pascal statements with respect to containing block. 338 pascal-case-indent (default 2) 339 Indentation for case statements. 340 pascal-auto-newline (default nil) 341 Non-nil means automatically newline after semicolons and the punctuation 342 mark after an end. 343 pascal-indent-nested-functions (default t) 344 Non-nil means nested functions are indented. 345 pascal-tab-always-indent (default t) 346 Non-nil means TAB in Pascal mode should always reindent the current line, 347 regardless of where in the line point is when the TAB command is used. 348 pascal-auto-endcomments (default t) 349 Non-nil means a comment { ... } is set after the ends which ends cases and 350 functions. The name of the function or case will be set between the braces. 351 pascal-auto-lineup (default t) 352 List of contexts where auto lineup of :'s or ='s should be done. 353 354See also the user variables pascal-type-keywords, pascal-start-keywords and 355pascal-separator-keywords. 356 357Turning on Pascal mode calls the value of the variable pascal-mode-hook with 358no args, if that value is non-nil." 359 (interactive) 360 (kill-all-local-variables) 361 (use-local-map pascal-mode-map) 362 (setq major-mode 'pascal-mode) 363 (setq mode-name "Pascal") 364 (setq local-abbrev-table pascal-mode-abbrev-table) 365 (set-syntax-table pascal-mode-syntax-table) 366 (make-local-variable 'indent-line-function) 367 (setq indent-line-function 'pascal-indent-line) 368 (make-local-variable 'comment-indent-function) 369 (setq comment-indent-function 'pascal-indent-comment) 370 (make-local-variable 'parse-sexp-ignore-comments) 371 (setq parse-sexp-ignore-comments nil) 372 (make-local-variable 'blink-matching-paren-dont-ignore-comments) 373 (setq blink-matching-paren-dont-ignore-comments t) 374 (make-local-variable 'case-fold-search) 375 (setq case-fold-search t) 376 (make-local-variable 'comment-start) 377 (setq comment-start "{") 378 (make-local-variable 'comment-start-skip) 379 (setq comment-start-skip "(\\*+ *\\|{ *") 380 (make-local-variable 'comment-end) 381 (setq comment-end "}") 382 ;; Font lock support 383 (make-local-variable 'font-lock-defaults) 384 (setq font-lock-defaults '(pascal-font-lock-keywords nil t)) 385 ;; Imenu support 386 (make-local-variable 'imenu-generic-expression) 387 (setq imenu-generic-expression pascal-imenu-generic-expression) 388 (setq imenu-case-fold-search t) 389 (run-mode-hooks 'pascal-mode-hook)) 390 391 392 393;;; 394;;; Electric functions 395;;; 396(defun electric-pascal-terminate-line () 397 "Terminate line and indent next line." 398 (interactive) 399 ;; First, check if current line should be indented 400 (save-excursion 401 (beginning-of-line) 402 (skip-chars-forward " \t") 403 (if (looking-at pascal-autoindent-lines-re) 404 (pascal-indent-line))) 405 (delete-horizontal-space) ; Removes trailing whitespaces 406 (newline) 407 ;; Indent next line 408 (pascal-indent-line) 409 ;; Maybe we should set some endcomments 410 (if pascal-auto-endcomments 411 (pascal-set-auto-comments)) 412 ;; Check if we shall indent inside comment 413 (let ((setstar nil)) 414 (save-excursion 415 (forward-line -1) 416 (skip-chars-forward " \t") 417 (cond ((looking-at "\\*[ \t]+)") 418 ;; Delete region between `*' and `)' if there is only whitespaces. 419 (forward-char 1) 420 (delete-horizontal-space)) 421 ((and (looking-at "(\\*\\|\\*[^)]") 422 (not (save-excursion 423 (search-forward "*)" (pascal-get-end-of-line) t)))) 424 (setq setstar t)))) 425 ;; If last line was a star comment line then this one shall be too. 426 (if (null setstar) 427 (pascal-indent-line) 428 (insert "* ")))) 429 430 431(defun electric-pascal-semi-or-dot () 432 "Insert `;' or `.' character and reindent the line." 433 (interactive) 434 (insert last-command-char) 435 (save-excursion 436 (beginning-of-line) 437 (pascal-indent-line)) 438 (if pascal-auto-newline 439 (electric-pascal-terminate-line))) 440 441(defun electric-pascal-colon () 442 "Insert `:' and do all indentions except line indent on this line." 443 (interactive) 444 (insert last-command-char) 445 ;; Do nothing if within string. 446 (if (pascal-within-string) 447 () 448 (save-excursion 449 (beginning-of-line) 450 (pascal-indent-line)) 451 (let ((pascal-tab-always-indent nil)) 452 (pascal-indent-command)))) 453 454(defun electric-pascal-equal () 455 "Insert `=', and do indention if within type declaration." 456 (interactive) 457 (insert last-command-char) 458 (if (eq (car (pascal-calculate-indent)) 'declaration) 459 (let ((pascal-tab-always-indent nil)) 460 (pascal-indent-command)))) 461 462(defun electric-pascal-hash () 463 "Insert `#', and indent to column 0 if this is a CPP directive." 464 (interactive) 465 (insert last-command-char) 466 (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#")) 467 (save-excursion (beginning-of-line) 468 (delete-horizontal-space)))) 469 470(defun electric-pascal-tab () 471 "Function called when TAB is pressed in Pascal mode." 472 (interactive) 473 ;; Do nothing if within a string or in a CPP directive. 474 (if (or (pascal-within-string) 475 (and (not (bolp)) 476 (save-excursion (beginning-of-line) (eq (following-char) ?#)))) 477 (insert "\t") 478 ;; If pascal-tab-always-indent, indent the beginning of the line. 479 (if pascal-tab-always-indent 480 (save-excursion 481 (beginning-of-line) 482 (pascal-indent-line)) 483 (if (save-excursion 484 (skip-chars-backward " \t") 485 (bolp)) 486 (pascal-indent-line) 487 (insert "\t"))) 488 (pascal-indent-command))) 489 490 491 492;;; 493;;; Interactive functions 494;;; 495(defun pascal-insert-block () 496 "Insert Pascal begin ... end; block in the code with right indentation." 497 (interactive) 498 (insert "begin") 499 (electric-pascal-terminate-line) 500 (save-excursion 501 (newline) 502 (insert "end;") 503 (beginning-of-line) 504 (pascal-indent-line))) 505 506(defun pascal-star-comment () 507 "Insert Pascal star comment at point." 508 (interactive) 509 (pascal-indent-line) 510 (insert "(*") 511 (electric-pascal-terminate-line) 512 (save-excursion 513 (electric-pascal-terminate-line) 514 (delete-horizontal-space) 515 (insert ")")) 516 (insert " ")) 517 518(defun pascal-mark-defun () 519 "Mark the current pascal function (or procedure). 520This puts the mark at the end, and point at the beginning." 521 (interactive) 522 (push-mark (point)) 523 (pascal-end-of-defun) 524 (push-mark (point)) 525 (pascal-beg-of-defun) 526 (if (fboundp 'zmacs-activate-region) 527 (zmacs-activate-region))) 528 529(defun pascal-comment-area (start end) 530 "Put the region into a Pascal comment. 531The comments that are in this area are \"deformed\": 532`*)' becomes `!(*' and `}' becomes `!{'. 533These deformed comments are returned to normal if you use 534\\[pascal-uncomment-area] to undo the commenting. 535 536The commented area starts with `pascal-exclude-str-start', and ends with 537`pascal-include-str-end'. But if you change these variables, 538\\[pascal-uncomment-area] won't recognize the comments." 539 (interactive "r") 540 (save-excursion 541 ;; Insert start and endcomments 542 (goto-char end) 543 (if (and (save-excursion (skip-chars-forward " \t") (eolp)) 544 (not (save-excursion (skip-chars-backward " \t") (bolp)))) 545 (forward-line 1) 546 (beginning-of-line)) 547 (insert pascal-exclude-str-end) 548 (setq end (point)) 549 (newline) 550 (goto-char start) 551 (beginning-of-line) 552 (insert pascal-exclude-str-start) 553 (newline) 554 ;; Replace end-comments within commented area 555 (goto-char end) 556 (save-excursion 557 (while (re-search-backward "\\*)" start t) 558 (replace-match "!(*" t t))) 559 (save-excursion 560 (while (re-search-backward "}" start t) 561 (replace-match "!{" t t))))) 562 563(defun pascal-uncomment-area () 564 "Uncomment a commented area; change deformed comments back to normal. 565This command does nothing if the pointer is not in a commented 566area. See also `pascal-comment-area'." 567 (interactive) 568 (save-excursion 569 (let ((start (point)) 570 (end (point))) 571 ;; Find the boundaries of the comment 572 (save-excursion 573 (setq start (progn (search-backward pascal-exclude-str-start nil t) 574 (point))) 575 (setq end (progn (search-forward pascal-exclude-str-end nil t) 576 (point)))) 577 ;; Check if we're really inside a comment 578 (if (or (equal start (point)) (<= end (point))) 579 (message "Not standing within commented area.") 580 (progn 581 ;; Remove endcomment 582 (goto-char end) 583 (beginning-of-line) 584 (let ((pos (point))) 585 (end-of-line) 586 (delete-region pos (1+ (point)))) 587 ;; Change comments back to normal 588 (save-excursion 589 (while (re-search-backward "!{" start t) 590 (replace-match "}" t t))) 591 (save-excursion 592 (while (re-search-backward "!(\\*" start t) 593 (replace-match "*)" t t))) 594 ;; Remove startcomment 595 (goto-char start) 596 (beginning-of-line) 597 (let ((pos (point))) 598 (end-of-line) 599 (delete-region pos (1+ (point))))))))) 600 601(defun pascal-beg-of-defun () 602 "Move backward to the beginning of the current function or procedure." 603 (interactive) 604 (catch 'found 605 (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re))) 606 (forward-sexp 1)) 607 (let ((nest 0) (max -1) (func 0) 608 (reg (concat pascal-beg-block-re "\\|" 609 pascal-end-block-re "\\|" 610 pascal-defun-re))) 611 (while (re-search-backward reg nil 'move) 612 (cond ((let ((state (save-excursion 613 (parse-partial-sexp (point-min) (point))))) 614 (or (nth 3 state) (nth 4 state))) ; Inside string or comment 615 ()) 616 ((match-end 1) ; begin|case|record|repeat 617 (if (and (looking-at "\\<record\\>") (>= max 0)) 618 (setq func (1- func))) 619 (setq nest (1+ nest) 620 max (max nest max))) 621 ((match-end 2) ; end|until 622 (if (and (= nest max) (>= max 0)) 623 (setq func (1+ func))) 624 (setq nest (1- nest))) 625 ((match-end 3) ; function|procedure 626 (if (= 0 func) 627 (throw 'found t) 628 (setq func (1- func))))))) 629 nil)) 630 631(defun pascal-end-of-defun () 632 "Move forward to the end of the current function or procedure." 633 (interactive) 634 (if (looking-at "\\s ") 635 (forward-sexp 1)) 636 (if (not (looking-at pascal-defun-re)) 637 (pascal-beg-of-defun)) 638 (forward-char 1) 639 (let ((nest 0) (func 1) 640 (reg (concat pascal-beg-block-re "\\|" 641 pascal-end-block-re "\\|" 642 pascal-defun-re))) 643 (while (and (/= func 0) 644 (re-search-forward reg nil 'move)) 645 (cond ((let ((state (save-excursion 646 (parse-partial-sexp (point-min) (point))))) 647 (or (nth 3 state) (nth 4 state))) ; Inside string or comment 648 ()) 649 ((match-end 1) 650 (setq nest (1+ nest)) 651 (if (save-excursion 652 (goto-char (match-beginning 0)) 653 (looking-at "\\<record\\>")) 654 (setq func (1+ func)))) 655 ((match-end 2) 656 (setq nest (1- nest)) 657 (if (= nest 0) 658 (setq func (1- func)))) 659 ((match-end 3) 660 (setq func (1+ func)))))) 661 (forward-line 1)) 662 663(defun pascal-end-of-statement () 664 "Move forward to end of current statement." 665 (interactive) 666 (let ((parse-sexp-ignore-comments t) 667 (nest 0) pos 668 (regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\(" 669 pascal-end-block-re "\\)"))) 670 (if (not (looking-at "[ \t\n]")) (forward-sexp -1)) 671 (or (looking-at pascal-beg-block-re) 672 ;; Skip to end of statement 673 (setq pos (catch 'found 674 (while t 675 (forward-sexp 1) 676 (cond ((looking-at "[ \t]*;") 677 (skip-chars-forward "^;") 678 (forward-char 1) 679 (throw 'found (point))) 680 ((save-excursion 681 (forward-sexp -1) 682 (looking-at pascal-beg-block-re)) 683 (goto-char (match-beginning 0)) 684 (throw 'found nil)) 685 ((eobp) 686 (throw 'found (point)))))))) 687 (if (not pos) 688 ;; Skip a whole block 689 (catch 'found 690 (while t 691 (re-search-forward regexp nil 'move) 692 (setq nest (if (match-end 1) 693 (1+ nest) 694 (1- nest))) 695 (cond ((eobp) 696 (throw 'found (point))) 697 ((= 0 nest) 698 (throw 'found (pascal-end-of-statement)))))) 699 pos))) 700 701(defun pascal-downcase-keywords () 702 "Downcase all Pascal keywords in the buffer." 703 (interactive) 704 (pascal-change-keywords 'downcase-word)) 705 706(defun pascal-upcase-keywords () 707 "Upcase all Pascal keywords in the buffer." 708 (interactive) 709 (pascal-change-keywords 'upcase-word)) 710 711(defun pascal-capitalize-keywords () 712 "Capitalize all Pascal keywords in the buffer." 713 (interactive) 714 (pascal-change-keywords 'capitalize-word)) 715 716;; Change the keywords according to argument. 717(defun pascal-change-keywords (change-word) 718 (save-excursion 719 (let ((keyword-re (concat "\\<\\(" 720 (mapconcat 'identity pascal-keywords "\\|") 721 "\\)\\>"))) 722 (goto-char (point-min)) 723 (while (re-search-forward keyword-re nil t) 724 (funcall change-word -1))))) 725 726 727 728;;; 729;;; Other functions 730;;; 731(defun pascal-set-auto-comments () 732 "Insert `{ case }' or `{ NAME }' on this line if appropriate. 733Insert `{ case }' if there is an `end' on the line which 734ends a case block. Insert `{ NAME }' if there is an `end' 735on the line which ends a function or procedure named NAME." 736 (save-excursion 737 (forward-line -1) 738 (skip-chars-forward " \t") 739 (if (and (looking-at "\\<end;") 740 (not (save-excursion 741 (end-of-line) 742 (search-backward "{" (pascal-get-beg-of-line) t)))) 743 (let ((type (car (pascal-calculate-indent)))) 744 (if (eq type 'declaration) 745 () 746 (if (eq type 'case) 747 ;; This is a case block 748 (progn 749 (end-of-line) 750 (delete-horizontal-space) 751 (insert " { case }")) 752 (let ((nest 1)) 753 ;; Check if this is the end of a function 754 (save-excursion 755 (while (not (or (looking-at pascal-defun-re) (bobp))) 756 (backward-sexp 1) 757 (cond ((looking-at pascal-beg-block-re) 758 (setq nest (1- nest))) 759 ((looking-at pascal-end-block-re) 760 (setq nest (1+ nest))))) 761 (if (bobp) 762 (setq nest 1))) 763 (if (zerop nest) 764 (progn 765 (end-of-line) 766 (delete-horizontal-space) 767 (insert " { ") 768 (let (b e) 769 (save-excursion 770 (setq b (progn (pascal-beg-of-defun) 771 (skip-chars-forward "^ \t") 772 (skip-chars-forward " \t") 773 (point)) 774 e (progn (skip-chars-forward "a-zA-Z0-9_") 775 (point)))) 776 (insert-buffer-substring (current-buffer) b e)) 777 (insert " }")))))))))) 778 779 780 781;;; 782;;; Indentation 783;;; 784(defconst pascal-indent-alist 785 '((block . (+ ind pascal-indent-level)) 786 (case . (+ ind pascal-case-indent)) 787 (caseblock . ind) (cpp . 0) 788 (declaration . (+ ind pascal-indent-level)) 789 (paramlist . (pascal-indent-paramlist t)) 790 (comment . (pascal-indent-comment)) 791 (defun . ind) (contexp . ind) 792 (unknown . ind) (string . 0) (progbeg . 0))) 793 794(defun pascal-indent-command () 795 "Indent for special part of code." 796 (let* ((indent-str (pascal-calculate-indent)) 797 (type (car indent-str))) 798 (cond ((and (eq type 'paramlist) 799 (or (memq 'all pascal-auto-lineup) 800 (memq 'paramlist pascal-auto-lineup))) 801 (pascal-indent-paramlist) 802 (pascal-indent-paramlist)) 803 ((and (eq type 'declaration) 804 (or (memq 'all pascal-auto-lineup) 805 (memq 'declaration pascal-auto-lineup))) 806 (pascal-indent-declaration)) 807 ((and (eq type 'case) (not (looking-at "^[ \t]*$")) 808 (or (memq 'all pascal-auto-lineup) 809 (memq 'case pascal-auto-lineup))) 810 (pascal-indent-case))) 811 (if (looking-at "[ \t]+$") 812 (skip-chars-forward " \t")))) 813 814(defun pascal-indent-line () 815 "Indent current line as a Pascal statement." 816 (let* ((indent-str (pascal-calculate-indent)) 817 (type (car indent-str)) 818 (ind (car (cdr indent-str)))) 819 ;; Labels should not be indented. 820 (if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]") 821 (not (eq type 'declaration))) 822 (search-forward ":" nil t)) 823 (delete-horizontal-space) 824 (cond (; Some things should not be indented 825 (or (and (eq type 'declaration) (looking-at pascal-declaration-re)) 826 (eq type 'cpp)) 827 ()) 828 (; Other things should have no extra indent 829 (looking-at pascal-noindent-re) 830 (indent-to ind)) 831 (; Nested functions should be indented 832 (looking-at pascal-defun-re) 833 (if (and pascal-indent-nested-functions 834 (eq type 'defun)) 835 (indent-to (+ ind pascal-indent-level)) 836 (indent-to ind))) 837 (; But most lines are treated this way 838 (indent-to (eval (cdr (assoc type pascal-indent-alist)))) 839 )))) 840 841(defun pascal-calculate-indent () 842 "Calculate the indent of the current Pascal line. 843Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." 844 (save-excursion 845 (let* ((parse-sexp-ignore-comments t) 846 (oldpos (point)) 847 (state (save-excursion (parse-partial-sexp (point-min) (point)))) 848 (nest 0) (par 0) (complete (looking-at "[ \t]*end\\>")) 849 (elsed (looking-at "[ \t]*else\\>")) (funccnt 0) 850 (did-func (looking-at "[ \t]*\\(procedure\\|function\\)\\>")) 851 (type (catch 'nesting 852 ;; Check if inside a string, comment or parenthesis 853 (cond ((nth 3 state) (throw 'nesting 'string)) 854 ((nth 4 state) (throw 'nesting 'comment)) 855 ((> (car state) 0) 856 (goto-char (scan-lists (point) -1 (car state))) 857 (setq par (1+ (current-column)))) 858 ((save-excursion (beginning-of-line) 859 (eq (following-char) ?#)) 860 (throw 'nesting 'cpp))) 861 ;; Loop until correct indent is found 862 (while t 863 (backward-sexp 1) 864 (cond (;--Escape from case statements 865 (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]") 866 (not complete) 867 (save-excursion (skip-chars-backward " \t") 868 (bolp)) 869 (= (save-excursion 870 (end-of-line) (backward-sexp) (point)) 871 (point)) 872 (> (save-excursion (goto-char oldpos) 873 (beginning-of-line) 874 (point)) 875 (point))) 876 (throw 'nesting 'caseblock)) 877 (;--Beginning of program 878 (looking-at pascal-progbeg-re) 879 (throw 'nesting 'progbeg)) 880 (;--No known statements 881 (bobp) 882 (throw 'nesting 'progbeg)) 883 (;--Nest block outwards 884 (looking-at pascal-beg-block-re) 885 (if (= nest 0) 886 (cond ((looking-at "case\\>") 887 (throw 'nesting 'case)) 888 ((looking-at "record\\>") 889 (throw 'nesting 'declaration)) 890 (t (throw 'nesting 'block))) 891 (if (and (looking-at "record\\>") (= nest 1)) 892 (setq funccnt (1- funccnt))) 893 (setq nest (1- nest)))) 894 (;--Nest block inwards 895 (looking-at pascal-end-block-re) 896 (if (and (looking-at "end\\s ") 897 elsed (not complete)) 898 (throw 'nesting 'block)) 899 (if (= nest 0) 900 (setq funccnt (1+ funccnt))) 901 (setq complete t 902 nest (1+ nest))) 903 (;--Defun (or parameter list) 904 (and (looking-at pascal-defun-re) 905 (progn (setq funccnt (1- funccnt) 906 did-func t) 907 (or (bolp) (< funccnt 0)))) 908 ;; Prevent searching whole buffer 909 (if (and (bolp) (>= funccnt 0)) 910 (throw 'nesting 'progbeg)) 911 (if (= 0 par) 912 (throw 'nesting 'defun) 913 (setq par 0) 914 (let ((n 0)) 915 (while (re-search-forward 916 "\\(\\<record\\>\\)\\|\\<end\\>" 917 oldpos t) 918 (if (match-end 1) 919 (setq n (1+ n)) (setq n (1- n)))) 920 (if (> n 0) 921 (throw 'nesting 'declaration) 922 (throw 'nesting 'paramlist))))) 923 (;--Declaration part 924 (and (looking-at pascal-declaration-re) 925 (not did-func) 926 (= funccnt 0)) 927 (if (save-excursion 928 (goto-char oldpos) 929 (forward-line -1) 930 (looking-at "^[ \t]*$")) 931 (throw 'nesting 'unknown) 932 (throw 'nesting 'declaration))) 933 (;--If, else or while statement 934 (and (not complete) 935 (looking-at pascal-sub-block-re)) 936 (throw 'nesting 'block)) 937 (;--Found complete statement 938 (save-excursion (forward-sexp 1) 939 (= (following-char) ?\;)) 940 (setq complete t)) 941 ))))) 942 943 ;; Return type of block and indent level. 944 (if (> par 0) ; Unclosed Parenthesis 945 (list 'contexp par) 946 (list type (pascal-indent-level)))))) 947 948(defun pascal-indent-level () 949 "Return the indent-level the current statement has. 950Do not count labels, case-statements or records." 951 (save-excursion 952 (beginning-of-line) 953 (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]") 954 (search-forward ":" nil t) 955 (if (looking-at ".*=[ \t]*record\\>") 956 (search-forward "=" nil t))) 957 (skip-chars-forward " \t") 958 (current-column))) 959 960(defun pascal-indent-comment () 961 "Return indent for current comment." 962 (save-excursion 963 (re-search-backward "\\((\\*\\)\\|{" nil t) 964 (if (match-beginning 1) 965 (1+ (current-column)) 966 (current-column)))) 967 968(defun pascal-indent-case () 969 "Indent within case statements." 970 (let ((savepos (point-marker)) 971 (end (prog2 972 (end-of-line) 973 (point-marker) 974 (re-search-backward "\\<case\\>" nil t))) 975 (beg (point)) 976 (ind 0)) 977 ;; Get right indent 978 (while (< (point) end) 979 (if (re-search-forward 980 "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:" 981 (marker-position end) 'move) 982 (forward-char -1)) 983 (if (< (point) end) 984 (progn 985 (delete-horizontal-space) 986 (if (> (current-column) ind) 987 (setq ind (current-column))) 988 (pascal-end-of-statement)))) 989 (goto-char beg) 990 ;; Indent all case statements 991 (while (< (point) end) 992 (if (re-search-forward 993 "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:" 994 (marker-position end) 'move) 995 (forward-char -1)) 996 (indent-to (1+ ind)) 997 (if (/= (following-char) ?:) 998 () 999 (forward-char 1) 1000 (delete-horizontal-space) 1001 (insert " ")) 1002 (pascal-end-of-statement)) 1003 (goto-char savepos))) 1004 1005(defun pascal-indent-paramlist (&optional arg) 1006 "Indent current line in parameterlist. 1007If optional arg is non-nil, just return the 1008indent of the current line in parameterlist." 1009 (save-excursion 1010 (let* ((oldpos (point)) 1011 (stpos (progn (goto-char (scan-lists (point) -1 1)) (point))) 1012 (stcol (1+ (current-column))) 1013 (edpos (progn (pascal-declaration-end) 1014 (search-backward ")" (pascal-get-beg-of-line) t) 1015 (point))) 1016 (usevar (re-search-backward "\\<var\\>" stpos t))) 1017 (if arg (progn 1018 ;; If arg, just return indent 1019 (goto-char oldpos) 1020 (beginning-of-line) 1021 (if (or (not usevar) (looking-at "[ \t]*var\\>")) 1022 stcol (+ 4 stcol))) 1023 (goto-char stpos) 1024 (forward-char 1) 1025 (delete-horizontal-space) 1026 (if (and usevar (not (looking-at "var\\>"))) 1027 (indent-to (+ 4 stcol))) 1028 (pascal-indent-declaration nil stpos edpos))))) 1029 1030(defun pascal-indent-declaration (&optional arg start end) 1031 "Indent current lines as declaration, lining up the `:'s or `='s." 1032 (let ((pos (point-marker))) 1033 (if (and (not (or arg start)) (not (pascal-declaration-beg))) 1034 () 1035 (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start) 1036 ":" "=")) 1037 (stpos (if start start 1038 (forward-word 2) (backward-word 1) (point))) 1039 (edpos (set-marker (make-marker) 1040 (if end end 1041 (max (progn (pascal-declaration-end) 1042 (point)) 1043 pos)))) 1044 ind) 1045 1046 (goto-char stpos) 1047 ;; Indent lines in record block 1048 (if arg 1049 (while (<= (point) edpos) 1050 (beginning-of-line) 1051 (delete-horizontal-space) 1052 (if (looking-at "end\\>") 1053 (indent-to arg) 1054 (indent-to (+ arg pascal-indent-level))) 1055 (forward-line 1))) 1056 1057 ;; Do lineup 1058 (setq ind (pascal-get-lineup-indent stpos edpos lineup)) 1059 (goto-char stpos) 1060 (while (and (<= (point) edpos) (not (eobp))) 1061 (if (search-forward lineup (pascal-get-end-of-line) 'move) 1062 (forward-char -1)) 1063 (delete-horizontal-space) 1064 (indent-to ind) 1065 (if (not (looking-at lineup)) 1066 (forward-line 1) ; No more indent if there is no : or = 1067 (forward-char 1) 1068 (delete-horizontal-space) 1069 (insert " ") 1070 ;; Indent record block 1071 (if (looking-at "record\\>") 1072 (pascal-indent-declaration (current-column))) 1073 (forward-line 1))))) 1074 1075 ;; If arg - move point 1076 (if arg (forward-line -1) 1077 (goto-char pos)))) 1078 1079; "Return the indent level that will line up several lines within the region 1080;from b to e nicely. The lineup string is str." 1081(defun pascal-get-lineup-indent (b e str) 1082 (save-excursion 1083 (let ((ind 0) 1084 (reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re))) 1085 (goto-char b) 1086 ;; Get rightmost position 1087 (while (< (point) e) 1088 (and (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move) 1089 (cond ((match-beginning 1) 1090 ;; Skip record blocks 1091 (pascal-declaration-end)) 1092 ((match-beginning 2) 1093 ;; We have entered a new procedure. Exit. 1094 (goto-char e)) 1095 (t 1096 (goto-char (match-beginning 0)) 1097 (skip-chars-backward " \t") 1098 (if (> (current-column) ind) 1099 (setq ind (current-column))) 1100 (goto-char (match-end 0)) 1101 (end-of-line) 1102 )))) 1103 ;; In case no lineup was found 1104 (if (> ind 0) 1105 (1+ ind) 1106 ;; No lineup-string found 1107 (goto-char b) 1108 (end-of-line) 1109 (skip-chars-backward " \t") 1110 (1+ (current-column)))))) 1111 1112 1113 1114;;; 1115;;; Completion 1116;;; 1117(defvar pascal-str nil) 1118(defvar pascal-all nil) 1119(defvar pascal-pred nil) 1120(defvar pascal-buffer-to-use nil) 1121(defvar pascal-flag nil) 1122 1123(defun pascal-string-diff (str1 str2) 1124 "Return index of first letter where STR1 and STR2 differs." 1125 (catch 'done 1126 (let ((diff 0)) 1127 (while t 1128 (if (or (> (1+ diff) (length str1)) 1129 (> (1+ diff) (length str2))) 1130 (throw 'done diff)) 1131 (or (equal (aref str1 diff) (aref str2 diff)) 1132 (throw 'done diff)) 1133 (setq diff (1+ diff)))))) 1134 1135;; Calculate all possible completions for functions if argument is `function', 1136;; completions for procedures if argument is `procedure' or both functions and 1137;; procedures otherwise. 1138 1139(defun pascal-func-completion (type) 1140 ;; Build regular expression for function/procedure names 1141 (if (string= pascal-str "") 1142 (setq pascal-str "[a-zA-Z_]")) 1143 (let ((pascal-str (concat (cond 1144 ((eq type 'procedure) "\\<\\(procedure\\)\\s +") 1145 ((eq type 'function) "\\<\\(function\\)\\s +") 1146 (t "\\<\\(function\\|procedure\\)\\s +")) 1147 "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>")) 1148 match) 1149 1150 (if (not (looking-at "\\<\\(function\\|procedure\\)\\>")) 1151 (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t)) 1152 (forward-char 1) 1153 1154 ;; Search through all reachable functions 1155 (while (pascal-beg-of-defun) 1156 (if (re-search-forward pascal-str (pascal-get-end-of-line) t) 1157 (progn (setq match (buffer-substring (match-beginning 2) 1158 (match-end 2))) 1159 (if (or (null pascal-pred) 1160 (funcall pascal-pred match)) 1161 (setq pascal-all (cons match pascal-all))))) 1162 (goto-char (match-beginning 0))))) 1163 1164(defun pascal-get-completion-decl () 1165 ;; Macro for searching through current declaration (var, type or const) 1166 ;; for matches of `str' and adding the occurrence to `all' 1167 (let ((end (save-excursion (pascal-declaration-end) 1168 (point))) 1169 match) 1170 ;; Traverse lines 1171 (while (< (point) end) 1172 (if (re-search-forward "[:=]" (pascal-get-end-of-line) t) 1173 ;; Traverse current line 1174 (while (and (re-search-backward 1175 (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" 1176 pascal-symbol-re) 1177 (pascal-get-beg-of-line) t) 1178 (not (match-end 1))) 1179 (setq match (buffer-substring (match-beginning 0) (match-end 0))) 1180 (if (string-match (concat "\\<" pascal-str) match) 1181 (if (or (null pascal-pred) 1182 (funcall pascal-pred match)) 1183 (setq pascal-all (cons match pascal-all)))))) 1184 (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t) 1185 (pascal-declaration-end) 1186 (forward-line 1))))) 1187 1188(defun pascal-type-completion () 1189 "Calculate all possible completions for types." 1190 (let ((start (point)) 1191 goon) 1192 ;; Search for all reachable type declarations 1193 (while (or (pascal-beg-of-defun) 1194 (setq goon (not goon))) 1195 (save-excursion 1196 (if (and (< start (prog1 (save-excursion (pascal-end-of-defun) 1197 (point)) 1198 (forward-char 1))) 1199 (re-search-forward 1200 "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>" 1201 start t) 1202 (not (match-end 1))) 1203 ;; Check current type declaration 1204 (pascal-get-completion-decl)))))) 1205 1206(defun pascal-var-completion () 1207 "Calculate all possible completions for variables (or constants)." 1208 (let ((start (point)) 1209 goon twice) 1210 ;; Search for all reachable var declarations 1211 (while (or (pascal-beg-of-defun) 1212 (setq goon (not goon))) 1213 (save-excursion 1214 (if (> start (prog1 (save-excursion (pascal-end-of-defun) 1215 (point)))) 1216 () ; Declarations not reachable 1217 (if (search-forward "(" (pascal-get-end-of-line) t) 1218 ;; Check parameterlist 1219 (pascal-get-completion-decl)) 1220 (setq twice 2) 1221 (while (>= (setq twice (1- twice)) 0) 1222 (cond ((and (re-search-forward 1223 (concat "\\<\\(var\\|const\\)\\>\\|" 1224 "\\<\\(begin\\|function\\|procedure\\)\\>") 1225 start t) 1226 (not (match-end 2))) 1227 ;; Check var/const declarations 1228 (pascal-get-completion-decl)) 1229 ((match-end 2) 1230 (setq twice 0))))))))) 1231 1232 1233(defun pascal-keyword-completion (keyword-list) 1234 "Give list of all possible completions of keywords in KEYWORD-LIST." 1235 (mapcar '(lambda (s) 1236 (if (string-match (concat "\\<" pascal-str) s) 1237 (if (or (null pascal-pred) 1238 (funcall pascal-pred s)) 1239 (setq pascal-all (cons s pascal-all))))) 1240 keyword-list)) 1241 1242;; Function passed to completing-read, try-completion or 1243;; all-completions to get completion on STR. If predicate is non-nil, 1244;; it must be a function to be called for every match to check if this 1245;; should really be a match. If flag is t, the function returns a list 1246;; of all possible completions. If it is nil it returns a string, the 1247;; longest possible completion, or t if STR is an exact match. If flag 1248;; is 'lambda, the function returns t if STR is an exact match, nil 1249;; otherwise. 1250 1251(defun pascal-completion (pascal-str pascal-pred pascal-flag) 1252 (save-excursion 1253 (let ((pascal-all nil)) 1254 ;; Set buffer to use for searching labels. This should be set 1255 ;; within functions which use pascal-completions 1256 (set-buffer pascal-buffer-to-use) 1257 1258 ;; Determine what should be completed 1259 (let ((state (car (pascal-calculate-indent)))) 1260 (cond (;--Within a declaration or parameterlist 1261 (or (eq state 'declaration) (eq state 'paramlist) 1262 (and (eq state 'defun) 1263 (save-excursion 1264 (re-search-backward ")[ \t]*:" 1265 (pascal-get-beg-of-line) t)))) 1266 (if (or (eq state 'paramlist) (eq state 'defun)) 1267 (pascal-beg-of-defun)) 1268 (pascal-type-completion) 1269 (pascal-keyword-completion pascal-type-keywords)) 1270 (;--Starting a new statement 1271 (and (not (eq state 'contexp)) 1272 (save-excursion 1273 (skip-chars-backward "a-zA-Z0-9_.") 1274 (backward-sexp 1) 1275 (or (looking-at pascal-nosemi-re) 1276 (progn 1277 (forward-sexp 1) 1278 (looking-at "\\s *\\(;\\|:[^=]\\)"))))) 1279 (save-excursion (pascal-var-completion)) 1280 (pascal-func-completion 'procedure) 1281 (pascal-keyword-completion pascal-start-keywords)) 1282 (t;--Anywhere else 1283 (save-excursion (pascal-var-completion)) 1284 (pascal-func-completion 'function) 1285 (pascal-keyword-completion pascal-separator-keywords)))) 1286 1287 ;; Now we have built a list of all matches. Give response to caller 1288 (pascal-completion-response)))) 1289 1290(defun pascal-completion-response () 1291 (cond ((or (equal pascal-flag 'lambda) (null pascal-flag)) 1292 ;; This was not called by all-completions 1293 (if (null pascal-all) 1294 ;; Return nil if there was no matching label 1295 nil 1296 ;; Get longest string common in the labels 1297 (let* ((elm (cdr pascal-all)) 1298 (match (car pascal-all)) 1299 (min (length match)) 1300 tmp) 1301 (if (string= match pascal-str) 1302 ;; Return t if first match was an exact match 1303 (setq match t) 1304 (while (not (null elm)) 1305 ;; Find longest common string 1306 (if (< (setq tmp (pascal-string-diff match (car elm))) min) 1307 (progn 1308 (setq min tmp) 1309 (setq match (substring match 0 min)))) 1310 ;; Terminate with match=t if this is an exact match 1311 (if (string= (car elm) pascal-str) 1312 (progn 1313 (setq match t) 1314 (setq elm nil)) 1315 (setq elm (cdr elm))))) 1316 ;; If this is a test just for exact match, return nil ot t 1317 (if (and (equal pascal-flag 'lambda) (not (equal match 't))) 1318 nil 1319 match)))) 1320 ;; If flag is t, this was called by all-completions. Return 1321 ;; list of all possible completions 1322 (pascal-flag 1323 pascal-all))) 1324 1325(defvar pascal-last-word-numb 0) 1326(defvar pascal-last-word-shown nil) 1327(defvar pascal-last-completions nil) 1328 1329(defun pascal-complete-word () 1330 "Complete word at current point. 1331\(See also `pascal-toggle-completions', `pascal-type-keywords', 1332`pascal-start-keywords' and `pascal-separator-keywords'.)" 1333 (interactive) 1334 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) 1335 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) 1336 (pascal-str (buffer-substring b e)) 1337 ;; The following variable is used in pascal-completion 1338 (pascal-buffer-to-use (current-buffer)) 1339 (allcomp (if (and pascal-toggle-completions 1340 (string= pascal-last-word-shown pascal-str)) 1341 pascal-last-completions 1342 (all-completions pascal-str 'pascal-completion))) 1343 (match (if pascal-toggle-completions 1344 "" (try-completion 1345 pascal-str (mapcar '(lambda (elm) 1346 (cons elm 0)) allcomp))))) 1347 ;; Delete old string 1348 (delete-region b e) 1349 1350 ;; Toggle-completions inserts whole labels 1351 (if pascal-toggle-completions 1352 (progn 1353 ;; Update entry number in list 1354 (setq pascal-last-completions allcomp 1355 pascal-last-word-numb 1356 (if (>= pascal-last-word-numb (1- (length allcomp))) 1357 0 1358 (1+ pascal-last-word-numb))) 1359 (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb)) 1360 ;; Display next match or same string if no match was found 1361 (if (not (null allcomp)) 1362 (insert "" pascal-last-word-shown) 1363 (insert "" pascal-str) 1364 (message "(No match)"))) 1365 ;; The other form of completion does not necessarily do that. 1366 1367 ;; Insert match if found, or the original string if no match 1368 (if (or (null match) (equal match 't)) 1369 (progn (insert "" pascal-str) 1370 (message "(No match)")) 1371 (insert "" match)) 1372 ;; Give message about current status of completion 1373 (cond ((equal match 't) 1374 (if (not (null (cdr allcomp))) 1375 (message "(Complete but not unique)") 1376 (message "(Sole completion)"))) 1377 ;; Display buffer if the current completion didn't help 1378 ;; on completing the label. 1379 ((and (not (null (cdr allcomp))) (= (length pascal-str) 1380 (length match))) 1381 (with-output-to-temp-buffer "*Completions*" 1382 (display-completion-list allcomp pascal-str)) 1383 ;; Wait for a keypress. Then delete *Completion* window 1384 (momentary-string-display "" (point)) 1385 (delete-window (get-buffer-window (get-buffer "*Completions*"))) 1386 ))))) 1387 1388(defun pascal-show-completions () 1389 "Show all possible completions at current point." 1390 (interactive) 1391 (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) 1392 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) 1393 (pascal-str (buffer-substring b e)) 1394 ;; The following variable is used in pascal-completion 1395 (pascal-buffer-to-use (current-buffer)) 1396 (allcomp (if (and pascal-toggle-completions 1397 (string= pascal-last-word-shown pascal-str)) 1398 pascal-last-completions 1399 (all-completions pascal-str 'pascal-completion)))) 1400 ;; Show possible completions in a temporary buffer. 1401 (with-output-to-temp-buffer "*Completions*" 1402 (display-completion-list allcomp pascal-str)) 1403 ;; Wait for a keypress. Then delete *Completion* window 1404 (momentary-string-display "" (point)) 1405 (delete-window (get-buffer-window (get-buffer "*Completions*"))))) 1406 1407 1408(defun pascal-get-default-symbol () 1409 "Return symbol around current point as a string." 1410 (save-excursion 1411 (buffer-substring (progn 1412 (skip-chars-backward " \t") 1413 (skip-chars-backward "a-zA-Z0-9_") 1414 (point)) 1415 (progn 1416 (skip-chars-forward "a-zA-Z0-9_") 1417 (point))))) 1418 1419(defun pascal-build-defun-re (str &optional arg) 1420 "Return function/procedure starting with STR as regular expression. 1421With optional second arg non-nil, STR is the complete name of the instruction." 1422 (if arg 1423 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>") 1424 (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>"))) 1425 1426;; Function passed to completing-read, try-completion or 1427;; all-completions to get completion on any function name. If 1428;; predicate is non-nil, it must be a function to be called for every 1429;; match to check if this should really be a match. If flag is t, the 1430;; function returns a list of all possible completions. If it is nil 1431;; it returns a string, the longest possible completion, or t if STR 1432;; is an exact match. If flag is 'lambda, the function returns t if 1433;; STR is an exact match, nil otherwise. 1434 1435(defun pascal-comp-defun (pascal-str pascal-pred pascal-flag) 1436 (save-excursion 1437 (let ((pascal-all nil) 1438 match) 1439 1440 ;; Set buffer to use for searching labels. This should be set 1441 ;; within functions which use pascal-completions 1442 (set-buffer pascal-buffer-to-use) 1443 1444 (let ((pascal-str pascal-str)) 1445 ;; Build regular expression for functions 1446 (if (string= pascal-str "") 1447 (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]")) 1448 (setq pascal-str (pascal-build-defun-re pascal-str))) 1449 (goto-char (point-min)) 1450 1451 ;; Build a list of all possible completions 1452 (while (re-search-forward pascal-str nil t) 1453 (setq match (buffer-substring (match-beginning 2) (match-end 2))) 1454 (if (or (null pascal-pred) 1455 (funcall pascal-pred match)) 1456 (setq pascal-all (cons match pascal-all))))) 1457 1458 ;; Now we have built a list of all matches. Give response to caller 1459 (pascal-completion-response)))) 1460 1461(defun pascal-goto-defun () 1462 "Move to specified Pascal function/procedure. 1463The default is a name found in the buffer around point." 1464 (interactive) 1465 (let* ((default (pascal-get-default-symbol)) 1466 ;; The following variable is used in pascal-comp-function 1467 (pascal-buffer-to-use (current-buffer)) 1468 (default (if (pascal-comp-defun default nil 'lambda) 1469 default "")) 1470 (label (if (not (string= default "")) 1471 ;; Do completion with default 1472 (completing-read (concat "Label (default " default "): ") 1473 'pascal-comp-defun nil t "") 1474 ;; There is no default value. Complete without it 1475 (completing-read "Label: " 1476 'pascal-comp-defun nil t "")))) 1477 ;; If there was no response on prompt, use default value 1478 (if (string= label "") 1479 (setq label default)) 1480 ;; Goto right place in buffer if label is not an empty string 1481 (or (string= label "") 1482 (progn 1483 (goto-char (point-min)) 1484 (re-search-forward (pascal-build-defun-re label t)) 1485 (beginning-of-line))))) 1486 1487 1488 1489;;; 1490;;; Pascal-outline-mode 1491;;; 1492(defvar pascal-outline-map 1493 (let ((map (make-sparse-keymap))) 1494 (if (fboundp 'set-keymap-name) 1495 (set-keymap-name pascal-outline-map 'pascal-outline-map)) 1496 (define-key map "\M-\C-a" 'pascal-outline-prev-defun) 1497 (define-key map "\M-\C-e" 'pascal-outline-next-defun) 1498 (define-key map "\C-c\C-d" 'pascal-outline-goto-defun) 1499 (define-key map "\C-c\C-s" 'pascal-show-all) 1500 (define-key map "\C-c\C-h" 'pascal-hide-other-defuns) 1501 map) 1502 "Keymap used in Pascal Outline mode.") 1503 1504(define-obsolete-function-alias 'pascal-outline 'pascal-outline-mode) 1505(define-minor-mode pascal-outline-mode 1506 "Outline-line minor mode for Pascal mode. 1507When in Pascal Outline mode, portions 1508of the text being edited may be made invisible. \\<pascal-outline-map> 1509 1510Pascal Outline mode provides some additional commands. 1511 1512\\[pascal-outline-prev-defun]\ 1513\t- Move to previous function/procedure, hiding everything else. 1514\\[pascal-outline-next-defun]\ 1515\t- Move to next function/procedure, hiding everything else. 1516\\[pascal-outline-goto-defun]\ 1517\t- Goto function/procedure prompted for in minibuffer, 1518\t hide all other functions. 1519\\[pascal-show-all]\t- Show the whole buffer. 1520\\[pascal-hide-other-defuns]\ 1521\t- Hide everything but the current function (function under the cursor). 1522\\[pascal-outline]\t- Leave pascal-outline-mode." 1523 :init-value nil :lighter " Outl" :keymap pascal-outline-map 1524 (add-to-invisibility-spec '(pascal . t)) 1525 (unless pascal-outline-mode 1526 (pascal-show-all))) 1527 1528(defun pascal-outline-change (b e pascal-flag) 1529 (save-excursion 1530 ;; This used to use selective display so the boundaries used by the 1531 ;; callers didn't have to be precise, since it just looked for \n or \^M 1532 ;; and switched them. 1533 (goto-char b) (setq b (line-end-position)) 1534 (goto-char e) (setq e (line-end-position))) 1535 (when (> e b) 1536 ;; We could try and optimize this in the case where the region is 1537 ;; already hidden. But I'm not sure it's worth the trouble. 1538 (remove-overlays b e 'invisible 'pascal) 1539 (when (eq pascal-flag ?\^M) 1540 (let ((ol (make-overlay b e nil t nil))) 1541 (overlay-put ol 'invisible 'pascal) 1542 (overlay-put ol 'evaporate t))))) 1543 1544(defun pascal-show-all () 1545 "Show all of the text in the buffer." 1546 (interactive) 1547 (pascal-outline-change (point-min) (point-max) ?\n)) 1548 1549(defun pascal-hide-other-defuns () 1550 "Show only the current defun." 1551 (interactive) 1552 (save-excursion 1553 (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>")) 1554 (pascal-beg-of-defun)) 1555 (point))) 1556 (end (progn (pascal-end-of-defun) 1557 (backward-sexp 1) 1558 (search-forward "\n\\|\^M" nil t) 1559 (point))) 1560 (opoint (point-min))) 1561 (goto-char (point-min)) 1562 1563 ;; Hide all functions before current function 1564 (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move) 1565 (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) 1566 (setq opoint (point)) 1567 ;; Functions may be nested 1568 (if (> (progn (pascal-end-of-defun) (point)) beg) 1569 (goto-char opoint))) 1570 (if (> beg opoint) 1571 (pascal-outline-change opoint (1- beg) ?\^M)) 1572 1573 ;; Show current function 1574 (pascal-outline-change beg end ?\n) 1575 ;; Hide nested functions 1576 (forward-char 1) 1577 (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move) 1578 (setq opoint (point)) 1579 (pascal-end-of-defun) 1580 (pascal-outline-change opoint (point) ?\^M)) 1581 1582 (goto-char end) 1583 (setq opoint end) 1584 1585 ;; Hide all function after current function 1586 (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move) 1587 (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) 1588 (setq opoint (point)) 1589 (pascal-end-of-defun)) 1590 (pascal-outline-change opoint (point-max) ?\^M) 1591 1592 ;; Hide main program 1593 (if (< (progn (forward-line -1) (point)) end) 1594 (progn 1595 (goto-char beg) 1596 (pascal-end-of-defun) 1597 (backward-sexp 1) 1598 (pascal-outline-change (point) (point-max) ?\^M)))))) 1599 1600(defun pascal-outline-next-defun () 1601 "Move to next function/procedure, hiding all others." 1602 (interactive) 1603 (pascal-end-of-defun) 1604 (pascal-hide-other-defuns)) 1605 1606(defun pascal-outline-prev-defun () 1607 "Move to previous function/procedure, hiding all others." 1608 (interactive) 1609 (pascal-beg-of-defun) 1610 (pascal-hide-other-defuns)) 1611 1612(defun pascal-outline-goto-defun () 1613 "Move to specified function/procedure, hiding all others." 1614 (interactive) 1615 (pascal-goto-defun) 1616 (pascal-hide-other-defuns)) 1617 1618(provide 'pascal) 1619 1620;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5 1621;;; pascal.el ends here 1622