X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/3f715d17fef56ee78a3df7ebb00d4e8b1aec37de..bcd70d976f1035f84f55fa6969b9c0c419b7cc06:/lisp/progmodes/pascal.el diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index a21fd1f9e3..57ed13969b 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1,7 +1,6 @@ -;;; pascal.el --- major mode for editing pascal source in Emacs +;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1993-2011 Free Software Foundation, Inc. ;; Author: Espen Skoglund ;; Keywords: languages @@ -41,7 +40,6 @@ ;; pascal-tab-always-indent t ;; pascal-auto-endcomments t ;; pascal-auto-lineup '(all) -;; pascal-toggle-completions nil ;; pascal-type-keywords '("array" "file" "packed" "char" ;; "integer" "real" "string" "record") ;; pascal-start-keywords '("begin" "end" "function" "procedure" @@ -59,6 +57,8 @@ ;;; 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) @@ -75,10 +75,11 @@ (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) + ;; These are user preferences, so not to set by default. + ;;(define-key map "\r" 'electric-pascal-terminate-line) + ;;(define-key map "\t" 'electric-pascal-tab) + (define-key map "\M-\t" 'completion-at-point) + (define-key map "\M-?" 'completion-help-at-point) (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) @@ -220,7 +221,7 @@ The name of the function or case is included between the braces." "*List of contexts where auto lineup of :'s or ='s should be done. Elements can be of type: 'paramlist', 'declaration' or 'case', which will do auto lineup in parameterlist, declarations or case-statements -respectively. The word 'all' will do all lineups. '(case paramlist) for +respectively. The word 'all' will do all lineups. '(case paramlist) for instance will do lineup in case-statements and parameterlist, while '(all) will do all lineups." :type '(set :extra-offset 8 @@ -230,13 +231,13 @@ will do all lineups." (const :tag "Case statements" case)) :group 'pascal) -(defcustom pascal-toggle-completions nil - "*Non-nil means \\\\[pascal-complete-word] should try all possible completions one by one. -Repeated use of \\[pascal-complete-word] will show you all of them. +(defvar pascal-toggle-completions nil + "*Non-nil meant \\\\[pascal-complete-word] would try all possible completions one by one. +Repeated use of \\[pascal-complete-word] would show you all of them. Normally, when there is more than one possible completion, -it displays a list of all possible completions." - :type 'boolean - :group 'pascal) +it displays a list of all possible completions.") +(make-obsolete-variable 'pascal-toggle-completions + 'completion-cycle-threshold "24.1") (defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") @@ -271,22 +272,12 @@ are handled in another way, and should not be added to this list." ;;; Macros ;;; -(defsubst pascal-get-beg-of-line (&optional arg) - (save-excursion - (beginning-of-line arg) - (point))) - -(defsubst pascal-get-end-of-line (&optional arg) - (save-excursion - (end-of-line arg) - (point))) - (defun pascal-declaration-end () (let ((nest 1)) (while (and (> nest 0) (re-search-forward "[:=]\\|\\(\\\\)\\|\\(\\\\)" - (save-excursion (end-of-line 2) (point)) t)) + (point-at-eol 2) t)) (cond ((match-beginning 1) (setq nest (1+ nest))) ((match-beginning 2) (setq nest (1- nest))) ((looking-at "[^(\n]+)") (setq nest 0)))))) @@ -295,7 +286,7 @@ are handled in another way, and should not be added to this list." (defun pascal-declaration-beg () (let ((nest 1)) (while (and (> nest 0) - (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\\\)\\|\\(\\\\)" (pascal-get-beg-of-line 0) t)) + (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\\\)\\|\\(\\\\)" (point-at-bol 0) t)) (cond ((match-beginning 1) (setq nest 0)) ((match-beginning 2) (setq nest (1- nest))) ((match-beginning 3) (setq nest (1+ nest))))) @@ -303,18 +294,17 @@ are handled in another way, and should not be added to this list." (defsubst pascal-within-string () - (save-excursion - (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point))))) + (nth 3 (parse-partial-sexp (point-at-bol) (point)))) ;;;###autoload -(defun pascal-mode () +(define-derived-mode pascal-mode prog-mode "Pascal" "Major mode for editing Pascal code. \\ TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. -\\[pascal-complete-word] completes the word around current point with respect \ +\\[completion-at-point] completes the word around current point with respect \ to position in code -\\[pascal-show-completions] shows all possible completions at this point. +\\[completion-help-at-point] shows all possible completions at this point. Other useful functions are: @@ -331,60 +321,48 @@ Other useful functions are: Variables controlling indentation/edit style: - pascal-indent-level (default 3) + `pascal-indent-level' (default 3) Indentation of Pascal statements with respect to containing block. - pascal-case-indent (default 2) + `pascal-case-indent' (default 2) Indentation for case statements. - pascal-auto-newline (default nil) + `pascal-auto-newline' (default nil) Non-nil means automatically newline after semicolons and the punctuation mark after an end. - pascal-indent-nested-functions (default t) + `pascal-indent-nested-functions' (default t) Non-nil means nested functions are indented. - pascal-tab-always-indent (default t) + `pascal-tab-always-indent' (default t) Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. - pascal-auto-endcomments (default t) + `pascal-auto-endcomments' (default t) Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. - pascal-auto-lineup (default t) + `pascal-auto-lineup' (default t) List of contexts where auto lineup of :'s or ='s should be done. -See also the user variables pascal-type-keywords, pascal-start-keywords and -pascal-separator-keywords. +See also the user variables `pascal-type-keywords', `pascal-start-keywords' and +`pascal-separator-keywords'. Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map pascal-mode-map) - (setq major-mode 'pascal-mode) - (setq mode-name "Pascal") - (setq local-abbrev-table pascal-mode-abbrev-table) - (set-syntax-table pascal-mode-syntax-table) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'pascal-indent-line) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'pascal-indent-comment) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments nil) - (make-local-variable 'blink-matching-paren-dont-ignore-comments) - (setq blink-matching-paren-dont-ignore-comments t) - (make-local-variable 'case-fold-search) - (setq case-fold-search t) - (make-local-variable 'comment-start) - (setq comment-start "{") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "(\\*+ *\\|{ *") - (make-local-variable 'comment-end) - (setq comment-end "}") + (set (make-local-variable 'local-abbrev-table) pascal-mode-abbrev-table) + (set (make-local-variable 'indent-line-function) 'pascal-indent-line) + (set (make-local-variable 'comment-indent-function) 'pascal-indent-comment) + (set (make-local-variable 'parse-sexp-ignore-comments) nil) + (set (make-local-variable 'blink-matching-paren-dont-ignore-comments) t) + (set (make-local-variable 'case-fold-search) t) + (set (make-local-variable 'comment-start) "{") + (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *") + (set (make-local-variable 'comment-end) "}") + (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t) ;; Font lock support - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(pascal-font-lock-keywords nil t)) + (set (make-local-variable 'font-lock-defaults) + '(pascal-font-lock-keywords nil t)) ;; Imenu support - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression pascal-imenu-generic-expression) - (setq imenu-case-fold-search t) - (run-mode-hooks 'pascal-mode-hook)) + (set (make-local-variable 'imenu-generic-expression) + pascal-imenu-generic-expression) + (set (make-local-variable 'imenu-case-fold-search) t) + ;; Pascal-mode's own hide/show support. + (add-to-invisibility-spec '(pascal . t))) @@ -417,8 +395,7 @@ no args, if that value is non-nil." (forward-char 1) (delete-horizontal-space)) ((and (looking-at "(\\*\\|\\*[^)]") - (not (save-excursion - (search-forward "*)" (pascal-get-end-of-line) t)))) + (not (save-excursion (search-forward "*)" (point-at-eol) t)))) (setq setstar t)))) ;; If last line was a star comment line then this one shall be too. (if (null setstar) @@ -429,7 +406,7 @@ no args, if that value is non-nil." (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)) @@ -439,7 +416,7 @@ no args, if that value is non-nil." (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) () @@ -452,7 +429,7 @@ no args, if that value is non-nil." (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)))) @@ -460,7 +437,7 @@ no args, if that value is non-nil." (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)))) @@ -737,7 +714,7 @@ on the line which ends a function or procedure named NAME." (if (and (looking-at "\\" stpos t))) (if arg (progn @@ -1056,7 +1033,7 @@ indent of the current line in parameterlist." (setq ind (pascal-get-lineup-indent stpos edpos lineup)) (goto-char stpos) (while (and (<= (point) edpos) (not (eobp))) - (if (search-forward lineup (pascal-get-end-of-line) 'move) + (if (search-forward lineup (point-at-eol) 'move) (forward-char -1)) (delete-horizontal-space) (indent-to ind) @@ -1083,7 +1060,7 @@ indent of the current line in parameterlist." (goto-char b) ;; Get rightmost position (while (< (point) e) - (and (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move) + (and (re-search-forward reg (min e (point-at-eol 2)) 'move) (cond ((match-beginning 1) ;; Skip record blocks (pascal-declaration-end)) @@ -1111,12 +1088,6 @@ indent of the current line in parameterlist." ;;; ;;; 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." @@ -1134,58 +1105,62 @@ indent of the current line in parameterlist." ;; 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 (point-at-eol) t) + (progn (setq match (buffer-substring (match-beginning 2) + (match-end 2))) + (push match pascal-all))) + (goto-char (match-beginning 0))) - (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 () + pascal-all))) + +(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) - (if (re-search-forward "[:=]" (pascal-get-end-of-line) t) + (if (re-search-forward "[:=]" (point-at-eol) t) ;; Traverse current line (while (and (re-search-backward (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" pascal-symbol-re) - (pascal-get-beg-of-line) t) + (point-at-bol) t) (not (match-end 1))) (setq match (buffer-substring (match-beginning 0) (match-end 0))) (if (string-match (concat "\\<" pascal-str) match) - (if (or (null pascal-pred) - (funcall pascal-pred match)) - (setq pascal-all (cons match pascal-all)))))) - (if (re-search-forward "\\" (pascal-get-end-of-line) t) + (push match pascal-all)))) + (if (re-search-forward "\\" (point-at-eol) t) (pascal-declaration-end) - (forward-line 1))))) + (forward-line 1))) + + pascal-all)) -(defun pascal-type-completion () +(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) @@ -1199,43 +1174,56 @@ indent of the current line in parameterlist." 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))))) -(defun pascal-var-completion () + pascal-all)) + +(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 "(" (point-at-eol) 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, @@ -1246,161 +1234,70 @@ indent of the current line in parameterlist." ;; 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]*:" (point-at-bol) 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) (defvar pascal-last-completions nil) -(defun pascal-complete-word () - "Complete word at current point. -\(See also `pascal-toggle-completions', `pascal-type-keywords', -`pascal-start-keywords' and `pascal-separator-keywords'.)" - (interactive) +(defun pascal-completions-at-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))) - (match (if pascal-toggle-completions - "" (try-completion - pascal-str (mapcar '(lambda (elm) - (cons elm 0)) allcomp))))) - ;; Delete old string - (delete-region b e) - - ;; Toggle-completions inserts whole labels - (if pascal-toggle-completions - (progn - ;; Update entry number in list - (setq pascal-last-completions allcomp - pascal-last-word-numb - (if (>= pascal-last-word-numb (1- (length allcomp))) - 0 - (1+ pascal-last-word-numb))) - (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb)) - ;; Display next match or same string if no match was found - (if (not (null allcomp)) - (insert "" pascal-last-word-shown) - (insert "" pascal-str) - (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 pascal-str)) - ;; Wait for a keypress. Then delete *Completion* window - (momentary-string-display "" (point)) - (delete-window (get-buffer-window (get-buffer "*Completions*"))) - ))))) - -(defun pascal-show-completions () - "Show all possible completions at current point." - (interactive) - (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) - (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) - (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 pascal-str)) - ;; Wait for a keypress. Then delete *Completion* window - (momentary-string-display "" (point)) - (delete-window (get-buffer-window (get-buffer "*Completions*"))))) + (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))) + (when (> e b) + (list b e #'pascal-completion)))) + +(define-obsolete-function-alias 'pascal-complete-word + 'completion-at-point "24.1") + +(define-obsolete-function-alias 'pascal-show-completions + 'completion-help-at-point "24.1") (defun pascal-get-default-symbol () @@ -1432,46 +1329,40 @@ With optional second arg non-nil, STR is the complete name of the instruction." (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)) @@ -1499,7 +1390,7 @@ The default is a name found in the buffer around point." map) "Keymap used in Pascal Outline mode.") -(define-obsolete-function-alias 'pascal-outline '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 @@ -1523,18 +1414,12 @@ Pascal Outline mode provides some additional commands. (unless pascal-outline-mode (pascal-show-all))) -(defun pascal-outline-change (b e pascal-flag) - (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))) +(defun pascal-outline-change (b e hide) (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) + (when hide (let ((ol (make-overlay b e nil t nil))) (overlay-put ol 'invisible 'pascal) (overlay-put ol 'evaporate t))))) @@ -1542,7 +1427,7 @@ Pascal Outline mode provides some additional commands. (defun pascal-show-all () "Show all of the text in the buffer." (interactive) - (pascal-outline-change (point-min) (point-max) ?\n)) + (pascal-outline-change (point-min) (point-max) nil)) (defun pascal-hide-other-defuns () "Show only the current defun." @@ -1550,42 +1435,45 @@ Pascal Outline mode provides some additional commands. (save-excursion (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>")) (pascal-beg-of-defun)) - (point))) + (line-beginning-position))) (end (progn (pascal-end-of-defun) (backward-sexp 1) - (search-forward "\n\\|\^M" nil t) - (point))) + (line-beginning-position 2))) (opoint (point-min))) + ;; BEG at BOL. + ;; OPOINT at EOL. + ;; END at BOL. (goto-char (point-min)) ;; Hide all functions before current function - (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move) - (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) - (setq opoint (point)) + (while (re-search-forward "^[ \t]*\\(function\\|procedure\\)\\>" + beg 'move) + (pascal-outline-change opoint (line-end-position 0) t) + (setq opoint (line-end-position)) ;; Functions may be nested (if (> (progn (pascal-end-of-defun) (point)) beg) (goto-char opoint))) (if (> beg opoint) - (pascal-outline-change opoint (1- beg) ?\^M)) + (pascal-outline-change opoint (1- beg) t)) ;; Show current function - (pascal-outline-change beg end ?\n) + (pascal-outline-change (1- beg) end nil) ;; Hide nested functions (forward-char 1) (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move) - (setq opoint (point)) + (setq opoint (line-end-position)) (pascal-end-of-defun) - (pascal-outline-change opoint (point) ?\^M)) + (pascal-outline-change opoint (line-end-position) t)) (goto-char end) (setq opoint end) ;; Hide all function after current function (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move) - (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M) - (setq opoint (point)) + (pascal-outline-change opoint (line-end-position 0) t) + (setq opoint (line-end-position)) (pascal-end-of-defun)) - (pascal-outline-change opoint (point-max) ?\^M) + (pascal-outline-change opoint (point-max) t) ;; Hide main program (if (< (progn (forward-line -1) (point)) end) @@ -1593,7 +1481,7 @@ Pascal Outline mode provides some additional commands. (goto-char beg) (pascal-end-of-defun) (backward-sexp 1) - (pascal-outline-change (point) (point-max) ?\^M)))))) + (pascal-outline-change (line-end-position) (point-max) t)))))) (defun pascal-outline-next-defun () "Move to next function/procedure, hiding all others." @@ -1615,5 +1503,4 @@ Pascal Outline mode provides some additional commands. (provide 'pascal) -;; arch-tag: 04535136-fd93-40b4-a505-c9bebdc051f5 ;;; pascal.el ends here