;;; pascal.el - Major mode for editing pascal source in emacs.
-;;; Copyright (C) 1993 Free Software Foundation, Inc.
+;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
-;; Keywords: languages
+;;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
+;;; Keywords: languages
-;; This file is part of GNU Emacs.
+;;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
-;;; If you want to customize the pascal mode in your startup file, you
-;;; can add these lines to your .emacs file (and remove the ;s at the
-;;; beginning of the line):
-;;;
-;;; ;;; Pascal-mode custumization.
-;;; (autoload 'pascal-mode "pascal-mode" nil t)
-;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode)
-;;; (cons "\\.pas$" 'pascal-mode))
-;;; auto-mode-alist))
-;;; (setq pascal-mode-hook '(lambda ()
-;;; ;; User specifications
-;;; (setq pascal-tab-always-indent t
-;;; pascal-auto-newline nil
-;;; pascal-auto-endcomments t
-;;; pascal-indent-level 3
-;;; pascal-continued-expr 1
-;;; pascal-label-offset -2
-;;; pascal-case-offset 2
-;;; pascal-typedecl-indent 10
-;;; pascal-vardecl-indent 20)))
-
;;; USAGE
;;; =====
-;;; If you have modified your startup file as described above, emacs
-;;; should enter pascal-mode when you load a pascal source into emacs.
-;;; If not, you will have to start pascal-mode manually:
-;;; M-x load-library pascal-mode
-;;; M-x pascal-mode
-;;; When you have entered pascal-mode, you may get more info by pressing
+
+;;; Emacs should enter Pascal mode when you find a Pascal source file.
+;;; When you have entered Pascal mode, you may get more info by pressing
;;; C-h m. You may also get online help describing various functions by:
-;;; C-h d <Name of function you want described>
+;;; C-h f <Name of function you want described>
+
+;;; If you want to customize Pascal mode to fit you better, you may add
+;;; these lines (the values of the variables presented here are the defaults):
+;;;
+;;; ;; User customization for Pascal mode
+;;; (setq pascal-indent-level 3
+;;; pascal-case-indent 2
+;;; pascal-auto-newline nil
+;;; pascal-tab-always-indent t
+;;; pascal-auto-endcomments t
+;;; pascal-toggle-completions nil
+;;; pascal-type-keywords '("array" "file" "packed" "char"
+;;; "integer" "real" "string" "record")
+;;; pascal-start-keywords '("begin" "end" "function" "procedure"
+;;; "repeat" "until" "while" "read" "readln"
+;;; "reset" "rewrite" "write" "writeln")
+;;; pascal-seperator-keywords '("downto" "else" "mod" "div" "then"))
;;; KNOWN BUGS / BUGREPORTS
;;; =======================
;;; As far as I know, there are no bugs in the current version of this
-;;; package. This may not be true however, since I never use this mode
-;;; myself and therefore would never notice them anyway. But if you DO
-;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no
-
-;;; LCD Archive Entry:
-;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no|
-;;; Major mode for editing Pascal code|
-;;; 14-Sep-93|$Revision: 1.3 $|~/modes/pascal-mode.el.Z|
+;;; package. This may not be true however, since I never use this mode
+;;; myself and therefore would never notice them anyway. If you do
+;;; find any bugs, you may submit them to: espensk@stud.cs.uit.no
+;;; as well as to bug-gnu-emacs@prep.ai.mit.edu.
+\f
+;;; Code:
-(defconst pascal-mode-version "1.3"
- "Version of this pascal mode.")
+(defconst pascal-mode-version "2.1a"
+ "Version of `pascal-mode.el'.")
(defvar pascal-mode-abbrev-table nil
"Abbrev table in use in Pascal-mode buffers.")
(defvar pascal-mode-map ()
"Keymap used in Pascal mode.")
-(if (null pascal-mode-map)
- (setq pascal-mode-map (make-sparse-keymap)))
-
-(define-key pascal-mode-map ";" 'electric-pascal-semi)
-(define-key pascal-mode-map "." 'electric-pascal-dot)
-(define-key pascal-mode-map ":" 'electric-pascal-colon)
-(define-key pascal-mode-map "=" 'electric-pascal-equal)
-(define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
-(define-key pascal-mode-map "\t" 'electric-pascal-tab)
-(define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
-(define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function)
-(define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function)
-(define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function)
-(define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
-(define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
-(define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
-(define-key pascal-mode-map "\M-*" 'pascal-star-comment)
-
+(if pascal-mode-map
+ ()
+ (setq pascal-mode-map (make-sparse-keymap))
+ (define-key pascal-mode-map ";" 'electric-pascal-semi-or-dot)
+ (define-key pascal-mode-map "." 'electric-pascal-semi-or-dot)
+ (define-key pascal-mode-map ":" 'electric-pascal-colon)
+ (define-key pascal-mode-map "=" 'electric-pascal-equal)
+ (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
+ (define-key pascal-mode-map "\t" 'electric-pascal-tab)
+ (define-key pascal-mode-map "\e\t" 'pascal-complete-word)
+ (define-key pascal-mode-map "\e?" 'pascal-show-completions)
+ (define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
+ (define-key pascal-mode-map "\e\C-h" 'pascal-mark-defun)
+ (define-key pascal-mode-map "\C-cb" 'pascal-insert-block)
+ (define-key pascal-mode-map "\M-*" 'pascal-star-comment)
+ (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
+ (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
+ (define-key pascal-mode-map "\e\C-a" 'pascal-beg-of-defun)
+ (define-key pascal-mode-map "\e\C-e" 'pascal-end-of-defun)
+ (define-key pascal-mode-map "\C-cg" 'pascal-goto-defun)
+ (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
;;; A command to change the whole buffer won't be used terribly
;;; often, so no need for a key binding.
-;;;(define-key pascal-mode-map "\C-c\C-l" 'pascal-downcase-keywords)
-;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords)
-;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords)
-
-(defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do"
-"downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod"
-"nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set"
-"then" "to" "type" "until" "var" "while" "with"
-;; The following are not standard in pascal, but widely used.
-"get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
-"writeln"))
+; (define-key pascal-mode-map "\C-cd" 'pascal-downcase-keywords)
+; (define-key pascal-mode-map "\C-cu" 'pascal-upcase-keywords)
+; (define-key pascal-mode-map "\C-cc" 'pascal-capitalize-keywords)
+ )
+
+(defvar pascal-keywords
+ '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
+ "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of"
+ "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to"
+ "type" "until" "var" "while" "with"
+ ;; The following are not standard in pascal, but widely used.
+ "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
+ "writeln"))
+
+;;;
+;;; Regular expressions used to calculate indent, etc.
+;;;
+(defconst pascal-symbol-re "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
+(defconst pascal-beg-block-re "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
+(defconst pascal-end-block-re "\\<\\(end\\|until\\)\\>")
+(defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
+(defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>")
+(defconst pascal-sub-block-re "\\<\\(if\\|else\\|while\\)\\>")
+(defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\)\\>")
+(defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
+(defconst pascal-autoindent-lines-re
+ "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
+
+;;; Strings used to mark beginning and end of excluded text
+(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
+(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
(defvar pascal-mode-syntax-table nil
"Syntax table in use in Pascal-mode buffers.")
(if pascal-mode-syntax-table
()
(setq pascal-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table)
- (modify-syntax-entry ?( ". 1" pascal-mode-syntax-table)
- (modify-syntax-entry ?) ". 4" pascal-mode-syntax-table)
+ (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table)
+ (modify-syntax-entry ?( "()1" pascal-mode-syntax-table)
+ (modify-syntax-entry ?) ")(4" pascal-mode-syntax-table)
(modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
- (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
- (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
- (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
- (modify-syntax-entry ?- "." pascal-mode-syntax-table)
- (modify-syntax-entry ?= "." pascal-mode-syntax-table)
- (modify-syntax-entry ?% "." pascal-mode-syntax-table)
- (modify-syntax-entry ?< "." pascal-mode-syntax-table)
- (modify-syntax-entry ?> "." pascal-mode-syntax-table)
- (modify-syntax-entry ?& "." pascal-mode-syntax-table)
- (modify-syntax-entry ?| "." pascal-mode-syntax-table)
- (modify-syntax-entry ?_ "w" pascal-mode-syntax-table)
- (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
-
-(defconst pascal-indent-level 3
+ (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
+ (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
+ (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?- "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?= "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?% "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?< "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?> "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?& "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?| "." pascal-mode-syntax-table)
+ (modify-syntax-entry ?_ "w" pascal-mode-syntax-table)
+ (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
+
+(defvar pascal-indent-level 3
"*Indentation of Pascal statements with respect to containing block.")
-(defconst pascal-continued-expr 1
- "*Indentation of line that is a continued expression.")
-(defconst pascal-label-offset -1
- "*Offset of Pascal label lines, case statements and record lines.
-This is relative to usual indentation.")
-(defconst pascal-case-offset 2
- "*Indentation after case statements.")
-(defconst pascal-vardecl-indent 15
- "*Indentation (from the beginning of line to `:' of the declaration.")
-(defconst pascal-typedecl-indent 10
- "*Indentation (from the beginning of line to `=' of the declaration.")
-(defconst pascal-auto-newline nil
- "*Non-nil means automatically newline after semicolons and `end'.")
-(defconst pascal-tab-always-indent t
- "*Non-nil means TAB in Pascal mode should always reindent the current line.
-It does so regardless of where in the line point is
-when the TAB command is used.")
-(defconst pascal-auto-endcomments t
- "*Non-nil means make a comment { ... } after the end for a case or function.
-The name of the function or case is put between the braces.")
+(defvar pascal-case-indent 2
+ "*Indentation for case statements.")
+(defvar pascal-auto-newline nil
+ "*Non-nil means automatically newline after simcolons and the punctation mark
+after an end.")
+(defvar pascal-tab-always-indent t
+ "*Non-nil means TAB in Pascal mode should always reindent the current line,
+regardless of where in the line point is when the TAB command is used.")
+(defvar pascal-auto-endcomments t
+ "*Non-nil means a comment { ... } is set after the ends which ends cases and
+functions. The name of the function or case will be set between the braces.")
+(defvar pascal-toggle-completions nil
+ "*Non-nil means that \\<pascal-mode-map>\\[pascal-complete-label] should \
+not display a completion buffer when
+the label couldn't be completed, but instead toggle the possible completions
+with repeated \\[pascal-complete-label]'s.")
+(defvar pascal-type-keywords
+ '("array" "file" "packed" "char" "integer" "real" "string" "record")
+ "*Keywords for types used when completing a word in a declaration or parmlist.
+\(eg. integer, real, char.) The types defined within the Pascal program
+will be completed runtime, and should not be added to this list.")
+(defvar pascal-start-keywords
+ '("begin" "end" "function" "procedure" "repeat" "until" "while"
+ "read" "readln" "reset" "rewrite" "write" "writeln")
+ "*Keywords to complete when standing at the first word of a statement.
+\(eg. begin, repeat, until, readln.)
+The procedures and variables defined within the Pascal program
+will be completed runtime and should not be added to this list.")
+(defvar pascal-seperator-keywords
+ '("downto" "else" "mod" "div" "then")
+ "*Keywords to complete when NOT standing at the first word of a statement.
+\(eg. downto, else, mod, then.)
+Variables and function names defined within the
+Pascal program are completed runtime and should not be added to this list.")
+
+;;;
+;;; Macros
+;;;
+
+(defsubst pascal-get-beg-of-line (&optional arg)
+ (save-excursion
+ (beginning-of-line arg)
+ (point)))
+
+(defsubst pascal-get-end-of-line (&optional arg)
+ (save-excursion
+ (end-of-line arg)
+ (point)))
+
+(defun pascal-declaration-end ()
+ (let ((nest 1))
+ (while (and (> nest 0)
+ (re-search-forward
+ "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)"
+ (save-excursion (end-of-line 2) (point)) t))
+ (cond ((match-beginning 1) (setq nest (1+ nest)))
+ ((match-beginning 2) (setq nest (1- nest)))))))
+
+(defun pascal-declaration-beg ()
+ (let ((nest 1))
+ (while (and (> nest 0)
+ (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line -0) t))
+ (cond ((match-beginning 1) (setq nest 0))
+ ((match-beginning 2) (setq nest (1- nest)))
+ ((match-beginning 3) (setq nest (1+ nest)))))
+ (= nest 0)))
+
+(defsubst pascal-within-string ()
+ (save-excursion
+ (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
+
;;;###autoload
(defun pascal-mode ()
- "Major mode for editing Pascal code.
-Tab indents for Pascal code.
-Delete converts tabs to spaces as it moves back.
-\\{pascal-mode-map}
-Variables controlling indentation style:
- pascal-tab-always-indent (default t)
+ "Major mode for editing Pascal code. \\<pascal-mode-map>
+TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
+
+\\[pascal-complete-word] completes the word around current point with respect \
+to position in code
+\\[pascal-show-completions] shows all possible completions at this point.
+
+Other useful functions are:
+
+\\[pascal-mark-defun]\t- Mark function.
+\\[pascal-insert-block]\t- insert begin ... end;
+\\[pascal-star-comment]\t- insert (* ... *)
+\\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
+\\[pascal-uncomment-area]\t- Uncomment an area commented with \
+\\[pascal-comment-area].
+\\[pascal-beg-of-defun]\t- Move to beginning of current function.
+\\[pascal-end-of-defun]\t- Move to end of current function.
+\\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
+\\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
+
+Variables controlling indentation/edit style:
+
+ pascal-indent-level (default 3)
+ Indentation of Pascal statements with respect to containing block.
+ pascal-case-indent (default 2)
+ Indentation for case statements.
+ pascal-auto-newline (default nil)
+ Non-nil means automatically newline after simcolons and the punctation mark
+ after an end.
+ pascal-tab-always-indent (defualt t)
Non-nil means TAB in Pascal mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.
- pascal-auto-newline (default nil)
- Non-nil means automatically newline after semicolons and the punctation
- mark after an end.
- pascal-auto-endcomments (default t)
- Non-nil means automatically set name of function or `case' in braces after
- after the `end' if this end ends a function or a case block.
- pascal-indent-level (default 3)
- Indentation of Pascal statements within surrounding block.
- pascal-continued-expr (default 1)
- Indentation of a line that is a continued expression.
- pascal-typedecl-indent (default 10)
- Indentation to the `=' in type declarations. (Or constant declarations.)
- pascal-vardecl-indent (default 20)
- Indentation to the `:' in var declarations.
- pascal-label-offset (default -1)
- Extra indentation for line that is a label, case statement or part of
- a record block.
- pascal-case-offset (default 2)
- Extra indent to the `:' in case statements.
-
-The only auto indention this mode doesn't fully support is if there is a
-case within a type declaration. However, this is seldom used.
-
-When typing text, you should not worry about to get right indentions, they
-will be set when you hit return. The mode will also automatically delete the
-whitespaces between `*' and `)' when ending a starcomment.
+ pascal-auto-endcomments (default t)
+ Non-nil means a comment { ... } is set after the ends which ends cases and
+ functions. The name of the function or case will be set between the braces.
+
+See also the user variables pascal-type-keywords, pascal-start-keywords and
+pascal-seperator-keywords.
Turning on Pascal mode calls the value of the variable pascal-mode-hook with
no args, if that value is non-nil."
(set-syntax-table pascal-mode-syntax-table)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'pascal-indent-line)
- (setq comment-indent-hook 'pascal-indent-within-comment)
+ (setq comment-indent-function 'pascal-indent-comment)
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t)
(make-local-variable 'case-fold-search)
(setq case-fold-search t)
(run-hooks 'pascal-mode-hook))
+\f
+
;;;
;;; Electric functions
;;;
-
(defun electric-pascal-terminate-line ()
"Terminate line and indent next line."
(interactive)
+ ;; First, check if current line should be indented
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
- (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b")
+ (if (looking-at pascal-autoindent-lines-re)
(pascal-indent-line)))
+ (delete-horizontal-space) ; Removes trailing whitespaces
(newline)
+ ;; Indent next line
(pascal-indent-line)
;; Maybe we should set some endcomments
(if pascal-auto-endcomments
(save-excursion
(forward-line -1)
(skip-chars-forward " \t")
- (cond ((looking-at "\\*[ \t]*)")
+ (cond ((looking-at "\\*[ \t]+)")
;; Delete region between `*' and `)' if there is only whitespaces.
(forward-char 1)
- (pascal-delete-whitespaces))
+ (delete-horizontal-space))
((and (looking-at "(\\*\\|\\*[^)]")
(not (save-excursion
(search-forward "*)" (pascal-get-end-of-line) t))))
(setq setstar t))))
;; If last line was a star comment line then this one shall be too.
- (if setstar
- (progn
- (insert "*")
- (pascal-indent-command))
- (pascal-indent-line))))
+ (if (null setstar)
+ (pascal-indent-line)
+ (insert "* "))))
-(defun electric-pascal-semi ()
- "Insert ; character and correct this line's indention."
- (interactive)
- (insert last-command-char)
- (save-excursion
- (beginning-of-line)
- (pascal-indent-line))
- (if pascal-auto-newline
- (electric-pascal-terminate-line)))
-(defun electric-pascal-dot ()
- "Insert a period and correct this line's indention."
+(defun electric-pascal-semi-or-dot ()
+ "Insert `;' or `.' character and reindent the line."
(interactive)
(insert last-command-char)
(save-excursion
(electric-pascal-terminate-line)))
(defun electric-pascal-colon ()
- "Insert : and do all indentions except line indent on this line."
+ "Insert `:' and do all indentions except line indent on this line."
(interactive)
(insert last-command-char)
- ;; Do nothing of within string.
- (if (not (pascal-within-string))
- (progn
- (if (save-excursion
- (backward-char 2)
- (looking-at "[0-9]"))
- (save-excursion
- (beginning-of-line)
- (pascal-indent-line)))
- (let ((pascal-tab-always-indent nil))
- (pascal-indent-command)))))
-
+ ;; Do nothing if within string.
+ (if (pascal-within-string)
+ ()
+ (save-excursion
+ (beginning-of-line)
+ (pascal-indent-line))
+ (let ((pascal-tab-always-indent nil))
+ (pascal-indent-command))))
+
(defun electric-pascal-equal ()
- "Insert = and do indention if within type declaration."
+ "Insert `=', and do indention if within type declaration."
(interactive)
(insert last-command-char)
- (if (eq (nth 1 (pascal-calculate-indent t)) 'decl)
+ (if (eq (car (pascal-calculate-indent)) 'declaration)
(let ((pascal-tab-always-indent nil))
(pascal-indent-command))))
(defun electric-pascal-tab ()
- "Function called when tab is pressed."
+ "Function called when TAB is pressed in Pascal mode."
(interactive)
;; Do nothing if within a string.
- (if (not (pascal-within-string))
- ;; If pascal-tab-always-indent is set then indent the beginning of
- ;; the line.
- (progn
- (if pascal-tab-always-indent
- (save-excursion
- (beginning-of-line)
- (pascal-indent-line)))
- (pascal-indent-command))))
+ (if (pascal-within-string)
+ (insert "\t")
+ ;; If pascal-tab-always-indent, indent the beginning of the line.
+ (if pascal-tab-always-indent
+ (save-excursion
+ (beginning-of-line)
+ (pascal-indent-line))
+ (insert "\t"))
+ (pascal-indent-command)))
+
+\f
;;;
;;; Interactive functions
;;;
(defun pascal-insert-block ()
- "Insert begin ... end; block in the code with right indents."
+ "Insert Pascal begin ... end; block in the code with right indentation."
(interactive)
(pascal-indent-line)
(insert "begin")
(pascal-indent-line)))
(defun pascal-star-comment ()
- "Insert star comment in the code."
+ "Insert Pascal star comment at point."
(interactive)
(pascal-indent-line)
(insert "(*")
(electric-pascal-terminate-line)
(save-excursion
(electric-pascal-terminate-line)
- (pascal-delete-whitespaces)
- (insert ")")))
+ (delete-horizontal-space)
+ (insert ")"))
+ (insert " "))
-(defun pascal-mark-function ()
+(defun pascal-mark-defun ()
"Mark the current pascal function (or procedure).
-Put the mark at the end of the function, and point at the beginning."
+This puts the mark at the end, and point at the beginning."
(interactive)
(push-mark (point))
- (pascal-forward-to-end-of-function)
+ (pascal-end-of-defun)
(push-mark (point))
- (pascal-backward-to-beginning-of-function)
- (zmacs-activate-region))
+ (pascal-beg-of-defun)
+ (if (fboundp 'zmacs-activate-region)
+ (zmacs-activate-region)))
(defun pascal-comment-area (start end)
- "Put the current region in a comment.
-The comments that are in this area are
-be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will
-however be turned back to normal when the area is uncommented by pressing
-\\[pascal-uncomment-area].
-The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with:
-` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area
-will not be able to recognize them."
+ "Put the region into a Pascal comment.
+The comments that are in this area are \"deformed\":
+`*)' becomes `!(*' and `}' becomes `!{'.
+These deformed comments are returned to normal if you use
+\\[pascal-uncomment-area] to undo the commenting.
+
+The commented area starts with `pascal-exclude-str-start', and ends with
+`pascal-include-str-end'. But if you change these variables,
+\\[pascal-uncomment-area] won't recognize the comments."
(interactive "r")
(save-excursion
;; Insert start and endcomments
(not (save-excursion (skip-chars-backward " \t") (bolp))))
(forward-line 1)
(beginning-of-line))
- (insert " ---/\\---EXCLUDED---/\\---}")
+ (insert pascal-exclude-str-end)
(setq end (point))
(newline)
(goto-char start)
(beginning-of-line)
- (insert "{---\\/---EXCLUDED---\\/--- ")
+ (insert pascal-exclude-str-start)
(newline)
;; Replace end-comments within commented area
(goto-char end)
(replace-match "!{" t t)))))
(defun pascal-uncomment-area ()
- "Uncomment a commented area.
-Change all deformed comments in this area back to normal.
-This function does nothing if the pointer is not in a commented
+ "Uncomment a commented area; change deformed comments back to normal.
+This command does nothing if the pointer is not in a commented
area. See also `pascal-comment-area'."
(interactive)
(save-excursion
(end (point)))
;; Find the boundaries of the comment
(save-excursion
- (setq start (progn (search-backward "{---\\/---EXCLUDED---\\/--" nil t)
+ (setq start (progn (search-backward pascal-exclude-str-start nil t)
(point)))
- (setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" nil t)
+ (setq end (progn (search-forward pascal-exclude-str-end nil t)
(point))))
;; Check if we're really inside a comment
(if (or (equal start (point)) (<= end (point)))
(end-of-line)
(delete-region pos (1+ (point)))))))))
-(defun pascal-backward-to-beginning-of-function ()
- "Move backwards to the beginning of this function or procedure."
+(defun pascal-beg-of-defun ()
+ "Move backward to the beginning of the current function or procedure."
(interactive)
- ;; Check if this is a
- (if (save-excursion
- (re-search-backward "\\<end" nil t)
- (looking-at "end\\."))
- (beginning-of-buffer)
- (let ((nest-depth 0) (nest-max 0)
- (nest-noexit 1))
- (beginning-of-line)
- ;; First we find the max depth of the nesting
- (save-excursion
- (while (not (or (bobp) (looking-at "function\\b\\|procedure\\b")))
- (backward-sexp 1)
- (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
- (setq nest-depth (1+ nest-depth)))
- ((looking-at "end\\(\\b\\|;\\|\\.\\)")
- (setq nest-depth (1- nest-depth))))
- (setq nest-max (max nest-depth nest-max))))
- ;; Then we can start searching
- (setq nest-depth 0)
- (while (not (or (bobp) (and (looking-at "function\\b\\|procedure\\b")
- (zerop nest-noexit))))
- (backward-sexp 1)
- (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
- (setq nest-depth (1+ nest-depth)))
- ((looking-at "end\\(\\b\\|;\\|\\.\\)")
- (if (equal nest-depth nest-max)
- (setq nest-noexit (1+ nest-noexit)))
- (setq nest-depth (1- nest-depth)))
- ((looking-at "function\\b\\|procedure\\b")
- (setq nest-noexit (1- nest-noexit))))))))
-
-(defun pascal-forward-to-end-of-function ()
- "Moves the point to the end of the function."
+ (catch 'found
+ (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
+ (forward-sexp 1))
+ (let ((nest 0) (max -1) (func 0)
+ (reg (concat pascal-beg-block-re "\\|"
+ pascal-end-block-re "\\|"
+ pascal-defun-re)))
+ (while (re-search-backward reg nil 'move)
+ (cond ((let ((state (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (or (nth 3 state) (nth 4 state))) ; Inside string or comment
+ ())
+ ((match-end 1) ; begin|case|record|repeat
+ (if (and (looking-at "\\<record\\>") (>= max 0))
+ (setq func (1- func)))
+ (setq nest (1+ nest)
+ max (max nest max)))
+ ((match-end 2) ; end|until
+ (if (and (= nest max) (>= max 0))
+ (setq func (1+ func)))
+ (setq nest (1- nest)))
+ ((match-end 3) ; function|procedure
+ (if (= 0 func)
+ (throw 'found t)
+ (setq func (1- func)))))))
+ nil))
+
+(defun pascal-end-of-defun ()
+ "Move forward to the end of the current function or procedure."
(interactive)
- (if (not (looking-at "function\\b\\|procedure\\b"))
- (pascal-backward-to-beginning-of-function))
- (if (bobp)
- (end-of-buffer)
- (progn
- (let ((nest-depth 0)
- (func-depth 1))
- (while (not (or (and (zerop nest-depth) (zerop func-depth)) (eobp)))
- (forward-sexp 2)
- (if (not (eobp))
- (progn
- (backward-sexp 1) ; Move to the beginning of the next sexp
- (cond ((looking-at "begin\\b\\|case\\b\\|record\\b")
- (setq nest-depth (1+ nest-depth)))
- ((looking-at "end\\(\\b\\|;\\|\\.\\)")
- (setq nest-depth (1- nest-depth))
- (if (zerop nest-depth)
- (setq func-depth (1- func-depth))))
- ((looking-at "function\\b\\|procedure\\b")
- (setq func-depth (1+ func-depth)))))))
- (end-of-line)))))
+ (if (looking-at "\\s ")
+ (forward-sexp 1))
+ (if (not (looking-at pascal-defun-re))
+ (pascal-beg-of-defun))
+ (forward-char 1)
+ (let ((nest 0) (func 1)
+ (reg (concat pascal-beg-block-re "\\|"
+ pascal-end-block-re "\\|"
+ pascal-defun-re)))
+ (while (and (/= func 0)
+ (re-search-forward reg nil 'move))
+ (cond ((let ((state (save-excursion
+ (parse-partial-sexp (point-min) (point)))))
+ (or (nth 3 state) (nth 4 state))) ; Inside string or comment
+ ())
+ ((match-end 1)
+ (setq nest (1+ nest))
+ (if (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "\\<record\\>"))
+ (setq func (1+ func))))
+ ((match-end 2)
+ (setq nest (1- nest))
+ (if (= nest 0)
+ (setq func (1- func))))
+ ((match-end 3)
+ (setq func (1+ func))))))
+ (forward-line 1))
(defun pascal-downcase-keywords ()
- "Makes all Pascal keywords in the buffer lowercase."
+ "Downcase all Pascal keywords in the buffer."
(interactive)
(pascal-change-keywords 'downcase-word))
(defun pascal-upcase-keywords ()
- "Makes all Pascal keywords in the buffer uppercase."
+ "Upcase all Pascal keywords in the buffer."
(interactive)
(pascal-change-keywords 'upcase-word))
(defun pascal-capitalize-keywords ()
- "Makes all Pascal keywords in the buffer uppercase."
+ "Capitalize all Pascal keywords in the buffer."
(interactive)
(pascal-change-keywords 'capitalize-word))
+;; Change the keywords according to argument.
(defun pascal-change-keywords (change-word)
- "Change the keywords according to argument."
(save-excursion
- (beginning-of-buffer)
- (while (re-search-forward (mapconcat
- 'downcase pascal-keywords "\\>\\|\\<") nil t)
- (funcall change-word -1))))
+ (let ((keyword-re (concat "\\<\\("
+ (mapconcat 'identity pascal-keywords "\\|")
+ "\\)\\>")))
+ (goto-char (point-min))
+ (while (re-search-forward keyword-re nil t)
+ (funcall change-word -1)))))
+
+\f
;;;
;;; Other functions
;;;
-(defun pascal-delete-whitespaces ()
- "Deletes the whitespaces around the current point."
- (interactive)
- (let ((pos (progn (skip-chars-backward " \t") (point))))
- (skip-chars-forward " \t")
- (delete-region pos (point))))
-
-(defun pascal-get-beg-of-line ()
- (save-excursion
- (beginning-of-line)
- (point)))
-
-(defun pascal-get-end-of-line ()
- (save-excursion
- (end-of-line)
- (point)))
-
-(defun pascal-within-string ()
- "Return t if within string; nil otherwise."
- (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t))
- (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2)))))
-
-(defun pascal-check-if-within-comment ()
- "If within a comment, return the correct indent. Return nil otherwise."
- (let ((comstart (point))
- (comend (point)))
- (save-excursion
- (if (re-search-backward "(\\*\\|{" nil t)
- (setq comstart (point))
- (setq comstart 0)))
- (save-excursion
- (if (re-search-backward "\\*)\\|}" nil t)
- (setq comend (point))
- (setq comend 0)))
- (if (< comend comstart)
- (save-excursion
- (goto-char comstart)
- ;; Add 1 to indent if this is a starcomment
- (if (looking-at "(\\*")
- (1+ (current-column))
- (current-column)))
- nil)))
(defun pascal-set-auto-comments ()
- "Put { case } or { FUNNAME } on this line if appropriate after `end'."
+ "Insert `{ case }' or `{ NAME }' on this line if appropriate.
+Insert `{ case }' if there is an `end' on the line which
+ends a case block. Insert `{ NAME }' if there is an `end'
+on the line which ends a function or procedure named NAME."
(save-excursion
(forward-line -1)
(skip-chars-forward " \t")
- (if (and (looking-at "end\\(\>\\|;\\)")
+ (if (and (looking-at "\\<end;")
(not (save-excursion
(end-of-line)
- (search-backward "}" (pascal-get-beg-of-line) t))))
+ (search-backward "{" (pascal-get-beg-of-line) t))))
(progn
- (if (eq (nth 1 (pascal-calculate-indent)) 'case)
+ (if (eq (car (pascal-calculate-indent)) 'case)
;; This is a case block
(progn
(end-of-line)
- (pascal-delete-whitespaces)
+ (delete-horizontal-space)
(insert " { case }"))
(let ((nest 1))
;; Check if this is the end of a function
(save-excursion
- (while (not (or (looking-at "function\\b\\|\\procedure\\b")
- (bobp)))
+ (while (not (or (looking-at pascal-defun-re) (bobp)))
(backward-sexp 1)
- (cond ((looking-at "begin\\b\\|case\\b")
+ (cond ((looking-at pascal-beg-block-re)
(setq nest (1- nest)))
- ((looking-at "end\\(\\b\\|;\\|\\.\\)")
+ ((looking-at pascal-end-block-re)
(setq nest (1+ nest)))))
(if (bobp)
(setq nest 1)))
(if (zerop nest)
- (let ((last-command nil))
- ;; Find the function name and put it in braces
- (save-excursion
- (pascal-backward-to-beginning-of-function)
- (skip-chars-forward "^ \t")
- (skip-chars-forward " \t")
- (copy-region-as-kill (point)
- (save-excursion
- (skip-chars-forward "a-zA-Z0-9_")
- (point))))
+ (progn
(end-of-line)
- (pascal-delete-whitespaces)
+ (delete-horizontal-space)
(insert " { ")
- ;; We've filled up the kill ring, but hey, who cares?
- (yank) (rotate-yank-pointer 1)
+ (let (b e)
+ (save-excursion
+ (setq b (progn (pascal-beg-of-defun)
+ (skip-chars-forward "^ \t")
+ (skip-chars-forward " \t")
+ (point))
+ e (progn (skip-chars-forward "a-zA-Z0-9_")
+ (point))))
+ (insert-buffer-substring (current-buffer) b e))
(insert " }")))))))))
+\f
+
;;;
-;;; Indent functions and calculation of indent
-;;;
+;;; Indentation
+;;;
+(defconst pascal-indent-alist
+ '((block . (+ ind pascal-indent-level))
+ (case . (+ ind pascal-case-indent))
+ (declaration . (+ ind pascal-indent-level))
+ (paramlist . (pascal-indent-paramlist t))
+ (comment . (pascal-indent-comment t))
+ (defun . ind) (contexp . ind)
+ (unknown . 0) (string . 0)))
+
(defun pascal-indent-command ()
- "Indent current line as Pascal code and/or indent within line."
- ;; Call pascal-indent-line. This does nothing if we're not at the
- ;; beginning of the line.
- (pascal-indent-line)
- (let ((indent (pascal-calculate-indent t))
- (pos 0))
- (save-excursion
- (cond ((or (eq (nth 1 indent) 'case)
- (eq (nth 1 indent) 'record))
- ;; Indent for case and record blocks
- (beginning-of-line)
- (if (search-forward ":" (pascal-get-end-of-line) t)
- (progn
- ;; Indent before colon
- (backward-char 1)
- (pascal-delete-whitespaces)
- (indent-to (max (pascal-find-leading-case-colon)
- (1+ (current-column))))
- ;; Indent after colon
- (forward-char 1)
- (pascal-delete-whitespaces)
- (indent-to (1+ (current-column))))
- ;; Indent if there is no colon
- (progn
- (beginning-of-line)
- (skip-chars-forward " \t")
- (if (not (eolp))
- (progn
- (skip-chars-forward "0-9a-zA-Z\"\'_;")
- (pascal-delete-whitespaces)
- (indent-to (max (pascal-find-leading-case-colon)
- (1+ (current-column)))))))))
- ((eq (nth 1 indent) 'decl)
- ;; Indent for declarations
- (let ((posii (pascal-get-beg-of-line)))
- (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>"
- nil t)
- (cond ((looking-at "var\\b")
- (pascal-declindent-middle-of-line
- ":" posii pascal-vardecl-indent))
- ((looking-at "type\\b\\|const\\b")
- (pascal-declindent-middle-of-line
- "=" posii pascal-typedecl-indent)))))
- ((eq (nth 1 indent) 'function)
- ;; Indent for parameterlist
- ;; Done twice in case something has changed
- (pascal-indent-parameter-list)
- (pascal-indent-parameter-list))))
- ;; Go to the end of a line if rest of line contains only whitespaces
- (if (save-excursion (skip-chars-forward " \t") (eolp))
- (end-of-line))))
+ "Indent for special part of code."
+ (let* ((indent-str (pascal-calculate-indent))
+ (type (car indent-str))
+ (ind (car (cdr indent-str))))
+ (cond ((eq type 'paramlist)
+ (pascal-indent-paramlist)
+ (pascal-indent-paramlist))
+ ((eq type 'declaration)
+ (pascal-indent-declaration))
+ ((and (eq type 'case) (not (looking-at "^[ \t]*$")))
+ (pascal-indent-case)))
+ (if (looking-at "[ \t]+$")
+ (skip-chars-forward " \t"))))
(defun pascal-indent-line ()
- "Indent current line as Pascal code."
- (let ((indent (list 0 nil))
- (comindent 0)
- beg (point))
- (save-excursion
- (beginning-of-line)
- (setq indent (pascal-calculate-indent)))
- ;; If we are inside a comment, do special indent.
- (if (setq comindent (pascal-check-if-within-comment))
- (pascal-indent-within-comment comindent)
- ;; Skip the rest if we're not standing on the beginning of a line.
- (if (save-excursion (skip-chars-backward " \t") (bolp))
- (progn
- (beginning-of-line)
- (pascal-delete-whitespaces)
- ;; When to skip the ekstra indent:
- ;; If we are standing at end or until.
- ;; If we are in an if statement and standing at else,
- ;; begin or repeat
- ;; If we are in a with, while or for statement and standing
- ;; at begin or end.
- (cond ((or (or (looking-at "end\\b\\|until\\b")
- (not (nth 1 indent)))
- (and (eq (nth 1 indent) 'if)
- (looking-at "begin\\b\\|\\repeat\\b\\|else\\b"))
- (and (eq (nth 1 indent) 'whilewith)
- (looking-at "begin\\b\\|\\repeat\\b")))
- (indent-to (car indent)))
- ;; Continued expression
- ((eq (nth 1 indent) 'contexp)
- (indent-to (+ (car indent) pascal-continued-expr)))
- ;; If this is a part of a case or record block,
- ;; then modify the indent level.
- ((or (eq (nth 1 indent) 'case)
- (eq (nth 1 indent) 'record))
- (indent-to (+ (car indent) pascal-indent-level
- pascal-label-offset)))
- ;; If this is a label - don't indent.
- ((looking-at "[0-9]*:")
- (skip-chars-forward "0-9:")
- (pascal-delete-whitespaces)
- (indent-to (+ (car indent) pascal-indent-level)))
- ;; If this is insde a parameter list, do special indent
- ((eq (nth 1 indent) 'function)
- (pascal-indent-parameter-list))
- ;; All other indents are set normaly.
- (t
- (indent-to (+ (car indent) pascal-indent-level)))))))))
-
-(defun pascal-calculate-indent (&optional arg)
- "Search backward in code to find the right indent level.
-Return a list containing:
-1. Indent level
-2. The indent keyword (begin, case etc.), or nil if backtracking failed.
-If arg is non-nil, we do not search for continued expressions."
- (let ((pascal-nest-depth 1)
- (oldpos (save-excursion (forward-line -1) (end-of-line) (point)))
- (samepos (point)) (if-is-set t)
- (return-struct (list 0 nil)) (pos 0)
- (contexpr nil) (after-contexpr (not arg))
- (case-fold-search t))
- (save-excursion
- (while (and (not (zerop pascal-nest-depth))
- (not (bobp)))
- (progn
- (backward-sexp 1)
- (if (save-excursion
- (setq pos (point))
- (end-of-line)
- (search-backward ";" pos t))
- (setq if-is-set nil
- after-contexpr nil))
- (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b")
- (setq after-contexpr nil))
-
- (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b")
- (setq pascal-nest-depth (1- pascal-nest-depth)))
- ;;
- ;; END | UNTIL
- ((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b")
- (setq if-is-set nil)
- (if after-contexpr
- (setq pascal-nest-depth 0
- contexpr t)
- (setq pascal-nest-depth (1+ pascal-nest-depth))))
- ;;
- ;; IF | ELSE | WITH | WHILE | FOR
- ;; LABEL | CONST | TYPE | FUNCTION | PROCEDURE
- ((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b")
- if-is-set)
- (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b"))
- (setq pascal-nest-depth 0))
- ;;
- ;; VAR
- ((looking-at "var\\b")
- ;; A `var' can be in a declaration part or parameter part
- (let ((stpos 0) (edpos 0))
- (save-excursion
- (if (not (re-search-backward
- "\\<\\(function\\|procedure\\)\\>" nil t))
- (beginning-of-buffer))
- (setq stpos (save-excursion
- (search-forward "(" nil t) (point)))
- (setq edpos (save-excursion
- (search-forward ")" nil t) (point))))
- (cond ((or (= stpos edpos) (< samepos stpos)
- (and (> (point) edpos) (> edpos stpos)))
- ;; This is really a declaration block!!
- nil)
- ((and (>= samepos stpos) (or (< samepos edpos)
- (> stpos edpos)))
- ;; Hmm... part of a parameter
- (re-search-backward
- "\\<\\(function\\|procedure\\)\\>" nil t))
- (t
- ;; This is just after a parameter declaration
- (forward-char 1)))
- ;; We'll quit anyway
- (setq pascal-nest-depth 0)))
- ;;
- ;; CONTINUED EXPRESSIONS
- (after-contexpr
- (save-excursion
- ;; First, we have to be at the begining of a line
- (if (and (progn (skip-chars-backward " \t") (bolp))
- ;; Blank lines don't count
- (not (progn (skip-chars-forward " \t") (eolp)))
- ;; But nonblank without ';' do
- (not (search-forward ";" (pascal-get-end-of-line) t)))
- (save-excursion
- (forward-line -1)
- (end-of-line)
- (backward-sexp 1)
- (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>")
- (progn
- (skip-chars-forward "^; " (pascal-get-end-of-line))
- (equal (char-to-string (following-char))
- ";")))
- (setq pascal-nest-depth 0))
- (setq contexpr t)))))
- )))
- (cond (contexpr
- (setq return-struct (list (pascal-lstart-col) 'contexp)))
- ((looking-at "begin\\b")
- (setq return-struct (list (pascal-lstart-col) 'begin)))
- ((looking-at "else\\b")
- (setq return-struct (list (save-excursion
- (re-search-backward "if\\b" nil t)
- (pascal-lstart-col)) 'if))
- ;; Indent line in case this is a multiple if
- (beginning-of-line)
- (pascal-delete-whitespaces)
- (indent-to (car return-struct)))
- ((looking-at "if\\b")
- (if (save-excursion
- (narrow-to-region (pascal-get-beg-of-line) (point))
- (backward-sexp 1)
- (widen)
- (looking-at "else\\b"))
- ;; Indent line if this is a multiple if
- (progn
- (beginning-of-line)
- (pascal-delete-whitespaces)
- (indent-to (save-excursion
- (re-search-backward "if\\b" nil t)
- (pascal-lstart-col)))))
- ;; This could be a continued expression
- (if (and after-contexpr
- (not (save-excursion (re-search-forward
- "then\\b" (pascal-get-end-of-line) t))))
- (setq return-struct (list (pascal-lstart-col) 'contexp))
- (setq return-struct (list (pascal-lstart-col) 'if))))
- ((looking-at "repeat\\b")
- (setq return-struct (list (pascal-lstart-col) 'repeat)))
- ((looking-at "case\\b")
- (setq return-struct (list (current-column) 'case)))
- ((looking-at "record\\b")
- (setq return-struct (list (current-column) 'record)))
- ((looking-at "while\\b\\|with\\b\\|for\\b")
- ;; This could ba a continued expression
- (if (and after-contexpr
- (not (save-excursion (re-search-forward
- "do\\b" (pascal-get-end-of-line) t))))
- (setq return-struct (list (pascal-lstart-col) 'contexp))
- (setq return-struct (list (current-column) 'whilewith))))
- ((looking-at "procedure\\b\\|function\\b")
- ;; Make sure that this is a function with parameters, and
- ;; that we are actually standing inside the paranthesis.
- (let ((spos (save-excursion
- (search-forward "(" samepos t) (point)))
- (epos (save-excursion
- (search-forward ")" samepos t) (point))))
- (if (and (>= samepos spos) (or (< samepos epos)
- (> spos epos)))
- (setq return-struct (list 0 'function))
- (setq return-struct (list 0 nil)))))
- ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b")
- ;; Are we really in the declaration part?(Check for blank lines)
- (if (< oldpos (point))
- (setq return-struct (list 0 'decl))
- (if (save-excursion
- (not (re-search-forward "^[ \t]*$" oldpos t)))
- (setq return-struct (list 0 'decl))
- (setq return-struct (list 0 nil)))))
- (t
- (setq return-struct (list 0 nil))))
- return-struct)))
-
-(defun pascal-lstart-col ()
- "Return the column of the beginning of the first command on the line."
+ "Indent current line as a Pascal statement."
+ (let* ((indent-str (pascal-calculate-indent))
+ (type (car indent-str))
+ (ind (car (cdr indent-str))))
+ (if (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
+ (search-forward ":" nil t))
+ (delete-horizontal-space)
+ ;; Some thing should not be indented
+ (if (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
+ (looking-at pascal-defun-re))
+ ()
+ ;; Other things should have no extra indent
+ (if (looking-at pascal-noindent-re)
+ (indent-to ind)
+ ;; But most lines are treated this way:
+ (indent-to (eval (cdr (assoc type pascal-indent-alist))))
+ ))))
+
+(defun pascal-calculate-indent ()
+ "Calculate the indent of the current Pascal line.
+Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
+ (save-excursion
+ (let* ((oldpos (point))
+ (state (save-excursion (parse-partial-sexp (point-min) (point))))
+ (nest 0) (par 0) (complete nil) (blocked nil)
+ (type (catch 'nesting
+ ;; Check if inside a string, comment or parenthesis
+ (cond ((nth 3 state) (throw 'nesting 'string))
+ ((nth 4 state) (throw 'nesting 'comment))
+ ((> (car state) 0)
+ (goto-char (scan-lists (point) -1 (car state)))
+ (setq par (1+ (current-column)))))
+ ;; Loop until correct indent is found
+ (while t
+ (backward-sexp 1)
+ (cond (;--Nest block outwards
+ (looking-at pascal-beg-block-re)
+ (if (= nest 0)
+ (cond ((looking-at "case\\>")
+ (setq blocked t)
+ (throw 'nesting 'case))
+ ((looking-at "record\\>")
+ (throw 'nesting 'declaration))
+ (t (setq blocked t)
+ (throw 'nesting 'block)))
+ (setq nest (1- nest))))
+ (;--Nest block inwards
+ (looking-at pascal-end-block-re)
+ (setq complete t
+ nest (1+ nest)))
+ (;--Defun (or parameter list)
+ (looking-at pascal-defun-re)
+ (if (= 0 par)
+ (throw 'nesting 'defun)
+ (setq par 0)
+ (let ((n 0))
+ (while (re-search-forward
+ "\\(\\<record\\>\\)\\|\\<end\\>"
+ oldpos t)
+ (if (match-end 1)
+ (setq n (1+ n)) (setq n (1- n))))
+ (if (> n 0)
+ (throw 'nesting 'declaration)
+ (throw 'nesting 'paramlist)))))
+ (;--Declaration part
+ (looking-at pascal-declaration-re)
+ (if (or blocked
+ (save-excursion
+ (goto-char oldpos)
+ (forward-line -1)
+ (looking-at "^[ \t]*$")))
+ (throw 'nesting 'unknown)
+ (throw 'nesting 'declaration)))
+ (;--If, else or while statement
+ (and (not complete)
+ (looking-at pascal-sub-block-re))
+ (throw 'nesting 'block))
+ (;--Found complete statement
+ (save-excursion (forward-sexp 1)
+ (= (following-char) ?\;))
+ (setq complete t))
+ (;--No known statements
+ (bobp)
+ (throw 'nesting 'unknown))
+ )))))
+ ;; Return type of block and indent level.
+ (if (> par 0) ; Unclosed Parenthesis
+ (list 'contexp par)
+ (list type (pascal-indent-level))))))
+
+(defun pascal-indent-level ()
+ "Return the indent-level the current statement has.
+Do not count labels, case-statements or records."
(save-excursion
(beginning-of-line)
- (skip-chars-forward ":0-9")
+ (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
+ (search-forward ":" nil t)
+ (if (looking-at ".*=[ \t]*record\\>")
+ (search-forward "=" nil t)))
(skip-chars-forward " \t")
(current-column)))
-(defun pascal-indent-parameter-list ()
- "Indent this line as part of a parameter list in a function."
- (let ((indents (pascal-get-highest-indents-in-parameterlist))
- (pos 0))
- (if (not (progn (beginning-of-line)
- (search-forward "(" (pascal-get-end-of-line) t)))
- (progn (beginning-of-line)
- (skip-chars-forward " \t")))
- ;; Indent region in front of var
- (skip-chars-forward " \t")
- (pascal-delete-whitespaces)
- (indent-to (nth 0 indents))
- (if (looking-at "var\\b")
- (forward-char 3))
- ;; Indent parameternames
- (pascal-delete-whitespaces)
- (indent-to (nth 1 indents))
- (if (not (save-excursion (skip-chars-forward " \t") (eolp)))
- (progn
- ;; Indent colon
- (if (search-forward ":" (pascal-get-end-of-line) t)
- (backward-char 1)
- (end-of-line))
- (pascal-delete-whitespaces)
- (indent-to (nth 2 indents))
- ;; Indent after colon
- (if (equal (following-char) ?:)
- (progn
- (forward-char 1)
- (pascal-delete-whitespaces)
- (indent-to (+ 2 (nth 2 indents)))))))))
-
-;; Get the indents to use in a parameterlist.
-;; Returns:
-;; 1. Indent to the beginning of the line.
-;; 2. Indent to the beginning of the parameter names.
-;; 3. Indent to the right colon position."
-(defun pascal-get-highest-indents-in-parameterlist ()
+(defun pascal-indent-comment (&optional arg)
+ "Indent current line as comment.
+If optional arg is non-nil, just return the
+column number the line should be indented to."
+ (let* ((stcol (save-excursion
+ (re-search-backward "(\\*\\|{" nil t)
+ (1+ (current-column)))))
+ (if arg stcol
+ (delete-horizontal-space)
+ (indent-to stcol))))
+
+(defun pascal-indent-case ()
+ "Indent within case statements."
+ (skip-chars-forward ": \t")
+ (let ((end (prog1 (point-marker)
+ (re-search-backward "\\<case\\>" nil t)))
+ (beg (point))
+ (ind 0))
+ ;; Get right indent
+ (while (< (point) (marker-position end))
+ (if (re-search-forward "^[ \t]*\\([^ \t]+\\)[ \t]*:"
+ (marker-position end) 'move)
+ (goto-char (match-end 1)))
+ (delete-horizontal-space)
+ (if (> (current-column) ind)
+ (setq ind (current-column)))
+ (beginning-of-line 2))
+ (goto-char beg)
+ ;; Indent all case statements
+ (while (< (point) (marker-position end))
+ (if (re-search-forward "^[ \t]*[^ \t]+[ \t]*:"
+ (marker-position end) 'move)
+ (forward-char -1))
+ (indent-to (1+ ind))
+ (if (/= (following-char) ?:)
+ ()
+ (forward-char 1)
+ (delete-horizontal-space)
+ (insert " ")))))
+
+(defun pascal-indent-paramlist (&optional arg)
+ "Indent current line in parameterlist.
+If optional arg is non-nil, just return the
+indent of the current line in parameterlist."
(save-excursion
- (let ((start (progn
- (re-search-backward
- "\\<\\(function\\|procedure\\)\\>" nil t)
- (search-forward "(")
- (current-column)))
- (arglength 0) (vardecl nil) (done nil))
- (while (not (or done (eobp)))
- (beginning-of-line)
- (if (save-excursion
- (re-search-forward "\\<var\\>" (pascal-get-end-of-line) t))
- (setq vardecl t))
- (if (not (re-search-forward ":" (pascal-get-end-of-line) t))
- (setq done t))
- (skip-chars-backward ": \t")
- (setq arglength (max arglength (current-column)))
- (forward-line 1))
- (if vardecl
- (list start (+ start 4) (1+ arglength))
- (list start start (1+ arglength))))))
-
-(defun pascal-declindent-middle-of-line (declkey endpos defaultindent)
- "Indent declaration line."
- (let ((decindent 0))
- (if (search-forward declkey endpos t)
- (setq decindent (1- (current-column)))
- (setq decindent defaultindent))
- (goto-char endpos)
- (end-of-line)
- (if (save-excursion (search-backward declkey endpos t))
- (progn (search-backward declkey) (skip-chars-backward " \t"))
- (skip-chars-backward " \t"))
- (pascal-delete-whitespaces)
- (indent-to (max decindent (1+ (current-column))))
- ;; Indent after `declkey'
- (if (looking-at declkey)
- (progn
- (forward-char 1)
- (pascal-delete-whitespaces)
- (indent-to (1+ (current-column)))))))
+ (let* ((oldpos (point))
+ (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
+ (stcol (1+ (current-column)))
+ (edpos (progn (pascal-declaration-end)
+ (search-backward ")" (pascal-get-beg-of-line) t)
+ (point)))
+ (usevar (re-search-backward "\\<var\\>" stpos t)))
+ (if arg (progn
+ ;; If arg, just return indent
+ (goto-char oldpos)
+ (beginning-of-line)
+ (if (or (not usevar) (looking-at "[ \t]*var\\>"))
+ stcol (+ 4 stcol)))
+ (goto-char stpos)
+ (forward-char 1)
+ (delete-horizontal-space)
+ (if (and usevar (not (looking-at "var\\>")))
+ (indent-to (+ 4 stcol)))
+ (pascal-indent-declaration nil stpos edpos)))))
+
+(defun pascal-indent-declaration (&optional arg start end)
+ "Indent current lines as declaration, lining up the `:'s or `='s."
+ (let ((pos (point-marker)))
+ (if (and (not (or arg start)) (not (pascal-declaration-beg)))
+ ()
+ (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start)
+ ":" "="))
+ (stpos (if start start
+ (forward-word 2) (backward-word 1) (point)))
+ (edpos (set-marker (make-marker)
+ (if end end
+ (max (progn (pascal-declaration-end)
+ (point))
+ pos))))
+ ind)
+
+ (goto-char stpos)
+ ;; Indent lines in record block
+ (if arg
+ (while (<= (point) (marker-position edpos))
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (if (looking-at "end\\>")
+ (indent-to arg)
+ (indent-to (+ arg pascal-indent-level)))
+ (forward-line 1)))
+
+ ;; Do lineup
+ (setq ind (pascal-get-lineup-indent stpos edpos lineup))
+ (goto-char stpos)
+ (while (<= (point) (marker-position edpos))
+ (if (search-forward lineup (pascal-get-end-of-line) 'move)
+ (forward-char -1))
+ (delete-horizontal-space)
+ (indent-to ind)
+ (if (not (looking-at lineup))
+ (forward-line 1) ; No more indent if there is no : or =
+ (forward-char 1)
+ (delete-horizontal-space)
+ (insert " ")
+ ;; Indent record block
+ (if (looking-at "record\\>")
+ (pascal-indent-declaration (current-column)))
+ (forward-line 1)))))
+
+ ;; If arg - move point
+ (if arg (forward-line -1)
+ (goto-char (marker-position pos)))))
+
+; "Return the indent level that will line up several lines within the region
+;from b to e nicely. The lineup string is str."
+(defun pascal-get-lineup-indent (b e str)
+ (save-excursion
+ (let ((ind 0)
+ (reg (concat str "\\|\\(\\<record\\>\\)"))
+ nest)
+ (goto-char b)
+ ;; Get rightmost position
+ (while (< (point) e)
+ (setq nest 1)
+ (if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
+ ;; Skip record blocks
+ (if (match-beginning 1)
+ (pascal-declaration-end)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t")
+ (if (> (current-column) ind)
+ (setq ind (current-column)))))))
+ ;; In case no lineup was found
+ (if (> ind 0)
+ (1+ ind)
+ ;; No lineup-string found
+ (goto-char b)
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (1+ (current-column))))))
+
+\f
+
+;;;
+;;; Completion
+;;;
+(defun pascal-string-diff (str1 str2)
+ "Return index of first letter where STR1 and STR2 differs."
+ (catch 'done
+ (let ((diff 0))
+ (while t
+ (if (or (> (1+ diff) (length str1))
+ (> (1+ diff) (length str2)))
+ (throw 'done diff))
+ (or (equal (aref str1 diff) (aref str2 diff))
+ (throw 'done diff))
+ (setq diff (1+ diff))))))
+
+;; Calculate all possible completions for functions if argument is `function',
+;; completions for procedures if argument is `procedure' or both functions and
+;; procedures otherwise.
+
+(defun pascal-func-completion (type)
+ ;; Build regular expression for function/procedure names
+ (if (string= str "")
+ (setq str "[a-zA-Z_]"))
+ (let ((str (concat (cond ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
+ ((eq type 'function) "\\<\\(function\\)\\s +")
+ (t "\\<\\(function\\|procedure\\)\\s +"))
+ "\\<\\(" str "[a-zA-Z0-9_.]*\\)\\>"))
+ match)
-(defun pascal-indent-within-comment (indent)
- "Indent comments and/or indent text within comment."
- (progn
- ;; If we are at the beginning of the line, then we indent this line.
- (if (save-excursion (skip-chars-backward " \t") (bolp))
+ (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
+ (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
+ (forward-char 1)
+
+ ;; Search through all reachable functions
+ (while (pascal-beg-of-defun)
+ (if (re-search-forward str (pascal-get-end-of-line) t)
+ (progn (setq match (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ (if (or (null predicate)
+ (funcall prdicate match))
+ (setq all (cons match all)))))
+ (goto-char (match-beginning 0)))))
+
+(defun pascal-get-completion-decl ()
+ ;; Macro for searching through current declaration (var, type or const)
+ ;; for matches of `str' and adding the occurence tp `all'
+ (let ((end (save-excursion (pascal-declaration-end)
+ (point)))
+ match)
+ ;; Traverse lines
+ (while (< (point) end)
+ (if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
+ ;; Traverse current line
+ (while (and (re-search-backward
+ (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|"
+ pascal-symbol-re)
+ (pascal-get-beg-of-line) t)
+ (not (match-end 1)))
+ (setq match (buffer-substring (match-beginning 0) (match-end 0)))
+ (if (string-match (concat "\\<" str) match)
+ (if (or (null predicate)
+ (funcall predicate match))
+ (setq all (cons match all))))))
+ (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
+ (pascal-declaration-end)
+ (forward-line 1)))))
+
+(defun pascal-type-completion ()
+ "Calculate all possible completions for types."
+ (let ((start (point))
+ goon)
+ ;; Search for all reachable type declarations
+ (while (or (pascal-beg-of-defun)
+ (setq goon (not goon)))
+ (save-excursion
+ (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
+ (point))
+ (forward-char 1)))
+ (re-search-forward
+ "\\<type\\>\\|\\<\\(begin\\|function\\|proceudre\\)\\>"
+ start t)
+ (not (match-end 1)))
+ ;; Check current type declaration
+ (pascal-get-completion-decl))))))
+
+(defun pascal-var-completion ()
+ "Calculate all possible completions for variables (or constants)."
+ (let ((start (point))
+ goon twice)
+ ;; Search for all reachable var declarations
+ (while (or (pascal-beg-of-defun)
+ (setq goon (not goon)))
+ (save-excursion
+ (if (> start (prog1 (save-excursion (pascal-end-of-defun)
+ (point))))
+ () ; Declarations not reacable
+ (if (search-forward "(" (pascal-get-end-of-line) t)
+ ;; Check parameterlist
+ (pascal-get-completion-decl))
+ (setq twice 2)
+ (while (>= (setq twice (1- twice)) 0)
+ (cond ((and (re-search-forward
+ (concat "\\<\\(var\\|const\\)\\>\\|"
+ "\\<\\(begin\\|function\\|procedure\\)\\>")
+ start t)
+ (not (match-end 2)))
+ ;; Check var/const declarations
+ (pascal-get-completion-decl))
+ ((match-end 2)
+ (setq twice 0)))))))))
+
+
+(defun pascal-keyword-completion (keyword-list)
+ "Give list of all possible completions of keywords in KEYWORD-LIST."
+ (mapcar '(lambda (s)
+ (if (string-match (concat "\\<" str) s)
+ (if (or (null predicate)
+ (funcall predicate s))
+ (setq all (cons s all)))))
+ keyword-list))
+
+;; Function passed to completing-read, try-completion or
+;; all-completions to get completion on STR. If predicate is non-nil,
+;; it must be a function to be called for every match to check if this
+;; should really be a match. If flag is t, the function returns a list
+;; of all possible completions. If it is nil it returns a string, the
+;; longest possible completion, or t if STR is an exact match. If flag
+;; is 'lambda, the function returns t if STR is an exact match, nil
+;; otherwise.
+
+(defun pascal-completion (str predicate flag)
+ (save-excursion
+ (let ((all nil))
+ ;; Set buffer to use for searching labels. This should be set
+ ;; within functins which use pascal-completions
+ (set-buffer buffer-to-use)
+
+ ;; Determine what should be completed
+ (let ((state (car (pascal-calculate-indent))))
+ (cond (;--Within a declaration or parameterlist
+ (or (eq state 'declaration) (eq state 'paramlist)
+ (and (eq state 'defun)
+ (save-excursion
+ (re-search-backward ")[ \t]*:" (pascal-get-beg-of-line) t))))
+ (if (or (eq state 'paramlist) (eq state 'defun))
+ (pascal-beg-of-defun))
+ (pascal-type-completion)
+ (pascal-keyword-completion pascal-type-keywords))
+ (;--Starting a new statement
+ (and (not (eq state 'contexp))
+ (save-excursion
+ (skip-chars-backward "a-zA-Z0-9_.")
+ (backward-sexp 1)
+ (or (looking-at pascal-nosemi-re)
+ (progn
+ (forward-sexp 1)
+ (looking-at "\\s *\\(;\\|:[^=]\\)")))))
+ (save-excursion (pascal-var-completion))
+ (pascal-func-completion 'procedure)
+ (pascal-keyword-completion pascal-start-keywords))
+ (t;--Anywhere else
+ (save-excursion (pascal-var-completion))
+ (pascal-func-completion 'function)
+ (pascal-keyword-completion pascal-seperator-keywords))))
+
+ ;; Now we have built a list of all matches. Give response to caller
+ (pascal-completion-response))))
+
+(defun pascal-completion-response ()
+ (cond ((or (equal flag 'lambda) (null flag))
+ ;; This was not called by all-completions
+ (if (null all)
+ ;; Return nil if there was no matching label
+ nil
+ ;; Get longest string common in the labels
+ (let* ((elm (cdr all))
+ (match (car all))
+ (min (length match))
+ exact tmp)
+ (if (string= match str)
+ ;; Return t if first match was an exact match
+ (setq match t)
+ (while (not (null elm))
+ ;; Find longest common string
+ (if (< (setq tmp (pascal-string-diff match (car elm))) min)
+ (progn
+ (setq min tmp)
+ (setq match (substring match 0 min))))
+ ;; Terminate with match=t if this is an exact match
+ (if (string= (car elm) str)
+ (progn
+ (setq match t)
+ (setq elm nil))
+ (setq elm (cdr elm)))))
+ ;; If this is a test just for exact match, return nil ot t
+ (if (and (equal flag 'lambda) (not (equal match 't)))
+ nil
+ match))))
+ ;; If flag is t, this was called by all-completions. Return
+ ;; list of all possible completions
+ (flag
+ all)))
+
+(defvar pascal-last-word-numb 0)
+(defvar pascal-last-word-shown nil)
+(defvar pascal-last-completions nil)
+
+(defun pascal-complete-word ()
+ "Complete word at current point.
+\(See also `pascal-toggle-completions', `pascal-type-keywords',
+`pascal-start-keywords' and `pascal-seperator-keywords'.)"
+ (interactive)
+ (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
+ (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
+ (str (buffer-substring b e))
+ ;; The following variable is used in pascal-completion
+ (buffer-to-use (current-buffer))
+ (allcomp (if (and pascal-toggle-completions
+ (string= pascal-last-word-shown str))
+ pascal-last-completions
+ (all-completions str 'pascal-completion)))
+ (match (if pascal-toggle-completions
+ "" (try-completion
+ str (mapcar '(lambda (elm) (cons elm 0)) allcomp)))))
+ ;; Delete old string
+ (delete-region b e)
+
+ ;; Toggle-completions inserts whole labels
+ (if pascal-toggle-completions
(progn
- (beginning-of-line)
- (pascal-delete-whitespaces)
- (indent-to indent))
- ;; Do nothing if we're not in a star comment.
- (if (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (looking-at "\\*\\|(\\*"))
- (save-excursion
- (beginning-of-line)
- (search-forward "*")
- (pascal-delete-whitespaces)
- (indent-to (+ (current-column) 2)))))))
-
-(defun pascal-find-leading-case-colon ()
- "Return hpos of first colon after the case-of or record line.
-If there's no such line, use the place where it ought to be."
- (let ((pos (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
- (point))))
- (save-excursion
- (re-search-backward "\\<\\(case\\|record\\)\\>")
- (forward-line 1)
- (skip-chars-forward " \t")
- (if (not (eq pos (point)))
+ ;; Update entry number in list
+ (setq pascal-last-completions allcomp
+ pascal-last-word-numb
+ (if (>= pascal-last-word-numb (1- (length allcomp)))
+ 0
+ (1+ pascal-last-word-numb)))
+ (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
+ ;; Display next match or same string if no match was found
+ (if (not (null allcomp))
+ (insert "" pascal-last-word-shown)
+ (insert "" str)
+ (message "(No match)")))
+ ;; The other form of completion does not necessarly do that.
+
+ ;; Insert match if found, or the original string if no match
+ (if (or (null match) (equal match 't))
+ (progn (insert "" str)
+ (message "(No match)"))
+ (insert "" match))
+ ;; Give message about current status of completion
+ (cond ((equal match 't)
+ (if (not (null (cdr allcomp)))
+ (message "(Complete but not unique)")
+ (message "(Sole completion)")))
+ ;; Display buffer if the current completion didn't help
+ ;; on completing the label.
+ ((and (not (null (cdr allcomp))) (= (length str) (length match)))
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list allcomp))
+ ;; Wait for a keypress. Then delete *Completion* window
+ (momentary-string-display "" (point))
+ (delete-window (get-buffer-window (get-buffer "*Completions*")))
+ )))))
+
+(defun pascal-show-completions ()
+ "Show all possible completions at current point."
+ (interactive)
+ (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
+ (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
+ (str (buffer-substring b e))
+ ;; The following variable is used in pascal-completion
+ (buffer-to-use (current-buffer))
+ (allcomp (if (and pascal-toggle-completions
+ (string= pascal-last-word-shown str))
+ pascal-last-completions
+ (all-completions str 'pascal-completion))))
+ ;; Show possible completions in a temporary buffer.
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list allcomp))
+ ;; Wait for a keypress. Then delete *Completion* window
+ (momentary-string-display "" (point))
+ (delete-window (get-buffer-window (get-buffer "*Completions*")))))
+
+
+(defun pascal-get-default-symbol ()
+ "Return symbol around current point as a string."
+ (save-excursion
+ (buffer-substring (progn
+ (skip-chars-backward " \t")
+ (skip-chars-backward "a-zA-Z0-9_")
+ (point))
+ (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)))))
+
+(defun pascal-build-defun-re (str &optional arg)
+ "Return function/procedure starting with STR as regular expression.
+With optional second arg non-nil, STR is the complete name of the instruction."
+ (if arg
+ (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
+ (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
+
+;; Function passed to completing-read, try-completion or
+;; all-completions to get completion on any function name. If
+;; predicate is non-nil, it must be a function to be called for every
+;; match to check if this should really be a match. If flag is t, the
+;; function returns a list of all possible completions. If it is nil
+;; it returns a string, the longest possible completion, or t if STR
+;; is an exact match. If flag is 'lambda, the function returns t if
+;; STR is an exact match, nil otherwise.
+
+(defun pascal-comp-defun (str predicate flag)
+ (save-excursion
+ (let ((all nil)
+ match)
+
+ ;; Set buffer to use for searching labels. This should be set
+ ;; within functins which use pascal-completions
+ (set-buffer buffer-to-use)
+
+ (let ((str str))
+ ;; Build regular expression for functions
+ (if (string= str "")
+ (setq str (pascal-build-defun-re "[a-zA-Z_]"))
+ (setq str (pascal-build-defun-re str)))
+ (goto-char (point-min))
+
+ ;; Build a list of all possible completions
+ (while (re-search-forward str nil t)
+ (setq match (buffer-substring (match-beginning 2) (match-end 2)))
+ (if (or (null predicate)
+ (funcall predicate match))
+ (setq all (cons match all)))))
+
+ ;; Now we have built a list of all matches. Give response to caller
+ (pascal-completion-response))))
+
+(defun pascal-goto-defun ()
+ "Move to specified Pascal function/procedure.
+The default is a name found in the buffer around point."
+ (interactive)
+ (let* ((default (pascal-get-default-symbol))
+ ;; The following variable is used in pascal-comp-function
+ (buffer-to-use (current-buffer))
+ (default (if (pascal-comp-defun default nil 'lambda)
+ default ""))
+ (label (if (not (string= default ""))
+ ;; Do completion with default
+ (completing-read (concat "Label: (default " default ") ")
+ 'pascal-comp-defun nil t "")
+ ;; There is no default value. Complete without it
+ (completing-read "Label: "
+ 'pascal-comp-defun nil t ""))))
+ ;; If there was no response on prompt, use default value
+ (if (string= label "")
+ (setq label default))
+ ;; Goto right place in buffer if label is not an empty string
+ (or (string= label "")
+ (progn
+ (goto-char (point-min))
+ (re-search-forward (pascal-build-defun-re label t))
+ (beginning-of-line)))))
+
+\f
+
+;;;
+;;; Pascal-outline-mode
+;;;
+(defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
+
+(if pascal-outline-map
+ nil
+ (if (boundp 'set-keymap-name)
+ (set-keymap-name pascal-outline-map 'pascal-outline-map))
+ (if (not (boundp 'set-keymap-parent))
+ (setq pascal-outline-map (copy-keymap pascal-mode-map))
+ (setq pascal-outline-map (make-sparse-keymap))
+ (set-keymap-parent pascal-outline-map pascal-mode-map))
+ (define-key pascal-outline-map "\e\C-a" 'pascal-outline-prev-defun)
+ (define-key pascal-outline-map "\e\C-e" 'pascal-outline-next-defun)
+ (define-key pascal-outline-map "\C-cg" 'pascal-outline-goto-defun)
+ (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
+ (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
+
+(defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
+(make-variable-buffer-local 'pascal-outline-mode)
+(set-default 'pascal-outline-mode nil)
+(if (not (assoc 'pascal-outline-mode minor-mode-alist))
+ (setq minor-mode-alist (append minor-mode-alist
+ (list '(pascal-outline-mode " Outl")))))
+
+(defun pascal-outline (&optional arg)
+ "Outline-line minor mode for Pascal mode.
+When in Pascal Outline mode, portions
+of the text being edited may be made invisible. \\<pascal-outline-map>
+
+Pascal Outline mode provides some additional commands.
+
+\\[pascal-outline-prev-defun]\
+\t- Move to previous function/procedure, hiding everything else.
+\\[pascal-outline-next-defun]\
+\t- Move to next function/procedure, hiding everything else.
+\\[pascal-outline-goto-defun]\
+\t- Goto function/procedure prompted for in minibuffer,
+\t hide all other functions.
+\\[pascal-show-all]\t- Show the whole buffer.
+\\[pascal-hide-other-defuns]\
+\t- Hide everything but the current function (function under the cursor).
+\\[pascal-outline]\t- Leave pascal-outline-mode."
+ (interactive "P")
+ (setq pascal-outline-mode
+ (if (null arg) (not pascal-outline-mode) t))
+ (if (boundp 'redraw-mode-line)
+ (redraw-mode-line))
+ (if pascal-outline-mode
+ (progn
+ (setq selective-display t)
+ (use-local-map pascal-outline-map))
+ (progn
+ (setq selective-display nil)
+ (pascal-show-all)
+ (use-local-map pascal-mode-map))))
+
+(defun pascal-outline-change (b e flag)
+ (let ((modp (buffer-modified-p)))
+ (unwind-protect
+ (subst-char-in-region b e (if (= flag ?\n) ?\^M ?\n) flag)
+ (set-buffer-modified-p modp))))
+
+(defun pascal-show-all ()
+ "Show all of the text in the buffer."
+ (interactive)
+ (pascal-outline-change (point-min) (point-max) ?\n))
+
+(defun pascal-hide-other-defuns ()
+ "Show only the current defun."
+ (interactive)
+ (save-excursion
+ (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
+ (pascal-beg-of-defun))
+ (point)))
+ (end (progn (pascal-end-of-defun)
+ (backward-sexp 1)
+ (search-forward "\n\\|\^M" nil t)
+ (point)))
+ (opoint (point-min)))
+ (goto-char (point-min))
+
+ ;; Hide all functions before current function
+ (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
+ (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
+ (setq opoint (point))
+ ;; Functions may be nested
+ (if (> (progn (pascal-end-of-defun) (point)) beg)
+ (goto-char opoint)))
+ (if (> beg opoint)
+ (pascal-outline-change opoint (1- beg) ?\^M))
+
+ ;; Show current function
+ (pascal-outline-change beg end ?\n)
+ ;; Hide nested functions
+ (forward-char 1)
+ (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
+ (setq opoint (point))
+ (pascal-end-of-defun)
+ (pascal-outline-change opoint (point) ?\^M))
+
+ (goto-char end)
+ (setq opoint end)
+
+ ;; Hide all function after current function
+ (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
+ (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
+ (setq opoint (point))
+ (pascal-end-of-defun))
+ (pascal-outline-change opoint (point-max) ?\^M)
+
+ ;; Hide main program
+ (if (< (progn (forward-line -1) (point)) end)
(progn
- (search-forward ":" (pascal-get-end-of-line) t)
- (1- (current-column)))
- (+ (current-column) pascal-case-offset)))))
+ (goto-char beg)
+ (pascal-end-of-defun)
+ (backward-sexp 1)
+ (pascal-outline-change (point) (point-max) ?\^M))))))
-(provide 'pascal)
+(defun pascal-outline-next-defun ()
+ "Move to next function/procedure, hiding all others."
+ (interactive)
+ (pascal-end-of-defun)
+ (pascal-hide-other-defuns))
+
+(defun pascal-outline-prev-defun ()
+ "Move to previous function/procedure, hiding all others."
+ (interactive)
+ (pascal-beg-of-defun)
+ (pascal-hide-other-defuns))
+
+(defun pascal-outline-goto-defun ()
+ "Move to specified function/procedure, hiding all others."
+ (interactive)
+ (pascal-goto-defun)
+ (pascal-hide-other-defuns))
-;; pascal.el ends here.
+;;; pascal.el ends here
projects / emacs.git / commitdiff