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