;;; pascal.el --- major mode for editing pascal source in Emacs
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
-;; 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: Espen Skoglund <esk@gnu.org>
;; Keywords: languages
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
\f
;;; Code:
+(eval-when-compile (require 'cl))
+
(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 ()
+(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)
+ ;; A command to change the whole buffer won't be used terribly
+ ;; often, so no need for a key binding.
+ ;; (define-key map "\C-cd" 'pascal-downcase-keywords)
+ ;; (define-key map "\C-cu" 'pascal-upcase-keywords)
+ ;; (define-key map "\C-cc" 'pascal-capitalize-keywords)
+ map)
"Keymap used in Pascal mode.")
-(if pascal-mode-map
- ()
- (setq pascal-mode-map (make-sparse-keymap))
- (define-key pascal-mode-map ";" 'electric-pascal-semi-or-dot)
- (define-key pascal-mode-map "." 'electric-pascal-semi-or-dot)
- (define-key pascal-mode-map ":" 'electric-pascal-colon)
- (define-key pascal-mode-map "=" 'electric-pascal-equal)
- (define-key pascal-mode-map "#" 'electric-pascal-hash)
- (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
- (define-key pascal-mode-map "\t" 'electric-pascal-tab)
- (define-key pascal-mode-map "\M-\t" 'pascal-complete-word)
- (define-key pascal-mode-map "\M-?" 'pascal-show-completions)
- (define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
- (define-key pascal-mode-map "\M-\C-h" 'pascal-mark-defun)
- (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
- (define-key pascal-mode-map "\M-*" 'pascal-star-comment)
- (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
- (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
- (define-key pascal-mode-map "\M-\C-a" 'pascal-beg-of-defun)
- (define-key pascal-mode-map "\M-\C-e" 'pascal-end-of-defun)
- (define-key pascal-mode-map "\C-c\C-d" 'pascal-goto-defun)
- (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
-;;; A command to change the whole buffer won't be used terribly
-;;; often, so no need for a key binding.
-; (define-key pascal-mode-map "\C-cd" 'pascal-downcase-keywords)
-; (define-key pascal-mode-map "\C-cu" 'pascal-upcase-keywords)
-; (define-key pascal-mode-map "\C-cc" 'pascal-capitalize-keywords)
- )
(defvar pascal-imenu-generic-expression
'((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2))
(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
-(defvar pascal-mode-syntax-table nil
+(defvar pascal-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\\ "." st)
+ (modify-syntax-entry ?\( "()1" st)
+ (modify-syntax-entry ?\) ")(4" st)
+ ;; This used to use comment-syntax `b'. But the only document I could
+ ;; find about the syntax of Pascal's comments said that (* ... } is
+ ;; a valid comment, just as { ... *) or (* ... *) or { ... }.
+ (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.")
-(if pascal-mode-syntax-table
- ()
- (setq pascal-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?\\ "." pascal-mode-syntax-table)
- (modify-syntax-entry ?( "()1" pascal-mode-syntax-table)
- (modify-syntax-entry ?) ")(4" pascal-mode-syntax-table)
- (modify-syntax-entry ?* ". 23b" pascal-mode-syntax-table)
- (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
- (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
- (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
- (modify-syntax-entry ?- "." pascal-mode-syntax-table)
- (modify-syntax-entry ?= "." pascal-mode-syntax-table)
- (modify-syntax-entry ?% "." pascal-mode-syntax-table)
- (modify-syntax-entry ?< "." pascal-mode-syntax-table)
- (modify-syntax-entry ?> "." pascal-mode-syntax-table)
- (modify-syntax-entry ?& "." pascal-mode-syntax-table)
- (modify-syntax-entry ?| "." pascal-mode-syntax-table)
- (modify-syntax-entry ?_ "_" pascal-mode-syntax-table)
- (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
+
(defconst pascal-font-lock-keywords (purecopy
(list
\\[pascal-beg-of-defun]\t- Move to beginning of current function.
\\[pascal-end-of-defun]\t- Move to end of current function.
\\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
-\\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
+\\[pascal-outline-mode]\t- Enter `pascal-outline-mode'.
Variables controlling indentation/edit style:
(defun electric-pascal-semi-or-dot ()
"Insert `;' or `.' character and reindent the line."
(interactive)
- (insert last-command-char)
+ (insert last-command-event)
(save-excursion
(beginning-of-line)
(pascal-indent-line))
(defun electric-pascal-colon ()
"Insert `:' and do all indentions except line indent on this line."
(interactive)
- (insert last-command-char)
+ (insert last-command-event)
;; Do nothing if within string.
(if (pascal-within-string)
()
(defun electric-pascal-equal ()
"Insert `=', and do indention if within type declaration."
(interactive)
- (insert last-command-char)
+ (insert last-command-event)
(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)
+ (insert last-command-event)
(if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
(save-excursion (beginning-of-line)
(delete-horizontal-space))))
(pascal-end-of-defun)
(push-mark (point))
(pascal-beg-of-defun)
- (if (fboundp 'zmacs-activate-region)
- (zmacs-activate-region)))
+ (when (featurep 'xemacs)
+ (zmacs-activate-region)))
(defun pascal-comment-area (start end)
"Put the region into a Pascal comment.
(defun pascal-indent-command ()
"Indent for special part of code."
(let* ((indent-str (pascal-calculate-indent))
- (type (car indent-str))
- (ind (car (cdr indent-str))))
+ (type (car indent-str)))
(cond ((and (eq type 'paramlist)
(or (memq 'all pascal-auto-lineup)
(memq 'paramlist pascal-auto-lineup)))
(end-of-line)
(point-marker)
(re-search-backward "\\<case\\>" nil t)))
- (beg (point)) oldpos
+ (beg (point))
(ind 0))
;; Get right indent
(while (< (point) end)
(setq ind (current-column)))
(pascal-end-of-statement))))
(goto-char beg)
- (setq oldpos (marker-position end))
;; Indent all case statements
(while (< (point) end)
(if (re-search-forward
(forward-char 1)
(delete-horizontal-space)
(insert " "))
- (setq oldpos (point))
(pascal-end-of-statement))
(goto-char savepos)))
;;;
;;; Completion
-;;;
-(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."
;; completions for procedures if argument is `procedure' or both functions and
;; procedures otherwise.
-(defun pascal-func-completion (type)
+(defun pascal-func-completion (type pascal-str)
;; Build regular expression for function/procedure names
- (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)
+ (save-excursion
+ (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_.]*\\)\\>"))
+ (pascal-all ())
+ match)
+
+ (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
+ (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
+ (forward-char 1)
+
+ ;; Search through all reachable functions
+ (while (pascal-beg-of-defun)
+ (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
+ (progn (setq match (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ (push match pascal-all)))
+ (goto-char (match-beginning 0)))
+
+ pascal-all)))
- (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
- (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
- (forward-char 1)
-
- ;; Search through all reachable functions
- (while (pascal-beg-of-defun)
- (if (re-search-forward 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 ()
+(defun pascal-get-completion-decl (pascal-str)
;; Macro for searching through current declaration (var, type or const)
;; for matches of `str' and adding the occurrence to `all'
(let ((end (save-excursion (pascal-declaration-end)
(point)))
+ (pascal-all ())
match)
;; Traverse lines
(while (< (point) end)
(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))))))
+ (push match pascal-all))))
(if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
(pascal-declaration-end)
- (forward-line 1)))))
+ (forward-line 1)))
-(defun pascal-type-completion ()
+ pascal-all))
+
+(defun pascal-type-completion (pascal-str)
"Calculate all possible completions for types."
(let ((start (point))
+ (pascal-all ())
goon)
;; Search for all reachable type declarations
(while (or (pascal-beg-of-defun)
start t)
(not (match-end 1)))
;; Check current type declaration
- (pascal-get-completion-decl))))))
+ (setq pascal-all
+ (nconc (pascal-get-completion-decl pascal-str)
+ pascal-all)))))
+
+ pascal-all))
-(defun pascal-var-completion ()
+(defun pascal-var-completion (prefix)
"Calculate all possible completions for variables (or constants)."
- (let ((start (point))
- goon twice)
- ;; Search for all reachable var declarations
- (while (or (pascal-beg-of-defun)
- (setq goon (not goon)))
- (save-excursion
- (if (> start (prog1 (save-excursion (pascal-end-of-defun)
- (point))))
- () ; Declarations not reachable
- (if (search-forward "(" (pascal-get-end-of-line) t)
- ;; Check parameterlist
- (pascal-get-completion-decl))
- (setq twice 2)
- (while (>= (setq twice (1- twice)) 0)
- (cond ((and (re-search-forward
- (concat "\\<\\(var\\|const\\)\\>\\|"
- "\\<\\(begin\\|function\\|procedure\\)\\>")
- start t)
- (not (match-end 2)))
- ;; Check var/const declarations
- (pascal-get-completion-decl))
- ((match-end 2)
- (setq twice 0)))))))))
-
-
-(defun pascal-keyword-completion (keyword-list)
+ (save-excursion
+ (let ((start (point))
+ (pascal-all ())
+ goon twice)
+ ;; Search for all reachable var declarations
+ (while (or (pascal-beg-of-defun)
+ (setq goon (not goon)))
+ (save-excursion
+ (if (> start (prog1 (save-excursion (pascal-end-of-defun)
+ (point))))
+ () ; Declarations not reachable
+ (if (search-forward "(" (pascal-get-end-of-line) t)
+ ;; Check parameterlist
+ ;; FIXME: pascal-get-completion-decl doesn't understand
+ ;; the var declarations in parameter lists :-(
+ (setq pascal-all
+ (nconc (pascal-get-completion-decl prefix)
+ pascal-all)))
+ (setq twice 2)
+ (while (>= (setq twice (1- twice)) 0)
+ (cond
+ ((and (re-search-forward
+ (concat "\\<\\(var\\|const\\)\\>\\|"
+ "\\<\\(begin\\|function\\|procedure\\)\\>")
+ start t)
+ (not (match-end 2)))
+ ;; Check var/const declarations
+ (setq pascal-all
+ (nconc (pascal-get-completion-decl prefix)
+ pascal-all)))
+ ((match-end 2)
+ (setq twice 0)))))))
+ pascal-all)))
+
+
+(defun pascal-keyword-completion (keyword-list pascal-str)
"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))
+ (let ((pascal-all ()))
+ (dolist (s keyword-list)
+ (if (string-match (concat "\\<" pascal-str) s)
+ (push s pascal-all)))
+ pascal-all))
;; Function passed to completing-read, try-completion or
;; all-completions to get completion on STR. If predicate is non-nil,
;; is 'lambda, the function returns t if STR is an exact match, nil
;; otherwise.
-(defun pascal-completion (pascal-str pascal-pred pascal-flag)
- (save-excursion
- (let ((pascal-all nil))
- ;; Set buffer to use for searching labels. This should be set
- ;; within functions which use pascal-completions
- (set-buffer pascal-buffer-to-use)
+(defvar pascal-completion-cache nil)
- ;; Determine what should be completed
+(defun pascal-completion (pascal-str pascal-pred pascal-flag)
+ (let ((all (car pascal-completion-cache)))
+ ;; Check the cache's freshness.
+ (unless (and pascal-completion-cache
+ (string-prefix-p (nth 1 pascal-completion-cache) pascal-str)
+ (eq (current-buffer) (nth 2 pascal-completion-cache))
+ (eq (field-beginning) (nth 3 pascal-completion-cache)))
(let ((state (car (pascal-calculate-indent))))
- (cond (;--Within a declaration or parameterlist
- (or (eq state 'declaration) (eq state 'paramlist)
- (and (eq state 'defun)
- (save-excursion
- (re-search-backward ")[ \t]*:"
- (pascal-get-beg-of-line) t))))
- (if (or (eq state 'paramlist) (eq state 'defun))
- (pascal-beg-of-defun))
- (pascal-type-completion)
- (pascal-keyword-completion pascal-type-keywords))
- (;--Starting a new statement
- (and (not (eq state 'contexp))
- (save-excursion
- (skip-chars-backward "a-zA-Z0-9_.")
- (backward-sexp 1)
- (or (looking-at pascal-nosemi-re)
- (progn
- (forward-sexp 1)
- (looking-at "\\s *\\(;\\|:[^=]\\)")))))
- (save-excursion (pascal-var-completion))
- (pascal-func-completion 'procedure)
- (pascal-keyword-completion pascal-start-keywords))
- (t;--Anywhere else
- (save-excursion (pascal-var-completion))
- (pascal-func-completion 'function)
- (pascal-keyword-completion pascal-separator-keywords))))
-
- ;; Now we have built a list of all matches. Give response to caller
- (pascal-completion-response))))
-
-(defun pascal-completion-response ()
- (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
- ;; This was not called by all-completions
- (if (null pascal-all)
- ;; Return nil if there was no matching label
- nil
- ;; Get longest string common in the labels
- (let* ((elm (cdr pascal-all))
- (match (car pascal-all))
- (min (length match))
- tmp)
- (if (string= match pascal-str)
- ;; Return t if first match was an exact match
- (setq match t)
- (while (not (null elm))
- ;; Find longest common string
- (if (< (setq tmp (pascal-string-diff match (car elm))) min)
- (progn
- (setq min tmp)
- (setq match (substring match 0 min))))
- ;; Terminate with match=t if this is an exact match
- (if (string= (car elm) pascal-str)
- (progn
- (setq match t)
- (setq elm nil))
- (setq elm (cdr elm)))))
- ;; If this is a test just for exact match, return nil ot t
- (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
- nil
- match))))
- ;; If flag is t, this was called by all-completions. Return
- ;; list of all possible completions
- (pascal-flag
- pascal-all)))
+ (setq all
+ ;; Determine what should be completed
+ (cond
+ ( ;--Within a declaration or parameterlist
+ (or (eq state 'declaration) (eq state 'paramlist)
+ (and (eq state 'defun)
+ (save-excursion
+ (re-search-backward ")[ \t]*:"
+ (pascal-get-beg-of-line) t))))
+ (if (or (eq state 'paramlist) (eq state 'defun))
+ (pascal-beg-of-defun))
+ (nconc
+ (pascal-type-completion pascal-str)
+ (pascal-keyword-completion pascal-type-keywords pascal-str)))
+ ( ;--Starting a new statement
+ (and (not (eq state 'contexp))
+ (save-excursion
+ (skip-chars-backward "a-zA-Z0-9_.")
+ (backward-sexp 1)
+ (or (looking-at pascal-nosemi-re)
+ (progn
+ (forward-sexp 1)
+ (looking-at "\\s *\\(;\\|:[^=]\\)")))))
+ (nconc
+ (pascal-var-completion pascal-str)
+ (pascal-func-completion 'procedure pascal-str)
+ (pascal-keyword-completion pascal-start-keywords pascal-str)))
+ (t ;--Anywhere else
+ (nconc
+ (pascal-var-completion pascal-str)
+ (pascal-func-completion 'function pascal-str)
+ (pascal-keyword-completion pascal-separator-keywords
+ pascal-str)))))
+
+ (setq pascal-completion-cache
+ (list all pascal-str (current-buffer) (field-beginning)))))
+
+ ;; Now we have built a list of all matches. Give response to caller
+ (complete-with-action pascal-flag all pascal-str pascal-pred)))
(defvar pascal-last-word-numb 0)
(defvar pascal-last-word-shown nil)
`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))
- ;; The following variable is used in pascal-completion
- (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 old string
- (delete-region b e)
+ (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))))
;; Toggle-completions inserts whole labels
(if pascal-toggle-completions
- (progn
+ (let* ((pascal-str (buffer-substring b e))
+ (allcomp (if (and pascal-toggle-completions
+ (string= pascal-last-word-shown pascal-str))
+ pascal-last-completions
+ (all-completions pascal-str 'pascal-completion))))
;; Update entry number in list
(setq pascal-last-completions allcomp
pascal-last-word-numb
(1+ pascal-last-word-numb)))
(setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
;; Display next match or same string if no match was found
- (if (not (null allcomp))
- (insert "" pascal-last-word-shown)
- (insert "" pascal-str)
+ (if allcomp
+ (progn
+ (goto-char e)
+ (insert-before-markers pascal-last-word-shown)
+ (delete-region b e))
(message "(No match)")))
;; The other form of completion does not necessarily do that.
-
- ;; Insert match if found, or the original string if no match
- (if (or (null match) (equal match 't))
- (progn (insert "" pascal-str)
- (message "(No match)"))
- (insert "" match))
- ;; Give message about current status of completion
- (cond ((equal match 't)
- (if (not (null (cdr allcomp)))
- (message "(Complete but not unique)")
- (message "(Sole completion)")))
- ;; Display buffer if the current completion didn't help
- ;; on completing the label.
- ((and (not (null (cdr allcomp))) (= (length pascal-str)
- (length match)))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list allcomp))
- ;; Wait for a keypress. Then delete *Completion* window
- (momentary-string-display "" (point))
- (delete-window (get-buffer-window (get-buffer "*Completions*")))
- )))))
+ (completion-in-region b e 'pascal-completion))))
(defun pascal-show-completions ()
"Show all possible completions at current point."
(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))
- ;; The following variable is used in pascal-completion
- (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))))
;; Show possible completions in a temporary buffer.
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list allcomp))
+ (display-completion-list allcomp pascal-str))
;; Wait for a keypress. Then delete *Completion* window
(momentary-string-display "" (point))
(delete-window (get-buffer-window (get-buffer "*Completions*")))))
(defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
(save-excursion
- (let ((pascal-all nil)
- match)
-
- ;; Set buffer to use for searching labels. This should be set
- ;; within functions which use pascal-completions
- (set-buffer pascal-buffer-to-use)
-
- (let ((pascal-str pascal-str))
- ;; Build regular expression for functions
- (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))
-
- ;; Build a list of all possible completions
- (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)))))
+ (let ((pascal-all nil))
+
+ ;; Build regular expression for functions
+ (let ((pascal-str (pascal-build-defun-re (if (string= pascal-str "")
+ "[a-zA-Z_]"
+ pascal-str))))
+ (goto-char (point-min))
+
+ ;; Build a list of all possible completions
+ (while (re-search-forward pascal-str nil t)
+ (push (match-string 2) pascal-all)))
;; Now we have built a list of all matches. Give response to caller
- (pascal-completion-response))))
+ (complete-with-action pascal-flag pascal-all pascal-str pascal-pred))))
(defun pascal-goto-defun ()
"Move to specified Pascal function/procedure.
The default is a name found in the buffer around point."
(interactive)
(let* ((default (pascal-get-default-symbol))
- ;; The following variable is used in pascal-comp-function
- (pascal-buffer-to-use (current-buffer))
(default (if (pascal-comp-defun default nil 'lambda)
default ""))
- (label (if (not (string= default ""))
- ;; Do completion with default
- (completing-read (concat "Label: (default " default ") ")
- 'pascal-comp-defun nil t "")
- ;; There is no default value. Complete without it
- (completing-read "Label: "
- 'pascal-comp-defun nil t ""))))
+ (label
+ ;; Do completion with default
+ (completing-read (if (not (string= default ""))
+ (concat "Label (default " default "): ")
+ "Label: ")
+ ;; Complete with the defuns found in the
+ ;; current-buffer.
+ (lexical-let ((buf (current-buffer)))
+ (lambda (s p a)
+ (with-current-buffer buf
+ (pascal-comp-defun s p a))))
+ nil t "")))
;; If there was no response on prompt, use default value
(if (string= label "")
(setq label default))
;;;
;;; Pascal-outline-mode
;;;
-(defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
-
-(if pascal-outline-map
- nil
- (if (fboundp 'set-keymap-name)
- (set-keymap-name pascal-outline-map 'pascal-outline-map))
- (if (fboundp 'set-keymap-parent)
- (set-keymap-parent (setq pascal-outline-map (make-sparse-keymap))
- pascal-mode-map)
- (setq pascal-outline-map (copy-keymap pascal-mode-map)))
- (define-key pascal-outline-map "\M-\C-a" 'pascal-outline-prev-defun)
- (define-key pascal-outline-map "\M-\C-e" 'pascal-outline-next-defun)
- (define-key pascal-outline-map "\C-c\C-d" 'pascal-outline-goto-defun)
- (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
- (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
-
-(defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
-(make-variable-buffer-local 'pascal-outline-mode)
-(set-default 'pascal-outline-mode nil)
-(if (not (assoc 'pascal-outline-mode minor-mode-alist))
- (setq minor-mode-alist (append minor-mode-alist
- (list '(pascal-outline-mode " Outl")))))
-
-(defun pascal-outline (&optional arg)
+(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 "22.1")
+(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-hide-other-defuns]\
\t- Hide everything but the current function (function under the cursor).
\\[pascal-outline]\t- Leave pascal-outline-mode."
- (interactive "P")
- (setq pascal-outline-mode
- (if (null arg) (not pascal-outline-mode) t))
- (if (fboundp 'redraw-mode-line)
- (redraw-mode-line))
- (if pascal-outline-mode
- (progn
- (setq selective-display t)
- (use-local-map pascal-outline-map))
- (progn
- (setq selective-display nil)
- (pascal-show-all)
- (use-local-map pascal-mode-map))))
+ :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)
- (let ((modp (buffer-modified-p)))
- (unwind-protect
- (subst-char-in-region b e (if (= pascal-flag ?\n)
- ?\^M ?\n) pascal-flag)
- (set-buffer-modified-p modp))))
+ (save-excursion
+ ;; This used to use selective display so the boundaries used by the
+ ;; callers didn't have to be precise, since it just looked for \n or \^M
+ ;; and switched them.
+ (goto-char b) (setq b (line-end-position))
+ (goto-char e) (setq e (line-end-position)))
+ (when (> e b)
+ ;; We could try and optimize this in the case where the region is
+ ;; already hidden. But I'm not sure it's worth the trouble.
+ (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."
(provide 'pascal)
-;;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5
+;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5
;;; pascal.el ends here
HCoop / bpt / emacs.git / blobdiff