(defgroup pascal nil
"Major mode for editing Pascal source in Emacs."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:group 'languages)
(defvar pascal-mode-abbrev-table nil
"Abbrev table in use in Pascal-mode buffers.")
(define-abbrev-table 'pascal-mode-abbrev-table ())
(defvar pascal-mode-map
(let ((map (make-sparse-keymap)))
(define-key map ";" 'electric-pascal-semi-or-dot)
(define-key map "." 'electric-pascal-semi-or-dot)
(define-key map ":" 'electric-pascal-colon)
(define-key map "=" 'electric-pascal-equal)
(define-key map "#" 'electric-pascal-hash)
(define-key map "\r" 'electric-pascal-terminate-line)
(define-key map "\t" 'electric-pascal-tab)
(define-key map "\M-\t" 'pascal-complete-word)
(define-key map "\M-?" 'pascal-show-completions)
(define-key map "\177" 'backward-delete-char-untabify)
(define-key map "\M-\C-h" 'pascal-mark-defun)
(define-key map "\C-c\C-b" 'pascal-insert-block)
(define-key map "\M-*" 'pascal-star-comment)
(define-key map "\C-c\C-c" 'pascal-comment-area)
(define-key map "\C-c\C-u" 'pascal-uncomment-area)
(define-key map "\M-\C-a" 'pascal-beg-of-defun)
(define-key map "\M-\C-e" 'pascal-end-of-defun)
(define-key map "\C-c\C-d" 'pascal-goto-defun)
(define-key map "\C-c\C-o" 'pascal-outline-mode)
map)
"Keymap used in Pascal mode.")
(defvar pascal-imenu-generic-expression
'((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2))
"Imenu expression for Pascal-mode. See `imenu-generic-expression'.")
(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"
"get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
"writeln"))
(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-progbeg-re "\\<\\program\\>")
(defconst pascal-defun-re "\\<\\(function\\|procedure\\|program\\)\\>")
(defconst pascal-sub-block-re "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
(defconst pascal-noindent-re "\\<\\(begin\\|end\\|until\\|else\\)\\>")
(defconst pascal-nosemi-re "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
(defconst pascal-autoindent-lines-re
"\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
(defvar pascal-mode-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?\\ "." st)
(modify-syntax-entry ?\( "()1" st)
(modify-syntax-entry ?\) ")(4" st)
(modify-syntax-entry ?* ". 23" st)
(modify-syntax-entry ?{ "<" st)
(modify-syntax-entry ?} ">" st)
(modify-syntax-entry ?+ "." st)
(modify-syntax-entry ?- "." st)
(modify-syntax-entry ?= "." st)
(modify-syntax-entry ?% "." st)
(modify-syntax-entry ?< "." st)
(modify-syntax-entry ?> "." st)
(modify-syntax-entry ?& "." st)
(modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "_" st)
(modify-syntax-entry ?\' "\"" st)
st)
"Syntax table in use in Pascal-mode buffers.")
(defconst pascal-font-lock-keywords (purecopy
(list
'("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)"
1 font-lock-keyword-face)
'("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)"
3 font-lock-function-name-face t)
(cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
"integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
'font-lock-type-face)
'("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face)
'("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
(concat "\\<\\("
"and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
"not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
"\\)\\>")
'("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
1 font-lock-keyword-face)
'("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
2 font-lock-keyword-face t)))
"Additional expressions to highlight in Pascal mode.")
(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
(defcustom pascal-indent-level 3
"*Indentation of Pascal statements with respect to containing block."
:type 'integer
:group 'pascal)
(defcustom pascal-case-indent 2
"*Indentation for case statements."
:type 'integer
:group 'pascal)
(defcustom pascal-auto-newline nil
"*Non-nil means automatically insert newlines in certain cases.
These include after semicolons and after the punctuation mark after an `end'."
:type 'boolean
:group 'pascal)
(defcustom pascal-indent-nested-functions t
"*Non-nil means nested functions are indented."
:type 'boolean
:group 'pascal)
(defcustom pascal-tab-always-indent t
"*Non-nil means TAB in Pascal mode should always reindent the current line.
If this is nil, TAB inserts a tab if it is at the end of the line
and follows non-whitespace text."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-endcomments t
"*Non-nil means automatically insert comments after certain `end's.
Specifically, this is done after the ends of cases statements and functions.
The name of the function or case is included between the braces."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-lineup '(all)
"*List of contexts where auto lineup of :'s or ='s should be done.
Elements can be of type: 'paramlist', 'declaration' or 'case', which will
do auto lineup in parameterlist, declarations or case-statements
respectively. The word 'all' will do all lineups. '(case paramlist) for
instance will do lineup in case-statements and parameterlist, while '(all)
will do all lineups."
:type '(set :extra-offset 8
(const :tag "Everything" all)
(const :tag "Parameter lists" paramlist)
(const :tag "Decalrations" declaration)
(const :tag "Case statements" case))
:group 'pascal)
(defcustom pascal-toggle-completions nil
"*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one.
Repeated use of \\[pascal-complete-word] will show you all of them.
Normally, when there is more than one possible completion,
it displays a list of all possible completions."
:type 'boolean
:group 'pascal)
(defcustom pascal-type-keywords
'("array" "file" "packed" "char" "integer" "real" "string" "record")
"*Keywords for types used when completing a word in a declaration or parmlist.
These include integer, real, char, etc.
The types defined within the Pascal program
are handled in another way, and should not be added to this list."
:type '(repeat (string :tag "Keyword"))
:group 'pascal)
(defcustom 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.
These are keywords such as begin, repeat, until, readln.
The procedures and variables defined within the Pascal program
are handled in another way, and should not be added to this list."
:type '(repeat (string :tag "Keyword"))
:group 'pascal)
(defcustom pascal-separator-keywords
'("downto" "else" "mod" "div" "then")
"*Keywords to complete when NOT standing at the first word of a statement.
These are keywords such as downto, else, mod, then.
Variables and function names defined within the Pascal program
are handled in another way, and should not be added to this list."
:type '(repeat (string :tag "Keyword"))
:group 'pascal)
(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)))
((looking-at "[^(\n]+)") (setq nest 0))))))
(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)))))
(defun pascal-mode ()
"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-mode]\t- Enter `pascal-outline-mode'.
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 semicolons and the punctuation
mark after an end.
pascal-indent-nested-functions (default t)
Non-nil means nested functions are indented.
pascal-tab-always-indent (default 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-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.
pascal-auto-lineup (default t)
List of contexts where auto lineup of :'s or ='s should be done.
See also the user variables pascal-type-keywords, pascal-start-keywords and
pascal-separator-keywords.
Turning on Pascal mode calls the value of the variable pascal-mode-hook with
no args, if that value is non-nil."
(interactive)
(kill-all-local-variables)
(use-local-map pascal-mode-map)
(setq major-mode 'pascal-mode)
(setq mode-name "Pascal")
(setq local-abbrev-table pascal-mode-abbrev-table)
(set-syntax-table pascal-mode-syntax-table)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'pascal-indent-line)
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'pascal-indent-comment)
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments nil)
(make-local-variable 'blink-matching-paren-dont-ignore-comments)
(setq blink-matching-paren-dont-ignore-comments t)
(make-local-variable 'case-fold-search)
(setq case-fold-search t)
(make-local-variable 'comment-start)
(setq comment-start "{")
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "(\\*+ *\\|{ *")
(make-local-variable 'comment-end)
(setq comment-end "}")
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(pascal-font-lock-keywords nil t))
(make-local-variable 'imenu-generic-expression)
(setq imenu-generic-expression pascal-imenu-generic-expression)
(setq imenu-case-fold-search t)
(run-mode-hooks 'pascal-mode-hook))
(defun electric-pascal-terminate-line ()
"Terminate line and indent next line."
(interactive)
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(if (looking-at pascal-autoindent-lines-re)
(pascal-indent-line)))
(delete-horizontal-space) (newline)
(pascal-indent-line)
(if pascal-auto-endcomments
(pascal-set-auto-comments))
(let ((setstar nil))
(save-excursion
(forward-line -1)
(skip-chars-forward " \t")
(cond ((looking-at "\\*[ \t]+)")
(forward-char 1)
(delete-horizontal-space))
((and (looking-at "(\\*\\|\\*[^)]")
(not (save-excursion
(search-forward "*)" (pascal-get-end-of-line) t))))
(setq setstar t))))
(if (null setstar)
(pascal-indent-line)
(insert "* "))))
(defun electric-pascal-semi-or-dot ()
"Insert `;' or `.' character and reindent the line."
(interactive)
(insert last-command-char)
(save-excursion
(beginning-of-line)
(pascal-indent-line))
(if pascal-auto-newline
(electric-pascal-terminate-line)))
(defun electric-pascal-colon ()
"Insert `:' and do all indentions except line indent on this line."
(interactive)
(insert last-command-char)
(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."
(interactive)
(insert last-command-char)
(if (eq (car (pascal-calculate-indent)) 'declaration)
(let ((pascal-tab-always-indent nil))
(pascal-indent-command))))
(defun electric-pascal-hash ()
"Insert `#', and indent to column 0 if this is a CPP directive."
(interactive)
(insert last-command-char)
(if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
(save-excursion (beginning-of-line)
(delete-horizontal-space))))
(defun electric-pascal-tab ()
"Function called when TAB is pressed in Pascal mode."
(interactive)
(if (or (pascal-within-string)
(and (not (bolp))
(save-excursion (beginning-of-line) (eq (following-char) ?#))))
(insert "\t")
(if pascal-tab-always-indent
(save-excursion
(beginning-of-line)
(pascal-indent-line))
(if (save-excursion
(skip-chars-backward " \t")
(bolp))
(pascal-indent-line)
(insert "\t")))
(pascal-indent-command)))
(defun pascal-insert-block ()
"Insert Pascal begin ... end; block in the code with right indentation."
(interactive)
(insert "begin")
(electric-pascal-terminate-line)
(save-excursion
(newline)
(insert "end;")
(beginning-of-line)
(pascal-indent-line)))
(defun pascal-star-comment ()
"Insert Pascal star comment at point."
(interactive)
(pascal-indent-line)
(insert "(*")
(electric-pascal-terminate-line)
(save-excursion
(electric-pascal-terminate-line)
(delete-horizontal-space)
(insert ")"))
(insert " "))
(defun pascal-mark-defun ()
"Mark the current pascal function (or procedure).
This puts the mark at the end, and point at the beginning."
(interactive)
(push-mark (point))
(pascal-end-of-defun)
(push-mark (point))
(pascal-beg-of-defun)
(if (fboundp 'zmacs-activate-region)
(zmacs-activate-region)))
(defun pascal-comment-area (start end)
"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
(goto-char end)
(if (and (save-excursion (skip-chars-forward " \t") (eolp))
(not (save-excursion (skip-chars-backward " \t") (bolp))))
(forward-line 1)
(beginning-of-line))
(insert pascal-exclude-str-end)
(setq end (point))
(newline)
(goto-char start)
(beginning-of-line)
(insert pascal-exclude-str-start)
(newline)
(goto-char end)
(save-excursion
(while (re-search-backward "\\*)" start t)
(replace-match "!(*" t t)))
(save-excursion
(while (re-search-backward "}" start t)
(replace-match "!{" t t)))))
(defun pascal-uncomment-area ()
"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
(let ((start (point))
(end (point)))
(save-excursion
(setq start (progn (search-backward pascal-exclude-str-start nil t)
(point)))
(setq end (progn (search-forward pascal-exclude-str-end nil t)
(point))))
(if (or (equal start (point)) (<= end (point)))
(message "Not standing within commented area.")
(progn
(goto-char end)
(beginning-of-line)
(let ((pos (point)))
(end-of-line)
(delete-region pos (1+ (point))))
(save-excursion
(while (re-search-backward "!{" start t)
(replace-match "}" t t)))
(save-excursion
(while (re-search-backward "!(\\*" start t)
(replace-match "*)" t t)))
(goto-char start)
(beginning-of-line)
(let ((pos (point)))
(end-of-line)
(delete-region pos (1+ (point)))))))))
(defun pascal-beg-of-defun ()
"Move backward to the beginning of the current function or procedure."
(interactive)
(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))) ())
((match-end 1) (if (and (looking-at "\\<record\\>") (>= max 0))
(setq func (1- func)))
(setq nest (1+ nest)
max (max nest max)))
((match-end 2) (if (and (= nest max) (>= max 0))
(setq func (1+ func)))
(setq nest (1- nest)))
((match-end 3) (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 (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))) ())
((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-end-of-statement ()
"Move forward to end of current statement."
(interactive)
(let ((parse-sexp-ignore-comments t)
(nest 0) pos
(regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\("
pascal-end-block-re "\\)")))
(if (not (looking-at "[ \t\n]")) (forward-sexp -1))
(or (looking-at pascal-beg-block-re)
(setq pos (catch 'found
(while t
(forward-sexp 1)
(cond ((looking-at "[ \t]*;")
(skip-chars-forward "^;")
(forward-char 1)
(throw 'found (point)))
((save-excursion
(forward-sexp -1)
(looking-at pascal-beg-block-re))
(goto-char (match-beginning 0))
(throw 'found nil))
((eobp)
(throw 'found (point))))))))
(if (not pos)
(catch 'found
(while t
(re-search-forward regexp nil 'move)
(setq nest (if (match-end 1)
(1+ nest)
(1- nest)))
(cond ((eobp)
(throw 'found (point)))
((= 0 nest)
(throw 'found (pascal-end-of-statement))))))
pos)))
(defun pascal-downcase-keywords ()
"Downcase all Pascal keywords in the buffer."
(interactive)
(pascal-change-keywords 'downcase-word))
(defun pascal-upcase-keywords ()
"Upcase all Pascal keywords in the buffer."
(interactive)
(pascal-change-keywords 'upcase-word))
(defun pascal-capitalize-keywords ()
"Capitalize all Pascal keywords in the buffer."
(interactive)
(pascal-change-keywords 'capitalize-word))
(defun pascal-change-keywords (change-word)
(save-excursion
(let ((keyword-re (concat "\\<\\("
(mapconcat 'identity pascal-keywords "\\|")
"\\)\\>")))
(goto-char (point-min))
(while (re-search-forward keyword-re nil t)
(funcall change-word -1)))))
(defun pascal-set-auto-comments ()
"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;")
(not (save-excursion
(end-of-line)
(search-backward "{" (pascal-get-beg-of-line) t))))
(let ((type (car (pascal-calculate-indent))))
(if (eq type 'declaration)
()
(if (eq type 'case)
(progn
(end-of-line)
(delete-horizontal-space)
(insert " { case }"))
(let ((nest 1))
(save-excursion
(while (not (or (looking-at pascal-defun-re) (bobp)))
(backward-sexp 1)
(cond ((looking-at pascal-beg-block-re)
(setq nest (1- nest)))
((looking-at pascal-end-block-re)
(setq nest (1+ nest)))))
(if (bobp)
(setq nest 1)))
(if (zerop nest)
(progn
(end-of-line)
(delete-horizontal-space)
(insert " { ")
(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 " }"))))))))))
(defconst pascal-indent-alist
'((block . (+ ind pascal-indent-level))
(case . (+ ind pascal-case-indent))
(caseblock . ind) (cpp . 0)
(declaration . (+ ind pascal-indent-level))
(paramlist . (pascal-indent-paramlist t))
(comment . (pascal-indent-comment))
(defun . ind) (contexp . ind)
(unknown . ind) (string . 0) (progbeg . 0)))
(defun pascal-indent-command ()
"Indent for special part of code."
(let* ((indent-str (pascal-calculate-indent))
(type (car indent-str)))
(cond ((and (eq type 'paramlist)
(or (memq 'all pascal-auto-lineup)
(memq 'paramlist pascal-auto-lineup)))
(pascal-indent-paramlist)
(pascal-indent-paramlist))
((and (eq type 'declaration)
(or (memq 'all pascal-auto-lineup)
(memq 'declaration pascal-auto-lineup)))
(pascal-indent-declaration))
((and (eq type 'case) (not (looking-at "^[ \t]*$"))
(or (memq 'all pascal-auto-lineup)
(memq 'case pascal-auto-lineup)))
(pascal-indent-case)))
(if (looking-at "[ \t]+$")
(skip-chars-forward " \t"))))
(defun pascal-indent-line ()
"Indent current line as a Pascal statement."
(let* ((indent-str (pascal-calculate-indent))
(type (car indent-str))
(ind (car (cdr indent-str))))
(if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
(not (eq type 'declaration)))
(search-forward ":" nil t))
(delete-horizontal-space)
(cond ( (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
(eq type 'cpp))
())
( (looking-at pascal-noindent-re)
(indent-to ind))
( (looking-at pascal-defun-re)
(if (and pascal-indent-nested-functions
(eq type 'defun))
(indent-to (+ ind pascal-indent-level))
(indent-to ind)))
( (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* ((parse-sexp-ignore-comments t)
(oldpos (point))
(state (save-excursion (parse-partial-sexp (point-min) (point))))
(nest 0) (par 0) (complete (looking-at "[ \t]*end\\>"))
(elsed (looking-at "[ \t]*else\\>")) (funccnt 0)
(did-func (looking-at "[ \t]*\\(procedure\\|function\\)\\>"))
(type (catch 'nesting
(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))))
((save-excursion (beginning-of-line)
(eq (following-char) ?#))
(throw 'nesting 'cpp)))
(while t
(backward-sexp 1)
(cond ( (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
(not complete)
(save-excursion (skip-chars-backward " \t")
(bolp))
(= (save-excursion
(end-of-line) (backward-sexp) (point))
(point))
(> (save-excursion (goto-char oldpos)
(beginning-of-line)
(point))
(point)))
(throw 'nesting 'caseblock))
( (looking-at pascal-progbeg-re)
(throw 'nesting 'progbeg))
( (bobp)
(throw 'nesting 'progbeg))
( (looking-at pascal-beg-block-re)
(if (= nest 0)
(cond ((looking-at "case\\>")
(throw 'nesting 'case))
((looking-at "record\\>")
(throw 'nesting 'declaration))
(t (throw 'nesting 'block)))
(if (and (looking-at "record\\>") (= nest 1))
(setq funccnt (1- funccnt)))
(setq nest (1- nest))))
( (looking-at pascal-end-block-re)
(if (and (looking-at "end\\s ")
elsed (not complete))
(throw 'nesting 'block))
(if (= nest 0)
(setq funccnt (1+ funccnt)))
(setq complete t
nest (1+ nest)))
( (and (looking-at pascal-defun-re)
(progn (setq funccnt (1- funccnt)
did-func t)
(or (bolp) (< funccnt 0))))
(if (and (bolp) (>= funccnt 0))
(throw 'nesting 'progbeg))
(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)))))
( (and (looking-at pascal-declaration-re)
(not did-func)
(= funccnt 0))
(if (save-excursion
(goto-char oldpos)
(forward-line -1)
(looking-at "^[ \t]*$"))
(throw 'nesting 'unknown)
(throw 'nesting 'declaration)))
( (and (not complete)
(looking-at pascal-sub-block-re))
(throw 'nesting 'block))
( (save-excursion (forward-sexp 1)
(= (following-char) ?\ (setq complete t))
)))))
(if (> par 0) (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)
(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-comment ()
"Return indent for current comment."
(save-excursion
(re-search-backward "\\((\\*\\)\\|{" nil t)
(if (match-beginning 1)
(1+ (current-column))
(current-column))))
(defun pascal-indent-case ()
"Indent within case statements."
(let ((savepos (point-marker))
(end (prog2
(end-of-line)
(point-marker)
(re-search-backward "\\<case\\>" nil t)))
(beg (point))
(ind 0))
(while (< (point) end)
(if (re-search-forward
"^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
(marker-position end) 'move)
(forward-char -1))
(if (< (point) end)
(progn
(delete-horizontal-space)
(if (> (current-column) ind)
(setq ind (current-column)))
(pascal-end-of-statement))))
(goto-char beg)
(while (< (point) end)
(if (re-search-forward
"^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
(marker-position end) 'move)
(forward-char -1))
(indent-to (1+ ind))
(if (/= (following-char) ?:)
()
(forward-char 1)
(delete-horizontal-space)
(insert " "))
(pascal-end-of-statement))
(goto-char savepos)))
(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* ((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
(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)
(if arg
(while (<= (point) edpos)
(beginning-of-line)
(delete-horizontal-space)
(if (looking-at "end\\>")
(indent-to arg)
(indent-to (+ arg pascal-indent-level)))
(forward-line 1)))
(setq ind (pascal-get-lineup-indent stpos edpos lineup))
(goto-char stpos)
(while (and (<= (point) edpos) (not (eobp)))
(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) (forward-char 1)
(delete-horizontal-space)
(insert " ")
(if (looking-at "record\\>")
(pascal-indent-declaration (current-column)))
(forward-line 1)))))
(if arg (forward-line -1)
(goto-char pos))))
(defun pascal-get-lineup-indent (b e str)
(save-excursion
(let ((ind 0)
(reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re)))
(goto-char b)
(while (< (point) e)
(and (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
(cond ((match-beginning 1)
(pascal-declaration-end))
((match-beginning 2)
(goto-char e))
(t
(goto-char (match-beginning 0))
(skip-chars-backward " \t")
(if (> (current-column) ind)
(setq ind (current-column)))
(goto-char (match-end 0))
(end-of-line)
))))
(if (> ind 0)
(1+ ind)
(goto-char b)
(end-of-line)
(skip-chars-backward " \t")
(1+ (current-column))))))
(defvar pascal-str nil)
(defvar pascal-all nil)
(defvar pascal-pred nil)
(defvar pascal-buffer-to-use nil)
(defvar pascal-flag nil)
(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))))))
(defun pascal-func-completion (type)
(if (string= pascal-str "")
(setq pascal-str "[a-zA-Z_]"))
(let ((pascal-str (concat (cond
((eq type 'procedure) "\\<\\(procedure\\)\\s +")
((eq type 'function) "\\<\\(function\\)\\s +")
(t "\\<\\(function\\|procedure\\)\\s +"))
"\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
match)
(if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
(re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
(forward-char 1)
(while (pascal-beg-of-defun)
(if (re-search-forward pascal-str (pascal-get-end-of-line) t)
(progn (setq match (buffer-substring (match-beginning 2)
(match-end 2)))
(if (or (null pascal-pred)
(funcall pascal-pred match))
(setq pascal-all (cons match pascal-all)))))
(goto-char (match-beginning 0)))))
(defun pascal-get-completion-decl ()
(let ((end (save-excursion (pascal-declaration-end)
(point)))
match)
(while (< (point) end)
(if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
(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 "\\<" pascal-str) match)
(if (or (null pascal-pred)
(funcall pascal-pred match))
(setq pascal-all (cons match pascal-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)
(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\\|procedure\\)\\>"
start t)
(not (match-end 1)))
(pascal-get-completion-decl))))))
(defun pascal-var-completion ()
"Calculate all possible completions for variables (or constants)."
(let ((start (point))
goon twice)
(while (or (pascal-beg-of-defun)
(setq goon (not goon)))
(save-excursion
(if (> start (prog1 (save-excursion (pascal-end-of-defun)
(point))))
() (if (search-forward "(" (pascal-get-end-of-line) t)
(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)))
(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 "\\<" pascal-str) s)
(if (or (null pascal-pred)
(funcall pascal-pred s))
(setq pascal-all (cons s pascal-all)))))
keyword-list))
(defun pascal-completion (pascal-str pascal-pred pascal-flag)
(save-excursion
(let ((pascal-all nil))
(set-buffer pascal-buffer-to-use)
(let ((state (car (pascal-calculate-indent))))
(cond ( (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))
( (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 (save-excursion (pascal-var-completion))
(pascal-func-completion 'function)
(pascal-keyword-completion pascal-separator-keywords))))
(pascal-completion-response))))
(defun pascal-completion-response ()
(cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
(if (null pascal-all)
nil
(let* ((elm (cdr pascal-all))
(match (car pascal-all))
(min (length match))
tmp)
(if (string= match pascal-str)
(setq match t)
(while (not (null elm))
(if (< (setq tmp (pascal-string-diff match (car elm))) min)
(progn
(setq min tmp)
(setq match (substring match 0 min))))
(if (string= (car elm) pascal-str)
(progn
(setq match t)
(setq elm nil))
(setq elm (cdr elm)))))
(if (and (equal pascal-flag 'lambda) (not (equal match 't)))
nil
match))))
(pascal-flag
pascal-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-separator-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)))
(pascal-str (buffer-substring b e))
(pascal-buffer-to-use (current-buffer))
(allcomp (if (and pascal-toggle-completions
(string= pascal-last-word-shown pascal-str))
pascal-last-completions
(all-completions pascal-str 'pascal-completion)))
(match (if pascal-toggle-completions
"" (try-completion
pascal-str (mapcar '(lambda (elm)
(cons elm 0)) allcomp)))))
(delete-region b e)
(if pascal-toggle-completions
(progn
(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))
(if (not (null allcomp))
(insert "" pascal-last-word-shown)
(insert "" pascal-str)
(message "(No match)")))
(if (or (null match) (equal match 't))
(progn (insert "" pascal-str)
(message "(No match)"))
(insert "" match))
(cond ((equal match 't)
(if (not (null (cdr allcomp)))
(message "(Complete but not unique)")
(message "(Sole completion)")))
((and (not (null (cdr allcomp))) (= (length pascal-str)
(length match)))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list allcomp pascal-str))
(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)))
(pascal-str (buffer-substring b e))
(pascal-buffer-to-use (current-buffer))
(allcomp (if (and pascal-toggle-completions
(string= pascal-last-word-shown pascal-str))
pascal-last-completions
(all-completions pascal-str 'pascal-completion))))
(with-output-to-temp-buffer "*Completions*"
(display-completion-list allcomp pascal-str))
(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_]*\\)\\>")))
(defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
(save-excursion
(let ((pascal-all nil)
match)
(set-buffer pascal-buffer-to-use)
(let ((pascal-str pascal-str))
(if (string= pascal-str "")
(setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
(setq pascal-str (pascal-build-defun-re pascal-str)))
(goto-char (point-min))
(while (re-search-forward pascal-str nil t)
(setq match (buffer-substring (match-beginning 2) (match-end 2)))
(if (or (null pascal-pred)
(funcall pascal-pred match))
(setq pascal-all (cons match pascal-all)))))
(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))
(pascal-buffer-to-use (current-buffer))
(default (if (pascal-comp-defun default nil 'lambda)
default ""))
(label (if (not (string= default ""))
(completing-read (concat "Label (default " default "): ")
'pascal-comp-defun nil t "")
(completing-read "Label: "
'pascal-comp-defun nil t ""))))
(if (string= label "")
(setq label default))
(or (string= label "")
(progn
(goto-char (point-min))
(re-search-forward (pascal-build-defun-re label t))
(beginning-of-line)))))
(defvar pascal-outline-map
(let ((map (make-sparse-keymap)))
(if (fboundp 'set-keymap-name)
(set-keymap-name pascal-outline-map 'pascal-outline-map))
(define-key map "\M-\C-a" 'pascal-outline-prev-defun)
(define-key map "\M-\C-e" 'pascal-outline-next-defun)
(define-key map "\C-c\C-d" 'pascal-outline-goto-defun)
(define-key map "\C-c\C-s" 'pascal-show-all)
(define-key map "\C-c\C-h" 'pascal-hide-other-defuns)
map)
"Keymap used in Pascal Outline mode.")
(define-obsolete-function-alias 'pascal-outline 'pascal-outline-mode)
(define-minor-mode pascal-outline-mode
"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."
:init-value nil :lighter " Outl" :keymap pascal-outline-map
(add-to-invisibility-spec '(pascal . t))
(unless pascal-outline-mode
(pascal-show-all)))
(defun pascal-outline-change (b e pascal-flag)
(save-excursion
(goto-char b) (setq b (line-end-position))
(goto-char e) (setq e (line-end-position)))
(when (> e b)
(remove-overlays b e 'invisible 'pascal)
(when (eq pascal-flag ?\^M)
(let ((ol (make-overlay b e nil t nil)))
(overlay-put ol 'invisible 'pascal)
(overlay-put ol 'evaporate t)))))
(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))
(while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
(pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
(setq opoint (point))
(if (> (progn (pascal-end-of-defun) (point)) beg)
(goto-char opoint)))
(if (> beg opoint)
(pascal-outline-change opoint (1- beg) ?\^M))
(pascal-outline-change beg end ?\n)
(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)
(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)
(if (< (progn (forward-line -1) (point)) end)
(progn
(goto-char beg)
(pascal-end-of-defun)
(backward-sexp 1)
(pascal-outline-change (point) (point-max) ?\^M))))))
(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))
(provide 'pascal)