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