;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2014 Free Software Foundation, Inc.
;; Author: Espen Skoglund <esk@gnu.org>
;; Keywords: languages
\f
;;; Code:
-(eval-when-compile (require 'cl))
(defgroup pascal nil
"Major mode for editing Pascal source in Emacs."
;; find about the syntax of Pascal's comments said that (* ... } is
;; a valid comment, just as { ... *) or (* ... *) or { ... }.
(modify-syntax-entry ?* ". 23" st)
+ ;; Allow //...\n comments as accepted by Free Pascal (bug#13585).
+ (modify-syntax-entry ?/ ". 12c" st)
+ (modify-syntax-entry ?\n "> c" st)
(modify-syntax-entry ?{ "<" st)
(modify-syntax-entry ?} ">" st)
(modify-syntax-entry ?+ "." st)
-(defconst pascal-font-lock-keywords (purecopy
- (list
- '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z]\\)"
+(defconst pascal-font-lock-keywords
+ `(("\\_<\\(function\\|pro\\(cedure\\|gram\\)\\)[ \t]+\\([[:alpha:]][[:alnum:]_]*\\)"
+ (1 font-lock-keyword-face)
+ (3 font-lock-function-name-face))
+ ;; ("type" "const" "real" "integer" "char" "boolean" "var"
+ ;; "record" "array" "file")
+ (,(concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
+ "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
+ font-lock-type-face)
+ ("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face)
+ ("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
+ ;; ("of" "to" "for" "if" "then" "else" "case" "while"
+ ;; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
+ ,(concat "\\<\\("
+ "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
+ "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
+ "\\)\\>")
+ ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
1 font-lock-keyword-face)
- '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)"
- 3 font-lock-function-name-face t)
-; ("type" "const" "real" "integer" "char" "boolean" "var"
-; "record" "array" "file")
- (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
- "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
- 'font-lock-type-face)
- '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face)
- '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
-; ("of" "to" "for" "if" "then" "else" "case" "while"
-; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
- (concat "\\<\\("
- "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
- "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
- "\\)\\>")
- '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
- 1 font-lock-keyword-face)
- '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
- 2 font-lock-keyword-face t)))
+ ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
+ 2 font-lock-keyword-face t))
"Additional expressions to highlight in Pascal mode.")
-(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
+
+(defconst pascal--syntax-propertize
+ (syntax-propertize-rules
+ ;; The syntax-table settings are too coarse and end up treating /* and (/
+ ;; as comment starters. Fix it here by removing the "2" from the syntax
+ ;; of the second char of such sequences.
+ ("/\\(\\*\\)" (1 ". 3b"))
+ ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
+ ;; Pascal uses '' and "" rather than \' and \" to escape quotes.
+ ("''\\|\"\"" (0 (if (save-excursion
+ (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ ;; In case of 3 or more quotes in a row, only advance
+ ;; one quote at a time.
+ (forward-char -1)
+ nil)))))
(defcustom pascal-indent-level 3
"Indentation of Pascal statements with respect to containing block."
:group 'pascal)
(defvar pascal-toggle-completions nil
- "Non-nil meant \\<pascal-mode-map>\\[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.")
+ "If non-nil, `pascal-complete-word' tries all possible completions.
+Repeated use of \\[pascal-complete-word] then shows all
+completions in turn, instead of displaying a list of all possible
+completions.")
(make-obsolete-variable 'pascal-toggle-completions
'completion-cycle-threshold "24.1")
Turning on Pascal mode calls the value of the variable pascal-mode-hook with
no args, if that value is non-nil."
- (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) "}")
+ (setq-local local-abbrev-table pascal-mode-abbrev-table)
+ (setq-local indent-line-function 'pascal-indent-line)
+ (setq-local comment-indent-function 'pascal-indent-comment)
+ (setq-local parse-sexp-ignore-comments nil)
+ (setq-local blink-matching-paren-dont-ignore-comments t)
+ (setq-local case-fold-search t)
+ (setq-local comment-start "{")
+ (setq-local comment-start-skip "(\\*+ *\\|{ *")
+ (setq-local comment-end "}")
(add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t)
;; Font lock support
- (set (make-local-variable 'font-lock-defaults)
- '(pascal-font-lock-keywords nil t))
+ (setq-local font-lock-defaults '(pascal-font-lock-keywords nil t))
+ (setq-local syntax-propertize-function pascal--syntax-propertize)
;; Imenu support
- (set (make-local-variable 'imenu-generic-expression)
- pascal-imenu-generic-expression)
- (set (make-local-variable 'imenu-case-fold-search) t)
+ (setq-local imenu-generic-expression pascal-imenu-generic-expression)
+ (setq-local imenu-case-fold-search t)
;; Pascal-mode's own hide/show support.
(add-to-invisibility-spec '(pascal . t)))
;;;
;;; Interactive functions
;;;
+(defvar pascal--extra-indent 0)
+
(defun pascal-insert-block ()
"Insert Pascal begin ... end; block in the code with right indentation."
(interactive)
;;; Indentation
;;;
(defconst pascal-indent-alist
- '((block . (+ ind pascal-indent-level))
- (case . (+ ind pascal-case-indent))
- (caseblock . ind) (cpp . 0)
- (declaration . (+ ind pascal-indent-level))
+ '((block . (+ pascal--extra-indent pascal-indent-level))
+ (case . (+ pascal--extra-indent pascal-case-indent))
+ (caseblock . pascal--extra-indent) (cpp . 0)
+ (declaration . (+ pascal--extra-indent pascal-indent-level))
(paramlist . (pascal-indent-paramlist t))
(comment . (pascal-indent-comment))
- (defun . ind) (contexp . ind)
- (unknown . ind) (string . 0) (progbeg . 0)))
+ (defun . pascal--extra-indent) (contexp . pascal--extra-indent)
+ (unknown . pascal--extra-indent) (string . 0) (progbeg . 0)))
(defun pascal-indent-command ()
"Indent for special part of code."
(if (looking-at "[ \t]+$")
(skip-chars-forward " \t"))))
-(defvar ind) ;Used via `eval' in pascal-indent-alist.
(defun pascal-indent-line ()
"Indent current line as a Pascal statement."
(let* ((indent-str (pascal-calculate-indent))
(type (car indent-str))
- (ind (car (cdr indent-str))))
+ (pascal--extra-indent (car (cdr indent-str))))
;; Labels should not be indented.
(if (and (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
(not (eq type 'declaration)))
())
(; Other things should have no extra indent
(looking-at pascal-noindent-re)
- (indent-to ind))
+ (indent-to pascal--extra-indent))
(; Nested functions should be indented
(looking-at pascal-defun-re)
(if (and pascal-indent-nested-functions
(eq type 'defun))
- (indent-to (+ ind pascal-indent-level))
- (indent-to ind)))
+ (indent-to (+ pascal--extra-indent pascal-indent-level))
+ (indent-to pascal--extra-indent)))
(; But most lines are treated this way
(indent-to (eval (cdr (assoc type pascal-indent-alist))))
))))
(point-marker)
(re-search-backward "\\<case\\>" nil t)))
(beg (point))
- (ind 0))
+ (pascal--extra-indent 0))
;; Get right indent
(while (< (point) end)
(if (re-search-forward
(if (< (point) end)
(progn
(delete-horizontal-space)
- (if (> (current-column) ind)
- (setq ind (current-column)))
+ (if (> (current-column) pascal--extra-indent)
+ (setq pascal--extra-indent (current-column)))
(pascal-end-of-statement))))
(goto-char beg)
;; Indent all case statements
"^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
(marker-position end) 'move)
(forward-char -1))
- (indent-to (1+ ind))
+ (indent-to (1+ pascal--extra-indent))
(if (/= (following-char) ?:)
()
(forward-char 1)
(max (progn (pascal-declaration-end)
(point))
pos))))
- ind)
+ pascal--extra-indent)
(goto-char stpos)
;; Indent lines in record block
(forward-line 1)))
;; Do lineup
- (setq ind (pascal-get-lineup-indent stpos edpos lineup))
+ (setq pascal--extra-indent (pascal-get-lineup-indent stpos edpos lineup))
(goto-char stpos)
(while (and (<= (point) edpos) (not (eobp)))
(if (search-forward lineup (point-at-eol) 'move)
(forward-char -1))
(delete-horizontal-space)
- (indent-to ind)
+ (indent-to pascal--extra-indent)
(if (not (looking-at lineup))
(forward-line 1) ; No more indent if there is no : or =
(forward-char 1)
;from b to e nicely. The lineup string is str."
(defun pascal-get-lineup-indent (b e str)
(save-excursion
- (let ((ind 0)
+ (let ((pascal--extra-indent 0)
(reg (concat str "\\|\\(\\<record\\>\\)\\|" pascal-defun-re)))
(goto-char b)
;; Get rightmost position
(t
(goto-char (match-beginning 0))
(skip-chars-backward " \t")
- (if (> (current-column) ind)
- (setq ind (current-column)))
+ (if (> (current-column) pascal--extra-indent)
+ (setq pascal--extra-indent (current-column)))
(goto-char (match-end 0))
(end-of-line)
))))
;; In case no lineup was found
- (if (> ind 0)
- (1+ ind)
+ (if (> pascal--extra-indent 0)
+ (1+ pascal--extra-indent)
;; No lineup-string found
(goto-char b)
(end-of-line)
(default (if (pascal-comp-defun default nil 'lambda)
default ""))
(label
- ;; Do completion with default
+ ;; 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)))
+ (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 there was no response on prompt, use default value.
(if (string= label "")
(setq label default))
- ;; Goto right place in buffer if label is not an empty string
+ ;; Goto right place in buffer if label is not an empty string.
(or (string= label "")
(progn
(goto-char (point-min))