diff options
| author | Richard M. Stallman | 1994-02-01 18:14:56 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-02-01 18:14:56 +0000 |
| commit | da4ce263a3d1a185f0c004260c90f55960ff9d32 (patch) | |
| tree | 813be358e259aa44e84bc2260bf73d4cd8c54001 | |
| parent | e70991d4203e889c35806ec8f5890579d9f78f80 (diff) | |
| download | emacs-da4ce263a3d1a185f0c004260c90f55960ff9d32.tar.gz emacs-da4ce263a3d1a185f0c004260c90f55960ff9d32.zip | |
Many doc fixes.
(pascal-get-beg-of-line, pascal-get-end-of-line):
Use defsubst. Renamed from get-...
(pascal-within-string): Use defsubst.
(delete-whitespaces): Function deleted;
callers use delete-horizontal-space instead.
(pascal-string-diff): Renamed from string-diff.
Complete rewrite. Added an outline- minor-mode and completion.
| -rw-r--r-- | lisp/progmodes/pascal.el | 1869 |
1 files changed, 1143 insertions, 726 deletions
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index cf5d2589029..469c9c1a9ce 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el | |||
| @@ -1,74 +1,65 @@ | |||
| 1 | ;;; pascal.el - Major mode for editing pascal source in emacs. | 1 | ;;; pascal.el - Major mode for editing pascal source in emacs. |
| 2 | 2 | ||
| 3 | ;;; Copyright (C) 1993 Free Software Foundation, Inc. | 3 | ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Espen Skoglund (espensk@stud.cs.uit.no) | 5 | ;;; Author: Espen Skoglund (espensk@stud.cs.uit.no) |
| 6 | ;; Keywords: languages | 6 | ;;; Keywords: languages |
| 7 | 7 | ||
| 8 | ;; This file is part of GNU Emacs. | 8 | ;;; This file is part of GNU Emacs. |
| 9 | 9 | ||
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | 10 | ;;; This program is free software; you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by | 11 | ;;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) | 12 | ;;; the Free Software Foundation; either version 2 of the License, or |
| 13 | ;; any later version. | 13 | ;;; (at your option) any later version. |
| 14 | 14 | ||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | 15 | ;;; This program is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. | 18 | ;;; GNU General Public License for more details. |
| 19 | 19 | ||
| 20 | ;; You should have received a copy of the GNU General Public License | 20 | ;;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to | 21 | ;;; along with this program; if not, write to the Free Software |
| 22 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 22 | ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
| 23 | 23 | ||
| 24 | ;;; Commentary: | 24 | ;;; Commentary: |
| 25 | 25 | ||
| 26 | ;;; If you want to customize the pascal mode in your startup file, you | ||
| 27 | ;;; can add these lines to your .emacs file (and remove the ;s at the | ||
| 28 | ;;; beginning of the line): | ||
| 29 | ;;; | ||
| 30 | ;;; ;;; Pascal-mode custumization. | ||
| 31 | ;;; (autoload 'pascal-mode "pascal-mode" nil t) | ||
| 32 | ;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode) | ||
| 33 | ;;; (cons "\\.pas$" 'pascal-mode)) | ||
| 34 | ;;; auto-mode-alist)) | ||
| 35 | ;;; (setq pascal-mode-hook '(lambda () | ||
| 36 | ;;; ;; User specifications | ||
| 37 | ;;; (setq pascal-tab-always-indent t | ||
| 38 | ;;; pascal-auto-newline nil | ||
| 39 | ;;; pascal-auto-endcomments t | ||
| 40 | ;;; pascal-indent-level 3 | ||
| 41 | ;;; pascal-continued-expr 1 | ||
| 42 | ;;; pascal-label-offset -2 | ||
| 43 | ;;; pascal-case-offset 2 | ||
| 44 | ;;; pascal-typedecl-indent 10 | ||
| 45 | ;;; pascal-vardecl-indent 20))) | ||
| 46 | |||
| 47 | ;;; USAGE | 26 | ;;; USAGE |
| 48 | ;;; ===== | 27 | ;;; ===== |
| 49 | ;;; If you have modified your startup file as described above, emacs | 28 | |
| 50 | ;;; should enter pascal-mode when you load a pascal source into emacs. | 29 | ;;; Emacs should enter Pascal mode when you find a Pascal source file. |
| 51 | ;;; If not, you will have to start pascal-mode manually: | 30 | ;;; When you have entered Pascal mode, you may get more info by pressing |
| 52 | ;;; M-x load-library pascal-mode | ||
| 53 | ;;; M-x pascal-mode | ||
| 54 | ;;; When you have entered pascal-mode, you may get more info by pressing | ||
| 55 | ;;; C-h m. You may also get online help describing various functions by: | 31 | ;;; C-h m. You may also get online help describing various functions by: |
| 56 | ;;; C-h d <Name of function you want described> | 32 | ;;; C-h f <Name of function you want described> |
| 33 | |||
| 34 | ;;; If you want to customize Pascal mode to fit you better, you may add | ||
| 35 | ;;; these lines (the values of the variables presented here are the defaults): | ||
| 36 | ;;; | ||
| 37 | ;;; ;; User customization for Pascal mode | ||
| 38 | ;;; (setq pascal-indent-level 3 | ||
| 39 | ;;; pascal-case-indent 2 | ||
| 40 | ;;; pascal-auto-newline nil | ||
| 41 | ;;; pascal-tab-always-indent t | ||
| 42 | ;;; pascal-auto-endcomments t | ||
| 43 | ;;; pascal-toggle-completions nil | ||
| 44 | ;;; pascal-type-keywords '("array" "file" "packed" "char" | ||
| 45 | ;;; "integer" "real" "string" "record") | ||
| 46 | ;;; pascal-start-keywords '("begin" "end" "function" "procedure" | ||
| 47 | ;;; "repeat" "until" "while" "read" "readln" | ||
| 48 | ;;; "reset" "rewrite" "write" "writeln") | ||
| 49 | ;;; pascal-seperator-keywords '("downto" "else" "mod" "div" "then")) | ||
| 57 | 50 | ||
| 58 | ;;; KNOWN BUGS / BUGREPORTS | 51 | ;;; KNOWN BUGS / BUGREPORTS |
| 59 | ;;; ======================= | 52 | ;;; ======================= |
| 60 | ;;; As far as I know, there are no bugs in the current version of this | 53 | ;;; As far as I know, there are no bugs in the current version of this |
| 61 | ;;; package. This may not be true however, since I never use this mode | 54 | ;;; package. This may not be true however, since I never use this mode |
| 62 | ;;; myself and therefore would never notice them anyway. But if you DO | 55 | ;;; myself and therefore would never notice them anyway. If you do |
| 63 | ;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no | 56 | ;;; find any bugs, you may submit them to: espensk@stud.cs.uit.no |
| 64 | 57 | ;;; as well as to bug-gnu-emacs@prep.ai.mit.edu. | |
| 65 | ;;; LCD Archive Entry: | 58 | |
| 66 | ;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no| | 59 | ;;; Code: |
| 67 | ;;; Major mode for editing Pascal code| | ||
| 68 | ;;; 14-Sep-93|$Revision: 1.3 $|~/modes/pascal-mode.el.Z| | ||
| 69 | 60 | ||
| 70 | (defconst pascal-mode-version "1.3" | 61 | (defconst pascal-mode-version "2.1a" |
| 71 | "Version of this pascal mode.") | 62 | "Version of `pascal-mode.el'.") |
| 72 | 63 | ||
| 73 | (defvar pascal-mode-abbrev-table nil | 64 | (defvar pascal-mode-abbrev-table nil |
| 74 | "Abbrev table in use in Pascal-mode buffers.") | 65 | "Abbrev table in use in Pascal-mode buffers.") |
| @@ -76,37 +67,60 @@ | |||
| 76 | 67 | ||
| 77 | (defvar pascal-mode-map () | 68 | (defvar pascal-mode-map () |
| 78 | "Keymap used in Pascal mode.") | 69 | "Keymap used in Pascal mode.") |
| 79 | (if (null pascal-mode-map) | 70 | (if pascal-mode-map |
| 80 | (setq pascal-mode-map (make-sparse-keymap))) | 71 | () |
| 81 | 72 | (setq pascal-mode-map (make-sparse-keymap)) | |
| 82 | (define-key pascal-mode-map ";" 'electric-pascal-semi) | 73 | (define-key pascal-mode-map ";" 'electric-pascal-semi-or-dot) |
| 83 | (define-key pascal-mode-map "." 'electric-pascal-dot) | 74 | (define-key pascal-mode-map "." 'electric-pascal-semi-or-dot) |
| 84 | (define-key pascal-mode-map ":" 'electric-pascal-colon) | 75 | (define-key pascal-mode-map ":" 'electric-pascal-colon) |
| 85 | (define-key pascal-mode-map "=" 'electric-pascal-equal) | 76 | (define-key pascal-mode-map "=" 'electric-pascal-equal) |
| 86 | (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line) | 77 | (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line) |
| 87 | (define-key pascal-mode-map "\t" 'electric-pascal-tab) | 78 | (define-key pascal-mode-map "\t" 'electric-pascal-tab) |
| 88 | (define-key pascal-mode-map "\177" 'backward-delete-char-untabify) | 79 | (define-key pascal-mode-map "\e\t" 'pascal-complete-word) |
| 89 | (define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function) | 80 | (define-key pascal-mode-map "\e?" 'pascal-show-completions) |
| 90 | (define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function) | 81 | (define-key pascal-mode-map "\177" 'backward-delete-char-untabify) |
| 91 | (define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function) | 82 | (define-key pascal-mode-map "\e\C-h" 'pascal-mark-defun) |
| 92 | (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block) | 83 | (define-key pascal-mode-map "\C-cb" 'pascal-insert-block) |
| 93 | (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area) | 84 | (define-key pascal-mode-map "\M-*" 'pascal-star-comment) |
| 94 | (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area) | 85 | (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area) |
| 95 | (define-key pascal-mode-map "\M-*" 'pascal-star-comment) | 86 | (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area) |
| 96 | 87 | (define-key pascal-mode-map "\e\C-a" 'pascal-beg-of-defun) | |
| 88 | (define-key pascal-mode-map "\e\C-e" 'pascal-end-of-defun) | ||
| 89 | (define-key pascal-mode-map "\C-cg" 'pascal-goto-defun) | ||
| 90 | (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline) | ||
| 97 | ;;; A command to change the whole buffer won't be used terribly | 91 | ;;; A command to change the whole buffer won't be used terribly |
| 98 | ;;; often, so no need for a key binding. | 92 | ;;; often, so no need for a key binding. |
| 99 | ;;;(define-key pascal-mode-map "\C-c\C-l" 'pascal-downcase-keywords) | 93 | ; (define-key pascal-mode-map "\C-cd" 'pascal-downcase-keywords) |
| 100 | ;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords) | 94 | ; (define-key pascal-mode-map "\C-cu" 'pascal-upcase-keywords) |
| 101 | ;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords) | 95 | ; (define-key pascal-mode-map "\C-cc" 'pascal-capitalize-keywords) |
| 102 | 96 | ) | |
| 103 | (defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do" | 97 | |
| 104 | "downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod" | 98 | (defvar pascal-keywords |
| 105 | "nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set" | 99 | '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end" |
| 106 | "then" "to" "type" "until" "var" "while" "with" | 100 | "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of" |
| 107 | ;; The following are not standard in pascal, but widely used. | 101 | "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to" |
| 108 | "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write" | 102 | "type" "until" "var" "while" "with" |
| 109 | "writeln")) | 103 | ;; The following are not standard in pascal, but widely used. |
| 104 | "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write" | ||
| 105 | "writeln")) | ||
| 106 | |||
| 107 | ;;; | ||
| 108 | ;;; Regular expressions used to calculate indent, etc. | ||
| 109 | ;;; | ||
| 110 | (defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>") | ||
| 111 | (defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>") | ||
| 112 | (defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>") | ||
| 113 | (defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>") | ||
| 114 | (defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>") | ||
| 115 | (defconst pascal-sub-block-re "\\<\\(if\\|else\\|while\\)\\>") | ||
| 116 | (defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\)\\>") | ||
| 117 | (defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>") | ||
| 118 | (defconst pascal-autoindent-lines-re | ||
| 119 | "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>") | ||
| 120 | |||
| 121 | ;;; Strings used to mark beginning and end of excluded text | ||
| 122 | (defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----") | ||
| 123 | (defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}") | ||
| 110 | 124 | ||
| 111 | (defvar pascal-mode-syntax-table nil | 125 | (defvar pascal-mode-syntax-table nil |
| 112 | "Syntax table in use in Pascal-mode buffers.") | 126 | "Syntax table in use in Pascal-mode buffers.") |
| @@ -114,82 +128,137 @@ | |||
| 114 | (if pascal-mode-syntax-table | 128 | (if pascal-mode-syntax-table |
| 115 | () | 129 | () |
| 116 | (setq pascal-mode-syntax-table (make-syntax-table)) | 130 | (setq pascal-mode-syntax-table (make-syntax-table)) |
| 117 | (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table) | 131 | (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table) |
| 118 | (modify-syntax-entry ?( ". 1" pascal-mode-syntax-table) | 132 | (modify-syntax-entry ?( "()1" pascal-mode-syntax-table) |
| 119 | (modify-syntax-entry ?) ". 4" pascal-mode-syntax-table) | 133 | (modify-syntax-entry ?) ")(4" pascal-mode-syntax-table) |
| 120 | (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table) | 134 | (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table) |
| 121 | (modify-syntax-entry ?{ "<" pascal-mode-syntax-table) | 135 | (modify-syntax-entry ?{ "<" pascal-mode-syntax-table) |
| 122 | (modify-syntax-entry ?} ">" pascal-mode-syntax-table) | 136 | (modify-syntax-entry ?} ">" pascal-mode-syntax-table) |
| 123 | (modify-syntax-entry ?+ "." pascal-mode-syntax-table) | 137 | (modify-syntax-entry ?+ "." pascal-mode-syntax-table) |
| 124 | (modify-syntax-entry ?- "." pascal-mode-syntax-table) | 138 | (modify-syntax-entry ?- "." pascal-mode-syntax-table) |
| 125 | (modify-syntax-entry ?= "." pascal-mode-syntax-table) | 139 | (modify-syntax-entry ?= "." pascal-mode-syntax-table) |
| 126 | (modify-syntax-entry ?% "." pascal-mode-syntax-table) | 140 | (modify-syntax-entry ?% "." pascal-mode-syntax-table) |
| 127 | (modify-syntax-entry ?< "." pascal-mode-syntax-table) | 141 | (modify-syntax-entry ?< "." pascal-mode-syntax-table) |
| 128 | (modify-syntax-entry ?> "." pascal-mode-syntax-table) | 142 | (modify-syntax-entry ?> "." pascal-mode-syntax-table) |
| 129 | (modify-syntax-entry ?& "." pascal-mode-syntax-table) | 143 | (modify-syntax-entry ?& "." pascal-mode-syntax-table) |
| 130 | (modify-syntax-entry ?| "." pascal-mode-syntax-table) | 144 | (modify-syntax-entry ?| "." pascal-mode-syntax-table) |
| 131 | (modify-syntax-entry ?_ "w" pascal-mode-syntax-table) | 145 | (modify-syntax-entry ?_ "w" pascal-mode-syntax-table) |
| 132 | (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table)) | 146 | (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table)) |
| 133 | 147 | ||
| 134 | (defconst pascal-indent-level 3 | 148 | (defvar pascal-indent-level 3 |
| 135 | "*Indentation of Pascal statements with respect to containing block.") | 149 | "*Indentation of Pascal statements with respect to containing block.") |
| 136 | (defconst pascal-continued-expr 1 | 150 | (defvar pascal-case-indent 2 |
| 137 | "*Indentation of line that is a continued expression.") | 151 | "*Indentation for case statements.") |
| 138 | (defconst pascal-label-offset -1 | 152 | (defvar pascal-auto-newline nil |
| 139 | "*Offset of Pascal label lines, case statements and record lines. | 153 | "*Non-nil means automatically newline after simcolons and the punctation mark |
| 140 | This is relative to usual indentation.") | 154 | after an end.") |
| 141 | (defconst pascal-case-offset 2 | 155 | (defvar pascal-tab-always-indent t |
| 142 | "*Indentation after case statements.") | 156 | "*Non-nil means TAB in Pascal mode should always reindent the current line, |
| 143 | (defconst pascal-vardecl-indent 15 | 157 | regardless of where in the line point is when the TAB command is used.") |
| 144 | "*Indentation (from the beginning of line to `:' of the declaration.") | 158 | (defvar pascal-auto-endcomments t |
| 145 | (defconst pascal-typedecl-indent 10 | 159 | "*Non-nil means a comment { ... } is set after the ends which ends cases and |
| 146 | "*Indentation (from the beginning of line to `=' of the declaration.") | 160 | functions. The name of the function or case will be set between the braces.") |
| 147 | (defconst pascal-auto-newline nil | 161 | (defvar pascal-toggle-completions nil |
| 148 | "*Non-nil means automatically newline after semicolons and `end'.") | 162 | "*Non-nil means that \\<pascal-mode-map>\\[pascal-complete-label] should \ |
| 149 | (defconst pascal-tab-always-indent t | 163 | not display a completion buffer when |
| 150 | "*Non-nil means TAB in Pascal mode should always reindent the current line. | 164 | the label couldn't be completed, but instead toggle the possible completions |
| 151 | It does so regardless of where in the line point is | 165 | with repeated \\[pascal-complete-label]'s.") |
| 152 | when the TAB command is used.") | 166 | (defvar pascal-type-keywords |
| 153 | (defconst pascal-auto-endcomments t | 167 | '("array" "file" "packed" "char" "integer" "real" "string" "record") |
| 154 | "*Non-nil means make a comment { ... } after the end for a case or function. | 168 | "*Keywords for types used when completing a word in a declaration or parmlist. |
| 155 | The name of the function or case is put between the braces.") | 169 | \(eg. integer, real, char.) The types defined within the Pascal program |
| 170 | will be completed runtime, and should not be added to this list.") | ||
| 171 | (defvar pascal-start-keywords | ||
| 172 | '("begin" "end" "function" "procedure" "repeat" "until" "while" | ||
| 173 | "read" "readln" "reset" "rewrite" "write" "writeln") | ||
| 174 | "*Keywords to complete when standing at the first word of a statement. | ||
| 175 | \(eg. begin, repeat, until, readln.) | ||
| 176 | The procedures and variables defined within the Pascal program | ||
| 177 | will be completed runtime and should not be added to this list.") | ||
| 178 | (defvar pascal-seperator-keywords | ||
| 179 | '("downto" "else" "mod" "div" "then") | ||
| 180 | "*Keywords to complete when NOT standing at the first word of a statement. | ||
| 181 | \(eg. downto, else, mod, then.) | ||
| 182 | Variables and function names defined within the | ||
| 183 | Pascal program are completed runtime and should not be added to this list.") | ||
| 184 | |||
| 185 | ;;; | ||
| 186 | ;;; Macros | ||
| 187 | ;;; | ||
| 188 | |||
| 189 | (defsubst pascal-get-beg-of-line (&optional arg) | ||
| 190 | (save-excursion | ||
| 191 | (beginning-of-line arg) | ||
| 192 | (point))) | ||
| 193 | |||
| 194 | (defsubst pascal-get-end-of-line (&optional arg) | ||
| 195 | (save-excursion | ||
| 196 | (end-of-line arg) | ||
| 197 | (point))) | ||
| 198 | |||
| 199 | (defun pascal-declaration-end () | ||
| 200 | (let ((nest 1)) | ||
| 201 | (while (and (> nest 0) | ||
| 202 | (re-search-forward | ||
| 203 | "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" | ||
| 204 | (save-excursion (end-of-line 2) (point)) t)) | ||
| 205 | (cond ((match-beginning 1) (setq nest (1+ nest))) | ||
| 206 | ((match-beginning 2) (setq nest (1- nest))))))) | ||
| 207 | |||
| 208 | (defun pascal-declaration-beg () | ||
| 209 | (let ((nest 1)) | ||
| 210 | (while (and (> nest 0) | ||
| 211 | (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line -0) t)) | ||
| 212 | (cond ((match-beginning 1) (setq nest 0)) | ||
| 213 | ((match-beginning 2) (setq nest (1- nest))) | ||
| 214 | ((match-beginning 3) (setq nest (1+ nest))))) | ||
| 215 | (= nest 0))) | ||
| 216 | |||
| 217 | (defsubst pascal-within-string () | ||
| 218 | (save-excursion | ||
| 219 | (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point))))) | ||
| 220 | |||
| 156 | 221 | ||
| 157 | ;;;###autoload | 222 | ;;;###autoload |
| 158 | (defun pascal-mode () | 223 | (defun pascal-mode () |
| 159 | "Major mode for editing Pascal code. | 224 | "Major mode for editing Pascal code. \\<pascal-mode-map> |
| 160 | Tab indents for Pascal code. | 225 | TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. |
| 161 | Delete converts tabs to spaces as it moves back. | 226 | |
| 162 | \\{pascal-mode-map} | 227 | \\[pascal-complete-word] completes the word around current point with respect \ |
| 163 | Variables controlling indentation style: | 228 | to position in code |
| 164 | pascal-tab-always-indent (default t) | 229 | \\[pascal-show-completions] shows all possible completions at this point. |
| 230 | |||
| 231 | Other useful functions are: | ||
| 232 | |||
| 233 | \\[pascal-mark-defun]\t- Mark function. | ||
| 234 | \\[pascal-insert-block]\t- insert begin ... end; | ||
| 235 | \\[pascal-star-comment]\t- insert (* ... *) | ||
| 236 | \\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments. | ||
| 237 | \\[pascal-uncomment-area]\t- Uncomment an area commented with \ | ||
| 238 | \\[pascal-comment-area]. | ||
| 239 | \\[pascal-beg-of-defun]\t- Move to beginning of current function. | ||
| 240 | \\[pascal-end-of-defun]\t- Move to end of current function. | ||
| 241 | \\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer. | ||
| 242 | \\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline). | ||
| 243 | |||
| 244 | Variables controlling indentation/edit style: | ||
| 245 | |||
| 246 | pascal-indent-level (default 3) | ||
| 247 | Indentation of Pascal statements with respect to containing block. | ||
| 248 | pascal-case-indent (default 2) | ||
| 249 | Indentation for case statements. | ||
| 250 | pascal-auto-newline (default nil) | ||
| 251 | Non-nil means automatically newline after simcolons and the punctation mark | ||
| 252 | after an end. | ||
| 253 | pascal-tab-always-indent (defualt t) | ||
| 165 | Non-nil means TAB in Pascal mode should always reindent the current line, | 254 | Non-nil means TAB in Pascal mode should always reindent the current line, |
| 166 | regardless of where in the line point is when the TAB command is used. | 255 | regardless of where in the line point is when the TAB command is used. |
| 167 | pascal-auto-newline (default nil) | 256 | pascal-auto-endcomments (default t) |
| 168 | Non-nil means automatically newline after semicolons and the punctation | 257 | Non-nil means a comment { ... } is set after the ends which ends cases and |
| 169 | mark after an end. | 258 | functions. The name of the function or case will be set between the braces. |
| 170 | pascal-auto-endcomments (default t) | 259 | |
| 171 | Non-nil means automatically set name of function or `case' in braces after | 260 | See also the user variables pascal-type-keywords, pascal-start-keywords and |
| 172 | after the `end' if this end ends a function or a case block. | 261 | pascal-seperator-keywords. |
| 173 | pascal-indent-level (default 3) | ||
| 174 | Indentation of Pascal statements within surrounding block. | ||
| 175 | pascal-continued-expr (default 1) | ||
| 176 | Indentation of a line that is a continued expression. | ||
| 177 | pascal-typedecl-indent (default 10) | ||
| 178 | Indentation to the `=' in type declarations. (Or constant declarations.) | ||
| 179 | pascal-vardecl-indent (default 20) | ||
| 180 | Indentation to the `:' in var declarations. | ||
| 181 | pascal-label-offset (default -1) | ||
| 182 | Extra indentation for line that is a label, case statement or part of | ||
| 183 | a record block. | ||
| 184 | pascal-case-offset (default 2) | ||
| 185 | Extra indent to the `:' in case statements. | ||
| 186 | |||
| 187 | The only auto indention this mode doesn't fully support is if there is a | ||
| 188 | case within a type declaration. However, this is seldom used. | ||
| 189 | |||
| 190 | When typing text, you should not worry about to get right indentions, they | ||
| 191 | will be set when you hit return. The mode will also automatically delete the | ||
| 192 | whitespaces between `*' and `)' when ending a starcomment. | ||
| 193 | 262 | ||
| 194 | Turning on Pascal mode calls the value of the variable pascal-mode-hook with | 263 | Turning on Pascal mode calls the value of the variable pascal-mode-hook with |
| 195 | no args, if that value is non-nil." | 264 | no args, if that value is non-nil." |
| @@ -202,26 +271,30 @@ no args, if that value is non-nil." | |||
| 202 | (set-syntax-table pascal-mode-syntax-table) | 271 | (set-syntax-table pascal-mode-syntax-table) |
| 203 | (make-local-variable 'indent-line-function) | 272 | (make-local-variable 'indent-line-function) |
| 204 | (setq indent-line-function 'pascal-indent-line) | 273 | (setq indent-line-function 'pascal-indent-line) |
| 205 | (setq comment-indent-hook 'pascal-indent-within-comment) | 274 | (setq comment-indent-function 'pascal-indent-comment) |
| 206 | (make-local-variable 'parse-sexp-ignore-comments) | 275 | (make-local-variable 'parse-sexp-ignore-comments) |
| 207 | (setq parse-sexp-ignore-comments t) | 276 | (setq parse-sexp-ignore-comments t) |
| 208 | (make-local-variable 'case-fold-search) | 277 | (make-local-variable 'case-fold-search) |
| 209 | (setq case-fold-search t) | 278 | (setq case-fold-search t) |
| 210 | (run-hooks 'pascal-mode-hook)) | 279 | (run-hooks 'pascal-mode-hook)) |
| 211 | 280 | ||
| 281 | |||
| 282 | |||
| 212 | ;;; | 283 | ;;; |
| 213 | ;;; Electric functions | 284 | ;;; Electric functions |
| 214 | ;;; | 285 | ;;; |
| 215 | |||
| 216 | (defun electric-pascal-terminate-line () | 286 | (defun electric-pascal-terminate-line () |
| 217 | "Terminate line and indent next line." | 287 | "Terminate line and indent next line." |
| 218 | (interactive) | 288 | (interactive) |
| 289 | ;; First, check if current line should be indented | ||
| 219 | (save-excursion | 290 | (save-excursion |
| 220 | (beginning-of-line) | 291 | (beginning-of-line) |
| 221 | (skip-chars-forward " \t") | 292 | (skip-chars-forward " \t") |
| 222 | (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b") | 293 | (if (looking-at pascal-autoindent-lines-re) |
| 223 | (pascal-indent-line))) | 294 | (pascal-indent-line))) |
| 295 | (delete-horizontal-space) ; Removes trailing whitespaces | ||
| 224 | (newline) | 296 | (newline) |
| 297 | ;; Indent next line | ||
| 225 | (pascal-indent-line) | 298 | (pascal-indent-line) |
| 226 | ;; Maybe we should set some endcomments | 299 | ;; Maybe we should set some endcomments |
| 227 | (if pascal-auto-endcomments | 300 | (if pascal-auto-endcomments |
| @@ -231,33 +304,22 @@ no args, if that value is non-nil." | |||
| 231 | (save-excursion | 304 | (save-excursion |
| 232 | (forward-line -1) | 305 | (forward-line -1) |
| 233 | (skip-chars-forward " \t") | 306 | (skip-chars-forward " \t") |
| 234 | (cond ((looking-at "\\*[ \t]*)") | 307 | (cond ((looking-at "\\*[ \t]+)") |
| 235 | ;; Delete region between `*' and `)' if there is only whitespaces. | 308 | ;; Delete region between `*' and `)' if there is only whitespaces. |
| 236 | (forward-char 1) | 309 | (forward-char 1) |
| 237 | (pascal-delete-whitespaces)) | 310 | (delete-horizontal-space)) |
| 238 | ((and (looking-at "(\\*\\|\\*[^)]") | 311 | ((and (looking-at "(\\*\\|\\*[^)]") |
| 239 | (not (save-excursion | 312 | (not (save-excursion |
| 240 | (search-forward "*)" (pascal-get-end-of-line) t)))) | 313 | (search-forward "*)" (pascal-get-end-of-line) t)))) |
| 241 | (setq setstar t)))) | 314 | (setq setstar t)))) |
| 242 | ;; If last line was a star comment line then this one shall be too. | 315 | ;; If last line was a star comment line then this one shall be too. |
| 243 | (if setstar | 316 | (if (null setstar) |
| 244 | (progn | 317 | (pascal-indent-line) |
| 245 | (insert "*") | 318 | (insert "* ")))) |
| 246 | (pascal-indent-command)) | ||
| 247 | (pascal-indent-line)))) | ||
| 248 | 319 | ||
| 249 | (defun electric-pascal-semi () | ||
| 250 | "Insert ; character and correct this line's indention." | ||
| 251 | (interactive) | ||
| 252 | (insert last-command-char) | ||
| 253 | (save-excursion | ||
| 254 | (beginning-of-line) | ||
| 255 | (pascal-indent-line)) | ||
| 256 | (if pascal-auto-newline | ||
| 257 | (electric-pascal-terminate-line))) | ||
| 258 | 320 | ||
| 259 | (defun electric-pascal-dot () | 321 | (defun electric-pascal-semi-or-dot () |
| 260 | "Insert a period and correct this line's indention." | 322 | "Insert `;' or `.' character and reindent the line." |
| 261 | (interactive) | 323 | (interactive) |
| 262 | (insert last-command-char) | 324 | (insert last-command-char) |
| 263 | (save-excursion | 325 | (save-excursion |
| @@ -267,48 +329,47 @@ no args, if that value is non-nil." | |||
| 267 | (electric-pascal-terminate-line))) | 329 | (electric-pascal-terminate-line))) |
| 268 | 330 | ||
| 269 | (defun electric-pascal-colon () | 331 | (defun electric-pascal-colon () |
| 270 | "Insert : and do all indentions except line indent on this line." | 332 | "Insert `:' and do all indentions except line indent on this line." |
| 271 | (interactive) | 333 | (interactive) |
| 272 | (insert last-command-char) | 334 | (insert last-command-char) |
| 273 | ;; Do nothing of within string. | 335 | ;; Do nothing if within string. |
| 274 | (if (not (pascal-within-string)) | 336 | (if (pascal-within-string) |
| 275 | (progn | 337 | () |
| 276 | (if (save-excursion | 338 | (save-excursion |
| 277 | (backward-char 2) | 339 | (beginning-of-line) |
| 278 | (looking-at "[0-9]")) | 340 | (pascal-indent-line)) |
| 279 | (save-excursion | 341 | (let ((pascal-tab-always-indent nil)) |
| 280 | (beginning-of-line) | 342 | (pascal-indent-command)))) |
| 281 | (pascal-indent-line))) | 343 | |
| 282 | (let ((pascal-tab-always-indent nil)) | ||
| 283 | (pascal-indent-command))))) | ||
| 284 | |||
| 285 | (defun electric-pascal-equal () | 344 | (defun electric-pascal-equal () |
| 286 | "Insert = and do indention if within type declaration." | 345 | "Insert `=', and do indention if within type declaration." |
| 287 | (interactive) | 346 | (interactive) |
| 288 | (insert last-command-char) | 347 | (insert last-command-char) |
| 289 | (if (eq (nth 1 (pascal-calculate-indent t)) 'decl) | 348 | (if (eq (car (pascal-calculate-indent)) 'declaration) |
| 290 | (let ((pascal-tab-always-indent nil)) | 349 | (let ((pascal-tab-always-indent nil)) |
| 291 | (pascal-indent-command)))) | 350 | (pascal-indent-command)))) |
| 292 | 351 | ||
| 293 | (defun electric-pascal-tab () | 352 | (defun electric-pascal-tab () |
| 294 | "Function called when tab is pressed." | 353 | "Function called when TAB is pressed in Pascal mode." |
| 295 | (interactive) | 354 | (interactive) |
| 296 | ;; Do nothing if within a string. | 355 | ;; Do nothing if within a string. |
| 297 | (if (not (pascal-within-string)) | 356 | (if (pascal-within-string) |
| 298 | ;; If pascal-tab-always-indent is set then indent the beginning of | 357 | (insert "\t") |
| 299 | ;; the line. | 358 | ;; If pascal-tab-always-indent, indent the beginning of the line. |
| 300 | (progn | 359 | (if pascal-tab-always-indent |
| 301 | (if pascal-tab-always-indent | 360 | (save-excursion |
| 302 | (save-excursion | 361 | (beginning-of-line) |
| 303 | (beginning-of-line) | 362 | (pascal-indent-line)) |
| 304 | (pascal-indent-line))) | 363 | (insert "\t")) |
| 305 | (pascal-indent-command)))) | 364 | (pascal-indent-command))) |
| 365 | |||
| 366 | |||
| 306 | 367 | ||
| 307 | ;;; | 368 | ;;; |
| 308 | ;;; Interactive functions | 369 | ;;; Interactive functions |
| 309 | ;;; | 370 | ;;; |
| 310 | (defun pascal-insert-block () | 371 | (defun pascal-insert-block () |
| 311 | "Insert begin ... end; block in the code with right indents." | 372 | "Insert Pascal begin ... end; block in the code with right indentation." |
| 312 | (interactive) | 373 | (interactive) |
| 313 | (pascal-indent-line) | 374 | (pascal-indent-line) |
| 314 | (insert "begin") | 375 | (insert "begin") |
| @@ -320,35 +381,38 @@ no args, if that value is non-nil." | |||
| 320 | (pascal-indent-line))) | 381 | (pascal-indent-line))) |
| 321 | 382 | ||
| 322 | (defun pascal-star-comment () | 383 | (defun pascal-star-comment () |
| 323 | "Insert star comment in the code." | 384 | "Insert Pascal star comment at point." |
| 324 | (interactive) | 385 | (interactive) |
| 325 | (pascal-indent-line) | 386 | (pascal-indent-line) |
| 326 | (insert "(*") | 387 | (insert "(*") |
| 327 | (electric-pascal-terminate-line) | 388 | (electric-pascal-terminate-line) |
| 328 | (save-excursion | 389 | (save-excursion |
| 329 | (electric-pascal-terminate-line) | 390 | (electric-pascal-terminate-line) |
| 330 | (pascal-delete-whitespaces) | 391 | (delete-horizontal-space) |
| 331 | (insert ")"))) | 392 | (insert ")")) |
| 393 | (insert " ")) | ||
| 332 | 394 | ||
| 333 | (defun pascal-mark-function () | 395 | (defun pascal-mark-defun () |
| 334 | "Mark the current pascal function (or procedure). | 396 | "Mark the current pascal function (or procedure). |
| 335 | Put the mark at the end of the function, and point at the beginning." | 397 | This puts the mark at the end, and point at the beginning." |
| 336 | (interactive) | 398 | (interactive) |
| 337 | (push-mark (point)) | 399 | (push-mark (point)) |
| 338 | (pascal-forward-to-end-of-function) | 400 | (pascal-end-of-defun) |
| 339 | (push-mark (point)) | 401 | (push-mark (point)) |
| 340 | (pascal-backward-to-beginning-of-function) | 402 | (pascal-beg-of-defun) |
| 341 | (zmacs-activate-region)) | 403 | (if (fboundp 'zmacs-activate-region) |
| 404 | (zmacs-activate-region))) | ||
| 342 | 405 | ||
| 343 | (defun pascal-comment-area (start end) | 406 | (defun pascal-comment-area (start end) |
| 344 | "Put the current region in a comment. | 407 | "Put the region into a Pascal comment. |
| 345 | The comments that are in this area are | 408 | The comments that are in this area are \"deformed\": |
| 346 | be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will | 409 | `*)' becomes `!(*' and `}' becomes `!{'. |
| 347 | however be turned back to normal when the area is uncommented by pressing | 410 | These deformed comments are returned to normal if you use |
| 348 | \\[pascal-uncomment-area]. | 411 | \\[pascal-uncomment-area] to undo the commenting. |
| 349 | The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with: | 412 | |
| 350 | ` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area | 413 | The commented area starts with `pascal-exclude-str-start', and ends with |
| 351 | will not be able to recognize them." | 414 | `pascal-include-str-end'. But if you change these variables, |
| 415 | \\[pascal-uncomment-area] won't recognize the comments." | ||
| 352 | (interactive "r") | 416 | (interactive "r") |
| 353 | (save-excursion | 417 | (save-excursion |
| 354 | ;; Insert start and endcomments | 418 | ;; Insert start and endcomments |
| @@ -357,12 +421,12 @@ will not be able to recognize them." | |||
| 357 | (not (save-excursion (skip-chars-backward " \t") (bolp)))) | 421 | (not (save-excursion (skip-chars-backward " \t") (bolp)))) |
| 358 | (forward-line 1) | 422 | (forward-line 1) |
| 359 | (beginning-of-line)) | 423 | (beginning-of-line)) |
| 360 | (insert " ---/\\---EXCLUDED---/\\---}") | 424 | (insert pascal-exclude-str-end) |
| 361 | (setq end (point)) | 425 | (setq end (point)) |
| 362 | (newline) | 426 | (newline) |
| 363 | (goto-char start) | 427 | (goto-char start) |
| 364 | (beginning-of-line) | 428 | (beginning-of-line) |
| 365 | (insert "{---\\/---EXCLUDED---\\/--- ") | 429 | (insert pascal-exclude-str-start) |
| 366 | (newline) | 430 | (newline) |
| 367 | ;; Replace end-comments within commented area | 431 | ;; Replace end-comments within commented area |
| 368 | (goto-char end) | 432 | (goto-char end) |
| @@ -374,9 +438,8 @@ will not be able to recognize them." | |||
| 374 | (replace-match "!{" t t))))) | 438 | (replace-match "!{" t t))))) |
| 375 | 439 | ||
| 376 | (defun pascal-uncomment-area () | 440 | (defun pascal-uncomment-area () |
| 377 | "Uncomment a commented area. | 441 | "Uncomment a commented area; change deformed comments back to normal. |
| 378 | Change all deformed comments in this area back to normal. | 442 | This command does nothing if the pointer is not in a commented |
| 379 | This function does nothing if the pointer is not in a commented | ||
| 380 | area. See also `pascal-comment-area'." | 443 | area. See also `pascal-comment-area'." |
| 381 | (interactive) | 444 | (interactive) |
| 382 | (save-excursion | 445 | (save-excursion |
| @@ -384,9 +447,9 @@ area. See also `pascal-comment-area'." | |||
| 384 | (end (point))) | 447 | (end (point))) |
| 385 | ;; Find the boundaries of the comment | 448 | ;; Find the boundaries of the comment |
| 386 | (save-excursion | 449 | (save-excursion |
| 387 | (setq start (progn (search-backward "{---\\/---EXCLUDED---\\/--" nil t) | 450 | (setq start (progn (search-backward pascal-exclude-str-start nil t) |
| 388 | (point))) | 451 | (point))) |
| 389 | (setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" nil t) | 452 | (setq end (progn (search-forward pascal-exclude-str-end nil t) |
| 390 | (point)))) | 453 | (point)))) |
| 391 | ;; Check if we're really inside a comment | 454 | ;; Check if we're really inside a comment |
| 392 | (if (or (equal start (point)) (<= end (point))) | 455 | (if (or (equal start (point)) (<= end (point))) |
| @@ -412,569 +475,923 @@ area. See also `pascal-comment-area'." | |||
| 412 | (end-of-line) | 475 | (end-of-line) |
| 413 | (delete-region pos (1+ (point))))))))) | 476 | (delete-region pos (1+ (point))))))))) |
| 414 | 477 | ||
| 415 | (defun pascal-backward-to-beginning-of-function () | 478 | (defun pascal-beg-of-defun () |
| 416 | "Move backwards to the beginning of this function or procedure." | 479 | "Move backward to the beginning of the current function or procedure." |
| 417 | (interactive) | 480 | (interactive) |
| 418 | ;; Check if this is a | 481 | (catch 'found |
| 419 | (if (save-excursion | 482 | (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re))) |
| 420 | (re-search-backward "\\<end" nil t) | 483 | (forward-sexp 1)) |
| 421 | (looking-at "end\\.")) | 484 | (let ((nest 0) (max -1) (func 0) |
| 422 | (beginning-of-buffer) | 485 | (reg (concat pascal-beg-block-re "\\|" |
| 423 | (let ((nest-depth 0) (nest-max 0) | 486 | pascal-end-block-re "\\|" |
| 424 | (nest-noexit 1)) | 487 | pascal-defun-re))) |
| 425 | (beginning-of-line) | 488 | (while (re-search-backward reg nil 'move) |
| 426 | ;; First we find the max depth of the nesting | 489 | (cond ((let ((state (save-excursion |
| 427 | (save-excursion | 490 | (parse-partial-sexp (point-min) (point))))) |
| 428 | (while (not (or (bobp) (looking-at "function\\b\\|procedure\\b"))) | 491 | (or (nth 3 state) (nth 4 state))) ; Inside string or comment |
| 429 | (backward-sexp 1) | 492 | ()) |
| 430 | (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b") | 493 | ((match-end 1) ; begin|case|record|repeat |
| 431 | (setq nest-depth (1+ nest-depth))) | 494 | (if (and (looking-at "\\<record\\>") (>= max 0)) |
| 432 | ((looking-at "end\\(\\b\\|;\\|\\.\\)") | 495 | (setq func (1- func))) |
| 433 | (setq nest-depth (1- nest-depth)))) | 496 | (setq nest (1+ nest) |
| 434 | (setq nest-max (max nest-depth nest-max)))) | 497 | max (max nest max))) |
| 435 | ;; Then we can start searching | 498 | ((match-end 2) ; end|until |
| 436 | (setq nest-depth 0) | 499 | (if (and (= nest max) (>= max 0)) |
| 437 | (while (not (or (bobp) (and (looking-at "function\\b\\|procedure\\b") | 500 | (setq func (1+ func))) |
| 438 | (zerop nest-noexit)))) | 501 | (setq nest (1- nest))) |
| 439 | (backward-sexp 1) | 502 | ((match-end 3) ; function|procedure |
| 440 | (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b") | 503 | (if (= 0 func) |
| 441 | (setq nest-depth (1+ nest-depth))) | 504 | (throw 'found t) |
| 442 | ((looking-at "end\\(\\b\\|;\\|\\.\\)") | 505 | (setq func (1- func))))))) |
| 443 | (if (equal nest-depth nest-max) | 506 | nil)) |
| 444 | (setq nest-noexit (1+ nest-noexit))) | 507 | |
| 445 | (setq nest-depth (1- nest-depth))) | 508 | (defun pascal-end-of-defun () |
| 446 | ((looking-at "function\\b\\|procedure\\b") | 509 | "Move forward to the end of the current function or procedure." |
| 447 | (setq nest-noexit (1- nest-noexit)))))))) | ||
| 448 | |||
| 449 | (defun pascal-forward-to-end-of-function () | ||
| 450 | "Moves the point to the end of the function." | ||
| 451 | (interactive) | 510 | (interactive) |
| 452 | (if (not (looking-at "function\\b\\|procedure\\b")) | 511 | (if (looking-at "\\s ") |
| 453 | (pascal-backward-to-beginning-of-function)) | 512 | (forward-sexp 1)) |
| 454 | (if (bobp) | 513 | (if (not (looking-at pascal-defun-re)) |
| 455 | (end-of-buffer) | 514 | (pascal-beg-of-defun)) |
| 456 | (progn | 515 | (forward-char 1) |
| 457 | (let ((nest-depth 0) | 516 | (let ((nest 0) (func 1) |
| 458 | (func-depth 1)) | 517 | (reg (concat pascal-beg-block-re "\\|" |
| 459 | (while (not (or (and (zerop nest-depth) (zerop func-depth)) (eobp))) | 518 | pascal-end-block-re "\\|" |
| 460 | (forward-sexp 2) | 519 | pascal-defun-re))) |
| 461 | (if (not (eobp)) | 520 | (while (and (/= func 0) |
| 462 | (progn | 521 | (re-search-forward reg nil 'move)) |
| 463 | (backward-sexp 1) ; Move to the beginning of the next sexp | 522 | (cond ((let ((state (save-excursion |
| 464 | (cond ((looking-at "begin\\b\\|case\\b\\|record\\b") | 523 | (parse-partial-sexp (point-min) (point))))) |
| 465 | (setq nest-depth (1+ nest-depth))) | 524 | (or (nth 3 state) (nth 4 state))) ; Inside string or comment |
| 466 | ((looking-at "end\\(\\b\\|;\\|\\.\\)") | 525 | ()) |
| 467 | (setq nest-depth (1- nest-depth)) | 526 | ((match-end 1) |
| 468 | (if (zerop nest-depth) | 527 | (setq nest (1+ nest)) |
| 469 | (setq func-depth (1- func-depth)))) | 528 | (if (save-excursion |
| 470 | ((looking-at "function\\b\\|procedure\\b") | 529 | (goto-char (match-beginning 0)) |
| 471 | (setq func-depth (1+ func-depth))))))) | 530 | (looking-at "\\<record\\>")) |
| 472 | (end-of-line))))) | 531 | (setq func (1+ func)))) |
| 532 | ((match-end 2) | ||
| 533 | (setq nest (1- nest)) | ||
| 534 | (if (= nest 0) | ||
| 535 | (setq func (1- func)))) | ||
| 536 | ((match-end 3) | ||
| 537 | (setq func (1+ func)))))) | ||
| 538 | (forward-line 1)) | ||
| 473 | 539 | ||
| 474 | (defun pascal-downcase-keywords () | 540 | (defun pascal-downcase-keywords () |
| 475 | "Makes all Pascal keywords in the buffer lowercase." | 541 | "Downcase all Pascal keywords in the buffer." |
| 476 | (interactive) | 542 | (interactive) |
| 477 | (pascal-change-keywords 'downcase-word)) | 543 | (pascal-change-keywords 'downcase-word)) |
| 478 | 544 | ||
| 479 | (defun pascal-upcase-keywords () | 545 | (defun pascal-upcase-keywords () |
| 480 | "Makes all Pascal keywords in the buffer uppercase." | 546 | "Upcase all Pascal keywords in the buffer." |
| 481 | (interactive) | 547 | (interactive) |
| 482 | (pascal-change-keywords 'upcase-word)) | 548 | (pascal-change-keywords 'upcase-word)) |
| 483 | 549 | ||
| 484 | (defun pascal-capitalize-keywords () | 550 | (defun pascal-capitalize-keywords () |
| 485 | "Makes all Pascal keywords in the buffer uppercase." | 551 | "Capitalize all Pascal keywords in the buffer." |
| 486 | (interactive) | 552 | (interactive) |
| 487 | (pascal-change-keywords 'capitalize-word)) | 553 | (pascal-change-keywords 'capitalize-word)) |
| 488 | 554 | ||
| 555 | ;; Change the keywords according to argument. | ||
| 489 | (defun pascal-change-keywords (change-word) | 556 | (defun pascal-change-keywords (change-word) |
| 490 | "Change the keywords according to argument." | ||
| 491 | (save-excursion | 557 | (save-excursion |
| 492 | (beginning-of-buffer) | 558 | (let ((keyword-re (concat "\\<\\(" |
| 493 | (while (re-search-forward (mapconcat | 559 | (mapconcat 'identity pascal-keywords "\\|") |
| 494 | 'downcase pascal-keywords "\\>\\|\\<") nil t) | 560 | "\\)\\>"))) |
| 495 | (funcall change-word -1)))) | 561 | (goto-char (point-min)) |
| 562 | (while (re-search-forward keyword-re nil t) | ||
| 563 | (funcall change-word -1))))) | ||
| 564 | |||
| 565 | |||
| 496 | 566 | ||
| 497 | ;;; | 567 | ;;; |
| 498 | ;;; Other functions | 568 | ;;; Other functions |
| 499 | ;;; | 569 | ;;; |
| 500 | (defun pascal-delete-whitespaces () | ||
| 501 | "Deletes the whitespaces around the current point." | ||
| 502 | (interactive) | ||
| 503 | (let ((pos (progn (skip-chars-backward " \t") (point)))) | ||
| 504 | (skip-chars-forward " \t") | ||
| 505 | (delete-region pos (point)))) | ||
| 506 | |||
| 507 | (defun pascal-get-beg-of-line () | ||
| 508 | (save-excursion | ||
| 509 | (beginning-of-line) | ||
| 510 | (point))) | ||
| 511 | |||
| 512 | (defun pascal-get-end-of-line () | ||
| 513 | (save-excursion | ||
| 514 | (end-of-line) | ||
| 515 | (point))) | ||
| 516 | |||
| 517 | (defun pascal-within-string () | ||
| 518 | "Return t if within string; nil otherwise." | ||
| 519 | (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t)) | ||
| 520 | (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2))))) | ||
| 521 | |||
| 522 | (defun pascal-check-if-within-comment () | ||
| 523 | "If within a comment, return the correct indent. Return nil otherwise." | ||
| 524 | (let ((comstart (point)) | ||
| 525 | (comend (point))) | ||
| 526 | (save-excursion | ||
| 527 | (if (re-search-backward "(\\*\\|{" nil t) | ||
| 528 | (setq comstart (point)) | ||
| 529 | (setq comstart 0))) | ||
| 530 | (save-excursion | ||
| 531 | (if (re-search-backward "\\*)\\|}" nil t) | ||
| 532 | (setq comend (point)) | ||
| 533 | (setq comend 0))) | ||
| 534 | (if (< comend comstart) | ||
| 535 | (save-excursion | ||
| 536 | (goto-char comstart) | ||
| 537 | ;; Add 1 to indent if this is a starcomment | ||
| 538 | (if (looking-at "(\\*") | ||
| 539 | (1+ (current-column)) | ||
| 540 | (current-column))) | ||
| 541 | nil))) | ||
| 542 | 570 | ||
| 543 | (defun pascal-set-auto-comments () | 571 | (defun pascal-set-auto-comments () |
| 544 | "Put { case } or { FUNNAME } on this line if appropriate after `end'." | 572 | "Insert `{ case }' or `{ NAME }' on this line if appropriate. |
| 573 | Insert `{ case }' if there is an `end' on the line which | ||
| 574 | ends a case block. Insert `{ NAME }' if there is an `end' | ||
| 575 | on the line which ends a function or procedure named NAME." | ||
| 545 | (save-excursion | 576 | (save-excursion |
| 546 | (forward-line -1) | 577 | (forward-line -1) |
| 547 | (skip-chars-forward " \t") | 578 | (skip-chars-forward " \t") |
| 548 | (if (and (looking-at "end\\(\>\\|;\\)") | 579 | (if (and (looking-at "\\<end;") |
| 549 | (not (save-excursion | 580 | (not (save-excursion |
| 550 | (end-of-line) | 581 | (end-of-line) |
| 551 | (search-backward "}" (pascal-get-beg-of-line) t)))) | 582 | (search-backward "{" (pascal-get-beg-of-line) t)))) |
| 552 | (progn | 583 | (progn |
| 553 | (if (eq (nth 1 (pascal-calculate-indent)) 'case) | 584 | (if (eq (car (pascal-calculate-indent)) 'case) |
| 554 | ;; This is a case block | 585 | ;; This is a case block |
| 555 | (progn | 586 | (progn |
| 556 | (end-of-line) | 587 | (end-of-line) |
| 557 | (pascal-delete-whitespaces) | 588 | (delete-horizontal-space) |
| 558 | (insert " { case }")) | 589 | (insert " { case }")) |
| 559 | (let ((nest 1)) | 590 | (let ((nest 1)) |
| 560 | ;; Check if this is the end of a function | 591 | ;; Check if this is the end of a function |
| 561 | (save-excursion | 592 | (save-excursion |
| 562 | (while (not (or (looking-at "function\\b\\|\\procedure\\b") | 593 | (while (not (or (looking-at pascal-defun-re) (bobp))) |
| 563 | (bobp))) | ||
| 564 | (backward-sexp 1) | 594 | (backward-sexp 1) |
| 565 | (cond ((looking-at "begin\\b\\|case\\b") | 595 | (cond ((looking-at pascal-beg-block-re) |
| 566 | (setq nest (1- nest))) | 596 | (setq nest (1- nest))) |
| 567 | ((looking-at "end\\(\\b\\|;\\|\\.\\)") | 597 | ((looking-at pascal-end-block-re) |
| 568 | (setq nest (1+ nest))))) | 598 | (setq nest (1+ nest))))) |
| 569 | (if (bobp) | 599 | (if (bobp) |
| 570 | (setq nest 1))) | 600 | (setq nest 1))) |
| 571 | (if (zerop nest) | 601 | (if (zerop nest) |
| 572 | (let ((last-command nil)) | 602 | (progn |
| 573 | ;; Find the function name and put it in braces | ||
| 574 | (save-excursion | ||
| 575 | (pascal-backward-to-beginning-of-function) | ||
| 576 | (skip-chars-forward "^ \t") | ||
| 577 | (skip-chars-forward " \t") | ||
| 578 | (copy-region-as-kill (point) | ||
| 579 | (save-excursion | ||
| 580 | (skip-chars-forward "a-zA-Z0-9_") | ||
| 581 | (point)))) | ||
| 582 | (end-of-line) | 603 | (end-of-line) |
| 583 | (pascal-delete-whitespaces) | 604 | (delete-horizontal-space) |
| 584 | (insert " { ") | 605 | (insert " { ") |
| 585 | ;; We've filled up the kill ring, but hey, who cares? | 606 | (let (b e) |
| 586 | (yank) (rotate-yank-pointer 1) | 607 | (save-excursion |
| 608 | (setq b (progn (pascal-beg-of-defun) | ||
| 609 | (skip-chars-forward "^ \t") | ||
| 610 | (skip-chars-forward " \t") | ||
| 611 | (point)) | ||
| 612 | e (progn (skip-chars-forward "a-zA-Z0-9_") | ||
| 613 | (point)))) | ||
| 614 | (insert-buffer-substring (current-buffer) b e)) | ||
| 587 | (insert " }"))))))))) | 615 | (insert " }"))))))))) |
| 588 | 616 | ||
| 617 | |||
| 618 | |||
| 589 | ;;; | 619 | ;;; |
| 590 | ;;; Indent functions and calculation of indent | 620 | ;;; Indentation |
| 591 | ;;; | 621 | ;;; |
| 622 | (defconst pascal-indent-alist | ||
| 623 | '((block . (+ ind pascal-indent-level)) | ||
| 624 | (case . (+ ind pascal-case-indent)) | ||
| 625 | (declaration . (+ ind pascal-indent-level)) | ||
| 626 | (paramlist . (pascal-indent-paramlist t)) | ||
| 627 | (comment . (pascal-indent-comment t)) | ||
| 628 | (defun . ind) (contexp . ind) | ||
| 629 | (unknown . 0) (string . 0))) | ||
| 630 | |||
| 592 | (defun pascal-indent-command () | 631 | (defun pascal-indent-command () |
| 593 | "Indent current line as Pascal code and/or indent within line." | 632 | "Indent for special part of code." |
| 594 | ;; Call pascal-indent-line. This does nothing if we're not at the | 633 | (let* ((indent-str (pascal-calculate-indent)) |
| 595 | ;; beginning of the line. | 634 | (type (car indent-str)) |
| 596 | (pascal-indent-line) | 635 | (ind (car (cdr indent-str)))) |
| 597 | (let ((indent (pascal-calculate-indent t)) | 636 | (cond ((eq type 'paramlist) |
| 598 | (pos 0)) | 637 | (pascal-indent-paramlist) |
| 599 | (save-excursion | 638 | (pascal-indent-paramlist)) |
| 600 | (cond ((or (eq (nth 1 indent) 'case) | 639 | ((eq type 'declaration) |
| 601 | (eq (nth 1 indent) 'record)) | 640 | (pascal-indent-declaration)) |
| 602 | ;; Indent for case and record blocks | 641 | ((and (eq type 'case) (not (looking-at "^[ \t]*$"))) |
| 603 | (beginning-of-line) | 642 | (pascal-indent-case))) |
| 604 | (if (search-forward ":" (pascal-get-end-of-line) t) | 643 | (if (looking-at "[ \t]+$") |
| 605 | (progn | 644 | (skip-chars-forward " \t")))) |
| 606 | ;; Indent before colon | ||
| 607 | (backward-char 1) | ||
| 608 | (pascal-delete-whitespaces) | ||
| 609 | (indent-to (max (pascal-find-leading-case-colon) | ||
| 610 | (1+ (current-column)))) | ||
| 611 | ;; Indent after colon | ||
| 612 | (forward-char 1) | ||
| 613 | (pascal-delete-whitespaces) | ||
| 614 | (indent-to (1+ (current-column)))) | ||
| 615 | ;; Indent if there is no colon | ||
| 616 | (progn | ||
| 617 | (beginning-of-line) | ||
| 618 | (skip-chars-forward " \t") | ||
| 619 | (if (not (eolp)) | ||
| 620 | (progn | ||
| 621 | (skip-chars-forward "0-9a-zA-Z\"\'_;") | ||
| 622 | (pascal-delete-whitespaces) | ||
| 623 | (indent-to (max (pascal-find-leading-case-colon) | ||
| 624 | (1+ (current-column))))))))) | ||
| 625 | ((eq (nth 1 indent) 'decl) | ||
| 626 | ;; Indent for declarations | ||
| 627 | (let ((posii (pascal-get-beg-of-line))) | ||
| 628 | (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>" | ||
| 629 | nil t) | ||
| 630 | (cond ((looking-at "var\\b") | ||
| 631 | (pascal-declindent-middle-of-line | ||
| 632 | ":" posii pascal-vardecl-indent)) | ||
| 633 | ((looking-at "type\\b\\|const\\b") | ||
| 634 | (pascal-declindent-middle-of-line | ||
| 635 | "=" posii pascal-typedecl-indent))))) | ||
| 636 | ((eq (nth 1 indent) 'function) | ||
| 637 | ;; Indent for parameterlist | ||
| 638 | ;; Done twice in case something has changed | ||
| 639 | (pascal-indent-parameter-list) | ||
| 640 | (pascal-indent-parameter-list)))) | ||
| 641 | ;; Go to the end of a line if rest of line contains only whitespaces | ||
| 642 | (if (save-excursion (skip-chars-forward " \t") (eolp)) | ||
| 643 | (end-of-line)))) | ||
| 644 | 645 | ||
| 645 | (defun pascal-indent-line () | 646 | (defun pascal-indent-line () |
| 646 | "Indent current line as Pascal code." | 647 | "Indent current line as a Pascal statement." |
| 647 | (let ((indent (list 0 nil)) | 648 | (let* ((indent-str (pascal-calculate-indent)) |
| 648 | (comindent 0) | 649 | (type (car indent-str)) |
| 649 | beg (point)) | 650 | (ind (car (cdr indent-str)))) |
| 650 | (save-excursion | 651 | (if (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]") |
| 651 | (beginning-of-line) | 652 | (search-forward ":" nil t)) |
| 652 | (setq indent (pascal-calculate-indent))) | 653 | (delete-horizontal-space) |
| 653 | ;; If we are inside a comment, do special indent. | 654 | ;; Some thing should not be indented |
| 654 | (if (setq comindent (pascal-check-if-within-comment)) | 655 | (if (or (and (eq type 'declaration) (looking-at pascal-declaration-re)) |
| 655 | (pascal-indent-within-comment comindent) | 656 | (looking-at pascal-defun-re)) |
| 656 | ;; Skip the rest if we're not standing on the beginning of a line. | 657 | () |
| 657 | (if (save-excursion (skip-chars-backward " \t") (bolp)) | 658 | ;; Other things should have no extra indent |
| 658 | (progn | 659 | (if (looking-at pascal-noindent-re) |
| 659 | (beginning-of-line) | 660 | (indent-to ind) |
| 660 | (pascal-delete-whitespaces) | 661 | ;; But most lines are treated this way: |
| 661 | ;; When to skip the ekstra indent: | 662 | (indent-to (eval (cdr (assoc type pascal-indent-alist)))) |
| 662 | ;; If we are standing at end or until. | 663 | )))) |
| 663 | ;; If we are in an if statement and standing at else, | 664 | |
| 664 | ;; begin or repeat | 665 | (defun pascal-calculate-indent () |
| 665 | ;; If we are in a with, while or for statement and standing | 666 | "Calculate the indent of the current Pascal line. |
| 666 | ;; at begin or end. | 667 | Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." |
| 667 | (cond ((or (or (looking-at "end\\b\\|until\\b") | 668 | (save-excursion |
| 668 | (not (nth 1 indent))) | 669 | (let* ((oldpos (point)) |
| 669 | (and (eq (nth 1 indent) 'if) | 670 | (state (save-excursion (parse-partial-sexp (point-min) (point)))) |
| 670 | (looking-at "begin\\b\\|\\repeat\\b\\|else\\b")) | 671 | (nest 0) (par 0) (complete nil) (blocked nil) |
| 671 | (and (eq (nth 1 indent) 'whilewith) | 672 | (type (catch 'nesting |
| 672 | (looking-at "begin\\b\\|\\repeat\\b"))) | 673 | ;; Check if inside a string, comment or parenthesis |
| 673 | (indent-to (car indent))) | 674 | (cond ((nth 3 state) (throw 'nesting 'string)) |
| 674 | ;; Continued expression | 675 | ((nth 4 state) (throw 'nesting 'comment)) |
| 675 | ((eq (nth 1 indent) 'contexp) | 676 | ((> (car state) 0) |
| 676 | (indent-to (+ (car indent) pascal-continued-expr))) | 677 | (goto-char (scan-lists (point) -1 (car state))) |
| 677 | ;; If this is a part of a case or record block, | 678 | (setq par (1+ (current-column))))) |
| 678 | ;; then modify the indent level. | 679 | ;; Loop until correct indent is found |
| 679 | ((or (eq (nth 1 indent) 'case) | 680 | (while t |
| 680 | (eq (nth 1 indent) 'record)) | 681 | (backward-sexp 1) |
| 681 | (indent-to (+ (car indent) pascal-indent-level | 682 | (cond (;--Nest block outwards |
| 682 | pascal-label-offset))) | 683 | (looking-at pascal-beg-block-re) |
| 683 | ;; If this is a label - don't indent. | 684 | (if (= nest 0) |
| 684 | ((looking-at "[0-9]*:") | 685 | (cond ((looking-at "case\\>") |
| 685 | (skip-chars-forward "0-9:") | 686 | (setq blocked t) |
| 686 | (pascal-delete-whitespaces) | 687 | (throw 'nesting 'case)) |
| 687 | (indent-to (+ (car indent) pascal-indent-level))) | 688 | ((looking-at "record\\>") |
| 688 | ;; If this is insde a parameter list, do special indent | 689 | (throw 'nesting 'declaration)) |
| 689 | ((eq (nth 1 indent) 'function) | 690 | (t (setq blocked t) |
| 690 | (pascal-indent-parameter-list)) | 691 | (throw 'nesting 'block))) |
| 691 | ;; All other indents are set normaly. | 692 | (setq nest (1- nest)))) |
| 692 | (t | 693 | (;--Nest block inwards |
| 693 | (indent-to (+ (car indent) pascal-indent-level))))))))) | 694 | (looking-at pascal-end-block-re) |
| 694 | 695 | (setq complete t | |
| 695 | (defun pascal-calculate-indent (&optional arg) | 696 | nest (1+ nest))) |
| 696 | "Search backward in code to find the right indent level. | 697 | (;--Defun (or parameter list) |
| 697 | Return a list containing: | 698 | (looking-at pascal-defun-re) |
| 698 | 1. Indent level | 699 | (if (= 0 par) |
| 699 | 2. The indent keyword (begin, case etc.), or nil if backtracking failed. | 700 | (throw 'nesting 'defun) |
| 700 | If arg is non-nil, we do not search for continued expressions." | 701 | (setq par 0) |
| 701 | (let ((pascal-nest-depth 1) | 702 | (let ((n 0)) |
| 702 | (oldpos (save-excursion (forward-line -1) (end-of-line) (point))) | 703 | (while (re-search-forward |
| 703 | (samepos (point)) (if-is-set t) | 704 | "\\(\\<record\\>\\)\\|\\<end\\>" |
| 704 | (return-struct (list 0 nil)) (pos 0) | 705 | oldpos t) |
| 705 | (contexpr nil) (after-contexpr (not arg)) | 706 | (if (match-end 1) |
| 706 | (case-fold-search t)) | 707 | (setq n (1+ n)) (setq n (1- n)))) |
| 707 | (save-excursion | 708 | (if (> n 0) |
| 708 | (while (and (not (zerop pascal-nest-depth)) | 709 | (throw 'nesting 'declaration) |
| 709 | (not (bobp))) | 710 | (throw 'nesting 'paramlist))))) |
| 710 | (progn | 711 | (;--Declaration part |
| 711 | (backward-sexp 1) | 712 | (looking-at pascal-declaration-re) |
| 712 | (if (save-excursion | 713 | (if (or blocked |
| 713 | (setq pos (point)) | 714 | (save-excursion |
| 714 | (end-of-line) | 715 | (goto-char oldpos) |
| 715 | (search-backward ";" pos t)) | 716 | (forward-line -1) |
| 716 | (setq if-is-set nil | 717 | (looking-at "^[ \t]*$"))) |
| 717 | after-contexpr nil)) | 718 | (throw 'nesting 'unknown) |
| 718 | (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b") | 719 | (throw 'nesting 'declaration))) |
| 719 | (setq after-contexpr nil)) | 720 | (;--If, else or while statement |
| 720 | 721 | (and (not complete) | |
| 721 | (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b") | 722 | (looking-at pascal-sub-block-re)) |
| 722 | (setq pascal-nest-depth (1- pascal-nest-depth))) | 723 | (throw 'nesting 'block)) |
| 723 | ;; | 724 | (;--Found complete statement |
| 724 | ;; END | UNTIL | 725 | (save-excursion (forward-sexp 1) |
| 725 | ((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b") | 726 | (= (following-char) ?\;)) |
| 726 | (setq if-is-set nil) | 727 | (setq complete t)) |
| 727 | (if after-contexpr | 728 | (;--No known statements |
| 728 | (setq pascal-nest-depth 0 | 729 | (bobp) |
| 729 | contexpr t) | 730 | (throw 'nesting 'unknown)) |
| 730 | (setq pascal-nest-depth (1+ pascal-nest-depth)))) | 731 | ))))) |
| 731 | ;; | 732 | ;; Return type of block and indent level. |
| 732 | ;; IF | ELSE | WITH | WHILE | FOR | 733 | (if (> par 0) ; Unclosed Parenthesis |
| 733 | ;; LABEL | CONST | TYPE | FUNCTION | PROCEDURE | 734 | (list 'contexp par) |
| 734 | ((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b") | 735 | (list type (pascal-indent-level)))))) |
| 735 | if-is-set) | 736 | |
| 736 | (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b")) | 737 | (defun pascal-indent-level () |
| 737 | (setq pascal-nest-depth 0)) | 738 | "Return the indent-level the current statement has. |
| 738 | ;; | 739 | Do not count labels, case-statements or records." |
| 739 | ;; VAR | ||
| 740 | ((looking-at "var\\b") | ||
| 741 | ;; A `var' can be in a declaration part or parameter part | ||
| 742 | (let ((stpos 0) (edpos 0)) | ||
| 743 | (save-excursion | ||
| 744 | (if (not (re-search-backward | ||
| 745 | "\\<\\(function\\|procedure\\)\\>" nil t)) | ||
| 746 | (beginning-of-buffer)) | ||
| 747 | (setq stpos (save-excursion | ||
| 748 | (search-forward "(" nil t) (point))) | ||
| 749 | (setq edpos (save-excursion | ||
| 750 | (search-forward ")" nil t) (point)))) | ||
| 751 | (cond ((or (= stpos edpos) (< samepos stpos) | ||
| 752 | (and (> (point) edpos) (> edpos stpos))) | ||
| 753 | ;; This is really a declaration block!! | ||
| 754 | nil) | ||
| 755 | ((and (>= samepos stpos) (or (< samepos edpos) | ||
| 756 | (> stpos edpos))) | ||
| 757 | ;; Hmm... part of a parameter | ||
| 758 | (re-search-backward | ||
| 759 | "\\<\\(function\\|procedure\\)\\>" nil t)) | ||
| 760 | (t | ||
| 761 | ;; This is just after a parameter declaration | ||
| 762 | (forward-char 1))) | ||
| 763 | ;; We'll quit anyway | ||
| 764 | (setq pascal-nest-depth 0))) | ||
| 765 | ;; | ||
| 766 | ;; CONTINUED EXPRESSIONS | ||
| 767 | (after-contexpr | ||
| 768 | (save-excursion | ||
| 769 | ;; First, we have to be at the begining of a line | ||
| 770 | (if (and (progn (skip-chars-backward " \t") (bolp)) | ||
| 771 | ;; Blank lines don't count | ||
| 772 | (not (progn (skip-chars-forward " \t") (eolp))) | ||
| 773 | ;; But nonblank without ';' do | ||
| 774 | (not (search-forward ";" (pascal-get-end-of-line) t))) | ||
| 775 | (save-excursion | ||
| 776 | (forward-line -1) | ||
| 777 | (end-of-line) | ||
| 778 | (backward-sexp 1) | ||
| 779 | (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>") | ||
| 780 | (progn | ||
| 781 | (skip-chars-forward "^; " (pascal-get-end-of-line)) | ||
| 782 | (equal (char-to-string (following-char)) | ||
| 783 | ";"))) | ||
| 784 | (setq pascal-nest-depth 0)) | ||
| 785 | (setq contexpr t))))) | ||
| 786 | ))) | ||
| 787 | (cond (contexpr | ||
| 788 | (setq return-struct (list (pascal-lstart-col) 'contexp))) | ||
| 789 | ((looking-at "begin\\b") | ||
| 790 | (setq return-struct (list (pascal-lstart-col) 'begin))) | ||
| 791 | ((looking-at "else\\b") | ||
| 792 | (setq return-struct (list (save-excursion | ||
| 793 | (re-search-backward "if\\b" nil t) | ||
| 794 | (pascal-lstart-col)) 'if)) | ||
| 795 | ;; Indent line in case this is a multiple if | ||
| 796 | (beginning-of-line) | ||
| 797 | (pascal-delete-whitespaces) | ||
| 798 | (indent-to (car return-struct))) | ||
| 799 | ((looking-at "if\\b") | ||
| 800 | (if (save-excursion | ||
| 801 | (narrow-to-region (pascal-get-beg-of-line) (point)) | ||
| 802 | (backward-sexp 1) | ||
| 803 | (widen) | ||
| 804 | (looking-at "else\\b")) | ||
| 805 | ;; Indent line if this is a multiple if | ||
| 806 | (progn | ||
| 807 | (beginning-of-line) | ||
| 808 | (pascal-delete-whitespaces) | ||
| 809 | (indent-to (save-excursion | ||
| 810 | (re-search-backward "if\\b" nil t) | ||
| 811 | (pascal-lstart-col))))) | ||
| 812 | ;; This could be a continued expression | ||
| 813 | (if (and after-contexpr | ||
| 814 | (not (save-excursion (re-search-forward | ||
| 815 | "then\\b" (pascal-get-end-of-line) t)))) | ||
| 816 | (setq return-struct (list (pascal-lstart-col) 'contexp)) | ||
| 817 | (setq return-struct (list (pascal-lstart-col) 'if)))) | ||
| 818 | ((looking-at "repeat\\b") | ||
| 819 | (setq return-struct (list (pascal-lstart-col) 'repeat))) | ||
| 820 | ((looking-at "case\\b") | ||
| 821 | (setq return-struct (list (current-column) 'case))) | ||
| 822 | ((looking-at "record\\b") | ||
| 823 | (setq return-struct (list (current-column) 'record))) | ||
| 824 | ((looking-at "while\\b\\|with\\b\\|for\\b") | ||
| 825 | ;; This could ba a continued expression | ||
| 826 | (if (and after-contexpr | ||
| 827 | (not (save-excursion (re-search-forward | ||
| 828 | "do\\b" (pascal-get-end-of-line) t)))) | ||
| 829 | (setq return-struct (list (pascal-lstart-col) 'contexp)) | ||
| 830 | (setq return-struct (list (current-column) 'whilewith)))) | ||
| 831 | ((looking-at "procedure\\b\\|function\\b") | ||
| 832 | ;; Make sure that this is a function with parameters, and | ||
| 833 | ;; that we are actually standing inside the paranthesis. | ||
| 834 | (let ((spos (save-excursion | ||
| 835 | (search-forward "(" samepos t) (point))) | ||
| 836 | (epos (save-excursion | ||
| 837 | (search-forward ")" samepos t) (point)))) | ||
| 838 | (if (and (>= samepos spos) (or (< samepos epos) | ||
| 839 | (> spos epos))) | ||
| 840 | (setq return-struct (list 0 'function)) | ||
| 841 | (setq return-struct (list 0 nil))))) | ||
| 842 | ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b") | ||
| 843 | ;; Are we really in the declaration part?(Check for blank lines) | ||
| 844 | (if (< oldpos (point)) | ||
| 845 | (setq return-struct (list 0 'decl)) | ||
| 846 | (if (save-excursion | ||
| 847 | (not (re-search-forward "^[ \t]*$" oldpos t))) | ||
| 848 | (setq return-struct (list 0 'decl)) | ||
| 849 | (setq return-struct (list 0 nil))))) | ||
| 850 | (t | ||
| 851 | (setq return-struct (list 0 nil)))) | ||
| 852 | return-struct))) | ||
| 853 | |||
| 854 | (defun pascal-lstart-col () | ||
| 855 | "Return the column of the beginning of the first command on the line." | ||
| 856 | (save-excursion | 740 | (save-excursion |
| 857 | (beginning-of-line) | 741 | (beginning-of-line) |
| 858 | (skip-chars-forward ":0-9") | 742 | (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]") |
| 743 | (search-forward ":" nil t) | ||
| 744 | (if (looking-at ".*=[ \t]*record\\>") | ||
| 745 | (search-forward "=" nil t))) | ||
| 859 | (skip-chars-forward " \t") | 746 | (skip-chars-forward " \t") |
| 860 | (current-column))) | 747 | (current-column))) |
| 861 | 748 | ||
| 862 | (defun pascal-indent-parameter-list () | 749 | (defun pascal-indent-comment (&optional arg) |
| 863 | "Indent this line as part of a parameter list in a function." | 750 | "Indent current line as comment. |
| 864 | (let ((indents (pascal-get-highest-indents-in-parameterlist)) | 751 | If optional arg is non-nil, just return the |
| 865 | (pos 0)) | 752 | column number the line should be indented to." |
| 866 | (if (not (progn (beginning-of-line) | 753 | (let* ((stcol (save-excursion |
| 867 | (search-forward "(" (pascal-get-end-of-line) t))) | 754 | (re-search-backward "(\\*\\|{" nil t) |
| 868 | (progn (beginning-of-line) | 755 | (1+ (current-column))))) |
| 869 | (skip-chars-forward " \t"))) | 756 | (if arg stcol |
| 870 | ;; Indent region in front of var | 757 | (delete-horizontal-space) |
| 871 | (skip-chars-forward " \t") | 758 | (indent-to stcol)))) |
| 872 | (pascal-delete-whitespaces) | 759 | |
| 873 | (indent-to (nth 0 indents)) | 760 | (defun pascal-indent-case () |
| 874 | (if (looking-at "var\\b") | 761 | "Indent within case statements." |
| 875 | (forward-char 3)) | 762 | (skip-chars-forward ": \t") |
| 876 | ;; Indent parameternames | 763 | (let ((end (prog1 (point-marker) |
| 877 | (pascal-delete-whitespaces) | 764 | (re-search-backward "\\<case\\>" nil t))) |
| 878 | (indent-to (nth 1 indents)) | 765 | (beg (point)) |
| 879 | (if (not (save-excursion (skip-chars-forward " \t") (eolp))) | 766 | (ind 0)) |
| 880 | (progn | 767 | ;; Get right indent |
| 881 | ;; Indent colon | 768 | (while (< (point) (marker-position end)) |
| 882 | (if (search-forward ":" (pascal-get-end-of-line) t) | 769 | (if (re-search-forward "^[ \t]*\\([^ \t]+\\)[ \t]*:" |
| 883 | (backward-char 1) | 770 | (marker-position end) 'move) |
| 884 | (end-of-line)) | 771 | (goto-char (match-end 1))) |
| 885 | (pascal-delete-whitespaces) | 772 | (delete-horizontal-space) |
| 886 | (indent-to (nth 2 indents)) | 773 | (if (> (current-column) ind) |
| 887 | ;; Indent after colon | 774 | (setq ind (current-column))) |
| 888 | (if (equal (following-char) ?:) | 775 | (beginning-of-line 2)) |
| 889 | (progn | 776 | (goto-char beg) |
| 890 | (forward-char 1) | 777 | ;; Indent all case statements |
| 891 | (pascal-delete-whitespaces) | 778 | (while (< (point) (marker-position end)) |
| 892 | (indent-to (+ 2 (nth 2 indents))))))))) | 779 | (if (re-search-forward "^[ \t]*[^ \t]+[ \t]*:" |
| 893 | 780 | (marker-position end) 'move) | |
| 894 | ;; Get the indents to use in a parameterlist. | 781 | (forward-char -1)) |
| 895 | ;; Returns: | 782 | (indent-to (1+ ind)) |
| 896 | ;; 1. Indent to the beginning of the line. | 783 | (if (/= (following-char) ?:) |
| 897 | ;; 2. Indent to the beginning of the parameter names. | 784 | () |
| 898 | ;; 3. Indent to the right colon position." | 785 | (forward-char 1) |
| 899 | (defun pascal-get-highest-indents-in-parameterlist () | 786 | (delete-horizontal-space) |
| 787 | (insert " "))))) | ||
| 788 | |||
| 789 | (defun pascal-indent-paramlist (&optional arg) | ||
| 790 | "Indent current line in parameterlist. | ||
| 791 | If optional arg is non-nil, just return the | ||
| 792 | indent of the current line in parameterlist." | ||
| 900 | (save-excursion | 793 | (save-excursion |
| 901 | (let ((start (progn | 794 | (let* ((oldpos (point)) |
| 902 | (re-search-backward | 795 | (stpos (progn (goto-char (scan-lists (point) -1 1)) (point))) |
| 903 | "\\<\\(function\\|procedure\\)\\>" nil t) | 796 | (stcol (1+ (current-column))) |
| 904 | (search-forward "(") | 797 | (edpos (progn (pascal-declaration-end) |
| 905 | (current-column))) | 798 | (search-backward ")" (pascal-get-beg-of-line) t) |
| 906 | (arglength 0) (vardecl nil) (done nil)) | 799 | (point))) |
| 907 | (while (not (or done (eobp))) | 800 | (usevar (re-search-backward "\\<var\\>" stpos t))) |
| 908 | (beginning-of-line) | 801 | (if arg (progn |
| 909 | (if (save-excursion | 802 | ;; If arg, just return indent |
| 910 | (re-search-forward "\\<var\\>" (pascal-get-end-of-line) t)) | 803 | (goto-char oldpos) |
| 911 | (setq vardecl t)) | 804 | (beginning-of-line) |
| 912 | (if (not (re-search-forward ":" (pascal-get-end-of-line) t)) | 805 | (if (or (not usevar) (looking-at "[ \t]*var\\>")) |
| 913 | (setq done t)) | 806 | stcol (+ 4 stcol))) |
| 914 | (skip-chars-backward ": \t") | 807 | (goto-char stpos) |
| 915 | (setq arglength (max arglength (current-column))) | 808 | (forward-char 1) |
| 916 | (forward-line 1)) | 809 | (delete-horizontal-space) |
| 917 | (if vardecl | 810 | (if (and usevar (not (looking-at "var\\>"))) |
| 918 | (list start (+ start 4) (1+ arglength)) | 811 | (indent-to (+ 4 stcol))) |
| 919 | (list start start (1+ arglength)))))) | 812 | (pascal-indent-declaration nil stpos edpos))))) |
| 920 | 813 | ||
| 921 | (defun pascal-declindent-middle-of-line (declkey endpos defaultindent) | 814 | (defun pascal-indent-declaration (&optional arg start end) |
| 922 | "Indent declaration line." | 815 | "Indent current lines as declaration, lining up the `:'s or `='s." |
| 923 | (let ((decindent 0)) | 816 | (let ((pos (point-marker))) |
| 924 | (if (search-forward declkey endpos t) | 817 | (if (and (not (or arg start)) (not (pascal-declaration-beg))) |
| 925 | (setq decindent (1- (current-column))) | 818 | () |
| 926 | (setq decindent defaultindent)) | 819 | (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start) |
| 927 | (goto-char endpos) | 820 | ":" "=")) |
| 928 | (end-of-line) | 821 | (stpos (if start start |
| 929 | (if (save-excursion (search-backward declkey endpos t)) | 822 | (forward-word 2) (backward-word 1) (point))) |
| 930 | (progn (search-backward declkey) (skip-chars-backward " \t")) | 823 | (edpos (set-marker (make-marker) |
| 931 | (skip-chars-backward " \t")) | 824 | (if end end |
| 932 | (pascal-delete-whitespaces) | 825 | (max (progn (pascal-declaration-end) |
| 933 | (indent-to (max decindent (1+ (current-column)))) | 826 | (point)) |
| 934 | ;; Indent after `declkey' | 827 | pos)))) |
| 935 | (if (looking-at declkey) | 828 | ind) |
| 936 | (progn | 829 | |
| 937 | (forward-char 1) | 830 | (goto-char stpos) |
| 938 | (pascal-delete-whitespaces) | 831 | ;; Indent lines in record block |
| 939 | (indent-to (1+ (current-column))))))) | 832 | (if arg |
| 833 | (while (<= (point) (marker-position edpos)) | ||
| 834 | (beginning-of-line) | ||
| 835 | (delete-horizontal-space) | ||
| 836 | (if (looking-at "end\\>") | ||
| 837 | (indent-to arg) | ||
| 838 | (indent-to (+ arg pascal-indent-level))) | ||
| 839 | (forward-line 1))) | ||
| 840 | |||
| 841 | ;; Do lineup | ||
| 842 | (setq ind (pascal-get-lineup-indent stpos edpos lineup)) | ||
| 843 | (goto-char stpos) | ||
| 844 | (while (<= (point) (marker-position edpos)) | ||
| 845 | (if (search-forward lineup (pascal-get-end-of-line) 'move) | ||
| 846 | (forward-char -1)) | ||
| 847 | (delete-horizontal-space) | ||
| 848 | (indent-to ind) | ||
| 849 | (if (not (looking-at lineup)) | ||
| 850 | (forward-line 1) ; No more indent if there is no : or = | ||
| 851 | (forward-char 1) | ||
| 852 | (delete-horizontal-space) | ||
| 853 | (insert " ") | ||
| 854 | ;; Indent record block | ||
| 855 | (if (looking-at "record\\>") | ||
| 856 | (pascal-indent-declaration (current-column))) | ||
| 857 | (forward-line 1))))) | ||
| 858 | |||
| 859 | ;; If arg - move point | ||
| 860 | (if arg (forward-line -1) | ||
| 861 | (goto-char (marker-position pos))))) | ||
| 862 | |||
| 863 | ; "Return the indent level that will line up several lines within the region | ||
| 864 | ;from b to e nicely. The lineup string is str." | ||
| 865 | (defun pascal-get-lineup-indent (b e str) | ||
| 866 | (save-excursion | ||
| 867 | (let ((ind 0) | ||
| 868 | (reg (concat str "\\|\\(\\<record\\>\\)")) | ||
| 869 | nest) | ||
| 870 | (goto-char b) | ||
| 871 | ;; Get rightmost position | ||
| 872 | (while (< (point) e) | ||
| 873 | (setq nest 1) | ||
| 874 | (if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move) | ||
| 875 | ;; Skip record blocks | ||
| 876 | (if (match-beginning 1) | ||
| 877 | (pascal-declaration-end) | ||
| 878 | (save-excursion | ||
| 879 | (goto-char (match-beginning 0)) | ||
| 880 | (skip-chars-backward " \t") | ||
| 881 | (if (> (current-column) ind) | ||
| 882 | (setq ind (current-column))))))) | ||
| 883 | ;; In case no lineup was found | ||
| 884 | (if (> ind 0) | ||
| 885 | (1+ ind) | ||
| 886 | ;; No lineup-string found | ||
| 887 | (goto-char b) | ||
| 888 | (end-of-line) | ||
| 889 | (skip-chars-backward " \t") | ||
| 890 | (1+ (current-column)))))) | ||
| 891 | |||
| 892 | |||
| 893 | |||
| 894 | ;;; | ||
| 895 | ;;; Completion | ||
| 896 | ;;; | ||
| 897 | (defun pascal-string-diff (str1 str2) | ||
| 898 | "Return index of first letter where STR1 and STR2 differs." | ||
| 899 | (catch 'done | ||
| 900 | (let ((diff 0)) | ||
| 901 | (while t | ||
| 902 | (if (or (> (1+ diff) (length str1)) | ||
| 903 | (> (1+ diff) (length str2))) | ||
| 904 | (throw 'done diff)) | ||
| 905 | (or (equal (aref str1 diff) (aref str2 diff)) | ||
| 906 | (throw 'done diff)) | ||
| 907 | (setq diff (1+ diff)))))) | ||
| 908 | |||
| 909 | ;; Calculate all possible completions for functions if argument is `function', | ||
| 910 | ;; completions for procedures if argument is `procedure' or both functions and | ||
| 911 | ;; procedures otherwise. | ||
| 912 | |||
| 913 | (defun pascal-func-completion (type) | ||
| 914 | ;; Build regular expression for function/procedure names | ||
| 915 | (if (string= str "") | ||
| 916 | (setq str "[a-zA-Z_]")) | ||
| 917 | (let ((str (concat (cond ((eq type 'procedure) "\\<\\(procedure\\)\\s +") | ||
| 918 | ((eq type 'function) "\\<\\(function\\)\\s +") | ||
| 919 | (t "\\<\\(function\\|procedure\\)\\s +")) | ||
| 920 | "\\<\\(" str "[a-zA-Z0-9_.]*\\)\\>")) | ||
| 921 | match) | ||
| 940 | 922 | ||
| 941 | (defun pascal-indent-within-comment (indent) | 923 | (if (not (looking-at "\\<\\(function\\|procedure\\)\\>")) |
| 942 | "Indent comments and/or indent text within comment." | 924 | (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t)) |
| 943 | (progn | 925 | (forward-char 1) |
| 944 | ;; If we are at the beginning of the line, then we indent this line. | 926 | |
| 945 | (if (save-excursion (skip-chars-backward " \t") (bolp)) | 927 | ;; Search through all reachable functions |
| 928 | (while (pascal-beg-of-defun) | ||
| 929 | (if (re-search-forward str (pascal-get-end-of-line) t) | ||
| 930 | (progn (setq match (buffer-substring (match-beginning 2) | ||
| 931 | (match-end 2))) | ||
| 932 | (if (or (null predicate) | ||
| 933 | (funcall prdicate match)) | ||
| 934 | (setq all (cons match all))))) | ||
| 935 | (goto-char (match-beginning 0))))) | ||
| 936 | |||
| 937 | (defun pascal-get-completion-decl () | ||
| 938 | ;; Macro for searching through current declaration (var, type or const) | ||
| 939 | ;; for matches of `str' and adding the occurence tp `all' | ||
| 940 | (let ((end (save-excursion (pascal-declaration-end) | ||
| 941 | (point))) | ||
| 942 | match) | ||
| 943 | ;; Traverse lines | ||
| 944 | (while (< (point) end) | ||
| 945 | (if (re-search-forward "[:=]" (pascal-get-end-of-line) t) | ||
| 946 | ;; Traverse current line | ||
| 947 | (while (and (re-search-backward | ||
| 948 | (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" | ||
| 949 | pascal-symbol-re) | ||
| 950 | (pascal-get-beg-of-line) t) | ||
| 951 | (not (match-end 1))) | ||
| 952 | (setq match (buffer-substring (match-beginning 0) (match-end 0))) | ||
| 953 | (if (string-match (concat "\\<" str) match) | ||
| 954 | (if (or (null predicate) | ||
| 955 | (funcall predicate match)) | ||
| 956 | (setq all (cons match all)))))) | ||
| 957 | (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t) | ||
| 958 | (pascal-declaration-end) | ||
| 959 | (forward-line 1))))) | ||
| 960 | |||
| 961 | (defun pascal-type-completion () | ||
| 962 | "Calculate all possible completions for types." | ||
| 963 | (let ((start (point)) | ||
| 964 | goon) | ||
| 965 | ;; Search for all reachable type declarations | ||
| 966 | (while (or (pascal-beg-of-defun) | ||
| 967 | (setq goon (not goon))) | ||
| 968 | (save-excursion | ||
| 969 | (if (and (< start (prog1 (save-excursion (pascal-end-of-defun) | ||
| 970 | (point)) | ||
| 971 | (forward-char 1))) | ||
| 972 | (re-search-forward | ||
| 973 | "\\<type\\>\\|\\<\\(begin\\|function\\|proceudre\\)\\>" | ||
| 974 | start t) | ||
| 975 | (not (match-end 1))) | ||
| 976 | ;; Check current type declaration | ||
| 977 | (pascal-get-completion-decl)))))) | ||
| 978 | |||
| 979 | (defun pascal-var-completion () | ||
| 980 | "Calculate all possible completions for variables (or constants)." | ||
| 981 | (let ((start (point)) | ||
| 982 | goon twice) | ||
| 983 | ;; Search for all reachable var declarations | ||
| 984 | (while (or (pascal-beg-of-defun) | ||
| 985 | (setq goon (not goon))) | ||
| 986 | (save-excursion | ||
| 987 | (if (> start (prog1 (save-excursion (pascal-end-of-defun) | ||
| 988 | (point)))) | ||
| 989 | () ; Declarations not reacable | ||
| 990 | (if (search-forward "(" (pascal-get-end-of-line) t) | ||
| 991 | ;; Check parameterlist | ||
| 992 | (pascal-get-completion-decl)) | ||
| 993 | (setq twice 2) | ||
| 994 | (while (>= (setq twice (1- twice)) 0) | ||
| 995 | (cond ((and (re-search-forward | ||
| 996 | (concat "\\<\\(var\\|const\\)\\>\\|" | ||
| 997 | "\\<\\(begin\\|function\\|procedure\\)\\>") | ||
| 998 | start t) | ||
| 999 | (not (match-end 2))) | ||
| 1000 | ;; Check var/const declarations | ||
| 1001 | (pascal-get-completion-decl)) | ||
| 1002 | ((match-end 2) | ||
| 1003 | (setq twice 0))))))))) | ||
| 1004 | |||
| 1005 | |||
| 1006 | (defun pascal-keyword-completion (keyword-list) | ||
| 1007 | "Give list of all possible completions of keywords in KEYWORD-LIST." | ||
| 1008 | (mapcar '(lambda (s) | ||
| 1009 | (if (string-match (concat "\\<" str) s) | ||
| 1010 | (if (or (null predicate) | ||
| 1011 | (funcall predicate s)) | ||
| 1012 | (setq all (cons s all))))) | ||
| 1013 | keyword-list)) | ||
| 1014 | |||
| 1015 | ;; Function passed to completing-read, try-completion or | ||
| 1016 | ;; all-completions to get completion on STR. If predicate is non-nil, | ||
| 1017 | ;; it must be a function to be called for every match to check if this | ||
| 1018 | ;; should really be a match. If flag is t, the function returns a list | ||
| 1019 | ;; of all possible completions. If it is nil it returns a string, the | ||
| 1020 | ;; longest possible completion, or t if STR is an exact match. If flag | ||
| 1021 | ;; is 'lambda, the function returns t if STR is an exact match, nil | ||
| 1022 | ;; otherwise. | ||
| 1023 | |||
| 1024 | (defun pascal-completion (str predicate flag) | ||
| 1025 | (save-excursion | ||
| 1026 | (let ((all nil)) | ||
| 1027 | ;; Set buffer to use for searching labels. This should be set | ||
| 1028 | ;; within functins which use pascal-completions | ||
| 1029 | (set-buffer buffer-to-use) | ||
| 1030 | |||
| 1031 | ;; Determine what should be completed | ||
| 1032 | (let ((state (car (pascal-calculate-indent)))) | ||
| 1033 | (cond (;--Within a declaration or parameterlist | ||
| 1034 | (or (eq state 'declaration) (eq state 'paramlist) | ||
| 1035 | (and (eq state 'defun) | ||
| 1036 | (save-excursion | ||
| 1037 | (re-search-backward ")[ \t]*:" (pascal-get-beg-of-line) t)))) | ||
| 1038 | (if (or (eq state 'paramlist) (eq state 'defun)) | ||
| 1039 | (pascal-beg-of-defun)) | ||
| 1040 | (pascal-type-completion) | ||
| 1041 | (pascal-keyword-completion pascal-type-keywords)) | ||
| 1042 | (;--Starting a new statement | ||
| 1043 | (and (not (eq state 'contexp)) | ||
| 1044 | (save-excursion | ||
| 1045 | (skip-chars-backward "a-zA-Z0-9_.") | ||
| 1046 | (backward-sexp 1) | ||
| 1047 | (or (looking-at pascal-nosemi-re) | ||
| 1048 | (progn | ||
| 1049 | (forward-sexp 1) | ||
| 1050 | (looking-at "\\s *\\(;\\|:[^=]\\)"))))) | ||
| 1051 | (save-excursion (pascal-var-completion)) | ||
| 1052 | (pascal-func-completion 'procedure) | ||
| 1053 | (pascal-keyword-completion pascal-start-keywords)) | ||
| 1054 | (t;--Anywhere else | ||
| 1055 | (save-excursion (pascal-var-completion)) | ||
| 1056 | (pascal-func-completion 'function) | ||
| 1057 | (pascal-keyword-completion pascal-seperator-keywords)))) | ||
| 1058 | |||
| 1059 | ;; Now we have built a list of all matches. Give response to caller | ||
| 1060 | (pascal-completion-response)))) | ||
| 1061 | |||
| 1062 | (defun pascal-completion-response () | ||
| 1063 | (cond ((or (equal flag 'lambda) (null flag)) | ||
| 1064 | ;; This was not called by all-completions | ||
| 1065 | (if (null all) | ||
| 1066 | ;; Return nil if there was no matching label | ||
| 1067 | nil | ||
| 1068 | ;; Get longest string common in the labels | ||
| 1069 | (let* ((elm (cdr all)) | ||
| 1070 | (match (car all)) | ||
| 1071 | (min (length match)) | ||
| 1072 | exact tmp) | ||
| 1073 | (if (string= match str) | ||
| 1074 | ;; Return t if first match was an exact match | ||
| 1075 | (setq match t) | ||
| 1076 | (while (not (null elm)) | ||
| 1077 | ;; Find longest common string | ||
| 1078 | (if (< (setq tmp (pascal-string-diff match (car elm))) min) | ||
| 1079 | (progn | ||
| 1080 | (setq min tmp) | ||
| 1081 | (setq match (substring match 0 min)))) | ||
| 1082 | ;; Terminate with match=t if this is an exact match | ||
| 1083 | (if (string= (car elm) str) | ||
| 1084 | (progn | ||
| 1085 | (setq match t) | ||
| 1086 | (setq elm nil)) | ||
| 1087 | (setq elm (cdr elm))))) | ||
| 1088 | ;; If this is a test just for exact match, return nil ot t | ||
| 1089 | (if (and (equal flag 'lambda) (not (equal match 't))) | ||
| 1090 | nil | ||
| 1091 | match)))) | ||
| 1092 | ;; If flag is t, this was called by all-completions. Return | ||
| 1093 | ;; list of all possible completions | ||
| 1094 | (flag | ||
| 1095 | all))) | ||
| 1096 | |||
| 1097 | (defvar pascal-last-word-numb 0) | ||
| 1098 | (defvar pascal-last-word-shown nil) | ||
| 1099 | (defvar pascal-last-completions nil) | ||
| 1100 | |||
| 1101 | (defun pascal-complete-word () | ||
| 1102 | "Complete word at current point. | ||
| 1103 | \(See also `pascal-toggle-completions', `pascal-type-keywords', | ||
| 1104 | `pascal-start-keywords' and `pascal-seperator-keywords'.)" | ||
| 1105 | (interactive) | ||
| 1106 | (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) | ||
| 1107 | (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) | ||
| 1108 | (str (buffer-substring b e)) | ||
| 1109 | ;; The following variable is used in pascal-completion | ||
| 1110 | (buffer-to-use (current-buffer)) | ||
| 1111 | (allcomp (if (and pascal-toggle-completions | ||
| 1112 | (string= pascal-last-word-shown str)) | ||
| 1113 | pascal-last-completions | ||
| 1114 | (all-completions str 'pascal-completion))) | ||
| 1115 | (match (if pascal-toggle-completions | ||
| 1116 | "" (try-completion | ||
| 1117 | str (mapcar '(lambda (elm) (cons elm 0)) allcomp))))) | ||
| 1118 | ;; Delete old string | ||
| 1119 | (delete-region b e) | ||
| 1120 | |||
| 1121 | ;; Toggle-completions inserts whole labels | ||
| 1122 | (if pascal-toggle-completions | ||
| 946 | (progn | 1123 | (progn |
| 947 | (beginning-of-line) | 1124 | ;; Update entry number in list |
| 948 | (pascal-delete-whitespaces) | 1125 | (setq pascal-last-completions allcomp |
| 949 | (indent-to indent)) | 1126 | pascal-last-word-numb |
| 950 | ;; Do nothing if we're not in a star comment. | 1127 | (if (>= pascal-last-word-numb (1- (length allcomp))) |
| 951 | (if (save-excursion | 1128 | 0 |
| 952 | (beginning-of-line) | 1129 | (1+ pascal-last-word-numb))) |
| 953 | (skip-chars-forward " \t") | 1130 | (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb)) |
| 954 | (looking-at "\\*\\|(\\*")) | 1131 | ;; Display next match or same string if no match was found |
| 955 | (save-excursion | 1132 | (if (not (null allcomp)) |
| 956 | (beginning-of-line) | 1133 | (insert "" pascal-last-word-shown) |
| 957 | (search-forward "*") | 1134 | (insert "" str) |
| 958 | (pascal-delete-whitespaces) | 1135 | (message "(No match)"))) |
| 959 | (indent-to (+ (current-column) 2))))))) | 1136 | ;; The other form of completion does not necessarly do that. |
| 960 | 1137 | ||
| 961 | (defun pascal-find-leading-case-colon () | 1138 | ;; Insert match if found, or the original string if no match |
| 962 | "Return hpos of first colon after the case-of or record line. | 1139 | (if (or (null match) (equal match 't)) |
| 963 | If there's no such line, use the place where it ought to be." | 1140 | (progn (insert "" str) |
| 964 | (let ((pos (save-excursion | 1141 | (message "(No match)")) |
| 965 | (beginning-of-line) | 1142 | (insert "" match)) |
| 966 | (skip-chars-forward " \t") | 1143 | ;; Give message about current status of completion |
| 967 | (point)))) | 1144 | (cond ((equal match 't) |
| 968 | (save-excursion | 1145 | (if (not (null (cdr allcomp))) |
| 969 | (re-search-backward "\\<\\(case\\|record\\)\\>") | 1146 | (message "(Complete but not unique)") |
| 970 | (forward-line 1) | 1147 | (message "(Sole completion)"))) |
| 971 | (skip-chars-forward " \t") | 1148 | ;; Display buffer if the current completion didn't help |
| 972 | (if (not (eq pos (point))) | 1149 | ;; on completing the label. |
| 1150 | ((and (not (null (cdr allcomp))) (= (length str) (length match))) | ||
| 1151 | (with-output-to-temp-buffer "*Completions*" | ||
| 1152 | (display-completion-list allcomp)) | ||
| 1153 | ;; Wait for a keypress. Then delete *Completion* window | ||
| 1154 | (momentary-string-display "" (point)) | ||
| 1155 | (delete-window (get-buffer-window (get-buffer "*Completions*"))) | ||
| 1156 | ))))) | ||
| 1157 | |||
| 1158 | (defun pascal-show-completions () | ||
| 1159 | "Show all possible completions at current point." | ||
| 1160 | (interactive) | ||
| 1161 | (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) | ||
| 1162 | (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) | ||
| 1163 | (str (buffer-substring b e)) | ||
| 1164 | ;; The following variable is used in pascal-completion | ||
| 1165 | (buffer-to-use (current-buffer)) | ||
| 1166 | (allcomp (if (and pascal-toggle-completions | ||
| 1167 | (string= pascal-last-word-shown str)) | ||
| 1168 | pascal-last-completions | ||
| 1169 | (all-completions str 'pascal-completion)))) | ||
| 1170 | ;; Show possible completions in a temporary buffer. | ||
| 1171 | (with-output-to-temp-buffer "*Completions*" | ||
| 1172 | (display-completion-list allcomp)) | ||
| 1173 | ;; Wait for a keypress. Then delete *Completion* window | ||
| 1174 | (momentary-string-display "" (point)) | ||
| 1175 | (delete-window (get-buffer-window (get-buffer "*Completions*"))))) | ||
| 1176 | |||
| 1177 | |||
| 1178 | (defun pascal-get-default-symbol () | ||
| 1179 | "Return symbol around current point as a string." | ||
| 1180 | (save-excursion | ||
| 1181 | (buffer-substring (progn | ||
| 1182 | (skip-chars-backward " \t") | ||
| 1183 | (skip-chars-backward "a-zA-Z0-9_") | ||
| 1184 | (point)) | ||
| 1185 | (progn | ||
| 1186 | (skip-chars-forward "a-zA-Z0-9_") | ||
| 1187 | (point))))) | ||
| 1188 | |||
| 1189 | (defun pascal-build-defun-re (str &optional arg) | ||
| 1190 | "Return function/procedure starting with STR as regular expression. | ||
| 1191 | With optional second arg non-nil, STR is the complete name of the instruction." | ||
| 1192 | (if arg | ||
| 1193 | (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>") | ||
| 1194 | (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>"))) | ||
| 1195 | |||
| 1196 | ;; Function passed to completing-read, try-completion or | ||
| 1197 | ;; all-completions to get completion on any function name. If | ||
| 1198 | ;; predicate is non-nil, it must be a function to be called for every | ||
| 1199 | ;; match to check if this should really be a match. If flag is t, the | ||
| 1200 | ;; function returns a list of all possible completions. If it is nil | ||
| 1201 | ;; it returns a string, the longest possible completion, or t if STR | ||
| 1202 | ;; is an exact match. If flag is 'lambda, the function returns t if | ||
| 1203 | ;; STR is an exact match, nil otherwise. | ||
| 1204 | |||
| 1205 | (defun pascal-comp-defun (str predicate flag) | ||
| 1206 | (save-excursion | ||
| 1207 | (let ((all nil) | ||
| 1208 | match) | ||
| 1209 | |||
| 1210 | ;; Set buffer to use for searching labels. This should be set | ||
| 1211 | ;; within functins which use pascal-completions | ||
| 1212 | (set-buffer buffer-to-use) | ||
| 1213 | |||
| 1214 | (let ((str str)) | ||
| 1215 | ;; Build regular expression for functions | ||
| 1216 | (if (string= str "") | ||
| 1217 | (setq str (pascal-build-defun-re "[a-zA-Z_]")) | ||
| 1218 | (setq str (pascal-build-defun-re str))) | ||
| 1219 | (goto-char (point-min)) | ||
| 1220 | |||
| 1221 | ;; Build a list of all possible completions | ||
| 1222 | (while (re-search-forward str nil t) | ||
| 1223 | (setq match (buffer-substring (match-beginning 2) (match-end 2))) | ||
| 1224 | (if (or (null predicate) | ||
| 1225 | (funcall predicate match)) | ||
| 1226 | (setq all (cons match all))))) | ||
| 1227 | |||
| 1228 | ;; Now we have built a list of all matches. Give response to caller | ||
| 1229 | (pascal-completion-response)))) | ||
| 1230 | |||
| 1231 | (defun pascal-goto-defun () | ||
| 1232 | "Move to specified Pascal function/procedure. | ||
| 1233 | The default is a name found in the buffer around point." | ||
| 1234 | (interactive) | ||
| 1235 | (let* ((default (pascal-get-default-symbol)) | ||
| 1236 | ;; The following variable is used in pascal-comp-function | ||
| 1237 | (buffer-to-use (current-buffer)) | ||
| 1238 | (default (if (pascal-comp-defun default nil 'lambda) | ||
| 1239 | default "")) | ||
| 1240 | (label (if (not (string= default "")) | ||
| 1241 | ;; Do completion with default | ||
| 1242 | (completing-read (concat "Label: (default " default ") ") | ||
| 1243 | 'pascal-comp-defun nil t "") | ||
| 1244 | ;; There is no default value. Complete without it | ||
| 1245 | (completing-read "Label: " | ||
| 1246 | 'pascal-comp-defun nil t "")))) | ||
| 1247 | ;; If there was no response on prompt, use default value | ||
| 1248 | (if (string= label "") | ||
| 1249 | (setq label default)) | ||
| 1250 | ;; Goto right place in buffer if label is not an empty string | ||
| 1251 | (or (string= label "") | ||
| 1252 | (progn | ||
| 1253 | (goto-char (point-min)) | ||
| 1254 | (re-search-forward (pascal-build-defun-re label t)) | ||
| 1255 | (beginning-of-line))))) | ||
| 1256 | |||
| 1257 | |||
| 1258 | |||
| 1259 | ;;; | ||
| 1260 | ;;; Pascal-outline-mode | ||
| 1261 | ;;; | ||
| 1262 | (defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.") | ||
| 1263 | |||
| 1264 | (if pascal-outline-map | ||
| 1265 | nil | ||
| 1266 | (if (boundp 'set-keymap-name) | ||
| 1267 | (set-keymap-name pascal-outline-map 'pascal-outline-map)) | ||
| 1268 | (if (not (boundp 'set-keymap-parent)) | ||
| 1269 | (setq pascal-outline-map (copy-keymap pascal-mode-map)) | ||
| 1270 | (setq pascal-outline-map (make-sparse-keymap)) | ||
| 1271 | (set-keymap-parent pascal-outline-map pascal-mode-map)) | ||
| 1272 | (define-key pascal-outline-map "\e\C-a" 'pascal-outline-prev-defun) | ||
| 1273 | (define-key pascal-outline-map "\e\C-e" 'pascal-outline-next-defun) | ||
| 1274 | (define-key pascal-outline-map "\C-cg" 'pascal-outline-goto-defun) | ||
| 1275 | (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all) | ||
| 1276 | (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns)) | ||
| 1277 | |||
| 1278 | (defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.") | ||
| 1279 | (make-variable-buffer-local 'pascal-outline-mode) | ||
| 1280 | (set-default 'pascal-outline-mode nil) | ||
| 1281 | (if (not (assoc 'pascal-outline-mode minor-mode-alist)) | ||
| 1282 | (setq minor-mode-alist (append minor-mode-alist | ||
| 1283 | (list '(pascal-outline-mode " Outl"))))) | ||
| 1284 | |||
| 1285 | (defun pascal-outline (&optional arg) | ||
| 1286 | "Outline-line minor mode for Pascal mode. | ||
| 1287 | When in Pascal Outline mode, portions | ||
| 1288 | of the text being edited may be made invisible. \\<pascal-outline-map> | ||
| 1289 | |||
| 1290 | Pascal Outline mode provides some additional commands. | ||
| 1291 | |||
| 1292 | \\[pascal-outline-prev-defun]\ | ||
| 1293 | \t- Move to previous function/procedure, hiding everything else. | ||
| 1294 | \\[pascal-outline-next-defun]\ | ||
| 1295 | \t- Move to next function/procedure, hiding everything else. | ||
| 1296 | \\[pascal-outline-goto-defun]\ | ||
| 1297 | \t- Goto function/procedure prompted for in minibuffer, | ||
| 1298 | \t hide all other functions. | ||
| 1299 | \\[pascal-show-all]\t- Show the whole buffer. | ||
| 1300 | \\[pascal-hide-other-defuns]\ | ||
| 1301 | \t- Hide everything but the current function (function under the cursor). | ||
| 1302 | \\[pascal-outline]\t- Leave pascal-outline-mode." | ||
| 1303 | (interactive "P") | ||
| 1304 | (setq pascal-outline-mode | ||
| 1305 | (if (null arg) (not pascal-outline-mode) t)) | ||
| 1306 | (if (boundp 'redraw-mode-line) | ||
| 1307 | (redraw-mode-line)) | ||
| 1308 | (if pascal-outline-mode | ||
| 1309 | (progn | ||
| 1310 | (setq selective-display t) | ||
| 1311 | (use-local-map pascal-outline-map)) | ||
| 1312 | (progn | ||
| 1313 | (setq selective-display nil) | ||
| 1314 | (pascal-show-all) | ||
| 1315 | (use-local-map pascal-mode-map)))) | ||
| 1316 | |||
| 1317 | (defun pascal-outline-change (b e flag) | ||
| 1318 | (let ((modp (buffer-modified-p))) | ||
| 1319 | (unwind-protect | ||
| 1320 | (subst-char-in-region b e (if (= flag ?\n) ?\^M ?\n) flag) | ||
| 1321 | (set-buffer-modified-p modp)))) | ||
| 1322 | |||
| 1323 | (defun pascal-show-all () | ||
| 1324 | "Show all of the text in the buffer." | ||
| 1325 | (interactive) | ||
| 1326 | (pascal-outline-change (point-min) (point-max) ?\n)) | ||
| 1327 | |||
| 1328 | (defun pascal-hide-other-defuns () | ||
| 1329 | "Show only the current defun." | ||
| 1330 | (interactive) | ||
| 1331 | (save-excursion | ||
| 1332 | (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>")) | ||
| 1333 | (pascal-beg-of-defun)) | ||
| 1334 | (point))) | ||
| 1335 | (end (progn (pascal-end-of-defun) | ||
| 1336 | (backward-sexp 1) | ||
| 1337 | (search-forward "\n\\|\^M" nil t) | ||
| 1338 | (point))) | ||
| 1339 | (opoint (point-min))) | ||
| 1340 | (goto-char (point-min)) | ||
| 1341 | |||
| 1342 | ;; Hide all functions before current function | ||
| 1343 | (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move) | ||
| 1344 | (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) | ||
| 1345 | (setq opoint (point)) | ||
| 1346 | ;; Functions may be nested | ||
| 1347 | (if (> (progn (pascal-end-of-defun) (point)) beg) | ||
| 1348 | (goto-char opoint))) | ||
| 1349 | (if (> beg opoint) | ||
| 1350 | (pascal-outline-change opoint (1- beg) ?\^M)) | ||
| 1351 | |||
| 1352 | ;; Show current function | ||
| 1353 | (pascal-outline-change beg end ?\n) | ||
| 1354 | ;; Hide nested functions | ||
| 1355 | (forward-char 1) | ||
| 1356 | (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move) | ||
| 1357 | (setq opoint (point)) | ||
| 1358 | (pascal-end-of-defun) | ||
| 1359 | (pascal-outline-change opoint (point) ?\^M)) | ||
| 1360 | |||
| 1361 | (goto-char end) | ||
| 1362 | (setq opoint end) | ||
| 1363 | |||
| 1364 | ;; Hide all function after current function | ||
| 1365 | (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move) | ||
| 1366 | (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) | ||
| 1367 | (setq opoint (point)) | ||
| 1368 | (pascal-end-of-defun)) | ||
| 1369 | (pascal-outline-change opoint (point-max) ?\^M) | ||
| 1370 | |||
| 1371 | ;; Hide main program | ||
| 1372 | (if (< (progn (forward-line -1) (point)) end) | ||
| 973 | (progn | 1373 | (progn |
| 974 | (search-forward ":" (pascal-get-end-of-line) t) | 1374 | (goto-char beg) |
| 975 | (1- (current-column))) | 1375 | (pascal-end-of-defun) |
| 976 | (+ (current-column) pascal-case-offset))))) | 1376 | (backward-sexp 1) |
| 1377 | (pascal-outline-change (point) (point-max) ?\^M)))))) | ||
| 977 | 1378 | ||
| 978 | (provide 'pascal) | 1379 | (defun pascal-outline-next-defun () |
| 1380 | "Move to next function/procedure, hiding all others." | ||
| 1381 | (interactive) | ||
| 1382 | (pascal-end-of-defun) | ||
| 1383 | (pascal-hide-other-defuns)) | ||
| 1384 | |||
| 1385 | (defun pascal-outline-prev-defun () | ||
| 1386 | "Move to previous function/procedure, hiding all others." | ||
| 1387 | (interactive) | ||
| 1388 | (pascal-beg-of-defun) | ||
| 1389 | (pascal-hide-other-defuns)) | ||
| 1390 | |||
| 1391 | (defun pascal-outline-goto-defun () | ||
| 1392 | "Move to specified function/procedure, hiding all others." | ||
| 1393 | (interactive) | ||
| 1394 | (pascal-goto-defun) | ||
| 1395 | (pascal-hide-other-defuns)) | ||
| 979 | 1396 | ||
| 980 | ;; pascal.el ends here. | 1397 | ;;; pascal.el ends here |