commit c25ab7852d48443c85865f5b9fbbaed2bba3431e Author: Stefan Monnier Date: Wed Sep 8 18:21:23 2010 +0200 Misc cleanups and simplifications. * lisp/font-lock.el (save-buffer-state): Remove `varlist' arg. (font-lock-unfontify-region, font-lock-default-fontify-region): Update usage correspondingly. (font-lock-fontify-syntactic-keywords-region): Set parse-sexp-lookup-properties buffer-locally here. (font-lock-fontify-syntactically-region): Remove unused `ppss' arg. * lisp/progmodes/ada-mode.el: Replace "(set '" with setq. (ada-mode): Simplify. (ada-create-case-exception, ada-adjust-case-interactive) (ada-adjust-case-region, ada-format-paramlist, ada-indent-current) (ada-search-ignore-string-comment, ada-move-to-start) (ada-move-to-end): Use with-syntax-table. * lisp/progmodes/fortran.el (fortran-line-length): Don't recompute syntactic keywords redundantly a second time. * lisp/progmodes/js.el (require): Require is already "eval-and-compile". (js--re-search-forward): Avoid `eval'. Preserve the error data. (js--re-search-backward): Use js--re-search-forward. * lisp/progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1d5e35b..40f8831 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,28 @@ 2010-09-08 Stefan Monnier + * progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp. + + * progmodes/js.el (require): Require is already "eval-and-compile". + (js--re-search-forward): Avoid `eval'. Preserve the error data. + (js--re-search-backward): Use js--re-search-forward. + + * progmodes/fortran.el (fortran-line-length): Don't recompute + syntactic keywords redundantly a second time. + + * progmodes/ada-mode.el: Replace "(set '" with setq. + (ada-mode): Simplify. + (ada-create-case-exception, ada-adjust-case-interactive) + (ada-adjust-case-region, ada-format-paramlist, ada-indent-current) + (ada-search-ignore-string-comment, ada-move-to-start) + (ada-move-to-end): Use with-syntax-table. + + * font-lock.el (save-buffer-state): Remove `varlist' arg. + (font-lock-unfontify-region, font-lock-default-fontify-region): + Update usage correspondingly. + (font-lock-fontify-syntactic-keywords-region): + Set parse-sexp-lookup-properties buffer-locally here. + (font-lock-fontify-syntactically-region): Remove unused `ppss' arg. + * simple.el (blink-matching-open): Don't burp if we can't find a match. 2010-09-08 Glenn Morris diff --git a/lisp/font-lock.el b/lisp/font-lock.el index bfea0da..7b2f0ef 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -612,11 +612,10 @@ Major/minor modes can set this variable if they know which option applies.") ;; ;; Borrowed from lazy-lock.el. ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) + (defmacro save-buffer-state (&rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." - (declare (indent 1) (debug let)) - `(let* ,(append varlist - `((inhibit-point-motion-hooks t))) + (declare (indent 0) (debug t)) + `(let ((inhibit-point-motion-hooks t)) (with-silent-modifications ,@body))) ;; @@ -1020,7 +1019,7 @@ The region it returns may start or end in the middle of a line.") (funcall font-lock-fontify-region-function beg end loudly)) (defun font-lock-unfontify-region (beg end) - (save-buffer-state nil + (save-buffer-state (funcall font-lock-unfontify-region-function beg end))) (defun font-lock-default-fontify-buffer () @@ -1113,8 +1112,6 @@ Put first the functions more likely to cause a change and cheaper to compute.") (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state - ((parse-sexp-lookup-properties - (or parse-sexp-lookup-properties font-lock-syntactic-keywords))) ;; Use the fontification syntax table, if any. (with-syntax-table (or font-lock-syntax-table (syntax-table)) (save-restriction @@ -1436,6 +1433,10 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM." (defun font-lock-fontify-syntactic-keywords-region (start end) "Fontify according to `font-lock-syntactic-keywords' between START and END. START should be at the beginning of a line." + (unless parse-sexp-lookup-properties + ;; We wouldn't go through so much trouble if we didn't intend to use those + ;; properties, would we? + (set (make-local-variable 'parse-sexp-lookup-properties) t)) ;; Ensure the beginning of the file is properly syntactic-fontified. (when (and font-lock-syntactically-fontified (< font-lock-syntactically-fontified start)) @@ -1483,19 +1484,17 @@ START should be at the beginning of a line." (defvar font-lock-comment-end-skip nil "If non-nil, Font Lock mode uses this instead of `comment-end'.") -(defun font-lock-fontify-syntactically-region (start end &optional loudly ppss) +(defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." (let ((comment-end-regexp (or font-lock-comment-end-skip (regexp-quote (replace-regexp-in-string "^ *" "" comment-end)))) - state face beg) + ;; Find the `start' state. + (state (syntax-ppss start)) + face beg) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) - (goto-char start) - ;; - ;; Find the `start' state. - (setq state (or ppss (syntax-ppss start))) ;; ;; Find each interesting place between here and `end'. (while diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 227f202..d402dd7 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1118,7 +1118,8 @@ the file name." ;;;###autoload (defun ada-mode () - "Ada mode is the major mode for editing Ada code." + "Ada mode is the major mode for editing Ada code. +\\{ada-mode-map}" (interactive) (kill-all-local-variables) @@ -1161,9 +1162,9 @@ the file name." (set (make-local-variable 'comment-padding) 0) (set (make-local-variable 'parse-sexp-lookup-properties) t)) - (set 'case-fold-search t) + (setq case-fold-search t) (if (boundp 'imenu-case-fold-search) - (set 'imenu-case-fold-search t)) + (setq imenu-case-fold-search t)) (set (make-local-variable 'fill-paragraph-function) 'ada-fill-comment-paragraph) @@ -1322,10 +1323,10 @@ the file name." ;; To be run after the hook, in case the user modified ;; ada-fill-comment-prefix - (make-local-variable 'comment-start) - (if ada-fill-comment-prefix - (set 'comment-start ada-fill-comment-prefix) - (set 'comment-start "-- ")) + ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs + ;; then it was already available before running the hook, and if he + ;; modifies it in the hook, he might as well modify comment-start instead. + (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- ")) ;; Run this after the hook to give the users a chance to activate ;; font-lock-mode @@ -1337,7 +1338,8 @@ the file name." ;; the following has to be done after running the ada-mode-hook ;; because users might want to set the values of these variable ;; inside the hook - + ;; FIXME: it might even be set later on via file-local vars, no? + ;; so maybe ada-keywords should be set lazily. (cond ((eq ada-language-version 'ada83) (setq ada-keywords ada-83-keywords)) ((eq ada-language-version 'ada95) @@ -1397,25 +1399,21 @@ If WORD is not given, then the current word in the buffer is used instead. The new word is added to the first file in `ada-case-exception-file'. The standard casing rules will no longer apply to this word." (interactive) - (let ((previous-syntax-table (syntax-table)) - file-name - ) - - (cond ((stringp ada-case-exception-file) - (setq file-name ada-case-exception-file)) - ((listp ada-case-exception-file) - (setq file-name (car ada-case-exception-file))) - (t - (error (concat "No exception file specified. " - "See variable ada-case-exception-file")))) + (let ((file-name + (cond ((stringp ada-case-exception-file) + ada-case-exception-file) + ((listp ada-case-exception-file) + (car ada-case-exception-file)) + (t + (error (concat "No exception file specified. " + "See variable ada-case-exception-file")))))) - (set-syntax-table ada-mode-symbol-syntax-table) (unless word - (save-excursion - (skip-syntax-backward "w") - (setq word (buffer-substring-no-properties - (point) (save-excursion (forward-word 1) (point)))))) - (set-syntax-table previous-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (skip-syntax-backward "w") + (setq word (buffer-substring-no-properties + (point) (save-excursion (forward-word 1) (point))))))) ;; Reread the exceptions file, in case it was modified by some other, (ada-case-read-exceptions-from-file file-name) @@ -1425,11 +1423,9 @@ The standard casing rules will no longer apply to this word." (if (and (not (equal ada-case-exception '())) (assoc-string word ada-case-exception t)) (setcar (assoc-string word ada-case-exception t) word) - (add-to-list 'ada-case-exception (cons word t)) - ) + (add-to-list 'ada-case-exception (cons word t))) - (ada-save-exceptions-to-file file-name) - )) + (ada-save-exceptions-to-file file-name))) (defun ada-create-case-exception-substring (&optional word) "Define the substring WORD as an exception for the casing system. @@ -1464,7 +1460,7 @@ word itself has a special casing." (modify-syntax-entry ?_ "." (syntax-table)) (save-excursion (skip-syntax-backward "w") - (set 'word (buffer-substring-no-properties + (setq word (buffer-substring-no-properties (point) (save-excursion (forward-word 1) (point)))))) (modify-syntax-entry ?_ (make-string 1 underscore-syntax) @@ -1633,37 +1629,30 @@ ARG is the prefix the user entered with \\[universal-argument]." (interactive "P") (if ada-auto-case - (let ((lastk last-command-event) - (previous-syntax-table (syntax-table))) - - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - (cond ((or (eq lastk ?\n) - (eq lastk ?\r)) - ;; horrible kludge - (insert " ") - (ada-adjust-case) - ;; horrible dekludge - (delete-char -1) - ;; some special keys and their bindings - (cond - ((eq lastk ?\n) - (funcall ada-lfd-binding)) - ((eq lastk ?\r) - (funcall ada-ret-binding)))) - ((eq lastk ?\C-i) (ada-tab)) - ;; Else just insert the character - ((self-insert-command (prefix-numeric-value arg)))) - ;; if there is a keyword in front of the underscore - ;; then it should be part of an identifier (MH) - (if (eq lastk ?_) - (ada-adjust-case t) - (ada-adjust-case)) - ) - ;; Restore the syntax table - (set-syntax-table previous-syntax-table)) - ) + (let ((lastk last-command-event)) + + (with-syntax-table ada-mode-symbol-syntax-table + (cond ((or (eq lastk ?\n) + (eq lastk ?\r)) + ;; horrible kludge + (insert " ") + (ada-adjust-case) + ;; horrible dekludge + (delete-char -1) + ;; some special keys and their bindings + (cond + ((eq lastk ?\n) + (funcall ada-lfd-binding)) + ((eq lastk ?\r) + (funcall ada-ret-binding)))) + ((eq lastk ?\C-i) (ada-tab)) + ;; Else just insert the character + ((self-insert-command (prefix-numeric-value arg)))) + ;; if there is a keyword in front of the underscore + ;; then it should be part of an identifier (MH) + (if (eq lastk ?_) + (ada-adjust-case t) + (ada-adjust-case)))) ;; Else, no auto-casing (cond @@ -1672,10 +1661,10 @@ ARG is the prefix the user entered with \\[universal-argument]." ((eq last-command-event ?\r) (funcall ada-ret-binding)) (t - (self-insert-command (prefix-numeric-value arg)))) - )) + (self-insert-command (prefix-numeric-value arg)))))) (defun ada-activate-keys-for-case () + ;; FIXME: Use post-self-insert-hook instead of changing key bindings. "Modify the key bindings for all the keys that should readjust the casing." (interactive) ;; Save original key-bindings to allow swapping ret/lfd @@ -1735,44 +1724,41 @@ Attention: This function might take very long for big regions!" (let ((begin nil) (end nil) (keywordp nil) - (attribp nil) - (previous-syntax-table (syntax-table))) + (attribp nil)) (message "Adjusting case ...") - (unwind-protect - (save-excursion - (set-syntax-table ada-mode-symbol-syntax-table) - (goto-char to) - ;; - ;; loop: look for all identifiers, keywords, and attributes - ;; - (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) - (setq end (match-end 1)) - (setq attribp - (and (> (point) from) - (save-excursion - (forward-char -1) - (setq attribp (looking-at "'.[^']"))))) - (or - ;; do nothing if it is a string or comment - (ada-in-string-or-comment-p) - (progn - ;; - ;; get the identifier or keyword or attribute - ;; - (setq begin (point)) - (setq keywordp (looking-at ada-keywords)) - (goto-char end) - ;; - ;; casing according to user-option - ;; - (if attribp - (funcall ada-case-attribute -1) - (if keywordp - (funcall ada-case-keyword -1) - (ada-adjust-case-identifier))) - (goto-char begin)))) - (message "Adjusting case ... Done")) - (set-syntax-table previous-syntax-table)))) + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (goto-char to) + ;; + ;; loop: look for all identifiers, keywords, and attributes + ;; + (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) + (setq end (match-end 1)) + (setq attribp + (and (> (point) from) + (save-excursion + (forward-char -1) + (setq attribp (looking-at "'.[^']"))))) + (or + ;; do nothing if it is a string or comment + (ada-in-string-or-comment-p) + (progn + ;; + ;; get the identifier or keyword or attribute + ;; + (setq begin (point)) + (setq keywordp (looking-at ada-keywords)) + (goto-char end) + ;; + ;; casing according to user-option + ;; + (if attribp + (funcall ada-case-attribute -1) + (if keywordp + (funcall ada-case-keyword -1) + (ada-adjust-case-identifier))) + (goto-char begin)))) + (message "Adjusting case ... Done"))))) (defun ada-adjust-case-buffer () "Adjust the case of all words in the whole buffer. @@ -1803,46 +1789,39 @@ ATTENTION: This function might take very long for big buffers!" (let ((begin nil) (end nil) (delend nil) - (paramlist nil) - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (paramlist nil)) + (with-syntax-table ada-mode-symbol-syntax-table - ;; check if really inside parameter list - (or (ada-in-paramlist-p) - (error "Not in parameter list")) + ;; check if really inside parameter list + (or (ada-in-paramlist-p) + (error "Not in parameter list")) - ;; find start of current parameter-list - (ada-search-ignore-string-comment - (concat ada-subprog-start-re "\\|\\" ) t nil) - (down-list 1) - (backward-char 1) - (setq begin (point)) + ;; find start of current parameter-list + (ada-search-ignore-string-comment + (concat ada-subprog-start-re "\\|\\" ) t nil) + (down-list 1) + (backward-char 1) + (setq begin (point)) - ;; find end of parameter-list - (forward-sexp 1) - (setq delend (point)) - (delete-char -1) - (insert "\n") + ;; find end of parameter-list + (forward-sexp 1) + (setq delend (point)) + (delete-char -1) + (insert "\n") - ;; find end of last parameter-declaration - (forward-comment -1000) - (setq end (point)) - - ;; build a list of all elements of the parameter-list - (setq paramlist (ada-scan-paramlist (1+ begin) end)) + ;; find end of last parameter-declaration + (forward-comment -1000) + (setq end (point)) - ;; delete the original parameter-list - (delete-region begin delend) + ;; build a list of all elements of the parameter-list + (setq paramlist (ada-scan-paramlist (1+ begin) end)) - ;; insert the new parameter-list - (goto-char begin) - (ada-insert-paramlist paramlist)) + ;; delete the original parameter-list + (delete-region begin delend) - ;; restore syntax-table - (set-syntax-table previous-syntax-table) - ))) + ;; insert the new parameter-list + (goto-char begin) + (ada-insert-paramlist paramlist)))) (defun ada-scan-paramlist (begin end) "Scan the parameter list found in between BEGIN and END. @@ -2186,14 +2165,12 @@ Return the new position of point or nil if not found." Return the calculation that was done, including the reference point and the offset." (interactive) - (let ((previous-syntax-table (syntax-table)) - (orgpoint (point-marker)) + (let ((orgpoint (point-marker)) cur-indent tmp-indent prev-indent) (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table ;; This need to be done here so that the advice is not always ;; activated (this might interact badly with other modes) @@ -2203,14 +2180,14 @@ and the offset." (save-excursion (setq cur-indent - ;; Not First line in the buffer ? - (if (save-excursion (zerop (forward-line -1))) - (progn - (back-to-indentation) - (ada-get-current-indent)) + ;; Not First line in the buffer ? + (if (save-excursion (zerop (forward-line -1))) + (progn + (back-to-indentation) + (ada-get-current-indent)) - ;; first line in the buffer - (list (point-min) 0)))) + ;; first line in the buffer + (list (point-min) 0)))) ;; Evaluate the list to get the column to indent to ;; prev-indent contains the column to indent to @@ -2242,14 +2219,10 @@ and the offset." (if (< (current-column) (current-indentation)) (back-to-indentation))) - ;; restore syntax-table - (set-syntax-table previous-syntax-table) (if (featurep 'xemacs) - (ad-deactivate 'parse-partial-sexp)) - ) + (ad-deactivate 'parse-partial-sexp))) - cur-indent - )) + cur-indent)) (defun ada-get-current-indent () "Return the indentation to use for the current line." @@ -2512,11 +2485,11 @@ and the offset." (if (looking-at "renames") (let (pos) (save-excursion - (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t))) + (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t))) (if (and pos (= (downcase (char-after (car pos))) ?r)) (goto-char (car pos))) - (set 'var 'ada-indent-renames))) + (setq var 'ada-indent-renames))) (forward-comment -1000) (if (= (char-before) ?\)) @@ -2533,7 +2506,7 @@ and the offset." (looking-at "\\(function\\|procedure\\)\\>")) (progn (backward-word 1) - (set 'num-back 2) + (setq num-back 2) (looking-at "\\(function\\|procedure\\)\\>"))))) ;; The indentation depends of the value of ada-indent-return @@ -4046,8 +4019,7 @@ Point is moved at the beginning of the SEARCH-RE." (let (found begin end - parse-result - (previous-syntax-table (syntax-table))) + parse-result) ;; FIXME: need to pass BACKWARD to search-func! (unless search-func @@ -4057,67 +4029,65 @@ Point is moved at the beginning of the SEARCH-RE." ;; search until found or end-of-buffer ;; We have to test that we do not look further than limit ;; - (set-syntax-table ada-mode-symbol-syntax-table) - (while (and (not found) - (or (not limit) - (or (and backward (<= limit (point))) - (>= limit (point)))) - (funcall search-func search-re limit 1)) - (setq begin (match-beginning 0)) - (setq end (match-end 0)) - - (setq parse-result (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))) - - (cond - ;; - ;; If inside a string, skip it (and the following comments) - ;; - ((ada-in-string-p parse-result) - (if (featurep 'xemacs) - (search-backward "\"" nil t) - (goto-char (nth 8 parse-result))) - (unless backward (forward-sexp 1))) - ;; - ;; If inside a comment, skip it (and the following comments) - ;; There is a special code for comments at the end of the file - ;; - ((ada-in-comment-p parse-result) - (if (featurep 'xemacs) - (progn - (forward-line 1) - (beginning-of-line) - (forward-comment -1)) - (goto-char (nth 8 parse-result))) - (unless backward - ;; at the end of the file, it is not possible to skip a comment - ;; so we just go at the end of the line - (if (forward-comment 1) - (progn - (forward-comment 1000) - (beginning-of-line)) - (end-of-line)))) - ;; - ;; directly in front of a comment => skip it, if searching forward - ;; - ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) - (unless backward (progn (forward-char -1) (forward-comment 1000)))) - - ;; - ;; found a parameter-list but should ignore it => skip it - ;; - ((and (not paramlists) (ada-in-paramlist-p)) - (if backward - (search-backward "(" nil t) - (search-forward ")" nil t))) - ;; - ;; found what we were looking for - ;; - (t - (setq found t)))) ; end of loop - - (set-syntax-table previous-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table + (while (and (not found) + (or (not limit) + (or (and backward (<= limit (point))) + (>= limit (point)))) + (funcall search-func search-re limit 1)) + (setq begin (match-beginning 0)) + (setq end (match-end 0)) + + (setq parse-result (parse-partial-sexp + (save-excursion (beginning-of-line) (point)) + (point))) + + (cond + ;; + ;; If inside a string, skip it (and the following comments) + ;; + ((ada-in-string-p parse-result) + (if (featurep 'xemacs) + (search-backward "\"" nil t) + (goto-char (nth 8 parse-result))) + (unless backward (forward-sexp 1))) + ;; + ;; If inside a comment, skip it (and the following comments) + ;; There is a special code for comments at the end of the file + ;; + ((ada-in-comment-p parse-result) + (if (featurep 'xemacs) + (progn + (forward-line 1) + (beginning-of-line) + (forward-comment -1)) + (goto-char (nth 8 parse-result))) + (unless backward + ;; at the end of the file, it is not possible to skip a comment + ;; so we just go at the end of the line + (if (forward-comment 1) + (progn + (forward-comment 1000) + (beginning-of-line)) + (end-of-line)))) + ;; + ;; directly in front of a comment => skip it, if searching forward + ;; + ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) + (unless backward (progn (forward-char -1) (forward-comment 1000)))) + + ;; + ;; found a parameter-list but should ignore it => skip it + ;; + ((and (not paramlists) (ada-in-paramlist-p)) + (if backward + (search-backward "(" nil t) + (search-forward ")" nil t))) + ;; + ;; found what we were looking for + ;; + (t + (setq found t))))) ; end of loop (if found (cons begin end) @@ -4398,122 +4368,109 @@ of the region. Otherwise, operate only on the current line." (defun ada-move-to-start () "Move point to the matching start of the current Ada structure." (interactive) - (let ((pos (point)) - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (let ((pos (point))) + (with-syntax-table ada-mode-symbol-syntax-table - (save-excursion - ;; - ;; do nothing if in string or comment or not on 'end ...;' - ;; or if an error occurs during processing - ;; - (or - (ada-in-string-or-comment-p) - (and (progn - (or (looking-at "[ \t]*\\") - (backward-word 1)) - (or (looking-at "[ \t]*\\") - (backward-word 1)) - (or (looking-at "[ \t]*\\") - (error "Not on end ...;"))) - (ada-goto-matching-start 1) - (setq pos (point)) - - ;; - ;; on 'begin' => go on, according to user option - ;; - ada-move-to-declaration - (looking-at "\\") - (ada-goto-decl-start) - (setq pos (point)))) - - ) ; end of save-excursion - - ;; now really move to the found position - (goto-char pos)) - - ;; restore syntax-table - (set-syntax-table previous-syntax-table)))) + (save-excursion + ;; + ;; do nothing if in string or comment or not on 'end ...;' + ;; or if an error occurs during processing + ;; + (or + (ada-in-string-or-comment-p) + (and (progn + (or (looking-at "[ \t]*\\") + (backward-word 1)) + (or (looking-at "[ \t]*\\") + (backward-word 1)) + (or (looking-at "[ \t]*\\") + (error "Not on end ...;"))) + (ada-goto-matching-start 1) + (setq pos (point)) + + ;; + ;; on 'begin' => go on, according to user option + ;; + ada-move-to-declaration + (looking-at "\\") + (ada-goto-decl-start) + (setq pos (point)))) + + ) ; end of save-excursion + + ;; now really move to the found position + (goto-char pos)))) (defun ada-move-to-end () "Move point to the end of the block around point. Moves to 'begin' if in a declarative part." (interactive) (let ((pos (point)) - decl-start - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - - (save-excursion - - (cond - ;; Go to the beginning of the current word, and check if we are - ;; directly on 'begin' - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\")) - (ada-goto-matching-end 1) - ) + decl-start) + (with-syntax-table ada-mode-symbol-syntax-table - ;; on first line of subprogram body - ;; Do nothing for specs or generic instantion, since these are - ;; handled as the general case (find the enclosing block) - ;; We also need to make sure that we ignore nested subprograms - ((save-excursion - (and (skip-syntax-backward "w") - (looking-at "\\\\|\\" ) - (ada-search-ignore-string-comment "is\\|;") - (not (= (char-before) ?\;)) - )) - (skip-syntax-backward "w") - (ada-goto-matching-end 0 t)) - - ;; on first line of task declaration - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\" ) - (forward-word 1) - (ada-goto-next-non-ws) - (looking-at "\\"))) - (ada-search-ignore-string-comment "begin" nil nil nil - 'word-search-forward)) - ;; accept block start - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\" ))) - (ada-goto-matching-end 0)) - ;; package start - ((save-excursion - (setq decl-start (and (ada-goto-decl-start t) (point))) - (and decl-start (looking-at "\\"))) - (ada-goto-matching-end 1)) - - ;; On a "declare" keyword - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\")) - (ada-goto-matching-end 0 t)) - - ;; inside a 'begin' ... 'end' block - (decl-start - (goto-char decl-start) - (ada-goto-matching-end 0 t)) - - ;; (hopefully ;-) everything else - (t - (ada-goto-matching-end 1))) - (setq pos (point)) - ) - - ;; now really move to the position found - (goto-char pos)) + (save-excursion - ;; restore syntax-table - (set-syntax-table previous-syntax-table)))) + (cond + ;; Go to the beginning of the current word, and check if we are + ;; directly on 'begin' + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\")) + (ada-goto-matching-end 1)) + + ;; on first line of subprogram body + ;; Do nothing for specs or generic instantion, since these are + ;; handled as the general case (find the enclosing block) + ;; We also need to make sure that we ignore nested subprograms + ((save-excursion + (and (skip-syntax-backward "w") + (looking-at "\\\\|\\" ) + (ada-search-ignore-string-comment "is\\|;") + (not (= (char-before) ?\;)) + )) + (skip-syntax-backward "w") + (ada-goto-matching-end 0 t)) + + ;; on first line of task declaration + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\" ) + (forward-word 1) + (ada-goto-next-non-ws) + (looking-at "\\"))) + (ada-search-ignore-string-comment "begin" nil nil nil + 'word-search-forward)) + ;; accept block start + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\" ))) + (ada-goto-matching-end 0)) + ;; package start + ((save-excursion + (setq decl-start (and (ada-goto-decl-start t) (point))) + (and decl-start (looking-at "\\"))) + (ada-goto-matching-end 1)) + + ;; On a "declare" keyword + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\")) + (ada-goto-matching-end 0 t)) + + ;; inside a 'begin' ... 'end' block + (decl-start + (goto-char decl-start) + (ada-goto-matching-end 0 t)) + + ;; (hopefully ;-) everything else + (t + (ada-goto-matching-end 1))) + (setq pos (point)) + ) + + ;; now really move to the position found + (goto-char pos)))) (defun ada-next-procedure () "Move point to next procedure." @@ -4818,7 +4775,7 @@ Moves to 'begin' if in a declarative part." (if (featurep 'xemacs) (progn (define-key ada-mode-map [menu-bar] ada-mode-menu) - (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) + (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) ;; ------------------------------------------------------- @@ -5040,7 +4997,7 @@ or the spec otherwise." (ada-find-src-file-in-dir (file-name-nondirectory (concat name (car suffixes)))))) (if other - (set 'is-spec other))) + (setq is-spec other))) ;; Else search in the current directory (if (file-exists-p (concat name (car suffixes))) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index c37744b..2002f05 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -920,8 +920,7 @@ affects all Fortran buffers, and also the default." new (fortran-font-lock-syntactic-keywords)) ;; Refontify only if necessary. (unless (equal new font-lock-syntactic-keywords) - (setq font-lock-syntactic-keywords - (fortran-font-lock-syntactic-keywords)) + (setq font-lock-syntactic-keywords new) (if font-lock-mode (font-lock-mode 1)))))) (if global (buffer-list) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5e854f8..c49f86e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -45,16 +45,16 @@ ;;; Code: -(eval-and-compile - (require 'cc-mode) - (require 'font-lock) - (require 'newcomment) - (require 'imenu) - (require 'etags) - (require 'thingatpt) - (require 'easymenu) - (require 'moz nil t) - (require 'json nil t)) + +(require 'cc-mode) +(require 'font-lock) +(require 'newcomment) +(require 'imenu) +(require 'etags) +(require 'thingatpt) +(require 'easymenu) +(require 'moz nil t) +(require 'json nil t) (eval-when-compile (require 'cl) @@ -725,20 +725,19 @@ as if strings, cpp macros, and comments have been removed. If invoked while inside a macro, it treats the contents of the macro as normal text." + (unless count (setq count 1)) (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js--re-search-forward-inner regexp bound 1)) - ((< count 0) - '(js--re-search-backward-inner regexp bound (- count))) - ((> count 0) - '(js--re-search-forward-inner regexp bound count))))) + (search-fun + (cond ((< count 0) (setq count (- count)) + #'js--re-search-backward-inner) + ((> count 0) #'js--re-search-forward-inner) + (t #'ignore)))) (condition-case err - (eval search-expr) + (funcall search-fun regexp bound count) (search-failed (goto-char saved-point) (unless noerror - (error (error-message-string err))))))) + (signal (car err) (cdr err))))))) (defun js--re-search-backward-inner (regexp &optional bound count) @@ -782,20 +781,7 @@ as if strings, preprocessor macros, and comments have been removed. If invoked while inside a macro, treat the macro as normal text." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js--re-search-backward-inner regexp bound 1)) - ((< count 0) - '(js--re-search-forward-inner regexp bound (- count))) - ((> count 0) - '(js--re-search-backward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) + (js--re-search-forward regexp bound noerror (if count (- count) -1))) (defun js--forward-expression () "Move forward over a whole JavaScript expression. diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index ede850f..5d17e48 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -544,6 +544,8 @@ Non-nil means always go to the next Octave code line after sending." 0) ((:before . "case") octave-block-offset))) +(defvar electric-indent-chars) + ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code.