diff options
Diffstat (limited to 'lisp/progmodes')
60 files changed, 3508 insertions, 2512 deletions
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 76c9be93d03..fd6a2b0b2da 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -4519,6 +4519,7 @@ Moves to `begin' if in a declarative part." (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body) ;; Use predefined function of Emacs19 for comments (RE) + ;; FIXME: Made redundant with Emacs-21's standard comment-dwim binding on M-; (define-key ada-mode-map "\C-c;" 'comment-region) (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) @@ -4756,16 +4757,17 @@ Moves to `begin' if in a declarative part." ;; function for justifying the comments. ;; ------------------------------------------------------- -(defadvice comment-region (before ada-uncomment-anywhere disable) - (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas - ;; \C-u 2 sets arg to '2' (fixed by S.Leake) - (derived-mode-p 'ada-mode)) - (save-excursion - (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) - (goto-char beg) - (while (re-search-forward cs end t) - (replace-match comment-start)) - )))) +(when (or (<= emacs-major-version 20) (featurep 'xemacs)) + (defadvice comment-region (before ada-uncomment-anywhere disable) + (if (and (consp arg) ;; a prefix with \C-u is of the form '(4), whereas + ;; \C-u 2 sets arg to '2' (fixed by S.Leake) + (derived-mode-p 'ada-mode)) + (save-excursion + (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) + (goto-char beg) + (while (re-search-forward cs end t) + (replace-match comment-start)) + ))))) (defun ada-uncomment-region (beg end &optional arg) "Uncomment region BEG .. END. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 1d4fd4f2bce..775fd878725 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -82,8 +82,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'easymenu) (require 'cc-mode) @@ -1066,7 +1065,7 @@ Used for `antlr-slow-syntactic-context'.") (buffer-syntactic-context-depth) nil) :EMACS -;;; (incf antlr-statistics-inval) +;;; (cl-incf antlr-statistics-inval) (setq antlr-slow-context-cache nil)) (defunx antlr-syntactic-context () @@ -1096,9 +1095,9 @@ WARNING: this may alter `match-data'." (if (>= orig antlr-slow-cache-diff-threshold) (beginning-of-defun) (goto-char (point-min))) -;;; (cond ((and diff (< diff 0)) (incf antlr-statistics-full-neg)) -;;; ((and diff (>= diff 3000)) (incf antlr-statistics-full-diff)) -;;; (t (incf antlr-statistics-full-other))) +;;; (cond ((and diff (< diff 0)) (cl-incf antlr-statistics-full-neg)) +;;; ((and diff (>= diff 3000)) (cl-incf antlr-statistics-full-diff)) +;;; (t (cl-incf antlr-statistics-full-other))) (setq state (parse-partial-sexp (point) orig))) (goto-char orig) (if antlr-slow-context-cache @@ -1110,12 +1109,12 @@ WARNING: this may alter `match-data'." ((nth 4 state) 'comment) ; block-comment? -- we don't care (t (car state))))) -;;; (incf (aref antlr-statistics 2)) +;;; (cl-incf (aref antlr-statistics 2)) ;;; (unless (and (eq (current-buffer) ;;; (caar antlr-slow-context-cache)) ;;; (eq (buffer-modified-tick) ;;; (cdar antlr-slow-context-cache))) -;;; (incf (aref antlr-statistics 1)) +;;; (cl-incf (aref antlr-statistics 1)) ;;; (setq antlr-slow-context-cache nil)) ;;; (let* ((orig (point)) ;;; (base (cadr antlr-slow-context-cache)) @@ -1124,7 +1123,7 @@ WARNING: this may alter `match-data'." ;;; ((eq orig (car base)) (cdr base)))) ;;; diff diff2) ;;; (unless state -;;; (incf (aref antlr-statistics 3)) +;;; (cl-incf (aref antlr-statistics 3)) ;;; (when curr ;;; (if (< (setq diff (abs (- orig (car curr)))) ;;; (setq diff2 (abs (- orig (car base))))) @@ -1137,7 +1136,7 @@ WARNING: this may alter `match-data'." ;;; (setq state ;;; (parse-partial-sexp (car state) orig nil nil (cdr state))) ;;; (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min))) -;;; (incf (aref antlr-statistics 4)) +;;; (cl-incf (aref antlr-statistics 4)) ;;; (setq cw (list orig (point) base curr)) ;;; (setq state (parse-partial-sexp (point) orig))) ;;; (goto-char orig) @@ -1348,10 +1347,10 @@ is non-nil, move to beginning of the rule." (antlr-skip-exception-part skip-comment)) (antlr-skip-file-prelude skip-comment)) (if (< arg 0) - (unless (and (< (point) pos) (zerop (incf arg))) + (unless (and (< (point) pos) (zerop (cl-incf arg))) ;; if we have moved backward, we already moved one defun backward (goto-char beg) ; rewind (to ";" / point) - (while (and arg (<= (incf arg) 0)) + (while (and arg (<= (cl-incf arg) 0)) (if (antlr-search-backward ";") (setq beg (point)) (when (>= arg -1) @@ -1368,9 +1367,9 @@ is non-nil, move to beginning of the rule." (antlr-skip-exception-part skip-comment))) (if (<= (point) pos) ; moved backward? (goto-char pos) ; rewind - (decf arg)) ; already moved one defun forward + (cl-decf arg)) ; already moved one defun forward (unless (zerop arg) - (while (>= (decf arg) 0) + (while (>= (cl-decf arg) 0) (antlr-search-forward ";")) (antlr-skip-exception-part skip-comment))))) @@ -1465,7 +1464,7 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'." (antlr-invalidate-context-cache) (while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil) (funcall transform (match-beginning 0) (match-end 0)) - (incf literals)))) + (cl-incf literals)))) (message "Transformed %d literals" literals))) (defun antlr-upcase-literals () @@ -2131,7 +2130,7 @@ its export vocabulary is used as an import vocabulary." (or (null ivocab) (member ivocab import-vocabs) (push ivocab import-vocabs))))) (if classes - (list* (file-name-nondirectory buffer-file-name) + (cl-list* (file-name-nondirectory buffer-file-name) (cons (nreverse classes) (nreverse superclasses)) (cons (nreverse export-vocabs) (nreverse import-vocabs)) antlr-language)))) @@ -2277,7 +2276,7 @@ command `antlr-show-makefile-rules' for detail." (dolist (dep deps) (let ((supers (cdadr dep)) (lang (cdr (assoc (cdddr dep) antlr-file-formats-alist)))) - (if n (incf n)) + (if n (cl-incf n)) (antlr-makefile-insert-variable n "" " =") (if supers (insert " " @@ -2313,7 +2312,7 @@ command `antlr-show-makefile-rules' for detail." (if n (let ((i 0)) (antlr-makefile-insert-variable nil "" " =") - (while (<= (incf i) n) + (while (<= (cl-incf i) n) (antlr-makefile-insert-variable i " $(" ")")) (insert "\n" (car antlr-makefile-specification)))) (if (string-equal (car antlr-makefile-specification) "\n") @@ -2442,8 +2441,8 @@ to a lesser extent, `antlr-tab-offset-alist'." (goto-char boi) (unless (symbolp syntax) ; direct indentation ;;(antlr-invalidate-context-cache) - (incf indent (antlr-syntactic-context)) - (and (> indent 0) (looking-at antlr-indent-item-regexp) (decf indent)) + (cl-incf indent (antlr-syntactic-context)) + (and (> indent 0) (looking-at antlr-indent-item-regexp) (cl-decf indent)) (setq indent (* indent c-basic-offset))) ;; the usual major-mode indent stuff --------------------------------- (setq orig (- (point-max) orig)) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 2910a7a1043..51acc6a949f 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -84,6 +84,8 @@ . 'bat-label-face) ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" (2 font-lock-variable-name-face)) + ("%~\\([0-9]\\)" + (1 font-lock-variable-name-face)) ("%\\([^%~ \n]+\\)%?" (1 font-lock-variable-name-face)) ("!\\([^!%~ \n]+\\)!?" ; delayed-expansion !variable! diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d2b3af19724..75bd0ba51e0 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -141,10 +141,7 @@ The second subexpression should match the bug reference (usually a number)." ;;;###autoload (define-minor-mode bug-reference-mode - "Toggle hyperlinking bug references in the buffer (Bug Reference mode). -With a prefix argument ARG, enable Bug Reference mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil." + "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." nil "" nil diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 09887b02f3b..1b48a5a66c9 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -868,12 +868,11 @@ returned if there's no template argument on the first line. Works with: template-args-cont." (save-excursion - (c-with-syntax-table c++-template-syntax-table - (beginning-of-line) - (backward-up-list 1) - (if (and (eq (char-after) ?<) - (zerop (c-forward-token-2 1 nil (c-point 'eol)))) - (vector (current-column)))))) + (beginning-of-line) + (backward-up-list 1) + (if (and (eq (char-after) ?<) + (zerop (c-forward-token-2 1 nil (c-point 'eol)))) + (vector (current-column))))) (defun c-lineup-ObjC-method-call (langelem) "Line up selector args as Emacs Lisp mode does with function args: diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 9315ce400be..0269c01a80e 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1383,7 +1383,7 @@ No indentation or other \"electric\" behavior is performed." (let ((eo-block (point)) bod) (and (eq (char-before) ?\}) - (eq (car (c-beginning-of-decl-1 lim)) 'previous) + (memq (car (c-beginning-of-decl-1 lim)) '(same previous)) (setq bod (point)) ;; Look for struct or union or ... If we find one, it might ;; be the return type of a function, or the like. Exclude @@ -1397,6 +1397,16 @@ No indentation or other \"electric\" behavior is performed." (not (eq (char-before) ?_)) (c-syntactic-re-search-forward "[;=([{]" eo-block t t t) (eq (char-before) ?\{) + ;; Exclude the entire "struct {...}" being the type of a + ;; function being declared. + (not + (and + (c-go-up-list-forward) + (eq (char-before) ?}) + (progn (c-forward-syntactic-ws) + (c-syntactic-re-search-forward + "[;=([{]" nil t t t)) + (eq (char-before) ?\())) bod))))) (defun c-where-wrt-brace-construct () @@ -1431,10 +1441,23 @@ No indentation or other \"electric\" behavior is performed." 'in-block) ((c-in-function-trailer-p) 'in-trailer) - ((and (not least-enclosing) - (consp paren-state) - (consp (car paren-state)) - (eq start (cdar paren-state))) + ((or (and (eq (char-before) ?\;) + (save-excursion + (backward-char) + (c-in-function-trailer-p))) + (and (not least-enclosing) + (consp paren-state) + (consp (car paren-state)) + (eq start (cdar paren-state)) + (or + (save-excursion + (c-forward-syntactic-ws) + (or (not (looking-at c-symbol-start)) + (looking-at c-keywords-regexp))) + (save-excursion + (goto-char (caar paren-state)) + (c-beginning-of-decl-1) + (not (looking-at c-defun-type-name-decl-key)))))) 'at-function-end) (t ;; Find the start of the current declaration. NOTE: If we're in the @@ -1450,6 +1473,18 @@ No indentation or other \"electric\" behavior is performed." "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)"))) (forward-char)) (setq kluge-start (point)) + ;; First approximation as to whether the current "header" we're in is + ;; one followed by braces. + (setq brace-decl-p + (save-excursion + (and (c-syntactic-re-search-forward "[;{]" nil t t) + (or (eq (char-before) ?\{) + (and c-recognize-knr-p + ;; Might have stopped on the + ;; ';' in a K&R argdecl. In + ;; that case the declaration + ;; should contain a block. + (c-in-knr-argdecl)))))) (setq decl-result (car (c-beginning-of-decl-1 ;; NOTE: If we're in a K&R region, this might be the start @@ -1460,17 +1495,9 @@ No indentation or other \"electric\" behavior is performed." (c-safe-position least-enclosing paren-state))))) ;; Has the declaration we've gone back to got braces? - (or (eq decl-result 'label) - (setq brace-decl-p - (save-excursion - (and (c-syntactic-re-search-forward "[;{]" nil t t) - (or (eq (char-before) ?\{) - (and c-recognize-knr-p - ;; Might have stopped on the - ;; ';' in a K&R argdecl. In - ;; that case the declaration - ;; should contain a block. - (c-in-knr-argdecl))))))) + (if (or (eq decl-result 'label) + (looking-at c-protection-key)) + (setq brace-decl-p nil)) (cond ((or (eq decl-result 'label) ; e.g. "private:" or invalid syntax. @@ -1613,6 +1640,8 @@ No indentation or other \"electric\" behavior is performed." paren-state orig-point-min orig-point-max)) (setq where 'in-block)))) +(def-edebug-spec c-while-widening-to-decl-block t) + (defun c-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. Every top level declaration that contains a brace paren block is @@ -1817,251 +1846,268 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." (c-keep-region-active) (= arg 0)))) -(defun c-defun-name () - "Return the name of the current defun, or NIL if there isn't one. -\"Defun\" here means a function, or other top level construct -with a brace block." +(defun c-defun-name-1 () + "Return the name of the current defun, at the current narrowing, +or NIL if there isn't one. \"Defun\" here means a function, or +other top level construct with a brace block." (c-save-buffer-state (beginning-of-defun-function end-of-defun-function - where pos name-end case-fold-search) + where pos decl0 decl type-pos tag-pos case-fold-search) - (save-restriction - (widen) - (save-excursion - ;; Move back out of any macro/comment/string we happen to be in. - (c-beginning-of-macro) - (setq pos (c-literal-start)) - (if pos (goto-char pos)) - - (setq where (c-where-wrt-brace-construct)) - - ;; Move to the beginning of the current defun, if any, if we're not - ;; already there. - (if (eq where 'outwith-function) - nil - (unless (eq where 'at-header) - (c-backward-to-nth-BOF-{ 1 where) - (c-beginning-of-decl-1)) - (when (looking-at c-typedef-key) - (goto-char (match-end 0)) - (c-forward-syntactic-ws)) + (save-excursion + ;; Move back out of any macro/comment/string we happen to be in. + (c-beginning-of-macro) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) - ;; Pick out the defun name, according to the type of defun. - (cond - ;; struct, union, enum, or similar: - ((save-excursion - (and - (looking-at c-type-prefix-key) - (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) - (or (not (or (eq (char-after) ?{) - (and c-recognize-knr-p - (c-in-knr-argdecl)))) - (progn (c-backward-syntactic-ws) - (not (eq (char-before) ?\))))))) - (let ((key-pos (point))) - (c-forward-over-token-and-ws) ; over "struct ". - (cond - ((looking-at c-symbol-key) ; "struct foo { ..." - (buffer-substring-no-properties key-pos (match-end 0))) - ((eq (char-after) ?{) ; "struct { ... } foo" - (when (c-go-list-forward) - (c-forward-syntactic-ws) - (when (looking-at c-symbol-key) ; a bit bogus - there might - ; be several identifiers. - (match-string-no-properties 0))))))) - - ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! - ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory - ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK - (down-list 1) + (setq where (c-where-wrt-brace-construct)) + + ;; Move to the beginning of the current defun, if any, if we're not + ;; already there. + (if (memq where '(outwith-function at-function-end)) + nil + (unless (eq where 'at-header) + (c-backward-to-nth-BOF-{ 1 where) + (c-beginning-of-decl-1)) + (when (looking-at c-typedef-key) + (goto-char (match-end 0)) + (c-forward-syntactic-ws)) + (setq type-pos (point)) + + ;; Pick out the defun name, according to the type of defun. + (cond + ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! + ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory + ;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK + (down-list 1) + (c-forward-syntactic-ws) + (when (eq (char-after) ?\") + (forward-sexp 1) + (c-forward-token-2)) ; over the comma and following WS. + (buffer-substring-no-properties + (point) + (progn + (c-forward-token-2) + (c-backward-syntactic-ws) + (point)))) + + (t ; Normal function or initializer. + (when (looking-at c-defun-type-name-decl-key) ; struct, etc. + (goto-char (match-end 0)) (c-forward-syntactic-ws) - (when (eq (char-after) ?\") - (forward-sexp 1) - (c-forward-token-2)) ; over the comma and following WS. - (buffer-substring-no-properties - (point) - (progn - (c-forward-token-2) - (when (looking-at ":") ; CLISP: DEFUN(PACKAGE:LISP-SYMBOL,...) - (skip-chars-forward "^,")) - (c-backward-syntactic-ws) - (point)))) - - ((looking-at "DEF[a-zA-Z0-9_]* *( *\\([^, ]*\\) *,") - ;; DEFCHECKER(sysconf_arg,prefix=_SC,default=, ...) ==> sysconf_arg - ;; DEFFLAGSET(syslog_opt_flags,LOG_PID ...) ==> syslog_opt_flags - (match-string-no-properties 1)) - - ;; Objc selectors. - ((assq 'objc-method-intro (c-guess-basic-syntax)) - (let ((bound (save-excursion (c-end-of-statement) (point))) - (kw-re (concat "\\(?:" c-symbol-key "\\)?:")) - (stretches)) - (when (c-syntactic-re-search-forward c-symbol-key bound t t t) - (push (match-string-no-properties 0) stretches) - (while (c-syntactic-re-search-forward kw-re bound t t t) - (push (match-string-no-properties 0) stretches))) - (apply 'concat (nreverse stretches)))) - - (t - ;; Normal function or initializer. - (when - (and - (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) - (or (eq (char-after) ?{) - (and c-recognize-knr-p - (c-in-knr-argdecl))) - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?\))) - (c-go-list-backward)) - (c-backward-syntactic-ws) - (when (eq (char-before) ?\=) ; struct foo bar = {0, 0} ; - (c-backward-token-2) - (c-backward-syntactic-ws)) - (setq name-end (point)) - (c-back-over-compound-identifier) - (and (looking-at c-symbol-start) - (buffer-substring-no-properties (point) name-end)))))))))) + (setq tag-pos (point)) + (goto-char type-pos)) + (setq decl0 (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) + (when (consp decl0) + (goto-char (car decl0)) + (setq decl (c-forward-declarator))) + (and decl + (car decl) (cadr decl) + (buffer-substring-no-properties + (if (eq (car decl) tag-pos) + type-pos + (car decl)) + (cadr decl))))))))) -(defun c-declaration-limits (near) - ;; Return a cons of the beginning and end positions of the current - ;; top level declaration or macro. If point is not inside any then - ;; nil is returned, unless NEAR is non-nil in which case the closest - ;; following one is chosen instead (if there is any). The end +(defun c-defun-name () + "Return the name of the current defun, or NIL if there isn't one. +\"Defun\" here means a function, or other top level construct +with a brace block, at the outermost level of nesting." + (c-save-buffer-state () + (save-restriction + (widen) + (c-defun-name-1)))) + +(defun c-declaration-limits-1 (near) + ;; Return a cons of the beginning and end position of the current + ;; declaration or macro in the current narrowing. If there is no current + ;; declaration or macro, return nil, unless NEAR is non-nil, in which case + ;; the closest following one is chosen instead (if there is any). The end ;; position is at the next line, providing there is one before the ;; declaration. ;; ;; This function might do hidden buffer changes. (save-excursion - (save-restriction - (let ((start (point)) - (paren-state (c-parse-state)) - lim pos end-pos where) - ;; Narrow enclosing brace blocks out, as required by the values of - ;; `c-defun-tactic', `near', and the position of point. - (when (eq c-defun-tactic 'go-outward) - (let ((bounds - (save-restriction - (if (and (not (save-excursion (c-beginning-of-macro))) - (save-restriction - (c-narrow-to-most-enclosing-decl-block) - (memq (c-where-wrt-brace-construct) - '(at-function-end outwith-function))) - (not near)) - (c-narrow-to-most-enclosing-decl-block nil 2) - (c-narrow-to-most-enclosing-decl-block)) - (cons (point-min) (point-max))))) - (narrow-to-region (car bounds) (cdr bounds)))) - (setq paren-state (c-parse-state)) - - (or - ;; Note: Some code duplication in `c-beginning-of-defun' and - ;; `c-end-of-defun'. - (catch 'exit - (unless (c-safe - (goto-char (c-least-enclosing-brace paren-state)) - ;; If we moved to the outermost enclosing paren - ;; then we can use c-safe-position to set the - ;; limit. Can't do that otherwise since the - ;; earlier paren pair on paren-state might very - ;; well be part of the declaration we should go - ;; to. - (setq lim (c-safe-position (point) paren-state)) - t) - ;; At top level. Make sure we aren't inside a literal. - (setq pos (c-literal-start - (c-safe-position (point) paren-state))) - (if pos (goto-char pos))) - - (when (c-beginning-of-macro) + (let ((start (point)) + (paren-state (c-parse-state)) + lim pos end-pos where) + (or + ;; Note: Some code duplication in `c-beginning-of-defun' and + ;; `c-end-of-defun'. + (catch 'exit + (unless (c-safe + (goto-char (c-least-enclosing-brace paren-state)) + ;; If we moved to the outermost enclosing paren + ;; then we can use c-safe-position to set the + ;; limit. Can't do that otherwise since the + ;; earlier paren pair on paren-state might very + ;; well be part of the declaration we should go + ;; to. + (setq lim (c-safe-position (point) paren-state)) + ;; We might have a struct foo {...} as the type of the + ;; function, so set LIM back one further block. + (if (eq (char-before lim) ?}) + (setq lim + (or + (save-excursion + (and + (c-go-list-backward lim) + (let ((paren-state-1 (c-parse-state))) + (c-safe-position + (point) paren-state-1)))) + (point-min)))) + t) + ;; At top level. Make sure we aren't inside a literal. + (setq pos (c-literal-start + (c-safe-position (point) paren-state))) + (if pos (goto-char pos))) + + (when (c-beginning-of-macro) + (throw 'exit + (cons (point) + (save-excursion + (c-end-of-macro) + (forward-line 1) + (point))))) + + (setq pos (point)) + (setq where (and (not (save-excursion (c-beginning-of-macro))) + (c-where-wrt-brace-construct))) + (when (and (not (eq where 'at-header)) + (or (and near + (memq where + '(at-function-end outwith-function)) + ;; Check we're not inside a declaration without + ;; braces. + (save-excursion + (memq (car (c-beginning-of-decl-1 lim)) + '(previous label)))) + (eq (car (c-beginning-of-decl-1 lim)) 'previous) + (= pos (point)))) + ;; We moved back over the previous defun. Skip to the next + ;; one. Not using c-forward-syntactic-ws here since we + ;; should not skip a macro. We can also be directly after + ;; the block in a `c-opt-block-decls-with-vars-key' + ;; declaration, but then we won't move significantly far + ;; here. + (goto-char pos) + (c-forward-comments) + + (when (and near (c-beginning-of-macro)) (throw 'exit (cons (point) (save-excursion (c-end-of-macro) (forward-line 1) - (point))))) + (point)))))) - (setq pos (point)) - (setq where (and (not (save-excursion (c-beginning-of-macro))) - (c-where-wrt-brace-construct))) - (when (and (not (eq where 'at-header)) - (or (and near - (memq where - '(at-function-end outwith-function))) - (eq (car (c-beginning-of-decl-1 lim)) 'previous) - (= pos (point)))) - ;; We moved back over the previous defun. Skip to the next - ;; one. Not using c-forward-syntactic-ws here since we - ;; should not skip a macro. We can also be directly after - ;; the block in a `c-opt-block-decls-with-vars-key' - ;; declaration, but then we won't move significantly far - ;; here. - (goto-char pos) - (c-forward-comments) - - (when (and near (c-beginning-of-macro)) - (throw 'exit - (cons (point) - (save-excursion - (c-end-of-macro) - (forward-line 1) - (point)))))) + (if (eobp) (throw 'exit nil)) - (if (eobp) (throw 'exit nil)) + ;; Check if `c-beginning-of-decl-1' put us after the block in a + ;; declaration that doesn't end there. We're searching back and + ;; forth over the block here, which can be expensive. + (setq pos (point)) + (if (and c-opt-block-decls-with-vars-key + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?})) + (eq (car (c-beginning-of-decl-1)) + 'previous) + (save-excursion + (c-end-of-decl-1) + (and (> (point) pos) + (setq end-pos (point))))) + nil + (goto-char pos)) + + (if (or (and (not near) (> (point) start)) + (not (eq (c-where-wrt-brace-construct) 'at-header))) + nil + + ;; Try to be line oriented; position the limits at the + ;; closest preceding boi, and after the next newline, that + ;; isn't inside a comment, but if we hit a neighboring + ;; declaration then we instead use the exact declaration + ;; limit in that direction. + (cons (progn + (setq pos (point)) + (while (and (/= (point) (c-point 'boi)) + (c-backward-single-comment))) + (if (/= (point) (c-point 'boi)) + pos + (point))) + (progn + (if end-pos + (goto-char end-pos) + (c-end-of-decl-1)) + (setq pos (point)) + (while (and (not (bolp)) + (not (looking-at "\\s *$")) + (c-forward-single-comment))) + (cond ((bolp) + (point)) + ((looking-at "\\s *$") + (forward-line 1) + (point)) + (t + pos)))))) + (and (not near) + (goto-char (point-min)) + (c-forward-decl-or-cast-1 -1 nil nil) + (eq (char-after) ?\{) + (cons (point-min) (point-max))))))) - ;; Check if `c-beginning-of-decl-1' put us after the block in a - ;; declaration that doesn't end there. We're searching back and - ;; forth over the block here, which can be expensive. - (setq pos (point)) - (if (and c-opt-block-decls-with-vars-key - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?})) - (eq (car (c-beginning-of-decl-1)) - 'previous) - (save-excursion - (c-end-of-decl-1) - (and (> (point) pos) - (setq end-pos (point))))) - nil - (goto-char pos)) - - (if (and (not near) (> (point) start)) - nil - - ;; Try to be line oriented; position the limits at the - ;; closest preceding boi, and after the next newline, that - ;; isn't inside a comment, but if we hit a neighboring - ;; declaration then we instead use the exact declaration - ;; limit in that direction. - (cons (progn - (setq pos (point)) - (while (and (/= (point) (c-point 'boi)) - (c-backward-single-comment))) - (if (/= (point) (c-point 'boi)) - pos - (point))) - (progn - (if end-pos - (goto-char end-pos) - (c-end-of-decl-1)) - (setq pos (point)) - (while (and (not (bolp)) - (not (looking-at "\\s *$")) - (c-forward-single-comment))) - (cond ((bolp) - (point)) - ((looking-at "\\s *$") - (forward-line 1) - (point)) - (t - pos)))))) - (and (not near) - (goto-char (point-min)) - (c-forward-decl-or-cast-1 -1 nil nil) - (eq (char-after) ?\{) - (cons (point-min) (point-max)))))))) +(defun c-declaration-limits (near) + ;; Return a cons of the beginning and end positions of the current + ;; top level declaration or macro. If point is not inside any then + ;; nil is returned, unless NEAR is non-nil in which case the closest + ;; following one is chosen instead (if there is any). The end + ;; position is at the next line, providing there is one before the + ;; declaration. + ;; + ;; This function might do hidden buffer changes. + (save-restriction + ;; Narrow enclosing brace blocks out, as required by the values of + ;; `c-defun-tactic', `near', and the position of point. + (when (eq c-defun-tactic 'go-outward) + (let ((bounds + (save-restriction + (if (and (not (save-excursion (c-beginning-of-macro))) + (save-restriction + (c-narrow-to-most-enclosing-decl-block) + (memq (c-where-wrt-brace-construct) + '(at-function-end outwith-function))) + (not near)) + (c-narrow-to-most-enclosing-decl-block nil 2) + (c-narrow-to-most-enclosing-decl-block)) + (cons (point-min) (point-max))))) + (narrow-to-region (car bounds) (cdr bounds)))) + (c-declaration-limits-1 near))) + +(defun c-defun-name-and-limits (near) + ;; Return a cons of the name and limits (itself a cons) of the current + ;; top-level declaration or macro, or nil of there is none. + ;; + ;; If `c-defun-tactic' is 'go-outward, we return the name and limits of the + ;; most tightly enclosing declaration or macro. Otherwise, we return that + ;; at the file level. + (save-restriction + (widen) + (if (eq c-defun-tactic 'go-outward) + (c-save-buffer-state ((paren-state (c-parse-state)) + (orig-point-min (point-min)) + (orig-point-max (point-max)) + lim name where limits fdoc) + (setq lim (c-widen-to-enclosing-decl-scope + paren-state orig-point-min orig-point-max)) + (and lim (setq lim (1- lim))) + (c-while-widening-to-decl-block (not (setq name (c-defun-name-1)))) + (when name + (setq limits (c-declaration-limits-1 near)) + (cons name limits))) + (c-save-buffer-state ((name (c-defun-name)) + (limits (c-declaration-limits near))) + (and name limits (cons name limits)))))) (defun c-display-defun-name (&optional arg) "Display the name of the current CC mode defun and the position in it. @@ -2069,12 +2115,13 @@ With a prefix arg, push the name onto the kill ring too." (interactive "P") (save-restriction (widen) - (c-save-buffer-state ((name (c-defun-name)) - (limits (c-declaration-limits t)) + (c-save-buffer-state ((name-and-limits (c-defun-name-and-limits nil)) + (name (car name-and-limits)) + (limits (cdr name-and-limits)) (point-bol (c-point 'bol))) (when name (message "%s. Line %s/%s." name - (1+ (count-lines (car limits) point-bol)) + (1+ (count-lines (car limits) (max point-bol (car limits)))) (count-lines (car limits) (cdr limits))) (if arg (kill-new name)) (sit-for 3 t))))) @@ -4737,7 +4784,7 @@ If a fill prefix is specified, it overrides all the above." (defalias 'c-comment-line-break-function 'c-indent-new-comment-line) (make-obsolete 'c-comment-line-break-function 'c-indent-new-comment-line "21.1") -;; advice for indent-new-comment-line for older Emacsen +;; Advice for Emacsen older than 21.1 (!), released 2001/10 (unless (boundp 'comment-line-break-function) (defvar c-inside-line-break-advice nil) (defadvice indent-new-comment-line (around c-line-break-advice diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 613e2b303d9..972d214c0c4 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -81,7 +81,7 @@ (progn (require 'font-lock) (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) + (font-lock-compile-keywords '("a\\`")) ; doesn't match anything. font-lock-keywords)))) @@ -219,6 +219,7 @@ one of the following symbols: `bol' -- beginning of line `eol' -- end of line +`eoll' -- end of logical line (i.e. without escaped NL) `bod' -- beginning of defun `eod' -- end of defun `boi' -- beginning of indentation @@ -254,6 +255,16 @@ to it is returned. This function does not modify the point or the mark." (end-of-line) (point)))) + ((eq position 'eoll) + `(save-excursion + ,@(if point `((goto-char ,point))) + (while (progn + (end-of-line) + (prog1 (eq (logand 1 (skip-chars-backward "\\\\")) 1))) + (beginning-of-line 2)) + (end-of-line) + (point))) + ((eq position 'boi) `(save-excursion ,@(if point `((goto-char ,point))) @@ -453,6 +464,13 @@ to it is returned. This function does not modify the point or the mark." `(int-to-char ,integer) integer)) +(defmacro c-characterp (arg) + ;; Return t when ARG is a character (XEmacs) or integer (Emacs), otherwise + ;; return nil. + (if (integerp ?c) + `(integerp ,arg) + `(characterp ,arg))) + (defmacro c-last-command-char () ;; The last character just typed. Note that `last-command-event' exists in ;; both Emacs and XEmacs, but with confusingly different meanings. @@ -1298,20 +1316,36 @@ with value CHAR in the region [FROM to)." ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn (def-edebug-spec cc-eval-when-compile (&rest def-form)) +(def-edebug-spec c--mapcan t) +(def-edebug-spec c--set-difference (form form &rest [symbolp form])) +(def-edebug-spec c--intersection (form form &rest [symbolp form])) +(def-edebug-spec c--delete-duplicates (form &rest [symbolp form])) (def-edebug-spec c-point t) +(def-edebug-spec c-next-single-property-change t) +(def-edebug-spec c-delete-and-extract-region t) (def-edebug-spec c-set-region-active t) (def-edebug-spec c-set-keymap-parent t) (def-edebug-spec c-safe t) +(def-edebug-spec c-int-to-char t) +(def-edebug-spec c-characterp t) (def-edebug-spec c-save-buffer-state let*) (def-edebug-spec c-tentative-buffer-changes t) (def-edebug-spec c-forward-syntactic-ws t) (def-edebug-spec c-backward-syntactic-ws t) (def-edebug-spec c-forward-sexp t) (def-edebug-spec c-backward-sexp t) +(def-edebug-spec c-safe-scan-lists t) +(def-edebug-spec c-go-list-forward t) +(def-edebug-spec c-go-list-backward t) (def-edebug-spec c-up-list-forward t) (def-edebug-spec c-up-list-backward t) (def-edebug-spec c-down-list-forward t) (def-edebug-spec c-down-list-backward t) +(def-edebug-spec c-go-up-list-forward t) +(def-edebug-spec c-go-up-list-backward t) +(def-edebug-spec c-go-down-list-forward t) +(def-edebug-spec c-go-down-list-backward t) +(def-edebug-spec c-at-vsemi-p t) (def-edebug-spec c-add-syntax t) (def-edebug-spec c-add-class-syntax t) (def-edebug-spec c-benign-error t) @@ -1319,15 +1353,28 @@ with value CHAR in the region [FROM to)." (def-edebug-spec c-skip-ws-forward t) (def-edebug-spec c-skip-ws-backward t) (def-edebug-spec c-major-mode-is t) +(def-edebug-spec c-search-forward-char-property t) +(def-edebug-spec c-search-backward-char-property t) (def-edebug-spec c-put-char-property t) (def-edebug-spec c-get-char-property t) (def-edebug-spec c-clear-char-property t) +(def-edebug-spec c-clear-char-property-with-value t) (def-edebug-spec c-clear-char-property-with-value-on-char t) (def-edebug-spec c-put-char-properties-on-char t) (def-edebug-spec c-clear-char-properties t) (def-edebug-spec c-put-overlay t) (def-edebug-spec c-delete-overlay t) -(def-edebug-spec c-self-bind-state-cache t);)) +(def-edebug-spec c-mark-<-as-paren t) +(def-edebug-spec c-mark->-as-paren t) +(def-edebug-spec c-unmark-<->-as-paren t) +(def-edebug-spec c-with-<->-as-parens-suppressed (body)) +(def-edebug-spec c-self-bind-state-cache (body)) +(def-edebug-spec c-sc-scan-lists-no-category+1+1 t) +(def-edebug-spec c-sc-scan-lists-no-category+1-1 t) +(def-edebug-spec c-sc-scan-lists-no-category-1+1 t) +(def-edebug-spec c-sc-scan-lists-no-category-1-1 t) +(def-edebug-spec c-sc-scan-lists t) +(def-edebug-spec c-sc-parse-partial-sexp t);)) ;;; Functions. @@ -1775,10 +1822,10 @@ when it's needed. The default is the current language taken from (t re))) - ;; Produce a regexp that matches nothing. + ;; Produce a regexp that doesn't match anything. (if adorn - "\\(\\<\\>\\)" - "\\<\\>"))) + "\\(a\\`\\)" + "a\\`"))) (put 'c-make-keywords-re 'lisp-indent-function 1) @@ -1840,7 +1887,7 @@ non-nil, a caret is prepended to invert the set." (setq entry (get-char-table ?a table))) ;; incompatible (t (error "CC Mode is incompatible with this version of Emacs"))) - (setq list (cons (if (= (logand (lsh entry -16) 255) 255) + (setq list (cons (if (= (logand (ash entry -16) 255) 255) '8-bit '1-bit) list))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 317968aafd3..7a6cfdd1b7d 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -870,7 +870,7 @@ comment at the start of cc-engine.el for more info." stack ;; Regexp which matches "for", "if", etc. (cond-key (or c-opt-block-stmt-key - "\\<\\>")) ; Matches nothing. + "a\\`")) ; Doesn't match anything. ;; Return value. (ret 'same) ;; Positions of the last three sexps or bounds we've stopped at. @@ -1124,7 +1124,16 @@ comment at the start of cc-engine.el for more info." (not (c-looking-at-inexpr-block lim nil t)) (save-excursion (c-backward-token-2 1 t nil) - (not (looking-at "=\\([^=]\\|$\\)")))) + (not (looking-at "=\\([^=]\\|$\\)"))) + (or + (not c-opt-block-decls-with-vars-key) + (save-excursion + (c-backward-token-2 1 t nil) + (if (and (looking-at c-symbol-start) + (not (looking-at c-keywords-regexp))) + (c-backward-token-2 1 t nil)) + (not (looking-at + c-opt-block-decls-with-vars-key))))) (save-excursion (c-forward-sexp) (point))) ;; Just gone back over some paren block? @@ -1273,7 +1282,7 @@ comment at the start of cc-engine.el for more info." (c-backward-syntactic-ws) ;; protect AWK post-inc/decrement operators, etc. (and (not (c-at-vsemi-p (point))) - (/= (skip-chars-backward "-+!*&~@`#") 0))) + (/= (skip-chars-backward "-.+!*&~@`#") 0))) (setq pos (point))) (goto-char pos) ret))) @@ -3870,9 +3879,10 @@ comment at the start of cc-engine.el for more info." (defmacro c-state-maybe-marker (place marker) ;; If PLACE is non-nil, return a marker marking it, otherwise nil. ;; We (re)use MARKER. - `(and ,place - (or ,marker (setq ,marker (make-marker))) - (set-marker ,marker ,place))) + `(let ((-place- ,place)) + (and -place- + (or ,marker (setq ,marker (make-marker))) + (set-marker ,marker -place-)))) (defun c-parse-state () ;; This is a wrapper over `c-parse-state-1'. See that function for a @@ -4286,6 +4296,41 @@ comment at the start of cc-engine.el for more info." "\\w\\|\\s_\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\"")) +(defun c-forward-over-token (&optional balanced) + "Move forward over a token. +Return t if we moved, nil otherwise (i.e. we were at EOB, or a +non-token or BALANCED is non-nil and we can't move). If we +are at syntactic whitespace, move over this in place of a token. + +If BALANCED is non-nil move over any balanced parens we are at, and never move +out of an enclosing paren." + (let ((jump-syntax (if balanced + c-jump-syntax-balanced + c-jump-syntax-unbalanced)) + (here (point))) + (condition-case nil + (cond + ((/= (point) + (progn (c-forward-syntactic-ws) (point))) + ;; If we're at whitespace, count this as the token. + t) + ((eobp) nil) + ((looking-at jump-syntax) + (goto-char (scan-sexps (point) 1)) + t) + ((looking-at c-nonsymbol-token-regexp) + (goto-char (match-end 0)) + t) + ((save-restriction + (widen) + (looking-at c-nonsymbol-token-regexp)) + nil) + (t + (forward-char) + t)) + (error (goto-char here) + nil)))) + (defun c-forward-over-token-and-ws (&optional balanced) "Move forward over a token and any following whitespace Return t if we moved, nil otherwise (i.e. we were at EOB, or a @@ -4297,35 +4342,8 @@ out of an enclosing paren. This function differs from `c-forward-token-2' in that it will move forward over the final token in a buffer, up to EOB." - (let ((jump-syntax (if balanced - c-jump-syntax-balanced - c-jump-syntax-unbalanced)) - (here (point))) - (when - (condition-case nil - (cond - ((/= (point) - (progn (c-forward-syntactic-ws) (point))) - ;; If we're at whitespace, count this as the token. - t) - ((eobp) nil) - ((looking-at jump-syntax) - (goto-char (scan-sexps (point) 1)) - t) - ((looking-at c-nonsymbol-token-regexp) - (goto-char (match-end 0)) - t) - ((save-restriction - (widen) - (looking-at c-nonsymbol-token-regexp)) - nil) - (t - (forward-char) - t)) - (error (goto-char here) - nil)) - (c-forward-syntactic-ws) - t))) + (prog1 (c-forward-over-token balanced) + (c-forward-syntactic-ws))) (defun c-forward-token-2 (&optional count balanced limit) "Move forward by tokens. @@ -4727,56 +4745,6 @@ comment at the start of cc-engine.el for more info." (defvar safe-pos-list) ; bound in c-syntactic-skip-backward -(defsubst c-ssb-lit-begin () - ;; Return the start of the literal point is in, or nil. - ;; We read and write the variables `safe-pos', `safe-pos-list', `state' - ;; bound in the caller. - - ;; Use `parse-partial-sexp' from a safe position down to the point to check - ;; if it's outside comments and strings. - (save-excursion - (let ((pos (point)) safe-pos state) - ;; Pick a safe position as close to the point as possible. - ;; - ;; FIXME: Consult `syntax-ppss' here if our cache doesn't give a good - ;; position. - - (while (and safe-pos-list - (> (car safe-pos-list) (point))) - (setq safe-pos-list (cdr safe-pos-list))) - (unless (setq safe-pos (car-safe safe-pos-list)) - (setq safe-pos (max (or (c-safe-position - (point) (c-parse-state)) - 0) - (point-min)) - safe-pos-list (list safe-pos))) - - ;; Cache positions along the way to use if we have to back up more. We - ;; cache every closing paren on the same level. If the paren cache is - ;; relevant in this region then we're typically already on the same - ;; level as the target position. Note that we might cache positions - ;; after opening parens in case safe-pos is in a nested list. That's - ;; both uncommon and harmless. - (while (progn - (setq state (parse-partial-sexp - safe-pos pos 0)) - (< (point) pos)) - (setq safe-pos (point) - safe-pos-list (cons safe-pos safe-pos-list))) - - ;; If the state contains the start of the containing sexp we cache that - ;; position too, so that parse-partial-sexp in the next run has a bigger - ;; chance of starting at the same level as the target position and thus - ;; will get more good safe positions into the list. - (if (elt state 1) - (setq safe-pos (1+ (elt state 1)) - safe-pos-list (cons safe-pos safe-pos-list))) - - (if (or (elt state 3) (elt state 4)) - ;; Inside string or comment. Continue search at the - ;; beginning of it. - (elt state 8))))) - (defun c-syntactic-skip-backward (skip-chars &optional limit paren-level) "Like `skip-chars-backward' but only look at syntactically relevant chars, i.e. don't stop at positions inside syntactic whitespace or string @@ -4793,108 +4761,110 @@ Non-nil is returned if the point moved, nil otherwise. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." - - (c-self-bind-state-cache - (let ((start (point)) - ;; A list of syntactically relevant positions in descending - ;; order. It's used to avoid scanning repeatedly over - ;; potentially large regions with `parse-partial-sexp' to verify - ;; each position. Used in `c-ssb-lit-begin' - safe-pos-list + (let* ((start (point)) ;; The result from `c-beginning-of-macro' at the start position or the - ;; start position itself if it isn't within a macro. Evaluated on - ;; demand. - start-macro-beg + ;; start position itself if it isn't within a macro. + (start-macro-beg + (save-excursion + (goto-char start) + (c-beginning-of-macro limit) + (point))) + lit-beg ;; The earliest position after the current one with the same paren ;; level. Used only when `paren-level' is set. - lit-beg - (paren-level-pos (point))) + (paren-level-pos (point)) + ;; Whether we can optimize with an early `c-backward-syntactic-ws'. + (opt-ws (string-match "^\\^[^ \t\n\r]+$" skip-chars))) - (while - (progn - ;; The next loop "tries" to find the end point each time round, - ;; loops when it hasn't succeeded. - (while - (and - (let ((pos (point))) - (while (and - (< (skip-chars-backward skip-chars limit) 0) - ;; Don't stop inside a literal. - (when (setq lit-beg (c-ssb-lit-begin)) + ;; In the next while form, we only loop when `skip-chars' is something + ;; like "^/" and we've stopped at the end of a block comment. + (while + (progn + ;; The next loop "tries" to find the end point each time round, + ;; loops when it's ended up at the wrong level of nesting. + (while + (and + ;; Optimize for, in particular, large blocks of comments from + ;; `comment-region'. + (progn (when opt-ws + (c-backward-syntactic-ws) + (setq paren-level-pos (point))) + t) + ;; Move back to a candidate end point which isn't in a literal + ;; or in a macro we didn't start in. + (let ((pos (point)) + macro-start) + (while (and + (< (skip-chars-backward skip-chars limit) 0) + (or + (when (setq lit-beg (c-literal-start)) (goto-char lit-beg) - t))) - (< (point) pos)) - - (let ((pos (point)) state-2 pps-end-pos) - - (cond - ((and paren-level - (save-excursion - (setq state-2 (parse-partial-sexp - pos paren-level-pos -1) - pps-end-pos (point)) - (/= (car state-2) 0))) - ;; Not at the right level. - - (if (and (< (car state-2) 0) - ;; We stop above if we go out of a paren. - ;; Now check whether it precedes or is - ;; nested in the starting sexp. - (save-excursion - (setq state-2 - (parse-partial-sexp - pps-end-pos paren-level-pos - nil nil state-2)) - (< (car state-2) 0))) - - ;; We've stopped short of the starting position - ;; so the hit was inside a nested list. Go up - ;; until we are at the right level. - (condition-case nil - (progn - (goto-char (scan-lists pos -1 - (- (car state-2)))) - (setq paren-level-pos (point)) - (if (and limit (>= limit paren-level-pos)) - (progn - (goto-char limit) - nil) - t)) - (error - (goto-char (or limit (point-min))) - nil)) - - ;; The hit was outside the list at the start - ;; position. Go to the start of the list and exit. - (goto-char (1+ (elt state-2 1))) - nil)) - - ((c-beginning-of-macro limit) - ;; Inside a macro. - (if (< (point) - (or start-macro-beg - (setq start-macro-beg - (save-excursion - (goto-char start) - (c-beginning-of-macro limit) - (point))))) - t - - ;; It's inside the same macro we started in so it's - ;; a relevant match. - (goto-char pos) - nil)))))) - - (> (point) - (progn - ;; Skip syntactic ws afterwards so that we don't stop at the - ;; end of a comment if `skip-chars' is something like "^/". - (c-backward-syntactic-ws) - (point))))) + t) + ;; Don't stop inside a macro we didn't start in. + (when + (save-excursion + (and (c-beginning-of-macro limit) + (< (point) start-macro-beg) + (setq macro-start (point)))) + (goto-char macro-start)))) + (when opt-ws + (c-backward-syntactic-ws))) + (< (point) pos)) + + ;; Check whether we're at the wrong level of nesting (when + ;; `paren-level' is non-nil). + (let ((pos (point)) state-2 pps-end-pos) + (when + (and paren-level + (save-excursion + (setq state-2 (parse-partial-sexp + pos paren-level-pos -1) + pps-end-pos (point)) + (/= (car state-2) 0))) + ;; Not at the right level. + (if (and (< (car state-2) 0) + ;; We stop above if we go out of a paren. + ;; Now check whether it precedes or is + ;; nested in the starting sexp. + (save-excursion + (setq state-2 + (parse-partial-sexp + pps-end-pos paren-level-pos + nil nil state-2)) + (< (car state-2) 0))) + + ;; We've stopped short of the starting position + ;; so the hit was inside a nested list. Go up + ;; until we are at the right level. + (condition-case nil + (progn + (goto-char (scan-lists pos -1 + (- (car state-2)))) + (setq paren-level-pos (point)) + (if (and limit (>= limit paren-level-pos)) + (progn + (goto-char limit) + nil) + t)) + (error + (goto-char (or limit (point-min))) + nil)) + + ;; The hit was outside the list at the start + ;; position. Go to the start of the list and exit. + (goto-char (1+ (elt state-2 1))) + nil))))) + + (> (point) + (progn + ;; Skip syntactic ws afterwards so that we don't stop at the + ;; end of a comment if `skip-chars' is something like "^/". + (c-backward-syntactic-ws) + (point))))) - ;; We might want to extend this with more useful return values in - ;; the future. - (/= (point) start)))) + ;; We might want to extend this with more useful return values in + ;; the future. + (/= (point) start))) ;; The following is an alternative implementation of ;; `c-syntactic-skip-backward' that uses backward movement to keep @@ -5177,6 +5147,9 @@ comment at the start of cc-engine.el for more info." (defsubst c-determine-limit-get-base (start try-size) ;; Get a "safe place" approximately TRY-SIZE characters before START. ;; This defsubst doesn't preserve point. + (goto-char start) + (c-backward-syntactic-ws) + (setq start (point)) (let* ((pos (max (- start try-size) (point-min))) (s (c-state-semi-pp-to-literal pos)) (cand (or (car (cddr s)) pos))) @@ -5186,9 +5159,9 @@ comment at the start of cc-engine.el for more info." (point)))) (defun c-determine-limit (how-far-back &optional start try-size) - ;; Return a buffer position HOW-FAR-BACK non-literal characters from - ;; START (default point). The starting position, either point or - ;; START may not be in a comment or string. + ;; Return a buffer position approximately HOW-FAR-BACK non-literal + ;; characters from START (default point). The starting position, either + ;; point or START may not be in a comment or string. ;; ;; The position found will not be before POINT-MIN and won't be in a ;; literal. @@ -5206,6 +5179,12 @@ comment at the start of cc-engine.el for more info." (s (parse-partial-sexp pos pos)) ; null state. stack elt size (count 0)) + ;; Optimization for large blocks of comments, particularly those being + ;; created by `comment-region'. + (goto-char pos) + (forward-comment try-size) + (setq pos (point)) + (while (< pos start) ;; Move forward one literal each time round this loop. ;; Move forward to the start of a comment or string. @@ -5248,6 +5227,10 @@ comment at the start of cc-engine.el for more info." ;; Have we found enough yet? (cond + ((null elt) ; No non-literal characters found. + (if (> base (point-min)) + (c-determine-limit how-far-back base (* 2 try-size)) + (point-min))) ((>= count how-far-back) (+ (car elt) (- count how-far-back))) ((eq base (point-min)) @@ -5255,7 +5238,7 @@ comment at the start of cc-engine.el for more info." ((> base (- start try-size)) ; Can only happen if we hit point-min. (car elt)) (t - (c-determine-limit (- how-far-back count) base try-size)))))) + (c-determine-limit (- how-far-back count) base (* 2 try-size))))))) (defun c-determine-+ve-limit (how-far &optional start-pos) ;; Return a buffer position about HOW-FAR non-literal characters forward @@ -7138,7 +7121,7 @@ comment at the start of cc-engine.el for more info." (progn (c-forward-syntactic-ws) (when (or (and c-record-type-identifiers all-types) - (not (equal c-inside-<>-type-key "\\(\\<\\>\\)"))) + (not (equal c-inside-<>-type-key "\\(a\\`\\)"))) (c-forward-syntactic-ws) (cond ((eq (char-after) ??) @@ -7688,7 +7671,7 @@ comment at the start of cc-engine.el for more info." (c-record-type-id id-range)) (unless res (setq res 'found))) - (setq res (if (c-check-type id-start id-end) + (setq res (if (c-check-qualified-type id-start) ;; It's an identifier that has been used as ;; a type somewhere else. 'found @@ -7700,7 +7683,7 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (setq res (if (eq (char-after) ?\() - (if (c-check-type id-start id-end) + (if (c-check-qualified-type id-start) ;; It's an identifier that has been used as ;; a type somewhere else. 'found @@ -7825,6 +7808,37 @@ comment at the start of cc-engine.el for more info." (prog1 (car ,ps) (setq ,ps (cdr ,ps))))) +(defun c-forward-over-compound-identifier () + ;; Go over a possibly compound identifier, such as C++'s Foo::Bar::Baz, + ;; returning that identifier (with any syntactic WS removed). Return nil if + ;; we're not at an identifier. + (when (c-on-identifier) + (let ((consolidated "") (consolidated-:: "") + start end) + (while + (progn + (setq start (point)) + (c-forward-over-token) + (setq consolidated + (concat consolidated-:: + (buffer-substring-no-properties start (point)))) + (c-forward-syntactic-ws) + (and c-opt-identifier-concat-key + (looking-at c-opt-identifier-concat-key) + (progn + (setq start (point)) + (c-forward-over-token) + (setq end (point)) + (c-forward-syntactic-ws) + (and + (c-on-identifier) + (setq consolidated-:: + (concat consolidated + (buffer-substring-no-properties start end)))))))) + (if (equal consolidated "") + nil + consolidated)))) + (defun c-back-over-compound-identifier () ;; Point is putatively just after a "compound identifier", i.e. something ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of @@ -7849,6 +7863,21 @@ comment at the start of cc-engine.el for more info." (goto-char end) t))) +(defun c-check-qualified-type (from) + ;; Look up successive tails of a (possibly) qualified type in + ;; `c-found-types'. If one of them matches, return it, else return nil. + (save-excursion + (goto-char from) + (let ((compound (c-forward-over-compound-identifier))) + (when compound + (while (and c-opt-identifier-concat-key + (> (length compound) 0) + (not (gethash compound c-found-types)) + (string-match c-opt-identifier-concat-key compound)) + (setq compound (substring compound (match-end 0)))) + (and (gethash compound c-found-types) + compound))))) + (defun c-back-over-member-initializer-braces () ;; Point is just after a closing brace/parenthesis. Try to parse this as a ;; C++ member initializer list, going back to just after the introducing ":" @@ -8548,7 +8577,7 @@ comment at the start of cc-engine.el for more info." ;; Skip over type decl prefix operators. (Note similar code in ;; `c-forward-declarator'.) (if (and c-recognize-typeless-decls - (equal c-type-decl-prefix-key "\\<\\>")) + (equal c-type-decl-prefix-key "a\\`")) ; Regexp which doesn't match (when (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) @@ -8605,6 +8634,7 @@ comment at the start of cc-engine.el for more info." ;; construct here in C, since we want to recognize this as a ;; typeless function declaration. (not (and (c-major-mode-is 'c-mode) + (not got-prefix) (or (eq context 'top) make-top) (eq (char-after) ?\))))) (if (eq (char-after) ?\)) @@ -8634,31 +8664,39 @@ comment at the start of cc-engine.el for more info." ;; (con|de)structors in C++ and `c-typeless-decl-kwds' ;; style declarations. That isn't applicable in an ;; arglist context, though. - (when (and (= paren-depth 1) - (not got-prefix-before-parens) - (not (eq at-type t)) - (or backup-at-type - maybe-typeless - backup-maybe-typeless - (when c-recognize-typeless-decls - (and (memq context '(nil top)) - ;; Deal with C++11's "copy-initialization" - ;; where we have <type>(<constant>), by - ;; contrasting with a typeless - ;; <name>(<type><parameter>, ...). - (save-excursion - (goto-char after-paren-pos) - (c-forward-syntactic-ws) - (or (c-forward-type) - ;; Recognize a top-level typeless - ;; function declaration in C. - (and (c-major-mode-is 'c-mode) - (or (eq context 'top) make-top) - (eq (char-after) ?\)))))))) - (setq pos (c-up-list-forward (point))) - (eq (char-before pos) ?\))) + (when (and (> paren-depth 0) + (not got-prefix-before-parens) + (not (eq at-type t)) + (or backup-at-type + maybe-typeless + backup-maybe-typeless + (when c-recognize-typeless-decls + (and (memq context '(nil top)) + ;; Deal with C++11's "copy-initialization" + ;; where we have <type>(<constant>), by + ;; contrasting with a typeless + ;; <name>(<type><parameter>, ...). + (save-excursion + (goto-char after-paren-pos) + (c-forward-syntactic-ws) + (or (c-forward-type) + ;; Recognize a top-level typeless + ;; function declaration in C. + (and (c-major-mode-is 'c-mode) + (or (eq context 'top) make-top) + (eq (char-after) ?\)))))))) + (let ((pd paren-depth)) + (setq pos (point)) + (catch 'pd + (while (> pd 0) + (setq pos (c-up-list-forward pos)) + (when (or (null pos) + (not (eq (char-before pos) ?\)))) + (throw 'pd nil)) + (goto-char pos) + (setq pd (1- pd))) + t))) (c-fdoc-shift-type-backward) - (goto-char pos) t))) (c-forward-syntactic-ws)) @@ -9527,11 +9565,10 @@ comment at the start of cc-engine.el for more info." ;; back we should search. ;; ;; This function might do hidden buffer changes. - (c-with-syntax-table c++-template-syntax-table - (c-backward-token-2 0 t lim) - (while (and (or (looking-at c-symbol-start) - (looking-at "[<,]\\|::")) - (zerop (c-backward-token-2 1 t lim)))))) + (c-backward-token-2 0 t lim) + (while (and (or (looking-at c-symbol-start) + (looking-at "[<,]\\|::")) + (zerop (c-backward-token-2 1 t lim))))) (defun c-in-method-def-p () ;; Return nil if we aren't in a method definition, otherwise the @@ -9829,9 +9866,15 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (save-excursion (and (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-block-stmt-hangon-key) + (zerop (c-backward-token-2 1 t lim)) + t) (or (looking-at c-block-stmt-1-key) (and (eq (char-after) ?\() (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-block-stmt-hangon-key) + (zerop (c-backward-token-2 1 t lim)) + t) (or (looking-at c-block-stmt-2-key) (looking-at c-block-stmt-1-2-key)))) (point)))) @@ -9901,11 +9944,10 @@ comment at the start of cc-engine.el for more info." (and (c-safe (c-backward-sexp) t) (looking-at c-opt-op-identifier-prefix))) (and (eq (char-before) ?<) - (c-with-syntax-table c++-template-syntax-table - (if (c-safe (goto-char (c-up-list-forward (point)))) - t - (goto-char (point-max)) - nil))))) + (if (c-safe (goto-char (c-up-list-forward (point)))) + t + (goto-char (point-max)) + nil)))) (setq base (point))) (while (and @@ -9998,28 +10040,25 @@ comment at the start of cc-engine.el for more info." ;; potentially can search over a large amount of text.). Take special ;; pains not to get mislead by C++'s "operator=", and the like. (if (and (eq move 'previous) - (c-with-syntax-table (if (c-major-mode-is 'c++-mode) - c++-template-syntax-table - (syntax-table)) - (save-excursion - (and - (progn - (while ; keep going back to "[;={"s until we either find - ; no more, or get to one which isn't an "operator =" - (and (c-syntactic-re-search-forward "[;={]" start t t t) - (eq (char-before) ?=) - c-overloadable-operators-regexp - c-opt-op-identifier-prefix - (save-excursion - (eq (c-backward-token-2) 0) - (looking-at c-overloadable-operators-regexp) - (eq (c-backward-token-2) 0) - (looking-at c-opt-op-identifier-prefix)))) - (eq (char-before) ?=)) - (c-syntactic-re-search-forward "[;{]" start t t) - (eq (char-before) ?{) - (c-safe (goto-char (c-up-list-forward (point))) t) - (not (c-syntactic-re-search-forward ";" start t t)))))) + (save-excursion + (and + (progn + (while ; keep going back to "[;={"s until we either find + ; no more, or get to one which isn't an "operator =" + (and (c-syntactic-re-search-forward "[;={]" start t t t) + (eq (char-before) ?=) + c-overloadable-operators-regexp + c-opt-op-identifier-prefix + (save-excursion + (eq (c-backward-token-2) 0) + (looking-at c-overloadable-operators-regexp) + (eq (c-backward-token-2) 0) + (looking-at c-opt-op-identifier-prefix)))) + (eq (char-before) ?=)) + (c-syntactic-re-search-forward "[;{]" start t t) + (eq (char-before) ?{) + (c-safe (goto-char (c-up-list-forward (point))) t) + (not (c-syntactic-re-search-forward ";" start t t))))) (cons 'same nil) (cons move nil))))) @@ -10034,10 +10073,7 @@ comment at the start of cc-engine.el for more info." ;; `c-end-of-macro' instead in those cases. ;; ;; This function might do hidden buffer changes. - (let ((start (point)) - (decl-syntax-table (if (c-major-mode-is 'c++-mode) - c++-template-syntax-table - (syntax-table)))) + (let ((start (point))) (catch 'return (c-search-decl-header-end) @@ -10058,34 +10094,32 @@ comment at the start of cc-engine.el for more info." (throw 'return nil))) (if (or (not c-opt-block-decls-with-vars-key) (save-excursion - (c-with-syntax-table decl-syntax-table - (let ((lim (point))) - (goto-char start) - (not (and - ;; Check for `c-opt-block-decls-with-vars-key' - ;; before the first paren. - (c-syntactic-re-search-forward - (concat "[;=([{]\\|\\(" - c-opt-block-decls-with-vars-key - "\\)") - lim t t t) - (match-beginning 1) - (not (eq (char-before) ?_)) - ;; Check that the first following paren is - ;; the block. - (c-syntactic-re-search-forward "[;=([{]" - lim t t t) - (eq (char-before) ?{))))))) + (let ((lim (point))) + (goto-char start) + (not (and + ;; Check for `c-opt-block-decls-with-vars-key' + ;; before the first paren. + (c-syntactic-re-search-forward + (concat "[;=\(\[{]\\|\\(" + c-opt-block-decls-with-vars-key + "\\)") + lim t t t) + (match-beginning 1) + (not (eq (char-before) ?_)) + ;; Check that the first following paren is + ;; the block. + (c-syntactic-re-search-forward "[;=\(\[{]" + lim t t t) + (eq (char-before) ?{)))))) ;; The declaration doesn't have any of the ;; `c-opt-block-decls-with-vars' keywords in the ;; beginning, so it ends here at the end of the block. (throw 'return t))) - (c-with-syntax-table decl-syntax-table - (while (progn - (if (eq (char-before) ?\;) - (throw 'return t)) - (c-syntactic-re-search-forward ";" nil 'move t)))) + (while (progn + (if (eq (char-before) ?\;) + (throw 'return t)) + (c-syntactic-re-search-forward ";" nil 'move t))) nil))) (defun c-looking-at-decl-block (_containing-sexp goto-start &optional limit) @@ -10165,7 +10199,7 @@ comment at the start of cc-engine.el for more info." ;; legal because it's part of a "compound keyword" like ;; "enum class". Of course, if c-after-brace-list-key ;; is nil, we can skip the test. - (or (equal c-after-brace-list-key "\\<\\>") + (or (equal c-after-brace-list-key "a\\`") ; Regexp which doesn't match (save-match-data (save-excursion (not @@ -10516,6 +10550,10 @@ comment at the start of cc-engine.el for more info." ((and class-key (looking-at class-key)) (setq braceassignp nil)) + ((and c-has-compound-literals + (looking-at c-return-key)) + (setq braceassignp t) + nil) ((eq (char-after) ?=) ;; We've seen a =, but must check earlier tokens so ;; that it isn't something that should be ignored. @@ -10554,9 +10592,14 @@ comment at the start of cc-engine.el for more info." )))) nil) (t t)))))) - (if (and (eq braceassignp 'dontknow) - (/= (c-backward-token-2 1 t lim) 0)) - (setq braceassignp nil))) + (when (and (eq braceassignp 'dontknow) + (/= (c-backward-token-2 1 t lim) 0)) + (if (save-excursion + (and c-has-compound-literals + (eq (c-backward-token-2 1 nil lim) 0) + (eq (char-after) ?\())) + (setq braceassignp t) + (setq braceassignp nil)))) (cond (braceassignp @@ -10631,7 +10674,8 @@ comment at the start of cc-engine.el for more info." ;; This will pick up brace list declarations. (save-excursion (goto-char containing-sexp) - (c-backward-over-enum-header)) + (and (c-backward-over-enum-header) + (point))) ;; this will pick up array/aggregate init lists, even if they are nested. (save-excursion (let ((bufpos t) @@ -10921,7 +10965,7 @@ comment at the start of cc-engine.el for more info." (c-on-identifier))) (and c-special-brace-lists (c-looking-at-special-brace-list)) - (and (c-major-mode-is 'c++-mode) + (and c-has-compound-literals (save-excursion (goto-char block-follows) (not (c-looking-at-statement-block))))) @@ -11256,9 +11300,7 @@ comment at the start of cc-engine.el for more info." (cdr (assoc (match-string 1) c-other-decl-block-key-in-symbols-alist)) (max (c-point 'boi paren-pos) (point)))) - ((save-excursion - (goto-char paren-pos) - (c-looking-at-or-maybe-in-bracelist containing-sexp)) + ((c-inside-bracelist-p paren-pos paren-state nil) (if (save-excursion (goto-char paren-pos) (c-looking-at-statement-block)) @@ -11350,10 +11392,9 @@ comment at the start of cc-engine.el for more info." ;; CASE B.2: brace-list-open ((or (consp special-brace-list) - (consp - (c-looking-at-or-maybe-in-bracelist - containing-sexp beg-of-same-or-containing-stmt)) - ) + (c-inside-bracelist-p (point) + (cons containing-sexp paren-state) + nil)) ;; The most semantically accurate symbol here is ;; brace-list-open, but we normally report it simply as a ;; statement-cont. The reason is that one normally adjusts @@ -11464,17 +11505,15 @@ comment at the start of cc-engine.el for more info." ((and (c-major-mode-is 'c++-mode) (save-excursion (goto-char indent-point) - (c-with-syntax-table c++-template-syntax-table - (setq placeholder (c-up-list-backward))) + (setq placeholder (c-up-list-backward)) (and placeholder (eq (char-after placeholder) ?<) (/= (char-before placeholder) ?<) (progn (goto-char (1+ placeholder)) (not (looking-at c-<-op-cont-regexp)))))) - (c-with-syntax-table c++-template-syntax-table - (goto-char placeholder) - (c-beginning-of-statement-1 containing-sexp t)) + (goto-char placeholder) + (c-beginning-of-statement-1 containing-sexp t) (if (save-excursion (c-backward-syntactic-ws containing-sexp) (eq (char-before) ?<)) @@ -12134,21 +12173,38 @@ comment at the start of cc-engine.el for more info." ;; NB: No c-after-special-operator-id stuff in this ;; clause - we assume only C++ needs it. (c-syntactic-skip-backward "^;,=" lim t)) + (setq placeholder (point)) (memq (char-before) '(?, ?= ?<))) (cond + ;; CASE 5D.6: Something like C++11's "using foo = <type-exp>" + ((save-excursion + (and (eq (char-before placeholder) ?=) + (goto-char placeholder) + (eq (c-backward-token-2 1 nil lim) 0) + (eq (point) (1- placeholder)) + (eq (c-beginning-of-statement-1 lim) 'same) + (looking-at c-equals-type-clause-key) + (let ((preserve-point (point))) + (when + (and + (eq (c-forward-token-2 1 nil nil) 0) + (c-on-identifier)) + (setq placeholder preserve-point))))) + (c-add-syntax + 'statement-cont placeholder) + ) + ;; CASE 5D.3: perhaps a template list continuation? ((and (c-major-mode-is 'c++-mode) (save-excursion (save-restriction - (c-with-syntax-table c++-template-syntax-table - (goto-char indent-point) - (setq placeholder (c-up-list-backward)) - (and placeholder - (eq (char-after placeholder) ?<)))))) - (c-with-syntax-table c++-template-syntax-table - (goto-char placeholder) - (c-beginning-of-statement-1 lim t)) + (goto-char indent-point) + (setq placeholder (c-up-list-backward)) + (and placeholder + (eq (char-after placeholder) ?<))))) + (goto-char placeholder) + (c-beginning-of-statement-1 lim t) (if (save-excursion (c-backward-syntactic-ws lim) (eq (char-before) ?<)) @@ -12172,8 +12228,7 @@ comment at the start of cc-engine.el for more info." (and (looking-at c-class-key) (zerop (c-forward-token-2 2 nil indent-point)) (if (eq (char-after) ?<) - (c-with-syntax-table c++-template-syntax-table - (zerop (c-forward-token-2 1 t indent-point))) + (zerop (c-forward-token-2 1 t indent-point)) t) (eq (char-after) ?:)))) (goto-char placeholder) @@ -12280,7 +12335,18 @@ comment at the start of cc-engine.el for more info." ;; The '}' is unbalanced. nil (c-end-of-decl-1) - (>= (point) indent-point)))))) + (>= (point) indent-point)))) + ;; Check that we only have one brace block here, i.e. that we + ;; don't have something like a function with a struct + ;; declaration as its type. + (save-excursion + (or (not (and state-cache (consp (car state-cache)))) + ;; The above probably can't happen. + (progn + (goto-char placeholder) + (and (c-syntactic-re-search-forward + "{" indent-point t) + (eq (1- (point)) (caar state-cache)))))))) (goto-char placeholder) (c-add-stmt-syntax 'topmost-intro-cont nil nil containing-sexp paren-state)) @@ -12428,6 +12494,11 @@ comment at the start of cc-engine.el for more info." ;; in-expression block or brace list. C.f. cases 4, 16A ;; and 17E. ((and (eq char-after-ip ?{) + (or (not (eq (char-after containing-sexp) ?\()) + (save-excursion + (and c-opt-inexpr-brace-list-key + (eq (c-beginning-of-statement-1 lim t nil t) 'same) + (looking-at c-opt-inexpr-brace-list-key)))) (progn (setq placeholder (c-inside-bracelist-p (point) paren-state @@ -12602,23 +12673,30 @@ comment at the start of cc-engine.el for more info." (= (point) containing-sexp))) (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-close (point)) - (setq lim (c-most-enclosing-brace state-cache (point))) + (setq lim (or (save-excursion + (and + (c-back-over-member-initializers) + (point))) + (c-most-enclosing-brace state-cache (point)))) (c-beginning-of-statement-1 lim nil nil t) (c-add-stmt-syntax 'brace-list-close nil t lim paren-state))) (t - ;; Prepare for the rest of the cases below by going to the - ;; token following the opening brace - (if (consp special-brace-list) - (progn - (goto-char (car (car special-brace-list))) - (c-forward-token-2 1 nil indent-point)) - (goto-char containing-sexp)) - (forward-char) - (let ((start (point))) - (c-forward-syntactic-ws indent-point) - (goto-char (max start (c-point 'bol)))) - (c-skip-ws-forward indent-point) + ;; Prepare for the rest of the cases below by going back to the + ;; previous entry, or BOI before that, providing that this is + ;; inside the enclosing brace. + (goto-char indent-point) + (c-beginning-of-statement-1 containing-sexp nil nil t) + (when (/= (point) indent-point) + (if (> (c-point 'boi) containing-sexp) + (goto-char (c-point 'boi)) + (if (consp special-brace-list) + (progn + (goto-char (caar special-brace-list)) + (c-forward-token-2 1 nil indent-point)) + (goto-char containing-sexp)) + (forward-char) + (c-skip-ws-forward indent-point))) (cond ;; CASE 9C: we're looking at the first line in a brace-list @@ -12628,7 +12706,11 @@ comment at the start of cc-engine.el for more info." (goto-char containing-sexp)) (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-intro (point)) - (setq lim (c-most-enclosing-brace state-cache (point))) + (setq lim (or (save-excursion + (and + (c-back-over-member-initializers) + (point))) + (c-most-enclosing-brace state-cache (point)))) (c-beginning-of-statement-1 lim) (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state))) @@ -13173,6 +13255,18 @@ Cannot combine absolute offsets %S and %S in `add' method" indent))) +(def-edebug-spec c-bos-pop-state t) +(def-edebug-spec c-bos-save-error-info t) +(def-edebug-spec c-state-cache-top-lparen t) +(def-edebug-spec c-state-cache-top-paren t) +(def-edebug-spec c-state-cache-after-top-paren t) +(def-edebug-spec c-state-maybe-marker (form symbolp)) +(def-edebug-spec c-record-type-id t) +(def-edebug-spec c-record-ref-id t) +(def-edebug-spec c-forward-keyword-prefixed-id t) +(def-edebug-spec c-forward-id-comma-list t) +(def-edebug-spec c-pull-open-brace (symbolp)) + (cc-provide 'cc-engine) ;; Local Variables: diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index fa9b8f354ef..79254ff7553 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -488,6 +488,9 @@ ; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn +(def-edebug-spec c-put-font-lock-face t) +(def-edebug-spec c-remove-font-lock-face t) +(def-edebug-spec c-put-font-lock-string-face t) (def-edebug-spec c-fontify-types-and-refs let*) (def-edebug-spec c-make-syntactic-matcher t) ;; If there are literal quoted or backquoted highlight specs in @@ -682,33 +685,6 @@ stuff. Used on level 1 and higher." ''c-nonbreakable-space-face))) )) -(defun c-font-lock-invalid-string () - ;; Assuming the point is after the opening character of a string, - ;; fontify that char with `font-lock-warning-face' if the string - ;; decidedly isn't terminated properly. - ;; - ;; This function does hidden buffer changes. - (let ((start (1- (point)))) - (save-excursion - (and (eq (elt (parse-partial-sexp start (c-point 'eol)) 8) start) - (if (if (eval-when-compile (integerp ?c)) - ;; Emacs - (integerp c-multiline-string-start-char) - ;; XEmacs - (characterp c-multiline-string-start-char)) - ;; There's no multiline string start char before the - ;; string, so newlines aren't allowed. - (not (eq (char-before start) c-multiline-string-start-char)) - ;; Multiline strings are allowed anywhere if - ;; c-multiline-string-start-char is t. - (not c-multiline-string-start-char)) - (if c-string-escaped-newlines - ;; There's no \ before the newline. - (not (eq (char-before (point)) ?\\)) - ;; Escaped newlines aren't supported. - t) - (c-put-font-lock-face start (1+ start) 'font-lock-warning-face))))) - (defun c-font-lock-invalid-single-quotes (limit) ;; This function will be called from font-lock for a region bounded by POINT ;; and LIMIT, as though it were to identify a keyword for @@ -749,16 +725,12 @@ casts and declarations are fontified. Used on level 2 and higher." ;; `c-recognize-<>-arglists' is set. t `(;; Put a warning face on the opener of unclosed strings that - ;; can't span lines. Later font + ;; can't span lines and on the "terminating" newlines. Later font ;; lock packages have a `font-lock-syntactic-face-function' for ;; this, but it doesn't give the control we want since any ;; fontification done inside the function will be ;; unconditionally overridden. - ,(c-make-font-lock-search-function - ;; Match a char before the string starter to make - ;; `c-skip-comments-and-strings' work correctly. - (concat ".\\(" c-string-limit-regexp "\\)") - '((c-font-lock-invalid-string))) + ("\\s|" 0 font-lock-warning-face t nil) ;; Invalid single quotes. c-font-lock-invalid-single-quotes @@ -1234,10 +1206,9 @@ casts and declarations are fontified. Used on level 2 and higher." (cons 'decl nil)) ;; We're inside a brace list. ((and (eq (char-before match-pos) ?{) - (save-excursion - (goto-char (1- match-pos)) - (consp - (c-looking-at-or-maybe-in-bracelist)))) + (c-inside-bracelist-p (1- match-pos) + (cdr (c-parse-state)) + nil)) (c-put-char-property (1- match-pos) 'c-type 'c-not-decl) (cons 'not-decl nil)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 271cc2f8464..de49ad75d3a 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -205,12 +205,13 @@ the evaluated constant value at compile time." ; ' (def-edebug-spec c-lang-defvar (&define name def-form &optional &or ("quote" symbolp) stringp)) +(def-edebug-spec c-lang-setvar (&define name def-form)) ;; Suppress "might not be defined at runtime" warning. ;; This file is only used when compiling other cc files. -;; These are defined in cl as aliases to the cl- versions. -;(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys) t) -;(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest) t) +(declare-function cl-delete-duplicates "cl-seq" (cl-seq &rest cl-keys)) +(declare-function cl-intersection "cl-seq" (cl-list1 cl-list2 &rest cl-keys)) +(declare-function cl-set-difference "cl-seq" (cl-list1 cl-list2 &rest cl-keys)) (eval-and-compile ;; Some helper functions used when building the language constants. @@ -392,27 +393,6 @@ The syntax tables aren't stored directly since they're quite large." ;; the constants in this file are evaluated. t (funcall (c-lang-const c-make-mode-syntax-table))) -(c-lang-defconst c++-make-template-syntax-table - ;; A variant of `c++-mode-syntax-table' that defines `<' and `>' as - ;; parenthesis characters. Used temporarily when template argument - ;; lists are parsed. Note that this encourages incorrect parsing of - ;; templates since they might contain normal operators that uses the - ;; '<' and '>' characters. Therefore this syntax table might go - ;; away when CC Mode handles templates correctly everywhere. WHILE - ;; THIS SYNTAX TABLE IS CURRENT, `c-parse-state' MUST _NOT_ BE - ;; CALLED!!! - t nil - (java c++) `(lambda () - (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table)))) - (modify-syntax-entry ?< "(>" table) - (modify-syntax-entry ?> ")<" table) - table))) -(c-lang-defvar c++-template-syntax-table - (and (c-lang-const c++-make-template-syntax-table) - ;; The next eval remove a superfluous ' from '(lambda. This - ;; gets rid of compilation warnings. - (funcall (eval (c-lang-const c++-make-template-syntax-table))))) - (c-lang-defconst c-make-no-parens-syntax-table ;; A variant of the standard syntax table which is used to find matching ;; "<"s and ">"s which have been marked as parens using syntax table @@ -472,21 +452,24 @@ so that all identifiers are recognized as words.") (c-lang-defconst c-get-state-before-change-functions ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. - t nil + t 'c-before-change-check-unbalanced-strings c++ '(c-extend-region-for-CPP c-before-change-check-raw-strings c-before-change-check-<>-operators c-depropertize-CPP c-invalidate-macro-cache c-truncate-bs-cache + c-before-change-check-unbalanced-strings c-parse-quotes-before-change) (c objc) '(c-extend-region-for-CPP c-depropertize-CPP c-invalidate-macro-cache c-truncate-bs-cache + c-before-change-check-unbalanced-strings c-parse-quotes-before-change) - java 'c-parse-quotes-before-change - ;; 'c-before-change-check-<>-operators + java '(c-parse-quotes-before-change + c-before-change-check-unbalanced-strings + c-before-change-check-<>-operators) awk 'c-awk-record-region-clear-NL) (c-lang-defvar c-get-state-before-change-functions (let ((fs (c-lang-const c-get-state-before-change-functions))) @@ -514,14 +497,17 @@ parameters \(point-min) and \(point-max).") ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. t '(c-depropertize-new-text + c-after-change-re-mark-unbalanced-strings c-change-expand-fl-region) (c objc) '(c-depropertize-new-text c-parse-quotes-after-change + c-after-change-re-mark-unbalanced-strings c-extend-font-lock-region-for-macros c-neutralize-syntax-in-CPP c-change-expand-fl-region) c++ '(c-depropertize-new-text c-parse-quotes-after-change + c-after-change-re-mark-unbalanced-strings c-extend-font-lock-region-for-macros c-after-change-re-mark-raw-strings c-neutralize-syntax-in-CPP @@ -529,6 +515,7 @@ parameters \(point-min) and \(point-max).") c-change-expand-fl-region) java '(c-depropertize-new-text c-parse-quotes-after-change + c-after-change-re-mark-unbalanced-strings c-restore-<>-properties c-change-expand-fl-region) awk '(c-depropertize-new-text @@ -611,12 +598,31 @@ EOL terminated statements." (c c++ objc) t) (c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields)) +(c-lang-defconst c-single-quotes-quote-strings + "Whether the language uses single quotes for multi-char strings." + t nil) +(c-lang-defvar c-single-quotes-quote-strings + (c-lang-const c-single-quotes-quote-strings)) + +(c-lang-defconst c-string-delims + "A list of characters which can delimit arbitrary length strings" + t (if (c-lang-const c-single-quotes-quote-strings) + '(?\" ?\') + '(?\"))) +(c-lang-defvar c-string-delims (c-lang-const c-string-delims)) + (c-lang-defconst c-has-quoted-numbers "Whether the language has numbers quoted like 4'294'967'295." t nil c++ t) (c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers)) +(c-lang-defconst c-has-compound-literals + "Whether literal initializers {...} are used other than in initializations." + t nil + (c c++) t) +(c-lang-defvar c-has-compound-literals (c-lang-const c-has-compound-literals)) + (c-lang-defconst c-modified-constant "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\", a “long character”. In particular, this recognizes forms of constant @@ -850,6 +856,28 @@ literal are multiline." (c-lang-defvar c-multiline-string-start-char (c-lang-const c-multiline-string-start-char)) +(c-lang-defconst c-string-innards-re-alist + ;; An alist of regexps matching the innards of a string, the key being the + ;; string's delimiter. + ;; + ;; The regexps' matches extend up to, but not including, the closing string + ;; delimiter or an unescaped NL. An EOL is part of the string only if it is + ;; escaped. + t (mapcar (lambda (delim) + (cons + delim + (concat "\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\\\n\r" + (string delim) + "]\\)*"))) + (and + (or (null (c-lang-const c-multiline-string-start-char)) + (c-characterp (c-lang-const c-multiline-string-start-char))) + (if (c-lang-const c-single-quotes-quote-strings) + '(?\" ?\') + '(?\"))))) +(c-lang-defvar c-string-innards-re-alist + (c-lang-const c-string-innards-re-alist)) + (c-lang-defconst c-opt-cpp-symbol "The symbol which starts preprocessor constructs when in the margin." t "#" @@ -1274,7 +1302,7 @@ operators." (c--set-difference (c-lang-const c-assignment-operators) '("=") :test 'string-equal))) - "\\<\\>")) + "a\\`")) ; Doesn't match anything. (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) @@ -1497,7 +1525,7 @@ properly." ;; language) t (if (c-lang-const c-block-comment-ender) (regexp-quote (c-lang-const c-block-comment-ender)) - "\\<\\>")) + "a\\`")) ; Doesn't match anything. (c-lang-defvar c-block-comment-ender-regexp (c-lang-const c-block-comment-ender-regexp)) @@ -1516,7 +1544,7 @@ properly." ;; language) t (if (c-lang-const c-block-comment-starter) (regexp-quote (c-lang-const c-block-comment-starter)) - "\\<\\>")) + "a\\`")) ; Doesn't match anything. (c-lang-defvar c-block-comment-start-regexp (c-lang-const c-block-comment-start-regexp)) @@ -1525,7 +1553,7 @@ properly." ;; language; it does in all 7 CC Mode languages). t (if (c-lang-const c-line-comment-starter) (regexp-quote (c-lang-const c-line-comment-starter)) - "\\<\\>")) + "a\\`")) ; Doesn't match anything. (c-lang-defvar c-line-comment-start-regexp (c-lang-const c-line-comment-start-regexp)) @@ -1540,7 +1568,7 @@ properly." (c-lang-defconst c-doc-comment-start-regexp "Regexp to match the start of documentation comments." - t "\\<\\>" + t "a\\`" ; Doesn't match anything. ;; From font-lock.el: `doxygen' uses /*! while others use /**. (c c++ objc) "/\\*[*!]" java "/\\*\\*" @@ -2101,6 +2129,18 @@ will be handled." "Alist associating keywords in c-other-decl-block-decl-kwds with their matching \"in\" syntactic symbols.") +(c-lang-defconst c-defun-type-name-decl-kwds + "Keywords introducing a named block, where the name is a \"defun\" + name." + t (append (c-lang-const c-class-decl-kwds) + (c-lang-const c-brace-list-decl-kwds))) + +(c-lang-defconst c-defun-type-name-decl-key + ;; Regexp matching a keyword in `c-defun-name-decl-kwds'. + t (c-make-keywords-re t (c-lang-const c-defun-type-name-decl-kwds))) +(c-lang-defvar c-defun-type-name-decl-key + (c-lang-const c-defun-type-name-decl-key)) + (c-lang-defconst c-typedef-decl-kwds "Keywords introducing declarations where the identifier(s) being declared are types. @@ -2150,6 +2190,18 @@ will be handled." pike (append (c-lang-const c-class-decl-kwds) '("constant"))) +(c-lang-defconst c-equals-type-clause-kwds + "Keywords which are followed by an identifier then an \"=\" + sign, which declares the identifier to be a type." + t nil + c++ '("using")) + +(c-lang-defconst c-equals-type-clause-key + ;; A regular expression which matches any member of + ;; `c-equals-type-clause-kwds'. + t (c-make-keywords-re t (c-lang-const c-equals-type-clause-kwds))) +(c-lang-defvar c-equals-type-clause-key (c-lang-const c-equals-type-clause-key)) + (c-lang-defconst c-modifier-kwds "Keywords that can prefix normal declarations of identifiers \(and typically act as flags). Things like argument declarations @@ -2443,7 +2495,11 @@ regexp if `c-colon-type-list-kwds' isn't nil." ;; before the ":" that starts the inherit list after "class" ;; or "struct" in C++. (Also used as default for other ;; languages.) - "[^][{}();,/#=:]*:")) + (if (c-lang-const c-opt-identifier-concat-key) + (concat "\\([^][{}();,/#=:]\\|" + (c-lang-const c-opt-identifier-concat-key) + "\\)*:") + "[^][{}();,/#=:]*:"))) (c-lang-defvar c-colon-type-list-re (c-lang-const c-colon-type-list-re)) (c-lang-defconst c-paren-nontype-kwds @@ -2569,6 +2625,17 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-const c-block-stmt-2-kwds)) :test 'string-equal)) +(c-lang-defconst c-block-stmt-hangon-kwds + "Keywords which may directly follow a member of `c-block-stmt-1/2-kwds'." + t nil + c++ '("constexpr")) + +(c-lang-defconst c-block-stmt-hangon-key + ;; Regexp matching a "hangon" keyword in a `c-block-stmt-1/2-kwds' + ;; construct. + t (c-make-keywords-re t (c-lang-const c-block-stmt-hangon-kwds))) +(c-lang-defvar c-block-stmt-hangon-key (c-lang-const c-block-stmt-hangon-key)) + (c-lang-defconst c-opt-block-stmt-key ;; Regexp matching the start of any statement that has a ;; substatement (except a bare block). Nil in languages that @@ -2972,7 +3039,7 @@ Note that Java specific rules are currently applied to tell this from "Regexp matching a keyword that is followed by a colon, where the whole construct can precede a declaration. E.g. \"public:\" in C++." - t "\\<\\>" + t "a\\`" ; Doesn't match anything. c++ (c-make-keywords-re t (c-lang-const c-protection-kwds))) (c-lang-defvar c-decl-start-colon-kwd-re (c-lang-const c-decl-start-colon-kwd-re)) @@ -3153,7 +3220,7 @@ Identifier syntax is in effect when this is matched \(see t (if (c-lang-const c-type-modifier-kwds) (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>") ;; Default to a regexp that never matches. - "\\<\\>") + "a\\`") ;; Check that there's no "=" afterwards to avoid matching tokens ;; like "*=". (c objc) (concat "\\(" @@ -3191,7 +3258,7 @@ that might precede the identifier in a declaration, e.g. the as the end of the operator. Identifier syntax is in effect when this is matched \(see `c-identifier-syntax-table')." t ;; Default to a regexp that never matches. - "\\<\\>" + "a\\`" ;; Check that there's no "=" afterwards to avoid matching tokens ;; like "*=". (c objc) (concat "\\(\\*\\)" @@ -3350,7 +3417,7 @@ list." (c-lang-defconst c-pre-id-bracelist-key "A regexp matching tokens which, preceding an identifier, signify a bracelist. " - t "\\<\\>" + t "a\\`" ; Doesn't match anything. c++ "new\\([^[:alnum:]_$]\\|$\\)\\|&&?\\(\\S.\\|$\\)") (c-lang-defvar c-pre-id-bracelist-key (c-lang-const c-pre-id-bracelist-key)) @@ -3406,7 +3473,7 @@ the invalidity of the putative template construct." ;; before the '{' of the enum list, to avoid searching too far. "[^][{};/#=]*" "{") - "\\<\\>")) + "a\\`")) ; Doesn't match anything. (c-lang-defvar c-enum-clause-introduction-re (c-lang-const c-enum-clause-introduction-re)) @@ -3522,7 +3589,7 @@ i.e. before \":\". Only used if `c-recognize-colon-labels' is set." "Regexp matching things that can't occur two symbols before a colon in a label construct. This catches C++'s inheritance construct \"class foo : bar\". Only used if `c-recognize-colon-labels' is set." - t "\\<\\>" ; matches nothing + t "a\\`" ; Doesn't match anything. c++ (c-make-keywords-re t '("class"))) (c-lang-defvar c-nonlabel-token-2-key (c-lang-const c-nonlabel-token-2-key)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 664f01012b8..09c30e2bd1b 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -11,6 +11,8 @@ ;; Maintainer: bug-cc-mode@gnu.org ;; Created: a long, long, time ago. adapted from the original c-mode.el ;; Keywords: c languages +;; The version header below is used for ELPA packaging. +;; Version: 5.33.1 ;; This file is part of GNU Emacs. @@ -499,9 +501,10 @@ preferably use the `c-mode-menu' language constant directly." ;; `basic-save-buffer' does (insert ?\n) when `require-final-newline' is ;; non-nil; (ii) to detect when Emacs fails to invoke ;; `before-change-functions'. This can happen when reverting a buffer - see -;; bug #24094. It seems these failures happen only in GNU Emacs; XEmacs -;; seems to maintain the strict alternation of calls to -;; `before-change-functions' and `after-change-functions'. +;; bug #24094. It seems these failures happen only in GNU Emacs; XEmacs seems +;; to maintain the strict alternation of calls to `before-change-functions' +;; and `after-change-functions'. Note that this variable is not set when +;; `c-before-change' is invoked by a change to text properties. (defun c-basic-common-init (mode default-style) "Do the necessary initialization for the syntax handling routines @@ -563,7 +566,7 @@ that requires a literal mode spec at compile time." (when (or c-recognize-<>-arglists (c-major-mode-is 'awk-mode) - (c-major-mode-is '(java-mode c-mode c++-mode objc-mode))) + (c-major-mode-is '(java-mode c-mode c++-mode objc-mode pike-mode))) ;; We'll use the syntax-table text property to change the syntax ;; of some chars for this language, so do the necessary setup for ;; that. @@ -996,9 +999,9 @@ Note that the style variables are always made local to the buffer." ;; characters, ones which would interact syntactically with stuff outside ;; this region. ;; - ;; These are unmatched string delimiters, or unmatched - ;; parens/brackets/braces. An unclosed comment is regarded as valid, NOT - ;; obtrusive. + ;; These are unmatched parens/brackets/braces. An unclosed comment is + ;; regarded as valid, NOT obtrusive. Unbalanced strings are handled + ;; elsewhere. (save-excursion (let (s) (while @@ -1008,9 +1011,11 @@ Note that the style variables are always made local to the buffer." ((< (nth 0 s) 0) ; found an unmated ),},] (c-put-char-property (1- (point)) 'syntax-table '(1)) t) - ((nth 3 s) ; In a string - (c-put-char-property (nth 8 s) 'syntax-table '(1)) - t) + ;; Unbalanced strings are now handled by + ;; `c-before-change-check-unbalanced-strings', etc. + ;; ((nth 3 s) ; In a string + ;; (c-put-char-property (nth 8 s) 'syntax-table '(1)) + ;; t) ((> (nth 0 s) 0) ; In a (,{,[ (c-put-char-property (nth 1 s) 'syntax-table '(1)) t) @@ -1070,6 +1075,292 @@ Note that the style variables are always made local to the buffer." (forward-line)) ; no infinite loop with, e.g., "#//" ))))) +(defun c-unescaped-nls-in-string-p (&optional quote-pos) + ;; Return whether unescaped newlines can be inside strings. + ;; + ;; QUOTE-POS, if present, is the position of the opening quote of a string. + ;; Depending on the language, there might be a special character before it + ;; signifying the validity of such NLs. + (cond + ((null c-multiline-string-start-char) nil) + ((c-characterp c-multiline-string-start-char) + (and quote-pos + (eq (char-before quote-pos) c-multiline-string-start-char))) + (t t))) + +(defun c-multiline-string-start-is-being-detached (end) + ;; If (e.g.), the # character in Pike is being detached from the string + ;; opener it applies to, return t. Else return nil. END is the argument + ;; supplied to every before-change function. + (and (memq (char-after end) c-string-delims) + (c-characterp c-multiline-string-start-char) + (eq (char-before end) c-multiline-string-start-char))) + +(defun c-pps-to-string-delim (end) + ;; parse-partial-sexp forward to the next string quote, which is deemed to + ;; be a closing quote. Return nil. + ;; + ;; We remove string-fence syntax-table text properties from characters we + ;; pass over. + (let* ((start (point)) + (no-st-s `(0 nil nil ?\" nil nil 0 nil ,start nil nil)) + (st-s `(0 nil nil t nil nil 0 nil ,start nil nil)) + no-st-pos st-pos + ) + (parse-partial-sexp start end nil nil no-st-s 'syntax-table) + (setq no-st-pos (point)) + (goto-char start) + (while (progn + (parse-partial-sexp (point) end nil nil st-s 'syntax-table) + (unless (bobp) + (c-clear-char-property (1- (point)) 'syntax-table)) + (setq st-pos (point)) + (and (< (point) end) + (not (eq (char-before) ?\"))))) + (goto-char (min no-st-pos st-pos)) + nil)) + +(defun c-multiline-string-check-final-quote () + ;; Check that the final quote in the buffer is correctly marked or not with + ;; a string-fence syntax-table text propery. The return value has no + ;; significance. + (let (pos-ll pos-lt) + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "^\"") + (while + (and + (not (bobp)) + (cond + ((progn + (setq pos-ll (c-literal-limits) + pos-lt (c-literal-type pos-ll)) + (memq pos-lt '(c c++))) + ;; In a comment. + (goto-char (car pos-ll))) + ((save-excursion + (backward-char) ; over " + (eq (logand (skip-chars-backward "\\\\") 1) 1)) + ;; At an escaped string. + (backward-char) + t) + (t + ;; At a significant " + (c-clear-char-property (1- (point)) 'syntax-table) + (setq pos-ll (c-literal-limits) + pos-lt (c-literal-type pos-ll)) + nil))) + (skip-chars-backward "^\"")) + (cond + ((bobp)) + ((eq pos-lt 'string) + (c-put-char-property (1- (point)) 'syntax-table '(15))) + (t nil))))) + +(defvar c-bc-changed-stringiness nil) +;; Non-nil when, in a before-change function, the deletion of a range of text +;; will change the "stringiness" of the subsequent text. Only used when +;; `c-multiline-sting-start-char' is a non-nil value which isn't a character. + +(defun c-before-change-check-unbalanced-strings (beg end) + ;; If BEG or END is inside an unbalanced string, remove the syntax-table + ;; text property from respectively the start or end of the string. Also + ;; extend the region (c-new-BEG c-new-END) as necessary to cope with the + ;; coming change involving the insertion or deletion of an odd number of + ;; quotes. + ;; + ;; POINT is undefined both at entry to and exit from this function, the + ;; buffer will have been widened, and match data will have been saved. + ;; + ;; This function is called exclusively as a before-change function via + ;; `c-get-state-before-change-functions'. + (c-save-buffer-state + ((end-limits + (progn + (goto-char (if (c-multiline-string-start-is-being-detached end) + (1+ end) + end)) + (c-literal-limits))) + (end-literal-type (and end-limits + (c-literal-type end-limits))) + (beg-limits + (progn + (goto-char beg) + (c-literal-limits))) + (beg-literal-type (and beg-limits + (c-literal-type beg-limits)))) + + (when (eq end-literal-type 'string) + (setq c-new-END (max c-new-END (cdr end-limits)))) + ;; It is possible the buffer change will include inserting a string quote. + ;; This could have the effect of flipping the meaning of any following + ;; quotes up until the next unescaped EOL. Also guard against the change + ;; being the insertion of \ before an EOL, escaping it. + (cond + ((c-characterp c-multiline-string-start-char) + ;; The text about to be inserted might contain a multiline string + ;; opener. Set c-new-END after anything which might be affected. + ;; Go to the end of the putative multiline string. + (goto-char end) + (c-pps-to-string-delim (point-max)) + (when (< (point) (point-max)) + (while + (and + (progn + (while + (and + (c-syntactic-re-search-forward + "\"\\|\\s|" (point-max) t t) + (progn + (c-clear-char-property (1- (point)) 'syntax-table) + (not (eq (char-before) ?\"))))) + (eq (char-before) ?\")) + (progn + (c-pps-to-string-delim (point-max)) + (< (point) (point-max)))))) + (setq c-new-END (max (point) c-new-END))) + + (c-multiline-string-start-char + (setq c-bc-changed-stringiness + (not (eq (eq end-literal-type 'string) + (eq beg-literal-type 'string)))) + ;; Deal with deletion of backslashes before "s. + (goto-char end) + (if (and (looking-at "\\\\*\"") + (eq (logand (skip-chars-backward "\\\\" beg) 1) 1)) + (setq c-bc-changed-stringiness (not c-bc-changed-stringiness))) + (if (eq beg-literal-type 'string) + (setq c-new-BEG (min (car beg-limits) c-new-BEG)))) + + ((< c-new-END (point-max)) + (goto-char (1+ c-new-END)) ; might be a newline. + ;; In the following regexp, the initial \n caters for a newline getting + ;; joined to a preceding \ by the removal of what comes between. + (re-search-forward "[\n\r]?\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\\\n\r]\\)*" + nil t) + ;; We're at an EOLL or point-max. + (setq c-new-END (min (1+ (point)) (point-max))) + (goto-char c-new-END) + (if (equal (c-get-char-property (1- (point)) 'syntax-table) '(15)) + (if (memq (char-before) '(?\n ?\r)) + ;; Normally terminated invalid string. + (progn + (backward-sexp) + (c-clear-char-property (1- c-new-END) 'syntax-table) + (c-clear-char-property (point) 'syntax-table)) + ;; Opening " at EOB. + (c-clear-char-property (1- (point)) 'syntax-table)) + (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) + ;; Opening " on last line of text (without EOL). + (c-clear-char-property (point) 'syntax-table)))) + + (t (goto-char c-new-END) + (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) + (c-clear-char-property (point) 'syntax-table)))) + + (unless (and c-multiline-string-start-char + (not (c-characterp c-multiline-string-start-char))) + (when (eq end-literal-type 'string) + (c-clear-char-property (1- (cdr end-limits)) 'syntax-table)) + + (when (eq beg-literal-type 'string) + (setq c-new-BEG (min c-new-BEG (car beg-limits))) + (c-clear-char-property (car beg-limits) 'syntax-table))))) + +(defun c-after-change-re-mark-unbalanced-strings (beg end _old-len) + ;; Mark any unbalanced strings in the region (c-new-BEG c-new-END) with + ;; string fence syntax-table text properties. + ;; + ;; POINT is undefined both at entry to and exit from this function, the + ;; buffer will have been widened, and match data will have been saved. + ;; + ;; This function is called exclusively as an after-change function via + ;; `c-before-font-lock-functions'. + (if (and c-multiline-string-start-char + (not (c-characterp c-multiline-string-start-char))) + ;; Only the last " might need to be marked. + (c-save-buffer-state + ((beg-literal-limits + (progn (goto-char beg) (c-literal-limits))) + (beg-literal-type (c-literal-type beg-literal-limits)) + end-literal-limits end-literal-type) + (when (and (eq beg-literal-type 'string) + (c-get-char-property (car beg-literal-limits) 'syntax-table)) + (c-clear-char-property (car beg-literal-limits) 'syntax-table) + (setq c-bc-changed-stringiness (not c-bc-changed-stringiness))) + (setq end-literal-limits (progn (goto-char end) (c-literal-limits)) + end-literal-type (c-literal-type end-literal-limits)) + ;; Deal with the insertion of backslashes before a ". + (goto-char end) + (if (and (looking-at "\\\\*\"") + (eq (logand (skip-chars-backward "\\\\" beg) 1) 1)) + (setq c-bc-changed-stringiness (not c-bc-changed-stringiness))) + (when (eq (eq (eq beg-literal-type 'string) + (eq end-literal-type 'string)) + c-bc-changed-stringiness) + (c-multiline-string-check-final-quote))) + ;; There could be several "s needing marking. + (c-save-buffer-state + ((cll (progn (goto-char c-new-BEG) + (c-literal-limits))) + (beg-literal-type (and cll (c-literal-type cll))) + (beg-limits + (cond + ((and (eq beg-literal-type 'string) + (c-unescaped-nls-in-string-p (car cll))) + (cons + (car cll) + (progn + (goto-char (1+ (car cll))) + (search-forward-regexp + (cdr (assq (char-after (car cll)) c-string-innards-re-alist)) + nil t) + (min (1+ (point)) (point-max))))) + ((and (null beg-literal-type) + (goto-char beg) + (eq (char-before) c-multiline-string-start-char) + (memq (char-after) c-string-delims)) + (cons (point) + (progn + (forward-char) + (search-forward-regexp + (cdr (assq (char-before) c-string-innards-re-alist)) nil t) + (1+ (point))))) + (cll))) + s) + (goto-char + (cond ((null beg-literal-type) + c-new-BEG) + ((eq beg-literal-type 'string) + (car beg-limits)) + (t ; comment + (cdr beg-limits)))) + (while + (and + (< (point) c-new-END) + (progn + ;; Skip over any comments before the next string. + (while (progn + (setq s (parse-partial-sexp (point) c-new-END nil + nil s 'syntax-table)) + (and (not (nth 3 s)) + (< (point) c-new-END) + (not (memq (char-before) c-string-delims))))) + ;; We're at the start of a string. + (memq (char-before) c-string-delims))) + (if (c-unescaped-nls-in-string-p (1- (point))) + (looking-at "\\(\\\\\\(.\\|\n|\\\r\\)\\|[^\"]\\)*") + (looking-at (cdr (assq (char-before) c-string-innards-re-alist)))) + (cond + ((memq (char-after (match-end 0)) '(?\n ?\r)) + (c-put-char-property (1- (point)) 'syntax-table '(15)) + (c-put-char-property (match-end 0) 'syntax-table '(15))) + ((or (eq (match-end 0) (point-max)) + (eq (char-after (match-end 0)) ?\\)) ; \ at EOB + (c-put-char-property (1- (point)) 'syntax-table '(15)))) + (goto-char (min (1+ (match-end 0)) (point-max))) + (setq s nil))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Parsing of quotes. ;; @@ -1418,7 +1709,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; without an intervening call to `before-change-functions' when reverting ;; the buffer (see bug #24094). Whatever the cause, assume that the entire ;; buffer has changed. - (when (not c-just-done-before-change) + (when (and (not c-just-done-before-change) + (not (c-called-from-text-property-change-p))) (save-restriction (widen) (c-before-change (point-min) (point-max)) @@ -1829,6 +2121,7 @@ Key bindings: (c-common-init 'c-mode) (easy-menu-add c-c-menu) (cc-imenu-init cc-imenu-c-generic-expression) + (add-hook 'flymake-diagnostic-functions 'flymake-cc nil t) (c-run-mode-hooks 'c-mode-common-hook)) (defconst c-or-c++-mode--regexp @@ -1916,6 +2209,7 @@ Key bindings: (c-common-init 'c++-mode) (easy-menu-add c-c++-menu) (cc-imenu-init cc-imenu-c++-generic-expression) + (add-hook 'flymake-diagnostic-functions 'flymake-cc nil t) (c-run-mode-hooks 'c-mode-common-hook)) @@ -1994,7 +2288,7 @@ Key bindings: ;; since it's practically impossible to write a regexp that reliably ;; matches such a construct. Other tools are necessary. (defconst c-Java-defun-prompt-regexp - "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*") + "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*") (easy-menu-define c-java-menu java-mode-map "Java Mode Commands" (cons "Java" (c-lang-const c-mode-menu java))) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index ecf034846bd..047511406d9 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1647,8 +1647,9 @@ white space either before or after the operator, but not both." :type 'boolean :group 'c) -(defvar c-noise-macro-with-parens-name-re "\\<\\>") -(defvar c-noise-macro-name-re "\\<\\>") +;; Initialize the next two to a regexp which never matches. +(defvar c-noise-macro-with-parens-name-re "a\\`") +(defvar c-noise-macro-name-re "a\\`") (defcustom c-noise-macro-names nil "A list of names of macros which expand to nothing, or compiler extensions @@ -1677,7 +1678,7 @@ These are recognized by CC Mode only in declarations." ;; Convert `c-noise-macro-names' and `c-noise-macro-with-parens-names' into ;; `c-noise-macro-name-re' and `c-noise-macro-with-parens-name-re'. (setq c-noise-macro-with-parens-name-re - (cond ((null c-noise-macro-with-parens-names) "\\<\\>") + (cond ((null c-noise-macro-with-parens-names) "a\\`") ; Never matches. ((consp c-noise-macro-with-parens-names) (concat (regexp-opt c-noise-macro-with-parens-names t) "\\([^[:alnum:]_$]\\|$\\)")) @@ -1686,7 +1687,7 @@ These are recognized by CC Mode only in declarations." (t (error "c-make-noise-macro-regexps: \ c-noise-macro-with-parens-names is invalid: %s" c-noise-macro-with-parens-names)))) (setq c-noise-macro-name-re - (cond ((null c-noise-macro-names) "\\<\\>") + (cond ((null c-noise-macro-names) "a\\`") ; Never matches anything. ((consp c-noise-macro-names) (concat (regexp-opt c-noise-macro-names t) "\\([^[:alnum:]_$]\\|$\\)")) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 742ac80be1e..7dcfb10af0a 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -383,7 +383,8 @@ Optional arg DISPLAY non-nil means show messages in the echo area." (not (member (file-name-nondirectory shell-file-name) msdos-shells))) (eq exit-status 0)) - (zerop (nth 7 (file-attributes (expand-file-name tempname)))) + (zerop (file-attribute-size + (file-attributes (expand-file-name tempname)))) (progn (goto-char (point-min)) ;; Put the messages inside a comment, so they won't get in diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 422974379ba..7e7c18fb30e 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -100,16 +100,6 @@ compilation buffer. It should return a string. If nil, compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.") ;;;###autoload -(defvar compilation-finish-function nil - "Function to call when a compilation process finishes. -It is called with two arguments: the compilation buffer, and a string -describing how the process finished.") - -(make-obsolete-variable 'compilation-finish-function - "use `compilation-finish-functions', but it works a little differently." - "22.1") - -;;;###autoload (defvar compilation-finish-functions nil "Functions to call when a compilation process finishes. Each function is called with two arguments: the compilation buffer, @@ -2101,7 +2091,6 @@ by replacing the first word, e.g., `compilation-scroll-output' from compilation-error-regexp-alist compilation-error-regexp-alist-alist compilation-error-screen-columns - compilation-finish-function compilation-finish-functions compilation-first-column compilation-mode-font-lock-keywords @@ -2175,9 +2164,6 @@ Optional argument MINOR indicates this is called from ;;;###autoload (define-minor-mode compilation-shell-minor-mode "Toggle Compilation Shell minor mode. -With a prefix argument ARG, enable Compilation Shell minor mode -if ARG is positive, and disable it otherwise. If called from -Lisp, enable the mode if ARG is omitted or nil. When Compilation Shell minor mode is enabled, all the error-parsing commands of the Compilation major mode are @@ -2192,9 +2178,6 @@ See `compilation-mode'." ;;;###autoload (define-minor-mode compilation-minor-mode "Toggle Compilation minor mode. -With a prefix argument ARG, enable Compilation minor mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. When Compilation minor mode is enabled, all the error-parsing commands of Compilation major mode are available. See @@ -2245,9 +2228,6 @@ commands of Compilation major mode are available. See (force-mode-line-update) (if (and opoint (< opoint omax)) (goto-char opoint)) - (with-no-warnings - (if compilation-finish-function - (funcall compilation-finish-function cur-buffer msg))) (run-hook-with-args 'compilation-finish-functions cur-buffer msg))) ;; Called when compilation process changes state. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index b152b9c724d..7d0884389eb 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1,9 +1,10 @@ -;;; cperl-mode.el --- Perl code editing commands for Emacs +;;; cperl-mode.el --- Perl code editing commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985-1987, 1991-2018 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich ;; Bob Olson +;; Jonathan Rockway <jon@jrock.us> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, Perl @@ -22,10 +23,19 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org +;; Corrections made by Ilya Zakharevich ilyaz@cpan.org ;;; Commentary: +;; This version of the file contains support for the syntax added by +;; the MooseX::Declare CPAN module, as well as Perl 5.10 keyword +;; support. + +;; The latest version is available from +;; http://github.com/jrockway/cperl-mode +;; +;; (perhaps in the moosex-declare branch) + ;; You can either fine-tune the bells and whistles of this mode or ;; bulk enable them by putting @@ -56,7 +66,7 @@ ;; (define-key global-map [M-S-down-mouse-3] 'imenu) -;;; Font lock bugs as of v4.32: +;;;; Font lock bugs as of v4.32: ;; The following kinds of Perl code erroneously start strings: ;; \$` \$' \$" @@ -65,6 +75,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar vc-rcs-header) (defvar vc-sccs-header) @@ -75,37 +87,11 @@ (condition-case nil (require 'man) (error nil)) - (defvar cperl-can-font-lock - (or (featurep 'xemacs) - (and (boundp 'emacs-major-version) - (or window-system - (> emacs-major-version 20))))) - (if cperl-can-font-lock - (require 'font-lock)) (defvar msb-menu-cond) (defvar gud-perldb-history) (defvar font-lock-background-mode) ; not in Emacs (defvar font-lock-display-type) ; ditto (defvar paren-backwards-message) ; Not in newer XEmacs? - (or (fboundp 'defgroup) - (defmacro defgroup (name val doc &rest arr) - nil)) - (or (fboundp 'custom-declare-variable) - (defmacro defcustom (name val doc &rest arr) - `(defvar ,name ,val ,doc))) - (or (and (fboundp 'custom-declare-variable) - (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work - (defmacro defface (&rest arr) - nil)) - ;; Avoid warning (tmp definitions) - (or (fboundp 'x-color-defined-p) - (defmacro x-color-defined-p (col) - (cond ((fboundp 'color-defined-p) `(color-defined-p ,col)) - ;; XEmacs >= 19.12 - ((fboundp 'valid-color-name-p) `(valid-color-name-p ,col)) - ;; XEmacs 19.11 - ((fboundp 'x-valid-color-name-p) `(x-valid-color-name-p ,col)) - (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) `(find-face ,arg)) @@ -132,7 +118,7 @@ `(progn (beginning-of-line 2) (list ,file ,line))) - (defmacro cperl-etags-snarf-tag (file line) + (defmacro cperl-etags-snarf-tag (_file _line) `(etags-snarf-tag))) (if (featurep 'xemacs) (defmacro cperl-etags-goto-tag-location (elt) @@ -147,12 +133,6 @@ (defmacro cperl-etags-goto-tag-location (elt) `(etags-goto-tag-location ,elt)))) -(defvar cperl-can-font-lock - (or (featurep 'xemacs) - (and (boundp 'emacs-major-version) - (or window-system - (> emacs-major-version 20))))) - (defun cperl-choose-color (&rest list) (let (answer) (while list @@ -228,10 +208,10 @@ for constructs with multiline if/unless/while/until/for/foreach condition." :type 'integer :group 'cperl-indentation-details) -;; Is is not unusual to put both things like perl-indent-level and -;; cperl-indent-level in the local variable section of a file. If only +;; It is not unusual to put both things like perl-indent-level and +;; cperl-indent-level in the local variable section of a file. If only ;; one of perl-mode and cperl-mode is in use, a warning will be issued -;; about the variable. Autoload these here, so that no warning is +;; about the variable. Autoload these here, so that no warning is ;; issued when using either perl-mode or cperl-mode. ;;;###autoload(put 'cperl-indent-level 'safe-local-variable 'integerp) ;;;###autoload(put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -286,6 +266,11 @@ Versions 5.2 ... 5.20 behaved as if this were nil." :type 'boolean :group 'cperl-indentation-details) +(defcustom cperl-indent-subs-specially t + "Non-nil means indent subs that are inside other blocks (hash values, for example) relative to the beginning of the \"sub\" keyword, rather than relative to the statement that contains the declaration." + :type 'boolean + :group 'cperl-indentation-details) + (defcustom cperl-auto-newline nil "Non-nil means automatically newline before and after braces, and after colons and semicolons, inserted in CPerl code. The following @@ -405,13 +390,6 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space', :type '(repeat string) :group 'cperl) -;; This became obsolete... -(defvar cperl-vc-header-alist nil) -(make-obsolete-variable - 'cperl-vc-header-alist - "use cperl-vc-rcs-header or cperl-vc-sccs-header instead." - "22.1") - ;; (defcustom cperl-clobber-mode-lists ;; (not ;; (and @@ -458,7 +436,7 @@ Font for POD headers." :type 'face :group 'cperl-faces) -;;; Some double-evaluation happened with font-locks... Needed with 21.2... +;; Some double-evaluation happened with font-locks... Needed with 21.2... (defvar cperl-singly-quote-face (featurep 'xemacs)) (defcustom cperl-invalid-face 'underline @@ -612,8 +590,7 @@ One should tune up `cperl-close-paren-offset' as well." :group 'cperl-indentation-details) (defcustom cperl-syntaxify-by-font-lock - (and cperl-can-font-lock - (boundp 'parse-sexp-lookup-properties)) + (boundp 'parse-sexp-lookup-properties) "Non-nil means that CPerl uses the `font-lock' routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) @@ -1010,33 +987,15 @@ In regular expressions (including character classes): (and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) -(defun cperl-mark-active () (mark)) ; Avoid undefined warning -(if (featurep 'xemacs) - (progn - ;; "Active regions" are on: use region only if active - ;; "Active regions" are off: use region unconditionally - (defun cperl-use-region-p () - (if zmacs-regions (mark) t))) - (defun cperl-use-region-p () - (if transient-mark-mode mark-active t)) - (defun cperl-mark-active () mark-active)) - -(defsubst cperl-enable-font-lock () - cperl-can-font-lock) - (defun cperl-putback-char (c) ; Emacs 19 (push c unread-command-events)) ; Avoid undefined warning (if (featurep 'xemacs) (defun cperl-putback-char (c) ; XEmacs >= 19.12 - (push (eval '(character-to-event c)) unread-command-events))) - -(or (fboundp 'uncomment-region) - (defun uncomment-region (beg end) - (interactive "r") - (comment-region beg end -1))) + (push (character-to-event c) unread-command-events))) (defvar cperl-do-not-fontify + ;; FIXME: This is not doing what it claims! (if (string< emacs-version "19.30") 'fontified 'lazy-lock) @@ -1056,8 +1015,6 @@ In regular expressions (including character classes): (defvar cperl-syntax-state nil) (defvar cperl-syntax-done-to nil) -(defvar cperl-emacs-can-parse (> (length (save-excursion - (parse-partial-sexp (point) (point)))) 9)) ;; Make customization possible "in reverse" (defsubst cperl-val (symbol &optional default hairy) @@ -1085,141 +1042,126 @@ versions of Emacs." (put-text-property (point) (match-end 0) 'syntax-type prop))))))) -;;; Probably it is too late to set these guys already, but it can help later: +;; Probably it is too late to set these guys already, but it can help later: -;;;(and cperl-clobber-mode-lists -;;;(setq auto-mode-alist -;;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) -;;;(and (boundp 'interpreter-mode-alist) -;;; (setq interpreter-mode-alist (append interpreter-mode-alist -;;; '(("miniperl" . perl-mode)))))) +;;(and cperl-clobber-mode-lists +;;(setq auto-mode-alist +;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist )) +;;(and (boundp 'interpreter-mode-alist) +;; (setq interpreter-mode-alist (append interpreter-mode-alist +;; '(("miniperl" . perl-mode)))))) (eval-when-compile - (mapc (lambda (p) - (condition-case nil - (require p) - (error nil))) - '(imenu easymenu etags timer man info)) - (if (fboundp 'ps-extend-face-list) - (defmacro cperl-ps-extend-face-list (arg) - `(ps-extend-face-list ,arg)) - (defmacro cperl-ps-extend-face-list (arg) - `(error "This version of Emacs has no `ps-extend-face-list'"))) - ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, - ;; macros instead of defsubsts don't work on Emacs, so we do the - ;; expansion manually. Any other suggestions? - (require 'cl)) - -(define-abbrev-table 'cperl-mode-abbrev-table - '( - ("if" "if" cperl-electric-keyword :system t) - ("elsif" "elsif" cperl-electric-keyword :system t) - ("while" "while" cperl-electric-keyword :system t) - ("until" "until" cperl-electric-keyword :system t) - ("unless" "unless" cperl-electric-keyword :system t) - ("else" "else" cperl-electric-else :system t) - ("continue" "continue" cperl-electric-else :system t) - ("for" "for" cperl-electric-keyword :system t) - ("foreach" "foreach" cperl-electric-keyword :system t) - ("formy" "formy" cperl-electric-keyword :system t) - ("foreachmy" "foreachmy" cperl-electric-keyword :system t) - ("do" "do" cperl-electric-keyword :system t) - ("=pod" "=pod" cperl-electric-pod :system t) - ("=over" "=over" cperl-electric-pod :system t) - ("=head1" "=head1" cperl-electric-pod :system t) - ("=head2" "=head2" cperl-electric-pod :system t) - ("pod" "pod" cperl-electric-pod :system t) - ("over" "over" cperl-electric-pod :system t) - ("head1" "head1" cperl-electric-pod :system t) - ("head2" "head2" cperl-electric-pod :system t)) - "Abbrev table in use in CPerl mode buffers.") - -(add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))) - -(defvar cperl-mode-map () "Keymap used in CPerl mode.") - -(if cperl-mode-map nil - (setq cperl-mode-map (make-sparse-keymap)) - (cperl-define-key "{" 'cperl-electric-lbrace) - (cperl-define-key "[" 'cperl-electric-paren) - (cperl-define-key "(" 'cperl-electric-paren) - (cperl-define-key "<" 'cperl-electric-paren) - (cperl-define-key "}" 'cperl-electric-brace) - (cperl-define-key "]" 'cperl-electric-rparen) - (cperl-define-key ")" 'cperl-electric-rparen) - (cperl-define-key ";" 'cperl-electric-semi) - (cperl-define-key ":" 'cperl-electric-terminator) - (cperl-define-key "\C-j" 'newline-and-indent) - (cperl-define-key "\C-c\C-j" 'cperl-linefeed) - (cperl-define-key "\C-c\C-t" 'cperl-invert-if-unless) - (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline) - (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev) - (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix) - (cperl-define-key "\C-c\C-f" 'auto-fill-mode) - (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric) - (cperl-define-key "\C-c\C-b" 'cperl-find-bad-style) - (cperl-define-key "\C-c\C-p" 'cperl-pod-spell) - (cperl-define-key "\C-c\C-d" 'cperl-here-doc-spell) - (cperl-define-key "\C-c\C-n" 'cperl-narrow-to-here-doc) - (cperl-define-key "\C-c\C-v" 'cperl-next-interpolated-REx) - (cperl-define-key "\C-c\C-x" 'cperl-next-interpolated-REx-0) - (cperl-define-key "\C-c\C-y" 'cperl-next-interpolated-REx-1) - (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp) - (cperl-define-key "\C-c\C-hp" 'cperl-perldoc) - (cperl-define-key "\C-c\C-hP" 'cperl-perldoc-at-point) - (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound - (cperl-define-key [?\C-\M-\|] 'cperl-lineup - [(control meta |)]) - ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph) - ;;(cperl-define-key "\e;" 'cperl-indent-for-comment) - (cperl-define-key "\177" 'cperl-electric-backspace) - (cperl-define-key "\t" 'cperl-indent-command) - ;; don't clobber the backspace binding: - (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command - [(control c) (control h) F]) - (if (cperl-val 'cperl-clobber-lisp-bindings) - (progn - (cperl-define-key "\C-hf" - ;;(concat (char-to-string help-char) "f") ; does not work - 'cperl-info-on-command - [(control h) f]) - (cperl-define-key "\C-hv" - ;;(concat (char-to-string help-char) "v") ; does not work - 'cperl-get-help - [(control h) v]) - (cperl-define-key "\C-c\C-hf" - ;;(concat (char-to-string help-char) "f") ; does not work - (key-binding "\C-hf") - [(control c) (control h) f]) - (cperl-define-key "\C-c\C-hv" - ;;(concat (char-to-string help-char) "v") ; does not work - (key-binding "\C-hv") - [(control c) (control h) v])) - (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command - [(control c) (control h) f]) - (cperl-define-key "\C-c\C-hv" - ;;(concat (char-to-string help-char) "v") ; does not work - 'cperl-get-help - [(control c) (control h) v])) - (if (and (featurep 'xemacs) - (<= emacs-minor-version 11) (<= emacs-major-version 19)) - (progn - ;; substitute-key-definition is usefulness-deenhanced... - ;;;;;(cperl-define-key "\M-q" 'cperl-fill-paragraph) - (cperl-define-key "\e;" 'cperl-indent-for-comment) - (cperl-define-key "\e\C-\\" 'cperl-indent-region)) + (mapc #'require '(imenu easymenu etags timer man info))) + +(define-abbrev-table 'cperl-mode-electric-keywords-abbrev-table + (mapcar (lambda (x) + (let ((name (car x)) + (fun (cadr x))) + (list name name fun :system t))) + '(("if" cperl-electric-keyword) + ("elsif" cperl-electric-keyword) + ("while" cperl-electric-keyword) + ("until" cperl-electric-keyword) + ("unless" cperl-electric-keyword) + ("else" cperl-electric-else) + ("continue" cperl-electric-else) + ("for" cperl-electric-keyword) + ("foreach" cperl-electric-keyword) + ("formy" cperl-electric-keyword) + ("foreachmy" cperl-electric-keyword) + ("do" cperl-electric-keyword) + ("=pod" cperl-electric-pod) + ("=begin" cperl-electric-pod t) + ("=over" cperl-electric-pod) + ("=head1" cperl-electric-pod) + ("=head2" cperl-electric-pod) + ("pod" cperl-electric-pod) + ("over" cperl-electric-pod) + ("head1" cperl-electric-pod) + ("head2" cperl-electric-pod))) + "Abbrev table for electric keywords. Controlled by `cperl-electric-keywords'." + :case-fixed t + :enable-function (lambda () (cperl-val 'cperl-electric-keywords))) + +(define-abbrev-table 'cperl-mode-abbrev-table () + "Abbrev table in use in CPerl mode buffers." + :parents (list cperl-mode-electric-keywords-abbrev-table)) + +(when (boundp 'edit-var-mode-alist) + ;; FIXME: What package uses this? + (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))) + +(defvar cperl-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "{" 'cperl-electric-lbrace) + (define-key map "[" 'cperl-electric-paren) + (define-key map "(" 'cperl-electric-paren) + (define-key map "<" 'cperl-electric-paren) + (define-key map "}" 'cperl-electric-brace) + (define-key map "]" 'cperl-electric-rparen) + (define-key map ")" 'cperl-electric-rparen) + (define-key map ";" 'cperl-electric-semi) + (define-key map ":" 'cperl-electric-terminator) + (define-key map "\C-j" 'newline-and-indent) + (define-key map "\C-c\C-j" 'cperl-linefeed) + (define-key map "\C-c\C-t" 'cperl-invert-if-unless) + (define-key map "\C-c\C-a" 'cperl-toggle-auto-newline) + (define-key map "\C-c\C-k" 'cperl-toggle-abbrev) + (define-key map "\C-c\C-w" 'cperl-toggle-construct-fix) + (define-key map "\C-c\C-f" 'auto-fill-mode) + (define-key map "\C-c\C-e" 'cperl-toggle-electric) + (define-key map "\C-c\C-b" 'cperl-find-bad-style) + (define-key map "\C-c\C-p" 'cperl-pod-spell) + (define-key map "\C-c\C-d" 'cperl-here-doc-spell) + (define-key map "\C-c\C-n" 'cperl-narrow-to-here-doc) + (define-key map "\C-c\C-v" 'cperl-next-interpolated-REx) + (define-key map "\C-c\C-x" 'cperl-next-interpolated-REx-0) + (define-key map "\C-c\C-y" 'cperl-next-interpolated-REx-1) + (define-key map "\C-c\C-ha" 'cperl-toggle-autohelp) + (define-key map "\C-c\C-hp" 'cperl-perldoc) + (define-key map "\C-c\C-hP" 'cperl-perldoc-at-point) + (define-key map "\e\C-q" 'cperl-indent-exp) ; Usually not bound + (define-key map [(control meta ?|)] 'cperl-lineup) + ;;(define-key map "\M-q" 'cperl-fill-paragraph) + ;;(define-key map "\e;" 'cperl-indent-for-comment) + (define-key map "\177" 'cperl-electric-backspace) + (define-key map "\t" 'cperl-indent-command) + ;; don't clobber the backspace binding: + (define-key map [(control ?c) (control ?h) ?F] 'cperl-info-on-command) + (if (cperl-val 'cperl-clobber-lisp-bindings) + (progn + (define-key map [(control ?h) ?f] + ;;(concat (char-to-string help-char) "f") ; does not work + 'cperl-info-on-command) + (define-key map [(control ?h) ?v] + ;;(concat (char-to-string help-char) "v") ; does not work + 'cperl-get-help) + (define-key map [(control ?c) (control ?h) ?f] + ;;(concat (char-to-string help-char) "f") ; does not work + (key-binding "\C-hf")) + (define-key map [(control ?c) (control ?h) ?v] + ;;(concat (char-to-string help-char) "v") ; does not work + (key-binding "\C-hv"))) + (define-key map [(control ?c) (control ?h) ?f] + 'cperl-info-on-current-command) + (define-key map [(control ?c) (control ?h) ?v] + ;;(concat (char-to-string help-char) "v") ; does not work + 'cperl-get-help)) (or (boundp 'fill-paragraph-function) - (substitute-key-definition - 'fill-paragraph 'cperl-fill-paragraph - cperl-mode-map global-map)) + (substitute-key-definition + 'fill-paragraph 'cperl-fill-paragraph + map global-map)) (substitute-key-definition 'indent-sexp 'cperl-indent-exp - cperl-mode-map global-map) + map global-map) (substitute-key-definition 'indent-region 'cperl-indent-region - cperl-mode-map global-map) + map global-map) (substitute-key-definition 'indent-for-comment 'cperl-indent-for-comment - cperl-mode-map global-map))) + map global-map) + map) + "Keymap used in CPerl mode.") (defvar cperl-menu) (defvar cperl-lazy-installed) @@ -1236,7 +1178,7 @@ versions of Emacs." ["Indent expression" cperl-indent-exp t] ["Fill paragraph/comment" fill-paragraph t] "----" - ["Line up a construction" cperl-lineup (cperl-use-region-p)] + ["Line up a construction" cperl-lineup (use-region-p)] ["Invert if/unless/while etc" cperl-invert-if-unless t] ("Regexp" ["Beautify" cperl-beautify-regexp @@ -1264,9 +1206,9 @@ versions of Emacs." ["Insert spaces if needed to fix style" cperl-find-bad-style t] ["Refresh \"hard\" constructions" cperl-find-pods-heres t] "----" - ["Indent region" cperl-indent-region (cperl-use-region-p)] - ["Comment region" cperl-comment-region (cperl-use-region-p)] - ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)] + ["Indent region" cperl-indent-region (use-region-p)] + ["Comment region" cperl-comment-region (use-region-p)] + ["Uncomment region" cperl-uncomment-region (use-region-p)] "----" ["Run" mode-compile (fboundp 'mode-compile)] ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill) @@ -1313,7 +1255,7 @@ versions of Emacs." (fboundp 'ps-extend-face-list)] "----" ["Syntaxify region" cperl-find-pods-heres-region - (cperl-use-region-p)] + (use-region-p)] ["Profile syntaxification" cperl-time-fontification t] ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t] ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t] @@ -1323,15 +1265,15 @@ versions of Emacs." ["Class Hierarchy from TAGS" cperl-tags-hier-init t] ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] ("Tags" -;;; ["Create tags for current file" cperl-etags t] -;;; ["Add tags for current file" (cperl-etags t) t] -;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] -;;; ["Add tags for Perl files in directory" (cperl-etags t t) t] -;;; ["Create tags for Perl files in (sub)directories" -;;; (cperl-etags nil 'recursive) t] -;;; ["Add tags for Perl files in (sub)directories" -;;; (cperl-etags t 'recursive) t]) -;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) + ;; ["Create tags for current file" cperl-etags t] + ;; ["Add tags for current file" (cperl-etags t) t] + ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] + ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] + ;; ["Create tags for Perl files in (sub)directories" + ;; (cperl-etags nil 'recursive) t] + ;; ["Add tags for Perl files in (sub)directories" + ;; (cperl-etags t 'recursive) t]) + ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) ["Create tags for current file" (cperl-write-tags nil t) t] ["Add tags for current file" (cperl-write-tags) t] ["Create tags for Perl files in directory" @@ -1352,11 +1294,9 @@ versions of Emacs." ["Perldoc on word at point" cperl-perldoc-at-point t] ["View manpage of POD in this file" cperl-build-manpage t] ["Auto-help on" cperl-lazy-install - (and (fboundp 'run-with-idle-timer) - (not cperl-lazy-installed))] + (not cperl-lazy-installed)] ["Auto-help off" cperl-lazy-unstall - (and (fboundp 'run-with-idle-timer) - cperl-lazy-installed)]) + cperl-lazy-installed]) ("Toggle..." ["Auto newline" cperl-toggle-auto-newline t] ["Electric parens" cperl-toggle-electric t] @@ -1383,7 +1323,8 @@ versions of Emacs." ["CPerl mode" (describe-function 'cperl-mode) t] ["CPerl version" (message "The version of master-file for this CPerl is %s-Emacs" - cperl-version) t])))) + cperl-version) + t])))) (error nil)) (autoload 'c-macro-expand "cmacexp" @@ -1391,22 +1332,22 @@ versions of Emacs." The expansion is entirely correct because it uses the C preprocessor." t) -;;; These two must be unwound, otherwise take exponential time +;; These two must be unwound, otherwise take exponential time (defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" "Regular expression to match optional whitespace with interspersed comments. Should contain exactly one group.") -;;; This one is tricky to unwind; still very inefficient... +;; This one is tricky to unwind; still very inefficient... (defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+" "Regular expression to match whitespace with interspersed comments. Should contain exactly one group.") -;;; Is incorporated in `cperl-imenu--function-name-regexp-perl' -;;; `cperl-outline-regexp', `defun-prompt-regexp'. -;;; Details of groups in this may be used in several functions; see comments -;;; near mentioned above variable(s)... -;;; sub($$):lvalue{} sub:lvalue{} Both allowed... +;; Is incorporated in `cperl-imenu--function-name-regexp-perl' +;; `cperl-outline-regexp', `defun-prompt-regexp'. +;; Details of groups in this may be used in several functions; see comments +;; near mentioned above variable(s)... +;; sub($$):lvalue{} sub:lvalue{} Both allowed... (defsubst cperl-after-sub-regexp (named attr) ; 9 groups without attr... "Match the text after `sub' in a subroutine declaration. If NAMED is nil, allows anonymous subroutines. Matches up to the first \":\" @@ -1441,9 +1382,22 @@ the last)." "\\)?" ; END n+6=proto-group )) -;;; Details of groups in this are used in `cperl-imenu--create-perl-index' -;;; and `cperl-outline-level'. -;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) +;; Tired of editing this in 8 places every time I remember that there +;; is another method-defining keyword +(defvar cperl-sub-keywords + '("sub")) + +(defvar cperl-sub-regexp (regexp-opt cperl-sub-keywords)) + +(defun cperl-char-ends-sub-keyword-p (char) + "Return T if CHAR is the last character of a perl sub keyword." + (cl-loop for keyword in cperl-sub-keywords + when (eq char (aref keyword (1- (length keyword)))) + return t)) + +;; Details of groups in this are used in `cperl-imenu--create-perl-index' +;; and `cperl-outline-level'. +;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) (defvar cperl-imenu--function-name-regexp-perl (concat "^\\(" ; 1 = all @@ -1452,7 +1406,8 @@ the last)." cperl-white-and-comment-rex ; 4 = pre-package-name "\\([a-zA-Z_0-9:']+\\)\\)?\\)" ; 5 = package-name "\\|" - "[ \t]*sub" + "[ \t]*" + cperl-sub-regexp (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start cperl-maybe-white-and-comment-rex ; 15=pre-block "\\|" @@ -1624,7 +1579,7 @@ It is possible to show this help automatically after some idle time. This is regulated by variable `cperl-lazy-help-time'. Default with `cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5 secs idle time . It is also possible to switch this on/off from the -menu, or via \\[cperl-toggle-autohelp]. Requires `run-with-idle-timer'. +menu, or via \\[cperl-toggle-autohelp]. Use \\[cperl-lineup] to vertically lineup some construction - put the beginning of the region at the start of construction, and make region @@ -1719,107 +1674,73 @@ or as help on variables `cperl-tips', `cperl-problems', ;; Until Emacs is multi-threaded, we do not actually need it local: (make-local-variable 'cperl-font-lock-multiline-start) (make-local-variable 'cperl-font-locking) - (make-local-variable 'outline-regexp) - ;; (setq outline-regexp imenu-example--function-name-regexp-perl) - (setq outline-regexp cperl-outline-regexp) - (make-local-variable 'outline-level) - (setq outline-level 'cperl-outline-level) - (make-local-variable 'add-log-current-defun-function) - (setq add-log-current-defun-function + (set (make-local-variable 'outline-regexp) cperl-outline-regexp) + (set (make-local-variable 'outline-level) 'cperl-outline-level) + (set (make-local-variable 'add-log-current-defun-function) (lambda () (save-excursion (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) (match-string-no-properties 1))))) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) + (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (if (featurep 'xemacs) - (progn - (make-local-variable 'paren-backwards-message) - (set 'paren-backwards-message t))) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'cperl-indent-line) - (make-local-variable 'require-final-newline) - (setq require-final-newline mode-require-final-newline) - (make-local-variable 'comment-start) - (setq comment-start "# ") - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-column) - (setq comment-column cperl-comment-column) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "#+ *") - (make-local-variable 'defun-prompt-regexp) -;;; "[ \t]*sub" -;;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start -;;; cperl-maybe-white-and-comment-rex ; 15=pre-block - (setq defun-prompt-regexp - (concat "^[ \t]*\\(sub" - (cperl-after-sub-regexp 'named 'attr-groups) - "\\|" ; per toke.c - "\\(BEGIN\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)" - "\\)" - cperl-maybe-white-and-comment-rex)) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'cperl-comment-indent) + (set (make-local-variable 'paren-backwards-message) t)) + (set (make-local-variable 'indent-line-function) #'cperl-indent-line) + (set (make-local-variable 'require-final-newline) mode-require-final-newline) + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-column) cperl-comment-column) + (set (make-local-variable 'comment-start-skip) "#+ *") + +;; "[ \t]*sub" +;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start +;; cperl-maybe-white-and-comment-rex ; 15=pre-block + (set (make-local-variable 'defun-prompt-regexp) + (concat "^[ \t]*\\(" + cperl-sub-regexp + (cperl-after-sub-regexp 'named 'attr-groups) + "\\|" ; per toke.c + "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)" + "\\)" + cperl-maybe-white-and-comment-rex)) + (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent) (and (boundp 'fill-paragraph-function) - (progn - (make-local-variable 'fill-paragraph-function) - (set 'fill-paragraph-function 'cperl-fill-paragraph))) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'indent-region-function) - (setq indent-region-function 'cperl-indent-region) - ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off! - (make-local-variable 'imenu-create-index-function) - (setq imenu-create-index-function - (function cperl-imenu--create-perl-index)) - (make-local-variable 'imenu-sort-function) - (setq imenu-sort-function nil) - (make-local-variable 'vc-rcs-header) - (set 'vc-rcs-header cperl-vc-rcs-header) - (make-local-variable 'vc-sccs-header) - (set 'vc-sccs-header cperl-vc-sccs-header) + (set (make-local-variable 'fill-paragraph-function) + #'cperl-fill-paragraph)) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'indent-region-function) #'cperl-indent-region) + ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off! + (set (make-local-variable 'imenu-create-index-function) + #'cperl-imenu--create-perl-index) + (set (make-local-variable 'imenu-sort-function) nil) + (set (make-local-variable 'vc-rcs-header) cperl-vc-rcs-header) + (set (make-local-variable 'vc-sccs-header) cperl-vc-sccs-header) (when (featurep 'xemacs) ;; This one is obsolete... - (make-local-variable 'vc-header-alist) - (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning - `((SCCS ,(car cperl-vc-sccs-header)) - (RCS ,(car cperl-vc-rcs-header)))))) + (set (make-local-variable 'vc-header-alist) + `((SCCS ,(car cperl-vc-sccs-header)) + (RCS ,(car cperl-vc-rcs-header))))) (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x - (make-local-variable 'compilation-error-regexp-alist-alist) - (set 'compilation-error-regexp-alist-alist + (set (make-local-variable 'compilation-error-regexp-alist-alist) (cons (cons 'cperl (car cperl-compilation-error-regexp-alist)) - (symbol-value 'compilation-error-regexp-alist-alist))) + compilation-error-regexp-alist-alist)) (if (fboundp 'compilation-build-compilation-error-regexp-alist) (let ((f 'compilation-build-compilation-error-regexp-alist)) (funcall f)) (make-local-variable 'compilation-error-regexp-alist) (push 'cperl compilation-error-regexp-alist))) ((boundp 'compilation-error-regexp-alist);; xemacs 19.x - (make-local-variable 'compilation-error-regexp-alist) - (set 'compilation-error-regexp-alist + (set (make-local-variable 'compilation-error-regexp-alist) (append cperl-compilation-error-regexp-alist - (symbol-value 'compilation-error-regexp-alist))))) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - (cond - ((string< emacs-version "19.30") - '(cperl-font-lock-keywords-2 nil nil ((?_ . "w")))) - ((string< emacs-version "19.33") ; Which one to use? - '((cperl-font-lock-keywords - cperl-font-lock-keywords-1 - cperl-font-lock-keywords-2) nil nil ((?_ . "w")))) - (t - '((cperl-load-font-lock-keywords - cperl-load-font-lock-keywords-1 - cperl-load-font-lock-keywords-2) nil nil ((?_ . "w")))))) - (make-local-variable 'cperl-syntax-state) - (setq cperl-syntax-state nil) ; reset syntaxification cache + compilation-error-regexp-alist)))) + (set (make-local-variable 'font-lock-defaults) + '((cperl-load-font-lock-keywords + cperl-load-font-lock-keywords-1 + cperl-load-font-lock-keywords-2) nil nil ((?_ . "w")))) + ;; Reset syntaxification cache. + (set (make-local-variable 'cperl-syntax-state) nil) (if cperl-use-syntax-table-text-property (if (eval-when-compile (fboundp 'syntax-propertize-rules)) (progn @@ -1834,21 +1755,19 @@ or as help on variables `cperl-tips', `cperl-problems', ;; to re-apply them. (setq cperl-syntax-done-to start) (cperl-fontify-syntaxically end)))) - (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! - (set 'parse-sexp-lookup-properties t) + (set (make-local-variable 'parse-sexp-lookup-properties) t) ;; Fix broken font-lock: (or (boundp 'font-lock-unfontify-region-function) - (set 'font-lock-unfontify-region-function - 'font-lock-default-unfontify-region)) + (setq font-lock-unfontify-region-function + #'font-lock-default-unfontify-region)) (unless (featurep 'xemacs) ; Our: just a plug for wrong font-lock - (make-local-variable 'font-lock-unfontify-region-function) - (set 'font-lock-unfontify-region-function ; not present with old Emacs - 'cperl-font-lock-unfontify-region-function)) - (make-local-variable 'cperl-syntax-done-to) - (setq cperl-syntax-done-to nil) ; reset syntaxification cache - (make-local-variable 'font-lock-syntactic-keywords) - (setq font-lock-syntactic-keywords + (set (make-local-variable 'font-lock-unfontify-region-function) + ;; not present with old Emacs + #'cperl-font-lock-unfontify-region-function)) + ;; Reset syntaxification cache. + (set (make-local-variable 'cperl-syntax-done-to) nil) + (set (make-local-variable 'font-lock-syntactic-keywords) (if cperl-syntaxify-by-font-lock '((cperl-fontify-syntaxically)) ;; unless font-lock-syntactic-keywords, font-lock (pre-22.1) @@ -1860,54 +1779,43 @@ or as help on variables `cperl-tips', `cperl-problems', (progn (setq cperl-font-lock-multiline t) ; Not localized... (set (make-local-variable 'font-lock-multiline) t)) - (make-local-variable 'font-lock-fontify-region-function) - (set 'font-lock-fontify-region-function ; not present with old Emacs - 'cperl-font-lock-fontify-region-function)) - (make-local-variable 'font-lock-fontify-region-function) - (set 'font-lock-fontify-region-function ; not present with old Emacs - 'cperl-font-lock-fontify-region-function) + (set (make-local-variable 'font-lock-fontify-region-function) + ;; not present with old Emacs + #'cperl-font-lock-fontify-region-function)) + (set (make-local-variable 'font-lock-fontify-region-function) + #'cperl-font-lock-fontify-region-function) (make-local-variable 'cperl-old-style) - (if (boundp 'normal-auto-fill-function) ; 19.33 and later - (set (make-local-variable 'normal-auto-fill-function) - 'cperl-do-auto-fill) - (or (fboundp 'cperl-old-auto-fill-mode) - (progn - (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode)) - (defun auto-fill-mode (&optional arg) - (interactive "P") - (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning - (and auto-fill-function (memq major-mode '(perl-mode cperl-mode)) - (setq auto-fill-function 'cperl-do-auto-fill)))))) - (if (cperl-enable-font-lock) - (if (cperl-val 'cperl-font-lock) - (progn (or cperl-faces-init (cperl-init-faces)) - (font-lock-mode 1)))) + (set (make-local-variable 'normal-auto-fill-function) + #'cperl-do-auto-fill) + (if (cperl-val 'cperl-font-lock) + (progn (or cperl-faces-init (cperl-init-faces)) + (font-lock-mode 1))) (set (make-local-variable 'facemenu-add-face-function) - 'cperl-facemenu-add-face-function) ; XXXX What this guy is for??? + #'cperl-facemenu-add-face-function) ; XXXX What this guy is for??? (and (boundp 'msb-menu-cond) (not cperl-msb-fixed) (cperl-msb-fix)) (if (fboundp 'easy-menu-add) (easy-menu-add cperl-menu)) ; A NOP in Emacs. - (run-mode-hooks 'cperl-mode-hook) (if cperl-hook-after-change - (add-hook 'after-change-functions 'cperl-after-change-function nil t)) + (add-hook 'after-change-functions #'cperl-after-change-function nil t)) ;; After hooks since fontification will break this (if cperl-pod-here-scan (or cperl-syntaxify-by-font-lock (progn (or cperl-faces-init (cperl-init-faces-weak)) (cperl-find-pods-heres)))) ;; Setup Flymake - (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t)) + (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) ;; Fix for perldb - make default reasonable (defun cperl-db () (interactive) (require 'gud) + ;; FIXME: Use `read-string' or `read-shell-command'? (perldb (read-from-minibuffer "Run perldb (like this): " (if (consp gud-perldb-history) (car gud-perldb-history) - (concat "perl " + (concat "perl -d " (buffer-file-name))) nil nil '(gud-perldb-history . 1)))) @@ -1971,24 +1879,24 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-make-indent comment-column 1) ; Indent min 1 c))))) -;;;(defun cperl-comment-indent-fallback () -;;; "Is called if the standard comment-search procedure fails. -;;;Point is at start of real comment." -;;; (let ((c (current-column)) target cnt prevc) -;;; (if (= c comment-column) nil -;;; (setq cnt (skip-chars-backward "[ \t]")) -;;; (setq target (max (1+ (setq prevc -;;; (current-column))) ; Else indent at comment column -;;; comment-column)) -;;; (if (= c comment-column) nil -;;; (delete-backward-char cnt) -;;; (while (< prevc target) -;;; (insert "\t") -;;; (setq prevc (current-column))) -;;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) -;;; (while (< prevc target) -;;; (insert " ") -;;; (setq prevc (current-column))))))) +;;(defun cperl-comment-indent-fallback () +;; "Is called if the standard comment-search procedure fails. +;;Point is at start of real comment." +;; (let ((c (current-column)) target cnt prevc) +;; (if (= c comment-column) nil +;; (setq cnt (skip-chars-backward "[ \t]")) +;; (setq target (max (1+ (setq prevc +;; (current-column))) ; Else indent at comment column +;; comment-column)) +;; (if (= c comment-column) nil +;; (delete-backward-char cnt) +;; (while (< prevc target) +;; (insert "\t") +;; (setq prevc (current-column))) +;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) +;; (while (< prevc target) +;; (insert " ") +;; (setq prevc (current-column))))))) (defun cperl-indent-for-comment () "Substitute for `indent-for-comment' in CPerl." @@ -2024,7 +1932,7 @@ char is \"{\", insert extra newline before only if (interactive "P") (let (insertpos (other-end (if (and cperl-electric-parens-mark - (cperl-mark-active) + (region-active-p) (< (mark) (point))) (mark) nil))) @@ -2096,13 +2004,13 @@ char is \"{\", insert extra newline before only if (cperl-auto-newline cperl-auto-newline) (other-end (or end (if (and cperl-electric-parens-mark - (cperl-mark-active) + (region-active-p) (> (mark) (point))) (save-excursion (goto-char (mark)) (point-marker)) nil))) - pos after) + pos) (and (cperl-val 'cperl-electric-lbrace-space) (eq (preceding-char) ?$) (save-excursion @@ -2132,9 +2040,8 @@ char is \"{\", insert extra newline before only if "Insert an opening parenthesis or a matching pair of parentheses. See `cperl-electric-parens'." (interactive "P") - (let ((beg (point-at-bol)) - (other-end (if (and cperl-electric-parens-mark - (cperl-mark-active) + (let ((other-end (if (and cperl-electric-parens-mark + (region-active-p) (> (mark) (point))) (save-excursion (goto-char (mark)) @@ -2144,7 +2051,6 @@ See `cperl-electric-parens'." (memq last-command-event (append cperl-electric-parens-string nil)) (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) - ;;(not (save-excursion (search-backward "#" beg t))) (if (eq last-command-event ?<) (progn ;; This code is too electric, see Bug#3943. @@ -2169,12 +2075,11 @@ See `cperl-electric-parens'." If not, or if we are not at the end of marking range, would self-insert. Affected by `cperl-electric-parens'." (interactive "P") - (let ((beg (point-at-bol)) - (other-end (if (and cperl-electric-parens-mark + (let ((other-end (if (and cperl-electric-parens-mark (cperl-val 'cperl-electric-parens) (memq last-command-event (append cperl-electric-parens-string nil)) - (cperl-mark-active) + (region-active-p) (< (mark) (point))) (mark) nil)) @@ -2183,7 +2088,6 @@ Affected by `cperl-electric-parens'." (cperl-val 'cperl-electric-parens) (memq last-command-event '( ?\) ?\] ?\} ?\> )) (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)) - ;;(not (save-excursion (search-backward "#" beg t))) ) (progn (self-insert-command (prefix-numeric-value arg)) @@ -2223,6 +2127,7 @@ to nil." (save-excursion (or (not (re-search-backward "^=" nil t)) (or (looking-at "=cut") + (looking-at "=end") (and cperl-use-syntax-table-text-property (not (eq (get-text-property (point) 'syntax-type) @@ -2297,7 +2202,7 @@ to nil." (get-text-property (point) 'in-pod) (cperl-after-expr-p nil "{;:") (and (re-search-backward "\\(\\`\n?\\|^\n\\)=\\sw+" (point-min) t) - (not (looking-at "\n*=cut")) + (not (or (looking-at "\n*=cut") (looking-at "\n*=end"))) (or (not cperl-use-syntax-table-text-property) (eq (get-text-property (point) 'syntax-type) 'pod)))))) (progn @@ -2316,7 +2221,7 @@ to nil." nil t)))) ; Only one (progn (forward-word-strictly 1) - (setq name (file-name-base) + (setq name (file-name-base (buffer-file-name)) p (point)) (insert " NAME\n\n" name " - \n\n=head1 SYNOPSIS\n\n\n\n" @@ -2355,6 +2260,7 @@ to nil." beg t))) (save-excursion (or (not (re-search-backward "^=" nil t)) (looking-at "=cut") + (looking-at "=end") (and cperl-use-syntax-table-text-property (not (eq (get-text-property (point) 'syntax-type) @@ -2454,7 +2360,7 @@ If in POD, insert appropriate lines." ;; We are after \n now, so look for the rest (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+") (progn - (setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>")) + (setq cut (looking-at "\\(\\`\n?\\|\n\\)=\\(cut\\|end\\)\\>")) (setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>")) t))) (if (and over @@ -2622,11 +2528,10 @@ The relative indentation among the lines of the expression are preserved." Return the amount the indentation changed by." (let ((case-fold-search nil) (pos (- (point-max) (point))) - indent i beg shift-amt) + indent i shift-amt) (setq indent (cperl-calculate-indent parse-data) i indent) (beginning-of-line) - (setq beg (point)) (cond ((or (eq indent nil) (eq indent t)) (setq indent (current-indentation) i nil)) ;;((eq indent t) ; Never? @@ -2653,8 +2558,8 @@ Return the amount the indentation changed by." (zerop shift-amt)) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) - ;;;(delete-region beg (point)) - ;;;(indent-to indent) + ;;(delete-region beg (point)) + ;;(indent-to indent) (cperl-make-indent indent) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. @@ -2672,13 +2577,13 @@ Return the amount the indentation changed by." (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))) (defun cperl-get-state (&optional parse-start start-state) - ;; returns list (START STATE DEPTH PRESTART), - ;; START is a good place to start parsing, or equal to - ;; PARSE-START if preset, - ;; STATE is what is returned by `parse-partial-sexp'. - ;; DEPTH is true is we are immediately after end of block - ;; which contains START. - ;; PRESTART is the position basing on which START was found. + "Return list (START STATE DEPTH PRESTART), +START is a good place to start parsing, or equal to +PARSE-START if preset, +STATE is what is returned by `parse-partial-sexp'. +DEPTH is true is we are immediately after end of block +which contains START. +PRESTART is the position basing on which START was found." (save-excursion (let ((start-point (point)) depth state start prestart) (if (and parse-start @@ -2707,17 +2612,17 @@ Return the amount the indentation changed by." (defun cperl-beginning-of-property (p prop &optional lim) "Given that P has a property PROP, find where the property starts. Will not look before LIM." - ;;; XXXX What to do at point-max??? +;;; XXXX What to do at point-max??? (or (previous-single-property-change (cperl-1+ p) prop lim) (point-min)) -;;; (cond ((eq p (point-min)) -;;; p) -;;; ((and lim (<= p lim)) -;;; p) -;;; ((not (get-text-property (1- p) prop)) -;;; p) -;;; (t (or (previous-single-property-change p look-prop lim) -;;; (point-min)))) + ;; (cond ((eq p (point-min)) + ;; p) + ;; ((and lim (<= p lim)) + ;; p) + ;; ((not (get-text-property (1- p) prop)) + ;; p) + ;; (t (or (previous-single-property-change p look-prop lim) + ;; (point-min)))) ) (defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start @@ -2887,6 +2792,8 @@ Will not look before LIM." (cperl-backward-to-noncomment containing-sexp)) ;; Now we get non-label preceding the indent point (if (not (or (eq (1- (point)) containing-sexp) + (and cperl-indent-parens-as-block + (not is-block)) (memq (preceding-char) (append (if is-block " ;{" " ,;{") '(nil))) (and (eq (preceding-char) ?\}) @@ -2962,12 +2869,13 @@ Will not look before LIM." ;; first thing on the line, say in the case of ;; anonymous sub in a hash. (if (and;; Is it a sub in group starting on this line? + cperl-indent-subs-specially (cond ((get-text-property (point) 'attrib-group) (goto-char (cperl-beginning-of-property (point) 'attrib-group))) ((eq (preceding-char) ?b) (forward-sexp -1) - (looking-at "sub\\>"))) + (looking-at (concat cperl-sub-regexp "\\>")))) (setq p (nth 1 ; start of innermost containing list (parse-partial-sexp (point-at-bol) @@ -3001,7 +2909,10 @@ Will not look before LIM." "Alist of indentation rules for CPerl mode. The values mean: nil: do not indent; - number: add this amount of indentation.") + FUNCTION: a function to compute the indentation to use. + Takes a single argument which provides the currently computed indentation + context, and should return the column to which to indent. + NUMBER: add this amount of indentation.") (defun cperl-calculate-indent (&optional parse-data) ; was parse-start "Return appropriate indentation for current line as Perl code. @@ -3020,7 +2931,11 @@ and closing parentheses and brackets." ((vectorp i) (setq what (assoc (elt i 0) cperl-indent-rules-alist)) (cond - (what (cadr what)) ; Load from table + (what + (let ((action (cadr what))) + (cond ((functionp action) (apply action (list i parse-data))) + ((numberp action) (+ action (current-indentation))) + (t action)))) ;; ;; Indenters for regular expressions with //x and qw() ;; @@ -3184,7 +3099,7 @@ and closing parentheses and brackets." (defun cperl-calculate-indent-within-comment () "Return the indentation amount for line, assuming that the current line is to be regarded as part of a block comment." - (let (end star-start) + (let (end) (save-excursion (beginning-of-line) (skip-chars-forward " \t") @@ -3442,8 +3357,8 @@ Works before syntax recognition is done." (or now (put-text-property b e 'cperl-postpone (cons type val))) (put-text-property b e type val))) -;;; Here is how the global structures (those which cannot be -;;; recognized locally) are marked: +;; Here is how the global structures (those which cannot be +;; recognized locally) are marked: ;; a) PODs: ;; Start-to-end is marked `in-pod' ==> t ;; Each non-literal part is marked `syntax-type' ==> `pod' @@ -3463,17 +3378,16 @@ Works before syntax recognition is done." ;; (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'. ;; f) Multiline my/our declaration lists etc: `syntax-type' => `multiline' -;;; In addition, some parts of RExes may be marked as `REx-interpolated' -;;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). +;; In addition, some parts of RExes may be marked as `REx-interpolated' +;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). (defun cperl-unwind-to-safe (before &optional end) ;; if BEFORE, go to the previous start-of-line on each step of unwinding - (let ((pos (point)) opos) + (let ((pos (point))) (while (and pos (progn (beginning-of-line) (get-text-property (setq pos (point)) 'syntax-type))) - (setq opos pos - pos (cperl-beginning-of-property pos 'syntax-type)) + (setq pos (cperl-beginning-of-property pos 'syntax-type)) (if (eq pos (point-min)) (setq pos nil)) (if pos @@ -3502,7 +3416,7 @@ Works before syntax recognition is done." (setq end (point))))) (or end pos))))) -;;; These are needed for byte-compile (at least with v19) +;; These are needed for byte-compile (at least with v19) (defvar cperl-nonoverridable-face) (defvar font-lock-variable-name-face) (defvar font-lock-function-name-face) @@ -3517,7 +3431,7 @@ Works before syntax recognition is done." Should be called with the point before leading colon of an attribute." ;; Works *before* syntax recognition is done (or st-l (setq st-l (list nil))) ; Avoid overwriting '() - (let (st b p reset-st after-first (start (point)) start1 end1) + (let (st p reset-st after-first (start (point)) start1 end1) (condition-case b (while (looking-at (concat @@ -3618,7 +3532,8 @@ Should be called with the point before leading colon of an attribute." 'face dashface)) ;; save match data (for looking-at) (setq lll (mapcar (function (lambda (elt) (cons (match-beginning elt) - (match-end elt)))) l)) + (match-end elt)))) + l)) (while lll (setq ll (car lll)) (setq lle (cdr ll) @@ -3636,7 +3551,7 @@ Should be called with the point before leading colon of an attribute." (goto-char endbracket) ; just in case something misbehaves??? t)) -;;; Debugging this may require (setq max-specpdl-size 2000)... +;; Debugging this may require (setq max-specpdl-size 2000)... (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify @@ -3746,7 +3661,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob> "\\|" ;; 1+6+2+1+1=11 extra () before this - "\\<sub\\>" ; sub with proto/attr + "\\<" cperl-sub-regexp "\\>" ; sub with proto/attr "\\(" cperl-white-and-comment-rex "\\(::[a-zA-Z_:'0-9]*\\|[a-zA-Z_'][a-zA-Z_:'0-9]*\\)\\)?" ; name @@ -3759,7 +3674,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\|" ;; 1+6+2+1+1+6+1=18 extra () before this (old pack'var syntax; ;; we do not support intervening comments...): - "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" + "\\(\\<" cperl-sub-regexp "[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'" ;; 1+6+2+1+1+6+1+1=19 extra () before this: "\\|" "__\\(END\\|DATA\\)__" ; __END__ or __DATA__ @@ -3834,7 +3749,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', state-point b nil nil state) state-point b) (if (or (nth 3 state) (nth 4 state) - (looking-at "cut\\>")) + (looking-at "\\(cut\\|\\end\\)\\>")) (if (or (nth 3 state) (nth 4 state) ignore-max) nil ; Doing a chunk only (message "=cut is not preceded by a POD section") @@ -3847,10 +3762,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', b1 nil) ; error condition ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (re-search-forward "^\n=cut\\>" stop-point 'toend) + (or (re-search-forward "^\n=\\(cut\\|\\end\\)\\>" stop-point 'toend) (progn (goto-char b) - (if (re-search-forward "\n=cut\\>" stop-point 'toend) + (if (re-search-forward "\n=\\(cut\\|\\end\\)\\>" stop-point 'toend) (progn (message "=cut is not preceded by an empty line") (setq b1 t) @@ -3957,7 +3872,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (progn (forward-sexp -2) (not - (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>"))) + (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>"))) (error t))))))) (error nil))) ; func(<<EOF) (and (not (match-beginning 6)) ; Empty @@ -4141,7 +4056,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (not (memq (preceding-char) '(?$ ?@ ?& ?%))) (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>"))))) + "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>"))))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) @@ -4539,7 +4454,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq REx-subgr-end qtag) ;End smart-highlighted ;; Apparently, I can't put \] into a charclass ;; in m]]: m][\\\]\]] produces [\\]] -;;; POSIX? [:word:] [:^word:] only inside [] +;;; POSIX? [:word:] [:^word:] only inside [] ;;; "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]") (while ; look for unescaped ] (and argument @@ -4797,8 +4712,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq stop t)))))) ;; Used only in `cperl-calculate-indent'... -(defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! - ;; Positions is before ?\{. Checks whether it starts a block. +(defun cperl-block-p () + "Point is before ?\\{. Checks whether it starts a block." ;; No save-excursion! This is more a distinguisher of a block/hash ref... (cperl-backward-to-noncomment (point-min)) (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp @@ -4817,14 +4732,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and (eq (preceding-char) ?b) (progn (forward-sexp -1) - (looking-at "sub[ \t\n\f#]"))))))))) - -;;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? -;;; No save-excursion; condition-case ... In (cperl-block-p) the block -;;; may be a part of an in-statement construct, such as -;;; ${something()}, print {FH} $data. -;;; Moreover, one takes positive approach (looks for else,grep etc) -;;; another negative (looks for bless,tr etc) + (looking-at (concat cperl-sub-regexp "[ \t\n\f#]")))))))))) + +;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? +;; No save-excursion; condition-case ... In (cperl-block-p) the block +;; may be a part of an in-statement construct, such as +;; ${something()}, print {FH} $data. +;; Moreover, one takes positive approach (looks for else,grep etc) +;; another negative (looks for bless,tr etc) (defun cperl-after-block-p (lim &optional pre-block) "Return true if the preceding } (if PRE-BLOCK, following {) delimits a block. Would not look before LIM. Assumes that LIM is a good place to begin a @@ -4846,15 +4761,16 @@ statement would start; thus the block in ${func()} does not count." (save-excursion (forward-sexp -1) ;; else {} but not else::func {} - (or (and (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>") + (or (and (looking-at "\\(else\\|catch\\|try\\|continue\\|grep\\|map\\|BEGIN\\|END\\|UNITCHECK\\|CHECK\\|INIT\\)\\>") (not (looking-at "\\(\\sw\\|_\\)+::"))) ;; sub f {} (progn (cperl-backward-to-noncomment lim) - (and (eq (preceding-char) ?b) + (and (cperl-char-ends-sub-keyword-p (preceding-char)) (progn (forward-sexp -1) - (looking-at "sub[ \t\n\f#]")))))) + (looking-at + (concat cperl-sub-regexp "[ \t\n\f#]"))))))) ;; What precedes is not word... XXXX Last statement in sub??? (cperl-after-expr-p lim)))) (error nil)))) @@ -4865,7 +4781,7 @@ TEST is the expression to evaluate at the found position. If absent, CHARS is a string that contains good characters to have before us (however, `}' is treated \"smartly\" if it is not in the list)." (let ((lim (or lim (point-min))) - stop p pr) + stop p) (cperl-update-syntaxification (point) (point)) (save-excursion (while (and (not stop) (> (point) lim)) @@ -4940,7 +4856,6 @@ CHARS is a string that contains good characters to have before us (however, (error t)))) (defun cperl-forward-to-end-of-expr (&optional lim) - (let ((p (point)))) (condition-case nil (progn (while (and (< (point) (or lim (point-max))) @@ -4970,7 +4885,7 @@ CHARS is a string that contains good characters to have before us (however, (forward-sexp -1) (not (looking-at - "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>"))))))) + "\\(map\\|grep\\|say\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>"))))))) (defun cperl-indent-exp () @@ -5006,13 +4921,13 @@ conditional/loop constructs." (if (eq (following-char) ?$ ) ; for my $var (list) (progn (forward-sexp -1) - (if (looking-at "\\(my\\|local\\|our\\)\\>") + (if (looking-at "\\(state\\|my\\|local\\|our\\)\\>") (forward-sexp -1)))) (if (looking-at (concat "\\(\\elsif\\|if\\|unless\\|while\\|until" "\\|for\\(each\\)?\\>\\(\\(" cperl-maybe-white-and-comment-rex - "\\(my\\|local\\|our\\)\\)?" + "\\(state\\|my\\|local\\|our\\)\\)?" cperl-maybe-white-and-comment-rex "\\$[_a-zA-Z0-9]+\\)?\\)\\>")) (progn @@ -5097,7 +5012,7 @@ Returns some position at the last line." ;; Looking at: ;; foreach my $var (if (looking-at - "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") + "[ \t]*\\<for\\(each\\)?[ \t]+\\(state\\|my\\|local\\|our\\)\\(\t*\\|[ \t][ \t]+\\)[^ \t\n]") (progn (forward-word-strictly 2) (delete-horizontal-space) @@ -5106,7 +5021,7 @@ Returns some position at the last line." ;; Looking at: ;; foreach my $var ( (if (looking-at - "[ \t]*\\<for\\(each\\)?[ \t]+\\(my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") + "[ \t]*\\<for\\(each\\)?[ \t]+\\(state\\|my\\|local\\|our\\)[ \t]*\\$[_a-zA-Z0-9]+\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]") (progn (forward-sexp 3) (delete-horizontal-space) @@ -5116,7 +5031,7 @@ Returns some position at the last line." ;; Looking at (with or without "}" at start, ending after "({"): ;; } foreach my $var () OR { (if (looking-at - "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") + "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") (progn (setq ml (match-beginning 8)) ; "(" or "{" after control word (re-search-forward "[({]") @@ -5237,7 +5152,7 @@ Returns some position at the last line." (defvar cperl-update-start) ; Do not need to make them local (defvar cperl-update-end) -(defun cperl-delay-update-hook (beg end old-len) +(defun cperl-delay-update-hook (beg end _old-len) (setq cperl-update-start (min beg (or cperl-update-start (point-max)))) (setq cperl-update-end (max end (or cperl-update-end (point-min))))) @@ -5254,13 +5169,11 @@ conditional/loop constructs." (cperl-update-syntaxification end end) (save-excursion (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) - (let ((indent-info (if cperl-emacs-can-parse - (list nil nil nil) ; Cannot use '(), since will modify - nil)) - (pm 0) + (let ((indent-info (list nil nil nil) ; Cannot use '(), since will modify + ) after-change-functions ; Speed it up! - st comm old-comm-indent new-comm-indent p pp i empty) - (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook)) + comm old-comm-indent new-comm-indent i empty) + (if h-a-c (add-hook 'after-change-functions #'cperl-delay-update-hook)) (goto-char start) (setq old-comm-indent (and (cperl-to-comment-or-eol) (current-column)) @@ -5269,7 +5182,6 @@ conditional/loop constructs." (setq end (set-marker (make-marker) end)) ; indentation changes pos (or (bolp) (beginning-of-line 2)) (while (and (<= (point) end) (not (eobp))) ; bol to check start - (setq st (point)) (if (or (setq empty (looking-at "[ \t]*\n")) (and (setq comm (looking-at "[ \t]*#")) @@ -5455,10 +5367,10 @@ indentation and initial hashes. Behaves usually outside of comment." (defun cperl-imenu--create-perl-index (&optional regexp) (require 'imenu) ; May be called from TAGS creator (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) - (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function)) + (index-unsorted-alist '()) (index-meth-alist '()) meth packages ends-ranges p marker is-proto - (prev-pos 0) is-pack index index1 name (end-range 0) package) + is-pack index index1 name (end-range 0) package) (goto-char (point-min)) (cperl-update-syntaxification (point-max) (point-max)) ;; Search for the function @@ -5604,7 +5516,7 @@ indentation and initial hashes. Behaves usually outside of comment." (defun cperl-outline-level () (looking-at outline-regexp) (cond ((not (match-beginning 1)) 0) ; beginning-of-file -;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level + ;; 2=package-group, 5=package-name 8=sub-name 16=head-level ((match-beginning 2) 0) ; package ((match-beginning 8) 1) ; sub ((match-beginning 16) @@ -5627,10 +5539,9 @@ indentation and initial hashes. Behaves usually outside of comment." (if (memq major-mode '(perl-mode cperl-mode)) (progn (or cperl-faces-init (cperl-init-faces))))))) - (if (fboundp 'eval-after-load) - (eval-after-load - "ps-print" - '(or cperl-faces-init (cperl-init-faces))))))) + (eval-after-load + "ps-print" + '(or cperl-faces-init (cperl-init-faces)))))) (defvar cperl-font-lock-keywords-1 nil "Additional expressions to highlight in Perl mode. Minimal set.") @@ -5679,12 +5590,21 @@ indentation and initial hashes. Behaves usually outside of comment." (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" + ;; FIXME: Use regexp-opt. (mapconcat - 'identity - '("if" "until" "while" "elsif" "else" "unless" "for" + #'identity + (append + cperl-sub-keywords + '("if" "until" "while" "elsif" "else" + "given" "when" "default" "break" + "unless" "for" + "try" "catch" "finally" "foreach" "continue" "exit" "die" "last" "goto" "next" - "redo" "return" "local" "exec" "sub" "do" "dump" "use" "our" - "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT") + "redo" "return" "local" "exec" + "do" "dump" + "use" "our" + "require" "package" "eval" "evalbytes" "my" "state" + "BEGIN" "END" "CHECK" "INIT" "UNITCHECK")) "\\|") ; Flow control "\\)\\>") 2) ; was "\\)[ \n\t;():,|&]" ; In what follows we use `type' style @@ -5692,13 +5612,14 @@ indentation and initial hashes. Behaves usually outside of comment." (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" - ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm" + ;; FIXME: Use regexp-opt. + ;; "CORE" "__FILE__" "__LINE__" "__SUB__" "abs" "accept" "alarm" ;; "and" "atan2" "bind" "binmode" "bless" "caller" ;; "chdir" "chmod" "chown" "chr" "chroot" "close" ;; "closedir" "cmp" "connect" "continue" "cos" "crypt" ;; "dbmclose" "dbmopen" "die" "dump" "endgrent" ;; "endhostent" "endnetent" "endprotoent" "endpwent" - ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fcntl" + ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl" ;; "fileno" "flock" "fork" "formline" "ge" "getc" ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" ;; "gethostbyname" "gethostent" "getlogin" @@ -5721,7 +5642,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" ;; "shutdown" "sin" "sleep" "socket" "socketpair" ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink" - ;; "syscall" "sysopen" "sysread" "system" "syswrite" "tell" + ;; "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite" "tell" ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" ;; "umask" "unlink" "unpack" "utime" "values" "vec" ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor" @@ -5732,7 +5653,7 @@ indentation and initial hashes. Behaves usually outside of comment." "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|" "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|" "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|" - "f\\(ileno\\|cntl\\|lock\\|or\\(k\\|mline\\)\\)\\|" + "f\\(ileno\\|c\\(ntl\\)?\\|lock\\|or\\(k\\|mline\\)\\)\\|" "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|" "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w" "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|" @@ -5750,12 +5671,12 @@ indentation and initial hashes. Behaves usually outside of comment." "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|" "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|" "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|" - "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\)\\|" + "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\|seek\\)\\|" "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|" "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|" "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|" "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|" - "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\|PACKAGE__\\)" + "x\\(\\|or\\)\\|__\\(FILE\\|LINE\\|PACKAGE\\|SUB\\)__" "\\)\\>") 2 'font-lock-type-face) ;; In what follows we use `other' style ;; for nonoverwritable builtins @@ -5763,27 +5684,28 @@ indentation and initial hashes. Behaves usually outside of comment." (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" - ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "__END__" "chomp" - ;; "chop" "defined" "delete" "do" "each" "else" "elsif" - ;; "eval" "exists" "for" "foreach" "format" "goto" + ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK" "__END__" "chomp" + ;; "break" "chop" "default" "defined" "delete" "do" "each" "else" "elsif" + ;; "eval" "evalbytes" "exists" "for" "foreach" "format" "given" "goto" ;; "grep" "if" "keys" "last" "local" "map" "my" "next" - ;; "no" "our" "package" "pop" "pos" "print" "printf" "push" - ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift" - ;; "sort" "splice" "split" "study" "sub" "tie" "tr" + ;; "no" "our" "package" "pop" "pos" "print" "printf" "prototype" "push" + ;; "q" "qq" "qw" "qx" "redo" "return" "say" "scalar" "shift" + ;; "sort" "splice" "split" "state" "study" "sub" "tie" "tr" ;; "undef" "unless" "unshift" "untie" "until" "use" - ;; "while" "y" - "AUTOLOAD\\|BEGIN\\|CHECK\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|" - "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|" - "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|INIT\\|if\\|keys\\|" + ;; "when" "while" "y" + "AUTOLOAD\\|BEGIN\\|\\(UNIT\\)?CHECK\\|break\\|c\\(atch\\|ho\\(p\\|mp\\)\\)\\|d\\(e\\(f\\(inally\\|ault\\|ined\\)\\|lete\\)\\|" + "o\\)\\|DESTROY\\|e\\(ach\\|val\\(bytes\\)?\\|xists\\|ls\\(e\\|if\\)\\)\\|" + "END\\|for\\(\\|each\\|mat\\)\\|g\\(iven\\|rep\\|oto\\)\\|INIT\\|if\\|keys\\|" "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|" - "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" - "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|" - "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|" + "p\\(ackage\\|rototype\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|" + "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(ay\\|pli\\(ce\\|t\\)\\|" + "calar\\|t\\(ate\\|udy\\)\\|ub\\|hift\\|ort\\)\\|t\\(ry?\\|ied?\\)\\|" "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" - "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually + "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually "\\|[sm]" ; Added manually - "\\)\\>") 2 'cperl-nonoverridable-face) - ;; (mapconcat 'identity + "\\)\\>") + 2 'cperl-nonoverridable-face) + ;; (mapconcat #'identity ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" ;; "#include" "#define" "#undef") ;; "\\|") @@ -5792,7 +5714,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;; This highlights declarations and definitions differently. ;; We do not try to highlight in the case of attributes: ;; it is already done by `cperl-find-pods-heres' - (list (concat "\\<sub" + (list (concat "\\<" cperl-sub-regexp cperl-white-and-comment-rex ; whitespace/comments "\\([^ \n\t{;()]+\\)" ; 2=name (assume non-anonymous) "\\(" @@ -5834,14 +5756,14 @@ indentation and initial hashes. Behaves usually outside of comment." font-lock-string-face t) '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 font-lock-constant-face) ; labels - '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets + '("\\<\\(continue\\|next\\|last\\|redo\\|break\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets 2 font-lock-constant-face) ;; Uncomment to get perl-mode-like vars ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" ;;; (2 (cons font-lock-variable-name-face '(underline)))) (cond ((featurep 'font-lock-extra) - '("^[ \t]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" + '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" (3 font-lock-variable-name-face) (4 '(another 4 nil ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" @@ -5850,7 +5772,7 @@ indentation and initial hashes. Behaves usually outside of comment." nil t))) ; local variables, multiple (font-lock-anchored ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var - `(,(concat "\\<\\(my\\|local\\|our\\)" + `(,(concat "\\<\\(state\\|my\\|local\\|our\\)" cperl-maybe-white-and-comment-rex "\\((" cperl-maybe-white-and-comment-rex @@ -5898,54 +5820,47 @@ indentation and initial hashes. Behaves usually outside of comment." 'syntax-type 'multiline)) (setq cperl-font-lock-multiline-start nil))) (3 font-lock-variable-name-face)))) - (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" + (t '("^[ \t{}]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" 3 font-lock-variable-name-face))) - '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" + '("\\<for\\(each\\)?\\([ \t]+\\(state\\|my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*(" 4 font-lock-variable-name-face) ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntactically '("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face) '("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) (setq t-font-lock-keywords-1 - (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock - ;; not yet as of XEmacs 19.12, works with 21.1.11 - (or - (not (featurep 'xemacs)) - (string< "21.1.9" emacs-version) - (and (string< "21.1.10" emacs-version) - (string< emacs-version "21.1.2"))) - '( - ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 - (if (eq (char-after (match-beginning 2)) ?%) - 'cperl-hash-face - 'cperl-array-face) - t) ; arrays and hashes - ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" - 1 - (if (= (- (match-end 2) (match-beginning 2)) 1) - (if (eq (char-after (match-beginning 3)) ?{) - 'cperl-hash-face - 'cperl-array-face) ; arrays and hashes - font-lock-variable-name-face) ; Just to put something - t) - ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" - (1 cperl-array-face) - (2 font-lock-variable-name-face)) - ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" - (1 cperl-hash-face) - (2 font-lock-variable-name-face)) - ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") - ;;; Too much noise from \s* @s[ and friends - ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" - ;;(3 font-lock-function-name-face t t) - ;;(4 - ;; (if (cperl-slash-is-regexp) - ;; font-lock-function-name-face 'default) nil t)) - ))) + '( + ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 + (if (eq (char-after (match-beginning 2)) ?%) + 'cperl-hash-face + 'cperl-array-face) + t) ; arrays and hashes + ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" + 1 + (if (= (- (match-end 2) (match-beginning 2)) 1) + (if (eq (char-after (match-beginning 3)) ?{) + 'cperl-hash-face + 'cperl-array-face) ; arrays and hashes + font-lock-variable-name-face) ; Just to put something + t) + ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-array-face) + (2 font-lock-variable-name-face)) + ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-hash-face) + (2 font-lock-variable-name-face)) +;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") +;;; Too much noise from \s* @s[ and friends + ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" + ;;(3 font-lock-function-name-face t t) + ;;(4 + ;; (if (cperl-slash-is-regexp) + ;; font-lock-function-name-face 'default) nil t)) + )) (if cperl-highlight-variables-indiscriminately (setq t-font-lock-keywords-1 (append t-font-lock-keywords-1 - (list '("\\([$*]{?\\sw+\\)" 1 + (list '("\\([$*]{?\\(?:\\sw+\\|::\\)+\\)" 1 font-lock-variable-name-face))))) (setq cperl-font-lock-keywords-1 (if cperl-syntaxify-by-font-lock @@ -6036,13 +5951,6 @@ indentation and initial hashes. Behaves usually outside of comment." ;; Do it the dull way, without choose-color (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") - ;; (or (fboundp 'x-color-defined-p) - ;; (defalias 'x-color-defined-p - ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) - ;; ;; XEmacs >= 19.12 - ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) - ;; ;; XEmacs 19.11 - ;; (t 'x-valid-color-name-p)))) (cperl-force-face font-lock-constant-face "Face for constant and label names") (cperl-force-face font-lock-variable-name-face @@ -6108,15 +6016,7 @@ indentation and initial hashes. Behaves usually outside of comment." (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode - 'light)) - (face-list (and (fboundp 'face-list) (face-list)))) -;;;; (fset 'cperl-is-face -;;;; (cond ((fboundp 'find-face) -;;;; (symbol-function 'find-face)) -;;;; (face-list -;;;; (function (lambda (face) (member face face-list)))) -;;;; (t -;;;; (function (lambda (face) (boundp face)))))) + 'light))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) @@ -6155,40 +6055,40 @@ indentation and initial hashes. Behaves usually outside of comment." (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) -;;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil -;;; (copy-face 'bold-italic 'font-lock-other-emphasized-face) -;;; (cond -;;; ((eq background 'light) -;;; (set-face-background 'font-lock-other-emphasized-face -;;; (if (x-color-defined-p "lightyellow2") -;;; "lightyellow2" -;;; (if (x-color-defined-p "lightyellow") -;;; "lightyellow" -;;; "light yellow")))) -;;; ((eq background 'dark) -;;; (set-face-background 'font-lock-other-emphasized-face -;;; (if (x-color-defined-p "navy") -;;; "navy" -;;; (if (x-color-defined-p "darkgreen") -;;; "darkgreen" -;;; "dark green")))) -;;; (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) -;;; (if (cperl-is-face 'font-lock-emphasized-face) nil -;;; (copy-face 'bold 'font-lock-emphasized-face) -;;; (cond -;;; ((eq background 'light) -;;; (set-face-background 'font-lock-emphasized-face -;;; (if (x-color-defined-p "lightyellow2") -;;; "lightyellow2" -;;; "lightyellow"))) -;;; ((eq background 'dark) -;;; (set-face-background 'font-lock-emphasized-face -;;; (if (x-color-defined-p "navy") -;;; "navy" -;;; (if (x-color-defined-p "darkgreen") -;;; "darkgreen" -;;; "dark green")))) -;;; (t (set-face-background 'font-lock-emphasized-face "gray90")))) + ;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil + ;; (copy-face 'bold-italic 'font-lock-other-emphasized-face) + ;; (cond + ;; ((eq background 'light) + ;; (set-face-background 'font-lock-other-emphasized-face + ;; (if (x-color-defined-p "lightyellow2") + ;; "lightyellow2" + ;; (if (x-color-defined-p "lightyellow") + ;; "lightyellow" + ;; "light yellow")))) + ;; ((eq background 'dark) + ;; (set-face-background 'font-lock-other-emphasized-face + ;; (if (x-color-defined-p "navy") + ;; "navy" + ;; (if (x-color-defined-p "darkgreen") + ;; "darkgreen" + ;; "dark green")))) + ;; (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) + ;; (if (cperl-is-face 'font-lock-emphasized-face) nil + ;; (copy-face 'bold 'font-lock-emphasized-face) + ;; (cond + ;; ((eq background 'light) + ;; (set-face-background 'font-lock-emphasized-face + ;; (if (x-color-defined-p "lightyellow2") + ;; "lightyellow2" + ;; "lightyellow"))) + ;; ((eq background 'dark) + ;; (set-face-background 'font-lock-emphasized-face + ;; (if (x-color-defined-p "navy") + ;; "navy" + ;; (if (x-color-defined-p "darkgreen") + ;; "darkgreen" + ;; "dark green")))) + ;; (t (set-face-background 'font-lock-emphasized-face "gray90")))) (if (cperl-is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) (if (cperl-is-face 'font-lock-constant-face) nil @@ -6237,43 +6137,43 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." (require 'ps-print) ; To get ps-print-face-extension-alist (let ((ps-print-color-p t) (ps-print-face-extension-alist ps-print-face-extension-alist)) - (cperl-ps-extend-face-list cperl-ps-print-face-properties) + (ps-extend-face-list cperl-ps-print-face-properties) (ps-print-buffer-with-faces file))) -;;; (defun cperl-ps-print-init () -;;; "Initialization of `ps-print' components for faces used in CPerl." -;;; ;; Guard against old versions -;;; (defvar ps-underlined-faces nil) -;;; (defvar ps-bold-faces nil) -;;; (defvar ps-italic-faces nil) -;;; (setq ps-bold-faces -;;; (append '(font-lock-emphasized-face -;;; cperl-array-face -;;; font-lock-keyword-face -;;; font-lock-variable-name-face -;;; font-lock-constant-face -;;; font-lock-reference-face -;;; font-lock-other-emphasized-face -;;; cperl-hash-face) -;;; ps-bold-faces)) -;;; (setq ps-italic-faces -;;; (append '(cperl-nonoverridable-face -;;; font-lock-constant-face -;;; font-lock-reference-face -;;; font-lock-other-emphasized-face -;;; cperl-hash-face) -;;; ps-italic-faces)) -;;; (setq ps-underlined-faces -;;; (append '(font-lock-emphasized-face -;;; cperl-array-face -;;; font-lock-other-emphasized-face -;;; cperl-hash-face -;;; cperl-nonoverridable-face font-lock-type-face) -;;; ps-underlined-faces)) -;;; (cons 'font-lock-type-face ps-underlined-faces)) - - -(if (cperl-enable-font-lock) (cperl-windowed-init)) +;; (defun cperl-ps-print-init () +;; "Initialization of `ps-print' components for faces used in CPerl." +;; ;; Guard against old versions +;; (defvar ps-underlined-faces nil) +;; (defvar ps-bold-faces nil) +;; (defvar ps-italic-faces nil) +;; (setq ps-bold-faces +;; (append '(font-lock-emphasized-face +;; cperl-array-face +;; font-lock-keyword-face +;; font-lock-variable-name-face +;; font-lock-constant-face +;; font-lock-reference-face +;; font-lock-other-emphasized-face +;; cperl-hash-face) +;; ps-bold-faces)) +;; (setq ps-italic-faces +;; (append '(cperl-nonoverridable-face +;; font-lock-constant-face +;; font-lock-reference-face +;; font-lock-other-emphasized-face +;; cperl-hash-face) +;; ps-italic-faces)) +;; (setq ps-underlined-faces +;; (append '(font-lock-emphasized-face +;; cperl-array-face +;; font-lock-other-emphasized-face +;; cperl-hash-face +;; cperl-nonoverridable-face font-lock-type-face) +;; ps-underlined-faces)) +;; (cons 'font-lock-type-face ps-underlined-faces)) + + +(cperl-windowed-init) (defconst cperl-styles-entries '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset @@ -6484,16 +6384,14 @@ data already), may be restored by `cperl-set-style-back'. Choosing \"Current\" style will not change style, so this may be used for side-effect of memorizing only. Examples in `cperl-style-examples'." (interactive - (let ((list (mapcar (function (lambda (elt) (list (car elt)))) - cperl-style-alist))) - (list (completing-read "Enter style: " list nil 'insist)))) + (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) (or cperl-old-style (setq cperl-old-style (mapcar (function (lambda (name) (cons name (eval name)))) cperl-styles-entries))) - (let ((style (cdr (assoc style cperl-style-alist))) setting str sym) + (let ((style (cdr (assoc style cperl-style-alist))) setting) (while style (setq setting (car style) style (cdr style)) (set (car setting) (cdr setting))))) @@ -6508,6 +6406,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." cperl-old-style (cdr cperl-old-style)) (set (car setting) (cdr setting))))) +(defvar perl-dbg-flags) (defun cperl-check-syntax () (interactive) (require 'mode-compile) @@ -6540,8 +6439,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (set-buffer "*info-perl-tmp*") (rename-buffer "*info*") (set-buffer bname))) - (make-local-variable 'window-min-height) - (setq window-min-height 2) + (set (make-local-variable 'window-min-height) 2) (current-buffer))))) (defun cperl-word-at-point (&optional p) @@ -6572,8 +6470,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', default read)))) - (let ((buffer (current-buffer)) - (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" + (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner max-height char-height buf-list) (if (string-match "^-[a-zA-Z]$" command) @@ -6671,9 +6568,9 @@ Opens Perl Info buffer if needed." (setq imenu-create-index-function 'imenu-default-create-index-function imenu-prev-index-position-function - 'cperl-imenu-info-imenu-search + #'cperl-imenu-info-imenu-search imenu-extract-index-name-function - 'cperl-imenu-info-imenu-name) + #'cperl-imenu-info-imenu-name) (imenu-choose-buffer-index))))) (and index-item (progn @@ -6699,7 +6596,7 @@ If STEP is nil, `cperl-lineup-step' will be used \(or `cperl-indent-level', if `cperl-lineup-step' is nil). Will not move the position at the start to the left." (interactive "r") - (let (search col tcol seen b) + (let (search col tcol seen) (save-excursion (goto-char end) (end-of-line) @@ -6750,8 +6647,8 @@ in subdirectories too." (interactive) (let ((cmd "etags") (args '("-l" "none" "-r" - ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) - "/\\<sub[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/" + ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) + "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/" "-r" "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/" "-r" @@ -6805,17 +6702,16 @@ in subdirectories too." (if (cperl-val 'cperl-electric-parens) "" "not "))) (defun cperl-toggle-autohelp () + ;; FIXME: Turn me into a minor mode. Fix menu entries for "Auto-help on" as + ;; well. "Toggle the state of Auto-Help on Perl constructs (put in the message area). Delay of auto-help controlled by `cperl-lazy-help-time'." (interactive) - (if (fboundp 'run-with-idle-timer) - (progn - (if cperl-lazy-installed - (cperl-lazy-unstall) - (cperl-lazy-install)) - (message "Perl help messages will %sbe automatically shown now." - (if cperl-lazy-installed "" "not "))) - (message "Cannot automatically show Perl help messages - run-with-idle-timer missing."))) + (if cperl-lazy-installed + (cperl-lazy-unstall) + (cperl-lazy-install)) + (message "Perl help messages will %sbe automatically shown now." + (if cperl-lazy-installed "" "not "))) (defun cperl-toggle-construct-fix () "Toggle whether `indent-region'/`indent-sexp' fix whitespace too." @@ -6844,7 +6740,8 @@ by CPerl." (interactive "P") (or arg (setq arg (if (eq cperl-syntaxify-by-font-lock - (if backtrace 'backtrace 'message)) 0 1))) + (if backtrace 'backtrace 'message)) + 0 1))) (setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t)) (setq cperl-syntaxify-by-font-lock arg) (message "Debugging messages of syntax unwind %sabled." @@ -6861,9 +6758,8 @@ by CPerl." (auto-fill-mode 0) (if cperl-use-syntax-table-text-property-for-tags (progn - (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! - (set 'parse-sexp-lookup-properties t)))) + (set (make-local-variable 'parse-sexp-lookup-properties) t)))) ;; Copied from imenu-example--name-and-position. (defvar imenu-use-markers) @@ -6881,7 +6777,7 @@ Does not move point." (defun cperl-xsub-scan () (require 'imenu) (let ((index-alist '()) - (prev-pos 0) index index1 name package prefix) + index index1 name package prefix) (goto-char (point-min)) ;; Search for the function (progn ;;save-match-data @@ -6921,12 +6817,12 @@ Does not move point." (defun cperl-find-tags (ifile xs topdir) (let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel - (cperl-pod-here-fontify nil) f file) + (cperl-pod-here-fontify nil) file) (save-excursion (if b (set-buffer b) (cperl-setup-tmp-buf)) (erase-buffer) - (condition-case err + (condition-case nil (setq file (car (insert-file-contents ifile))) (error (if cperl-unreadable-ok nil (if (y-or-n-p @@ -6940,7 +6836,7 @@ Does not move point." (not xs)) (condition-case err ; after __END__ may have garbage (cperl-find-pods-heres nil nil noninteractive) - (error (message "While scanning for syntax: %s" err)))) + (error (message "While scanning for syntax: %S" err)))) (if xs (setq lst (cperl-xsub-scan)) (setq ind (cperl-imenu--create-perl-index)) @@ -6980,7 +6876,7 @@ Does not move point." (number-to-string (1- (elt elt 1))) ; Char pos 0-based "\n") (if (and (string-match "^[_a-zA-Z]+::" (car elt)) - (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]" + (string-match (concat "^" cperl-sub-regexp "[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]") (elt elt 3))) ;; Need to insert the name without package as well (setq lst (cons (cons (substring (elt elt 3) @@ -7038,7 +6934,7 @@ Use as (setq topdir default-directory)) (let ((tags-file-name "TAGS") (case-fold-search (and (featurep 'xemacs) (eq system-type 'emx))) - xs rel tm) + xs rel) (save-excursion (cond (inbuffer nil) ; Already there ((file-exists-p tags-file-name) @@ -7053,7 +6949,7 @@ Use as (erase-buffer) (setq erase 'ignore))) (let ((files - (condition-case err + (condition-case nil (directory-files file t (if recurse nil cperl-scan-files-regexp) t) @@ -7061,8 +6957,9 @@ Use as (if cperl-unreadable-ok nil (if (y-or-n-p (format "Directory %s unreadable. Continue? " file)) - (setq cperl-unreadable-ok t - tm nil) ; Return empty list + (progn + (setq cperl-unreadable-ok t) + nil) ; Return empty list (error "Aborting: unreadable directory %s" file))))))) (mapc (function (lambda (file) @@ -7110,7 +7007,7 @@ Use as "^\\(" "\\(package\\)\\>" "\\|" - "sub\\>[^\n]+::" + cperl-sub-regexp "\\>[^\n]+::" "\\|" "[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::" ; XSUB? "\\|" @@ -7127,10 +7024,9 @@ Use as (defun cperl-tags-hier-fill () ;; Suppose we are in a tag table cooked by cperl. (goto-char 1) - (let (type pack name pos line chunk ord cons1 file str info fileind) + (let (pack name line ord cons1 file info fileind) (while (re-search-forward cperl-tags-hier-regexp-list nil t) - (setq pos (match-beginning 0) - pack (match-beginning 2)) + (setq pack (match-beginning 2)) (beginning-of-line) (if (looking-at (concat "\\([^\n]+\\)" @@ -7182,7 +7078,7 @@ One may build such TAGS files from CPerl mode menu." (or (nthcdr 2 elt) ;; Only in one file (setcdr elt (cdr (nth 1 elt))))))) - pack name cons1 to l1 l2 l3 l4 b) + to l1 l2 l3) ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later! (setq cperl-hierarchy (list l1 l2 l3)) (if (featurep 'xemacs) ; Not checked @@ -7216,10 +7112,9 @@ One may build such TAGS files from CPerl mode menu." (or (nth 2 cperl-hierarchy) (error "No items found")) (setq update -;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) + ;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) (if (if (fboundp 'display-popup-menus-p) - (let ((f 'display-popup-menus-p)) - (funcall f)) + (display-popup-menus-p) window-system) (x-popup-menu t (nth 2 cperl-hierarchy)) (require 'tmm) @@ -7236,22 +7131,20 @@ One may build such TAGS files from CPerl mode menu." (defun cperl-tags-treeify (to level) ;; cadr of `to' is read-write. On start it is a cons (let* ((regexp (concat "^\\(" (mapconcat - 'identity + #'identity (make-list level "[_a-zA-Z0-9]+") "::") "\\)\\(::\\)?")) (packages (cdr (nth 1 to))) (methods (cdr (nth 2 to))) - l1 head tail cons1 cons2 ord writeto packs recurse - root-packages root-functions ms many_ms same_name ps + l1 head cons1 cons2 ord writeto recurse + root-packages root-functions (move-deeper (function (lambda (elt) (cond ((and (string-match regexp (car elt)) (or (eq ord 1) (match-end 2))) (setq head (substring (car elt) 0 (match-end 1)) - tail (if (match-end 2) (substring (car elt) - (match-end 2))) recurse t) (if (setq cons1 (assoc head writeto)) nil ;; Need to init new head @@ -7278,7 +7171,8 @@ One may build such TAGS files from CPerl mode menu." ;;Now clean up leaders with one child only (mapc (function (lambda (elt) (if (not (and (listp (cdr elt)) - (eq (length elt) 2))) nil + (eq (length elt) 2))) + nil (setcar elt (car (nth 1 elt))) (setcdr elt (cdr (nth 1 elt)))))) (cdr to)) @@ -7303,12 +7197,12 @@ One may build such TAGS files from CPerl mode menu." (sort root-packages (default-value 'imenu-sort-function))) root-packages)))) -;;;(x-popup-menu t -;;; '(keymap "Name1" -;;; ("Ret1" "aa") -;;; ("Head1" "ab" -;;; keymap "Name2" -;;; ("Tail1" "x") ("Tail2" "y")))) +;;(x-popup-menu t +;; '(keymap "Name1" +;; ("Ret1" "aa") +;; ("Head1" "ab" +;; keymap "Name2" +;; ("Tail1" "x") ("Tail2" "y")))) (defun cperl-list-fold (list name limit) (let (list1 list2 elt1 (num 0)) @@ -7329,7 +7223,7 @@ One may build such TAGS files from CPerl mode menu." (nreverse list2)) list1))))) -(defun cperl-menu-to-keymap (menu &optional name) +(defun cperl-menu-to-keymap (menu) (let (list) (cons 'keymap (mapcar @@ -7347,7 +7241,7 @@ One may build such TAGS files from CPerl mode menu." (defvar cperl-bad-style-regexp - (mapconcat 'identity + (mapconcat #'identity '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char "\\|") @@ -7355,7 +7249,7 @@ One may build such TAGS files from CPerl mode menu." (defvar cperl-not-bad-style-regexp (mapconcat - 'identity + #'identity '("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++ "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used. "&[(a-zA-Z0-9_$]" ; &subroutine &(var->field) @@ -7372,6 +7266,7 @@ One may build such TAGS files from CPerl mode menu." "\\$." ; $| "<<[a-zA-Z_'\"`]" ; <<FOO, <<'FOO' "||" + "//" "&&" "[CBIXSLFZ]<\\(\\sw\\|\\s \\|\\s_\\|[\n]\\)*>" ; C<code like text> "-[a-zA-Z_0-9]+[ \t]*=>" ; -option => value @@ -7393,22 +7288,22 @@ Currently it is tuned to C and Perl syntax." (setq last-nonmenu-event 13) ; To disable popup (goto-char (point-min)) (map-y-or-n-p "Insert space here? " - (lambda (arg) (insert " ")) + (lambda (_) (insert " ")) 'cperl-next-bad-style '("location" "locations" "insert a space into") - '((?\C-r (lambda (arg) - (let ((buffer-quit-function - 'exit-recursive-edit)) - (message "Exit with Esc Esc") - (recursive-edit) - t)) ; Consider acted upon + `((?\C-r ,(lambda (_) + (let ((buffer-quit-function + #'exit-recursive-edit)) + (message "Exit with Esc Esc") + (recursive-edit) + t)) ; Consider acted upon "edit, exit with Esc Esc") - (?e (lambda (arg) - (let ((buffer-quit-function - 'exit-recursive-edit)) - (message "Exit with Esc Esc") - (recursive-edit) - t)) ; Consider acted upon + (?e ,(lambda (_) + (let ((buffer-quit-function + #'exit-recursive-edit)) + (message "Exit with Esc Esc") + (recursive-edit) + t)) ; Consider acted upon "edit, exit with Esc Esc")) t) (if found-bad (goto-char found-bad) @@ -7416,7 +7311,7 @@ Currently it is tuned to C and Perl syntax." (message "No appropriate place found")))) (defun cperl-next-bad-style () - (let (p (not-found t) (point (point)) found) + (let (p (not-found t) found) (while (and not-found (re-search-forward cperl-bad-style-regexp nil 'to-end)) (setq p (point)) @@ -7445,7 +7340,7 @@ Currently it is tuned to C and Perl syntax." (defvar cperl-have-help-regexp ;;(concat "\\(" (mapconcat - 'identity + #'identity '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable "[$@]\\^[a-zA-Z]" ; Special variable "[$@][^ \n\t]" ; Special variable @@ -7545,7 +7440,7 @@ than a line. Your contribution to update/shorten it is appreciated." (defun cperl-describe-perl-symbol (val) "Display the documentation of symbol at point, a Perl operator." (let ((enable-recursive-minibuffers t) - args-file regexp) + regexp) (cond ((string-match "^[&*][a-zA-Z_]" val) (setq val (concat (substring val 0 1) "NAME"))) @@ -7712,6 +7607,7 @@ $~ The name of the current report format. ... = ... Assignment. ... == ... Numeric equality. ... =~ ... Search pattern, substitution, or translation +... ~~ .. Smart match ... > ... Numeric greater than. ... >= ... Numeric greater than or equal to. ... >> ... Bitwise shift right. @@ -7749,6 +7645,7 @@ ARGVOUT Output filehandle with -i flag. BEGIN { ... } Immediately executed (during compilation) piece of code. END { ... } Pseudo-subroutine executed after the script finishes. CHECK { ... } Pseudo-subroutine executed after the script is compiled. +UNITCHECK { ... } INIT { ... } Pseudo-subroutine executed before the script starts running. DATA Input filehandle for what follows after __END__ or __DATA__. accept(NEWSOCKET,GENERICSOCKET) @@ -7756,6 +7653,7 @@ alarm(SECONDS) atan2(X,Y) bind(SOCKET,NAME) binmode(FILEHANDLE) +break Break out of a given/when statement caller[(LEVEL)] chdir(EXPR) chmod(LIST) @@ -7771,6 +7669,7 @@ cos(EXPR) crypt(PLAINTEXT,SALT) dbmclose(%HASH) dbmopen(%HASH,DBNAME,MODE) +default { ... } default case for given/when block defined(EXPR) delete($HASH{KEY}) die(LIST) @@ -7787,6 +7686,7 @@ endservent eof[([FILEHANDLE])] ... eq ... String equality. eval(EXPR) or eval { BLOCK } +evalbytes See eval. exec([TRUENAME] ARGV0, ARGVs) or exec(SHELL_COMMAND_LINE) exit(EXPR) exp(EXPR) @@ -7823,6 +7723,7 @@ getservbyport(PORT,PROTO) getservent getsockname(SOCKET) getsockopt(SOCKET,LEVEL,OPTNAME) +given (EXPR) { [ when (EXPR) { ... } ]+ [ default { ... } ]? } gmtime(EXPR) goto LABEL ... gt ... String greater than. @@ -7883,6 +7784,7 @@ rewinddir(DIRHANDLE) rindex(STR,SUBSTR[,OFFSET]) rmdir(FILENAME) s/PATTERN/REPLACEMENT/gieoxsm +say [FILEHANDLE] [(LIST)] scalar(EXPR) seek(FILEHANDLE,POSITION,WHENCE) seekdir(DIRHANDLE,POS) @@ -7917,6 +7819,7 @@ sprintf(FORMAT,LIST) sqrt(EXPR) srand(EXPR) stat(EXPR|FILEHANDLE|VAR) +state VAR or state (VAR1,...) Introduces a static lexical variable study[(SCALAR)] sub [NAME [(format)]] { BODY } sub NAME [(format)]; sub [(format)] {...} substr(EXPR,OFFSET[,LEN]) @@ -7952,6 +7855,7 @@ x= ... Repetition assignment. y/SEARCHLIST/REPLACEMENTLIST/ ... | ... Bitwise or. ... || ... Logical or. +... // ... Defined-or. ~ ... Unary bitwise complement. #! OS interpreter indicator. If contains `perl', used for options, and -x. AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'. @@ -7972,6 +7876,7 @@ chr Converts a number to char with the same ordinal. else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. exists $HASH{KEY} True if the key exists. +fc EXPR Returns the casefolded version of EXPR. format [NAME] = Start of output format. Ended by a single dot (.) on a line. formline PICTURE, LIST Backdoor into \"format\" processing. glob EXPR Synonym of <EXPR>. @@ -7983,6 +7888,7 @@ no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method. not ... Low-precedence synonym for ! - negation. ... or ... Low-precedence synonym for ||. pos STRING Set/Get end-position of the last match over this string, see \\G. +prototype FUNC Returns the prototype of a function as a string, or undef. quotemeta [ EXPR ] Quote regexp metacharacters. qw/WORD1 .../ Synonym of split(\\='\\=', \\='WORD1 ...\\=') readline FH Synonym of <FH>. @@ -8005,6 +7911,8 @@ prototype \\&SUB Returns prototype of the function given a reference. =back End list. =cut Switch from POD to Perl. =pod Switch from Perl to POD. +=begin Switch from Perl6 to POD. +=end Switch from POD to Perl6. ") (defun cperl-switch-to-doc-buffer (&optional interactive) @@ -8027,7 +7935,7 @@ prototype \\&SUB Returns prototype of the function given a reference. ;; The REx is guaranteed to have //x ;; LEVEL shows how many levels deep to go ;; position at enter and at leave is not defined - (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos) + (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline pos) (if embed (progn (goto-char b) @@ -8223,8 +8131,8 @@ prototype \\&SUB Returns prototype of the function given a reference. (goto-char (match-end 1)) (re-search-backward "\\s|"))) ; Assume it is scanned already. ;;(forward-char 1) - (let ((b (point)) (e (make-marker)) have-x delim (c (current-column)) - (sub-p (eq (preceding-char) ?s)) s) + (let ((b (point)) (e (make-marker)) have-x delim + (sub-p (eq (preceding-char) ?s))) (forward-sexp 1) (set-marker e (1- (point))) (setq delim (preceding-char)) @@ -8301,7 +8209,7 @@ We suppose that the regexp is scanned already." (cperl-regext-to-level-start) (error ; We are outside outermost group (goto-char (cperl-make-regexp-x)))) - (let ((b (point)) (e (make-marker)) s c) + (let ((b (point)) (e (make-marker))) (forward-sexp 1) (set-marker e (1- (point))) (goto-char (1+ b)) @@ -8513,10 +8421,10 @@ the appropriate statement modifier." (declare-function Man-getpage-in-background "man" (topic)) -;;; By Anthony Foiani <afoiani@uswest.com> -;;; Getting help on modules in C-h f ? -;;; This is a modified version of `man'. -;;; Need to teach it how to lookup functions +;; By Anthony Foiani <afoiani@uswest.com> +;; Getting help on modules in C-h f ? +;; This is a modified version of `man'. +;; Need to teach it how to lookup functions ;;;###autoload (defun cperl-perldoc (word) "Run `perldoc' on WORD." @@ -8544,6 +8452,8 @@ the appropriate statement modifier." (manual-program (if is-func "perldoc -f" "perldoc"))) (cond ((featurep 'xemacs) + (defvar Manual-program) + (defvar Manual-switches) (let ((Manual-program "perldoc") (Manual-switches (if is-func (list "-f")))) (manual-entry word))) @@ -8561,7 +8471,7 @@ the appropriate statement modifier." :type 'file :group 'cperl) -;;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes) +;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (with changes) (defun cperl-pod-to-manpage () "Create a virtual manpage in Emacs from the Perl Online Documentation." (interactive) @@ -8578,13 +8488,14 @@ the appropriate statement modifier." (format (cperl-pod2man-build-command) pod2man-args)) 'Man-bgproc-sentinel))))) -;;; Updated version by him too +;; Updated version by him too (defun cperl-build-manpage () "Create a virtual manpage in Emacs from the POD in the file." (interactive) (require 'man) (cond ((featurep 'xemacs) + (defvar Manual-program) (let ((Manual-program "perldoc")) (manual-entry buffer-file-name))) (t @@ -8641,7 +8552,7 @@ a result of qr//, this is not a performance hit), t for the rest." (and (eq (get-text-property beg 'syntax-type) 'string) (setq beg (next-single-property-change beg 'syntax-type nil limit))) (cperl-map-pods-heres - (function (lambda (s e p) + (function (lambda (s _e _p) (if (memq (get-text-property s 'REx-interpolated) skip) t (setq pp s) @@ -8650,27 +8561,27 @@ a result of qr//, this is not a performance hit), t for the rest." (if pp (goto-char pp) (message "No more interpolated REx")))) -;;; Initial version contributed by Trey Belew -(defun cperl-here-doc-spell (&optional beg end) +;; Initial version contributed by Trey Belew +(defun cperl-here-doc-spell () "Spell-check HERE-documents in the Perl buffer. If a region is highlighted, restricts to the region." - (interactive "") - (cperl-pod-spell t beg end)) + (interactive) + (cperl-pod-spell t)) -(defun cperl-pod-spell (&optional do-heres beg end) +(defun cperl-pod-spell (&optional do-heres) "Spell-check POD documentation. If invoked with prefix argument, will do HERE-DOCs instead. If a region is highlighted, restricts to the region." (interactive "P") (save-excursion (let (beg end) - (if (cperl-mark-active) + (if (region-active-p) (setq beg (min (mark) (point)) end (max (mark) (point))) (setq beg (point-min) end (point-max))) (cperl-map-pods-heres (function - (lambda (s e p) + (lambda (s e _p) (if do-heres (setq e (save-excursion (goto-char e) @@ -8699,7 +8610,7 @@ function returns nil." (setq cont (funcall func pos posend prop))) (setq pos posend))))) -;;; Based on code by Masatake YAMATO: +;; Based on code by Masatake YAMATO: (defun cperl-get-here-doc-region (&optional pos pod) "Return HERE document region around the point. Return nil if the point is not in a HERE document region. If POD is non-nil, @@ -8735,7 +8646,7 @@ POS defaults to the point." (push-mark (cdr p) nil t)) ; Message, activate in transient-mode (message "I do not think POS is in POD or a HERE-doc...")))) -(defun cperl-facemenu-add-face-function (face end) +(defun cperl-facemenu-add-face-function (face _end) "A callback to process user-initiated font-change requests. Translates `bold', `italic', and `bold-italic' requests to insertion of corresponding POD directives, and `underline' to C<> POD directive. @@ -8748,7 +8659,7 @@ Such requests are usually bound to M-o LETTER." (italic . "I<") (bold-italic . "B<I<") (underline . "C<"))) - (error "Face %s not configured for cperl-mode" + (error "Face %S not configured for cperl-mode" face)))) (defun cperl-time-fontification (&optional l step lim) @@ -8811,61 +8722,52 @@ may be used to debug problems with delayed incremental fontification." (setq pos p)))) -(defun cperl-lazy-install ()) ; Avoid a warning -(defun cperl-lazy-unstall ()) ; Avoid a warning - -(if (fboundp 'run-with-idle-timer) - (progn - (defvar cperl-help-shown nil - "Non-nil means that the help was already shown now.") +(defvar cperl-help-shown nil + "Non-nil means that the help was already shown now.") - (defvar cperl-lazy-installed nil - "Non-nil means that the lazy-help handlers are installed now.") +(defvar cperl-lazy-installed nil + "Non-nil means that the lazy-help handlers are installed now.") - (defun cperl-lazy-install () - "Switches on Auto-Help on Perl constructs (put in the message area). +;; FIXME: Use eldoc? +(defun cperl-lazy-install () + "Switch on Auto-Help on Perl constructs (put in the message area). Delay of auto-help controlled by `cperl-lazy-help-time'." - (interactive) - (make-local-variable 'cperl-help-shown) - (if (and (cperl-val 'cperl-lazy-help-time) - (not cperl-lazy-installed)) - (progn - (add-hook 'post-command-hook 'cperl-lazy-hook) - (run-with-idle-timer - (cperl-val 'cperl-lazy-help-time 1000000 5) - t - 'cperl-get-help-defer) - (setq cperl-lazy-installed t)))) - - (defun cperl-lazy-unstall () - "Switches off Auto-Help on Perl constructs (put in the message area). + (interactive) + (make-local-variable 'cperl-help-shown) + (if (and (cperl-val 'cperl-lazy-help-time) + (not cperl-lazy-installed)) + (progn + (add-hook 'post-command-hook #'cperl-lazy-hook) + (run-with-idle-timer + (cperl-val 'cperl-lazy-help-time 1000000 5) + t + #'cperl-get-help-defer) + (setq cperl-lazy-installed t)))) + +(defun cperl-lazy-unstall () + "Switch off Auto-Help on Perl constructs (put in the message area). Delay of auto-help controlled by `cperl-lazy-help-time'." - (interactive) - (remove-hook 'post-command-hook 'cperl-lazy-hook) - (cancel-function-timers 'cperl-get-help-defer) - (setq cperl-lazy-installed nil)) + (interactive) + (remove-hook 'post-command-hook #'cperl-lazy-hook) + (cancel-function-timers #'cperl-get-help-defer) + (setq cperl-lazy-installed nil)) - (defun cperl-lazy-hook () - (setq cperl-help-shown nil)) +(defun cperl-lazy-hook () + (setq cperl-help-shown nil)) - (defun cperl-get-help-defer () - (if (not (memq major-mode '(perl-mode cperl-mode))) nil - (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) - (cperl-get-help) - (setq cperl-help-shown t)))) - (cperl-lazy-install))) +(defun cperl-get-help-defer () + (if (not (memq major-mode '(perl-mode cperl-mode))) nil + (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t)) + (cperl-get-help) + (setq cperl-help-shown t)))) +(cperl-lazy-install) ;;; Plug for wrong font-lock: (defun cperl-font-lock-unfontify-region-function (beg end) - (let* ((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename) - (remove-text-properties beg end '(face nil)) - (if (and (not modified) (buffer-modified-p)) - (set-buffer-modified-p nil)))) + (with-silent-modifications + (remove-text-properties beg end '(face nil)))) (defun cperl-font-lock-fontify-region-function (beg end loudly) "Extends the region to safe positions, then calls the default function. @@ -8897,6 +8799,7 @@ do extra unwind via `cperl-unwind-to-safe'." (font-lock-default-fontify-region beg end loudly)) (defvar cperl-d-l nil) +(defvar edebug-backtrace-buffer) ;FIXME: Why? (defun cperl-fontify-syntaxically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") @@ -8957,7 +8860,7 @@ do extra unwind via `cperl-unwind-to-safe'." nil) ; Do not iterate ;; Called when any modification is made to buffer text. -(defun cperl-after-change-function (beg end old-len) +(defun cperl-after-change-function (beg _end _old-len) ;; We should have been informed about changes by `font-lock'. Since it ;; does not inform as which calls are deferred, do it ourselves (if cperl-syntax-done-to diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 6cd02da8f52..432be1aaad8 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -568,6 +568,14 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (set-window-start nil start) (goto-char pos))) +(defun cpp-locate-user-emacs-file (file) + (locate-user-emacs-file + ;; Remove initial '.' from file. + (if (eq (aref file 0) ?.) + (substring file 1) + file) + file)) + (defun cpp-edit-load () "Load cpp configuration." (interactive) @@ -576,8 +584,8 @@ You can also use the keyboard accelerators indicated like this: [K]ey." nil) ((file-readable-p cpp-config-file) (load-file cpp-config-file)) - ((file-readable-p (concat "~/" cpp-config-file)) - (load-file cpp-config-file))) + ((file-readable-p (cpp-locate-user-emacs-file cpp-config-file)) + (load-file (cpp-locate-user-emacs-file cpp-config-file)))) (if (derived-mode-p 'cpp-edit-mode) (cpp-edit-reset))) @@ -586,7 +594,10 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (interactive) (require 'pp) (with-current-buffer cpp-edit-buffer - (let ((buffer (find-file-noselect cpp-config-file))) + (let* ((config-file (if (file-writable-p cpp-config-file) + cpp-config-file + (cpp-locate-user-emacs-file cpp-config-file))) + (buffer (find-file-noselect config-file))) (set-buffer buffer) (erase-buffer) (pp (list 'setq 'cpp-known-face @@ -601,7 +612,7 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (list 'quote cpp-unknown-writable)) buffer) (pp (list 'setq 'cpp-edit-list (list 'quote cpp-edit-list)) buffer) - (write-file cpp-config-file)))) + (write-file config-file)))) (defun cpp-edit-home () "Switch back to original buffer." diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index a578896dbf7..ff79b909563 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -180,11 +180,7 @@ Suspicious constructs are highlighted using `font-lock-warning-face'. Note, in addition to enabling this minor mode, the major mode must be included in the variable `cwarn-configuration'. By default C and -C++ modes are included. - -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." +C++ modes are included." :group 'cwarn :lighter cwarn-mode-text (cwarn-font-lock-keywords cwarn-mode) (font-lock-flush)) diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index 1ed07ba17bb..66f1d398df4 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2001-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.2 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index 7fe61cd626e..7defe9877b2 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.10 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index c0dbc9e3308..2dec3f9159b 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2001-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.1 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index bbaba13e688..0dc82fc3bff 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2001-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.2 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index c6ebc8d3969..06aaf8a3f55 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.9 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index 3affbcc41d7..5857aa306ba 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.0 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 894c9dd9d79..eac0bfc878a 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.4 ;; Package: ebnf2ps diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 40d6af9e654..e29eb74a05b 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1,9 +1,9 @@ -;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript +;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -*- lexical-binding:t -*- ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Version: 4.4 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre @@ -30,8 +30,7 @@ Vinicius's last change version. When reporting bugs, please also report the version of Emacs, if any, that ebnf2ps was running with. Please send all bug fixes and enhancements to - Vinicius Jose Latorre <viniciusjl@ig.com.br>. -") + Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") ;;; Commentary: @@ -1154,6 +1153,7 @@ Please send all bug fixes and enhancements to (require 'ps-print) +(eval-when-compile (require 'cl-lib)) (and (string< ps-print-version "5.2.3") (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) @@ -2047,8 +2047,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)." (defcustom ebnf-default-width 0.6 - "Specify additional border width over default terminal, non-terminal or -special." + "Additional border width over default terminal, non-terminal or special." :type 'number :version "20" :group 'ebnf2ps) @@ -2252,7 +2251,7 @@ See also `ebnf-print-buffer'." (defun ebnf-print-buffer (&optional filename) "Generate and print a PostScript syntactic chart image of the buffer. -When called with a numeric prefix argument (C-u), prompts the user for +When called with a numeric prefix argument (\\[universal-argument]), prompts the user for the name of a file to save the PostScript image in, instead of sending it to the printer. @@ -2383,6 +2382,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing (ebnf-log-header "(ebnf-eps-buffer)") (ebnf-eps-region (point-min) (point-max))) +(defvar ebnf-eps-executing) ;;;###autoload (defun ebnf-eps-region (from to) @@ -2411,7 +2411,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing ;;;###autoload -(defalias 'ebnf-despool 'ps-despool) +(defalias 'ebnf-despool #'ps-despool) ;;;###autoload @@ -2611,7 +2611,8 @@ See also `ebnf-syntax-buffer'." (defvar ebnf-stack-style nil - "Used in functions `ebnf-reset-style', `ebnf-push-style' and + "Stack of styles. +Used in functions `ebnf-reset-style', `ebnf-push-style' and `ebnf-pop-style'.") @@ -3999,7 +4000,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and % === end EBNF engine " - "EBNF PostScript prologue") + "EBNF PostScript prologue.") (defconst ebnf-eps-prologue @@ -4276,7 +4277,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and }bind def " - "EBNF EPS prologue") + "EBNF EPS prologue.") (defconst ebnf-eps-begin @@ -4292,14 +4293,14 @@ end %%EndProlog " - "EBNF EPS begin") + "EBNF EPS begin.") (defconst ebnf-eps-end "#ebnf2ps#end %%EOF " - "EBNF EPS end") + "EBNF EPS end.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -4329,14 +4330,16 @@ end ;; hacked fom `ps-output-string-prim' (ps-print.el) (defun ebnf-eps-string (string) - (let* ((str (string-as-unibyte string)) + (let* ((str string) (len (length str)) (index 0) (new "(") ; insert start-string delimiter start special) ;; Find and quote special characters as necessary for PS - ;; This skips everything except control chars, non-ASCII chars, (, ) and \. - (while (setq start (string-match "[^]-~ -'*-[]" str index)) + ;; This skips everything except control chars, non-ASCII chars, + ;; (, ), \, and DEL. + (while (setq start (string-match "[[:cntrl:][:nonascii:]\177()\\]" + str index)) (setq special (aref str start) new (concat new (substring str index start) @@ -4536,26 +4539,25 @@ end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PostScript generation +(defvar ebnf-tree) -(defun ebnf-generate-eps (ebnf-tree) - (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) +(defun ebnf-generate-eps (tree) + (let* ((ebnf-tree tree) + (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p (float (car (ps-color-values "white"))) 1.0)) (ebnf-total (length ebnf-tree)) (ebnf-nprod 0) - (old-ps-output (symbol-function 'ps-output)) - (old-ps-output-string (symbol-function 'ps-output-string)) (eps-buffer (get-buffer-create ebnf-eps-buffer-name)) - ebnf-debug-ps error-msg horizontal + ebnf-debug-ps horizontal prod prod-name prod-width prod-height prod-list file-list) - ;; redefines `ps-output' and `ps-output-string' - (defalias 'ps-output 'ebnf-eps-output) - (defalias 'ps-output-string 'ps-output-string-prim) ;; generate EPS file - (save-excursion - (condition-case data - (progn + (unwind-protect + ;; redefines `ps-output' and `ps-output-string' + (cl-letf (((symbol-function 'ps-output) #'ebnf-eps-output) + ((symbol-function 'ps-output-string) #'ps-output-string-prim)) + (save-excursion (while ebnf-tree (setq prod (car ebnf-tree) prod-name (ebnf-node-name prod) @@ -4573,8 +4575,9 @@ end (if (setq prod-list (cdr (assoc prod-name ebnf-eps-production-list))) ;; insert EPS buffer in all buffer associated with production - (ebnf-eps-production-list prod-list 'file-list horizontal - prod-width prod-height eps-buffer) + (ebnf-eps-production-list + prod-list (gv-ref file-list) horizontal + prod-width prod-height eps-buffer) ;; write EPS file for production (ebnf-eps-finish-and-write eps-buffer (ebnf-eps-filename prod-name))) @@ -4584,17 +4587,10 @@ end (setq ebnf-tree (cdr ebnf-tree))) ;; write and kill temporary buffers (ebnf-eps-write-kill-temp file-list t) - (setq file-list nil)) - ;; handler - ((quit error) - (setq error-msg (error-message-string data))))) - ;; restore `ps-output' and `ps-output-string' - (defalias 'ps-output old-ps-output) - (defalias 'ps-output-string old-ps-output-string) - ;; kill temporary buffers - (kill-buffer eps-buffer) - (ebnf-eps-write-kill-temp file-list nil) - (and error-msg (error error-msg)) + (setq file-list nil))) + ;; kill temporary buffers + (kill-buffer eps-buffer) + (ebnf-eps-write-kill-temp file-list nil)) (message " "))) @@ -4610,10 +4606,10 @@ end ;; insert EPS buffer in all buffer associated with production -(defun ebnf-eps-production-list (prod-list file-list-sym horizontal +(defun ebnf-eps-production-list (prod-list file-list-ref horizontal prod-width prod-height eps-buffer) (while prod-list - (add-to-list file-list-sym (car prod-list)) + (cl-pushnew (car prod-list) (gv-deref file-list-ref) :test #'equal) (with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*")) (goto-char (point-max)) (cond @@ -4647,8 +4643,9 @@ end (setq prod-list (cdr prod-list)))) -(defun ebnf-generate (ebnf-tree) - (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) +(defun ebnf-generate (tree) + (let* ((ebnf-tree tree) + (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p (float (car (ps-color-values "white"))) 1.0)) @@ -4658,14 +4655,13 @@ end ps-print-begin-page-hook ps-print-begin-column-hook) (ps-generate (current-buffer) (point-min) (point-max) - 'ebnf-generate-postscript))) + #'ebnf-generate-postscript))) -(defvar ebnf-tree nil) (defvar ebnf-direction "R") -(defun ebnf-generate-postscript (from to) +(defun ebnf-generate-postscript (_from _to) (ebnf-begin-file) (if ebnf-horizontal-max-height (ebnf-generate-with-max-height) @@ -5134,7 +5130,7 @@ killed after process termination." (defsubst ebnf-font-background (font) (nth 3 font)) (defsubst ebnf-font-list (font) (nthcdr 4 font)) (defsubst ebnf-font-attributes (font) - (lsh (ps-extension-bit (cdr font)) -2)) + (ash (ps-extension-bit (cdr font)) -2)) (defconst ebnf-font-name-select @@ -5314,9 +5310,9 @@ killed after process termination." "\n%%DocumentNeededResources: font " (or ebnf-fonts-required (setq ebnf-fonts-required - (mapconcat 'identity + (mapconcat #'identity (ps-remove-duplicates - (mapcar 'ebnf-font-name-select + (mapcar #'ebnf-font-name-select (list ebnf-production-font ebnf-terminal-font ebnf-non-terminal-font @@ -5545,7 +5541,7 @@ killed after process termination." (ebnf-log "(ebnf-dimensions tree)") (let ((ebnf-total (length tree)) (ebnf-nprod 0)) - (mapc 'ebnf-production-dimension tree)) + (mapc #'ebnf-production-dimension tree)) tree) @@ -5925,7 +5921,7 @@ killed after process termination." )))) -(defun ebnf-justify (node seq seq-width width last-p) +(defun ebnf-justify (_node seq seq-width width last-p) (let ((term (car (if last-p (last seq) seq)))) (cond ;; adjust empty term diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index c9557900190..07b58b53823 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1107,7 +1107,7 @@ Tree mode key bindings: (and tree (ebrowse-build-tree-obarray tree))) (set (make-local-variable 'ebrowse--frozen-flag) nil) - (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn nil t) + (add-hook 'write-file-functions 'ebrowse-write-file-hook-fn nil t) (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) (when tree (ebrowse-redraw-tree) @@ -4023,7 +4023,7 @@ If VIEW is non-nil, view else find source files." (defun ebrowse-write-file-hook-fn () "Write current buffer as a class tree. -Installed on `local-write-file-hooks'." +Added to `write-file-functions'." (ebrowse-save-tree) t) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 91d05ce6983..f694252c407 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -45,7 +45,7 @@ It has `lisp-mode-abbrev-table' as its parent." "Syntax table used in `emacs-lisp-mode'.") (defvar emacs-lisp-mode-map - (let ((map (make-sparse-keymap "Emacs-Lisp")) + (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Emacs-Lisp")) (lint-map (make-sparse-keymap)) (prof-map (make-sparse-keymap)) @@ -901,10 +901,11 @@ Semicolons start comments. ;;; Emacs Lisp Byte-Code mode (eval-and-compile - (defconst emacs-list-byte-code-comment-re + (defconst emacs-lisp-byte-code-comment-re (concat "\\(#\\)@\\([0-9]+\\) " ;; Make sure it's a docstring and not a lazy-loaded byte-code. - "\\(?:[^(]\\|([^\"]\\)"))) + "\\(?:[^(]\\|([^\"]\\)") + "Regular expression matching a dynamic doc string comment.")) (defun elisp--byte-code-comment (end &optional _point) "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files." @@ -913,7 +914,7 @@ Semicolons start comments. (eq (char-after (nth 8 ppss)) ?#)) (let* ((n (save-excursion (goto-char (nth 8 ppss)) - (when (looking-at emacs-list-byte-code-comment-re) + (when (looking-at emacs-lisp-byte-code-comment-re) (string-to-number (match-string 2))))) ;; `maxdiff' tries to make sure the loop below terminates. (maxdiff n)) @@ -939,7 +940,7 @@ Semicolons start comments. (elisp--byte-code-comment end (point)) (funcall (syntax-propertize-rules - (emacs-list-byte-code-comment-re + (emacs-lisp-byte-code-comment-re (1 (prog1 "< b" (elisp--byte-code-comment end (point)))))) start end)) @@ -1131,7 +1132,9 @@ character)." (eval-expression-get-print-arguments eval-last-sexp-arg-internal))) ;; Setup the lexical environment if lexical-binding is enabled. (elisp--eval-last-sexp-print-value - (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding) + (eval (macroexpand-all + (eval-sexp-add-defvars (elisp--preceding-sexp))) + lexical-binding) (if insert-value (current-buffer) t) no-truncate char-print-limit))) (defun elisp--eval-last-sexp-print-value @@ -1164,7 +1167,6 @@ character)." (defun eval-sexp-add-defvars (exp &optional pos) "Prepend EXP with all the `defvar's that precede it in the buffer. POS specifies the starting position where EXP was found and defaults to point." - (setq exp (macroexpand-all exp)) ;Eager macro-expansion. (if (not lexical-binding) exp (save-excursion @@ -1714,9 +1716,9 @@ current buffer state and calls REPORT-FN when done." :explanation (format "byte-compile process %s died" proc)))) (ignore-errors (delete-file temp-file)) - (kill-buffer output-buffer)))))) - :stderr null-device - :noquery t))) + (kill-buffer output-buffer)))) + :stderr " *stderr of elisp-flymake-byte-compile*" + :noquery t))))) (defun elisp-flymake--batch-compile-for-flymake (&optional file) "Helper for `elisp-flymake-byte-compile'. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index a31668e1baa..6844e9b0f7c 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -26,9 +26,17 @@ ;;; Code: +;; The namespacing of this package is a mess: +;; - The file name is "etags", but the "exported" functionality doesn't use +;; this name +;; - Uses "etags-", "tags-", and "tag-" prefixes. +;; - Many functions use "-tag-" or "-tags-", or even "-etags-" not as +;; prefixes but somewhere within the name. + (require 'ring) (require 'button) (require 'xref) +(require 'multifile) ;;;###autoload (defvar tags-file-name nil @@ -49,7 +57,6 @@ Use the `etags' program to make a tags table file.") "Whether tags operations should be case-sensitive. A value of t means case-insensitive, a value of nil means case-sensitive. Any other value means use the setting of `case-fold-search'." - :group 'etags :type '(choice (const :tag "Case-sensitive" nil) (const :tag "Case-insensitive" t) (other :tag "Use default" default)) @@ -63,7 +70,6 @@ An element that is a directory means the file \"TAGS\" in that directory. To switch to a new list of tags tables, setting this variable is sufficient. If you set this variable, do not also set `tags-file-name'. Use the `etags' program to make a tags table file." - :group 'etags :type '(repeat file)) ;;;###autoload @@ -72,8 +78,7 @@ Use the `etags' program to make a tags table file." "List of extensions tried by etags when `auto-compression-mode' is on. An empty string means search the non-compressed file." :version "24.1" ; added xz - :type '(repeat string) - :group 'etags) + :type '(repeat string)) ;; !!! tags-compression-info-list should probably be replaced by access ;; to directory list and matching jka-compr-compression-info-list. Currently, @@ -91,14 +96,12 @@ An empty string means search the non-compressed file." t means do; nil means don't (always start a new list). Any other value means ask the user whether to add a new tags table to the current list (as opposed to starting a new list)." - :group 'etags :type '(choice (const :tag "Do" t) (const :tag "Don't" nil) (other :tag "Ask" ask-user))) (defcustom tags-revert-without-query nil "Non-nil means reread a TAGS table without querying, if it has changed." - :group 'etags :type 'boolean) (defvar tags-table-computed-list nil @@ -131,7 +134,6 @@ Each element is a list of strings which are file names.") "Hook to be run by \\[find-tag] after finding a tag. See `run-hooks'. The value in the buffer in which \\[find-tag] is done is used, not the value in the buffer \\[find-tag] goes to." - :group 'etags :type 'hook) ;;;###autoload @@ -140,7 +142,6 @@ not the value in the buffer \\[find-tag] goes to." If nil, and the symbol that is the value of `major-mode' has a `find-tag-default-function' property (see `put'), that is used. Otherwise, `find-tag-default' is used." - :group 'etags :type '(choice (const nil) function)) (define-obsolete-variable-alias 'find-tag-marker-ring-length @@ -148,13 +149,11 @@ Otherwise, `find-tag-default' is used." (defcustom tags-tag-face 'default "Face for tags in the output of `tags-apropos'." - :group 'etags :type 'face :version "21.1") (defcustom tags-apropos-verbose nil "If non-nil, print the name of the tags file in the *Tags List* buffer." - :group 'etags :type 'boolean :version "21.1") @@ -175,7 +174,6 @@ Example value: ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray) (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray) (\"SCWM\" scwm-documentation scwm-obarray))" - :group 'etags :type '(repeat (list (string :tag "Title") function (sexp :tag "Tags to search"))) @@ -209,9 +207,6 @@ use function `tags-table-files' to do so.") (defvar tags-included-tables nil "List of tags tables included by the current tags table.") - -(defvar next-file-list nil - "List of files for \\[next-file] to process.") ;; Hooks for file formats. @@ -274,12 +269,9 @@ buffer-local and set them to nil." (run-hook-with-args-until-success 'tags-table-format-functions)) ;;;###autoload -(defun tags-table-mode () +(define-derived-mode tags-table-mode special-mode "Tags Table" "Major mode for tags table file buffers." - (interactive) - (setq major-mode 'tags-table-mode ;FIXME: Use define-derived-mode. - mode-name "Tags Table" - buffer-undo-list t) + (setq buffer-undo-list t) (initialize-new-tags-table)) ;;;###autoload @@ -331,10 +323,10 @@ file the tag was in." (defun tags-table-check-computed-list () "Compute `tags-table-computed-list' from `tags-table-list' if necessary." - (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list))) + (let ((expanded-list (mapcar #'tags-expand-table-name tags-table-list))) (or (equal tags-table-computed-list-for expanded-list) ;; The list (or default-directory) has changed since last computed. - (let* ((compute-for (mapcar 'copy-sequence expanded-list)) + (let* ((compute-for (mapcar #'copy-sequence expanded-list)) (tables (copy-sequence compute-for)) ;Mutated in the loop. (computed nil) table-buffer) @@ -354,7 +346,7 @@ file the tag was in." (if (tags-included-tables) ;; Insert the included tables into the list we ;; are processing. - (setcdr tables (nconc (mapcar 'tags-expand-table-name + (setcdr tables (nconc (mapcar #'tags-expand-table-name (tags-included-tables)) (cdr tables)))))) ;; This table is not in core yet. Insert a placeholder @@ -439,25 +431,25 @@ Returns non-nil if it is a valid table." (progn (set-buffer (get-file-buffer file)) (or verify-tags-table-function (tags-table-mode)) - (if (or (verify-visited-file-modtime (current-buffer)) - ;; Decide whether to revert the file. - ;; revert-without-query can say to revert - ;; or the user can say to revert. - (not (or (let ((tail revert-without-query) - (found nil)) - (while tail - (if (string-match (car tail) buffer-file-name) - (setq found t)) - (setq tail (cdr tail))) - found) - tags-revert-without-query - (yes-or-no-p - (format "Tags file %s has changed, read new contents? " - file))))) - (and verify-tags-table-function - (funcall verify-tags-table-function)) + (unless (or (verify-visited-file-modtime (current-buffer)) + ;; Decide whether to revert the file. + ;; revert-without-query can say to revert + ;; or the user can say to revert. + (not (or (let ((tail revert-without-query) + (found nil)) + (while tail + (if (string-match (car tail) buffer-file-name) + (setq found t)) + (setq tail (cdr tail))) + found) + tags-revert-without-query + (yes-or-no-p + (format "Tags file %s has changed, read new contents? " + file))))) (revert-buffer t t) - (tags-table-mode))) + (tags-table-mode)) + (and verify-tags-table-function + (funcall verify-tags-table-function))) (when (file-exists-p file) (let* ((buf (find-file-noselect file)) (newfile (buffer-file-name buf))) @@ -470,7 +462,9 @@ Returns non-nil if it is a valid table." ;; Only change buffer now that we're done using potentially ;; buffer-local variables. (set-buffer buf) - (tags-table-mode))))) + (tags-table-mode) + (and verify-tags-table-function + (funcall verify-tags-table-function)))))) ;; Subroutine of visit-tags-table-buffer. Search the current tags tables ;; for one that has tags for THIS-FILE (or that includes a table that @@ -503,7 +497,7 @@ buffers. If CORE-ONLY is nil, it is ignored." ;; Select the tags table buffer and get the file list up to date. (let ((tags-file-name (car tables))) (visit-tags-table-buffer 'same) - (if (member this-file (mapcar 'expand-file-name + (if (member this-file (mapcar #'expand-file-name (tags-table-files))) ;; Found it. (setq found tables)))) @@ -854,7 +848,7 @@ If no tags table is loaded, do nothing and return nil." (defun find-tag--default () (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default))) + #'find-tag-default))) (defvar last-tag nil "Last tag found by \\[find-tag].") @@ -1699,18 +1693,14 @@ Point should be just after a string that matches TAG." (let ((bol (point))) (and (search-forward "\177" (line-end-position) t) (re-search-backward re bol t))))) - -(defcustom tags-loop-revert-buffers nil - "Non-nil means tags-scanning loops should offer to reread changed files. -These loops normally read each file into Emacs, but when a file -is already visited, they use the existing buffer. -When this flag is non-nil, they offer to revert the existing buffer -in the case where the file has changed since you visited it." - :type 'boolean - :group 'etags) +(define-obsolete-variable-alias 'tags-loop-revert-buffers 'multifile-revert-buffers "27.1") ;;;###autoload -(defun next-file (&optional initialize novisit) +(defalias 'next-file 'tags-next-file) +(make-obsolete 'next-file + "use tags-next-file or multifile-initialize and multifile-next-file instead" "27.1") +;;;###autoload +(defun tags-next-file (&optional initialize novisit) "Select next file among files in current tags table. A first argument of t (prefix arg, if interactive) initializes to the @@ -1724,71 +1714,39 @@ Value is nil if the file was already visited; if the file was newly read in, the value is the filename." ;; Make the interactive arg t if there was any prefix arg. (interactive (list (if current-prefix-arg t))) - (cond ((not initialize) - ;; Not the first run. - ) - ((eq initialize t) - ;; Initialize the list from the tags table. - (save-excursion - (let ((cbuf (current-buffer))) - ;; Visit the tags table buffer to get its list of files. - (visit-tags-table-buffer) - ;; Copy the list so we can setcdr below, and expand the file - ;; names while we are at it, in this buffer's default directory. - (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) - ;; Iterate over all the tags table files, collecting - ;; a complete list of referenced file names. - (while (visit-tags-table-buffer t cbuf) - ;; Find the tail of the working list and chain on the new - ;; sublist for this tags table. - (let ((tail next-file-list)) - (while (cdr tail) - (setq tail (cdr tail))) - ;; Use a copy so the next loop iteration will not modify the - ;; list later returned by (tags-table-files). - (if tail - (setcdr tail (mapcar 'expand-file-name (tags-table-files))) - (setq next-file-list (mapcar 'expand-file-name - (tags-table-files))))))))) - (t - ;; Initialize the list by evalling the argument. - (setq next-file-list (eval initialize)))) - (unless next-file-list - (and novisit - (get-buffer " *next-file*") - (kill-buffer " *next-file*")) - (user-error "All files processed")) - (let* ((next (car next-file-list)) - (buffer (get-file-buffer next)) - (new (not buffer))) - ;; Advance the list before trying to find the file. - ;; If we get an error finding the file, don't get stuck on it. - (setq next-file-list (cdr next-file-list)) - ;; Optionally offer to revert buffers - ;; if the files have changed on disk. - (and buffer tags-loop-revert-buffers - (not (verify-visited-file-modtime buffer)) - (y-or-n-p - (format - (if (buffer-modified-p buffer) - "File %s changed on disk. Discard your edits? " - "File %s changed on disk. Reread from disk? ") - next)) - (with-current-buffer buffer - (revert-buffer t t))) - (if (not (and new novisit)) - (find-file next) - ;; Like find-file, but avoids random warning messages. - (switch-to-buffer (get-buffer-create " *next-file*")) - (kill-all-local-variables) - (erase-buffer) - (setq new next) - (insert-file-contents new nil)) - new)) + (when initialize ;; Not the first run. + (tags--compat-initialize initialize)) + (multifile-next-file novisit) + (switch-to-buffer (current-buffer))) +(defun tags--all-files () + (save-excursion + (let ((cbuf (current-buffer)) + (files nil)) + ;; Visit the tags table buffer to get its list of files. + (visit-tags-table-buffer) + ;; Copy the list so we can setcdr below, and expand the file + ;; names while we are at it, in this buffer's default directory. + (setq files (mapcar #'expand-file-name (tags-table-files))) + ;; Iterate over all the tags table files, collecting + ;; a complete list of referenced file names. + (while (visit-tags-table-buffer t cbuf) + ;; Find the tail of the working list and chain on the new + ;; sublist for this tags table. + (let ((tail files)) + (while (cdr tail) + (setq tail (cdr tail))) + ;; Use a copy so the next loop iteration will not modify the + ;; list later returned by (tags-table-files). + (setf (if tail (cdr tail) files) + (mapcar #'expand-file-name (tags-table-files))))) + files))) + +(make-obsolete-variable 'tags-loop-operate 'multifile-initialize "27.1") (defvar tags-loop-operate nil "Form for `tags-loop-continue' to eval to change one file.") +(make-obsolete-variable 'tags-loop-scan 'multifile-initialize "27.1") (defvar tags-loop-scan '(user-error "%s" (substitute-command-keys @@ -1806,121 +1764,84 @@ Bind `case-fold-search' during the evaluation, depending on the value of case-fold-search))) (eval form))) +(defun tags--compat-files (files) + (cond + ((eq files t) (tags--all-files)) ;; Initialize the list from the tags table. + ((functionp files) files) + ((stringp (car-safe files)) files) + (t + ;; Backward compatibility <27.1 + ;; Initialize the list by evalling the argument. + (eval files)))) + +(defun tags--compat-initialize (initialize) + (multifile-initialize + (tags--compat-files initialize) + (if tags-loop-operate + (lambda () (tags-loop-eval tags-loop-operate)) + (lambda () (message "Scanning file %s...found" buffer-file-name) nil)) + (lambda () (tags-loop-eval tags-loop-scan)))) ;;;###autoload (defun tags-loop-continue (&optional first-time) "Continue last \\[tags-search] or \\[tags-query-replace] command. Used noninteractively with non-nil argument to begin such a command (the -argument is passed to `next-file', which see). - -Two variables control the processing we do on each file: the value of -`tags-loop-scan' is a form to be executed on each file to see if it is -interesting (it returns non-nil if so) and `tags-loop-operate' is a form to -evaluate to operate on an interesting file. If the latter evaluates to -nil, we exit; otherwise we scan the next file." +argument is passed to `next-file', which see)." + ;; Two variables control the processing we do on each file: the value of + ;; `tags-loop-scan' is a form to be executed on each file to see if it is + ;; interesting (it returns non-nil if so) and `tags-loop-operate' is a form to + ;; evaluate to operate on an interesting file. If the latter evaluates to + ;; nil, we exit; otherwise we scan the next file. + (declare (obsolete multifile-continue "27.1")) (interactive) - (let (new - ;; Non-nil means we have finished one file - ;; and should not scan it again. - file-finished - original-point - (messaged nil)) - (while - (progn - ;; Scan files quickly for the first or next interesting one. - ;; This starts at point in the current buffer. - (while (or first-time file-finished - (save-restriction - (widen) - (not (tags-loop-eval tags-loop-scan)))) - ;; If nothing was found in the previous file, and - ;; that file isn't in a temp buffer, restore point to - ;; where it was. - (when original-point - (goto-char original-point)) - - (setq file-finished nil) - (setq new (next-file first-time t)) - - ;; If NEW is non-nil, we got a temp buffer, - ;; and NEW is the file name. - (when (or messaged - (and (not first-time) - (> baud-rate search-slow-speed) - (setq messaged t))) - (message "Scanning file %s..." (or new buffer-file-name))) - - (setq first-time nil) - (setq original-point (if new nil (point))) - (goto-char (point-min))) + (when first-time ;; Backward compatibility. + (tags--compat-initialize first-time)) + (multifile-continue)) - ;; If we visited it in a temp buffer, visit it now for real. - (if new - (let ((pos (point))) - (erase-buffer) - (set-buffer (find-file-noselect new)) - (setq new nil) ;No longer in a temp buffer. - (widen) - (goto-char pos)) - (push-mark original-point t)) - - (switch-to-buffer (current-buffer)) - - ;; Now operate on the file. - ;; If value is non-nil, continue to scan the next file. - (save-restriction - (widen) - (tags-loop-eval tags-loop-operate))) - (setq file-finished t)) - (and messaged - (null tags-loop-operate) - (message "Scanning file %s...found" buffer-file-name)))) +;; We use it to detect when the last loop was a tags-search. +(defvar tags--last-search-operate-function nil) ;;;###autoload -(defun tags-search (regexp &optional file-list-form) +(defun tags-search (regexp &optional files) "Search through all files listed in tags table for match for REGEXP. Stops when a match is found. To continue searching for next match, use command \\[tags-loop-continue]. -If FILE-LIST-FORM is non-nil, it should be a form that, when -evaluated, will return a list of file names. The search will be -restricted to these files. +If FILES if non-nil should be a list or an iterator returning the files to search. +The search will be restricted to these files. Also see the documentation of the `tags-file-name' variable." (interactive "sTags search (regexp): ") - (if (and (equal regexp "") - (eq (car tags-loop-scan) 're-search-forward) - (null tags-loop-operate)) - ;; Continue last tags-search as if by M-,. - (tags-loop-continue nil) - (setq tags-loop-scan `(re-search-forward ',regexp nil t) - tags-loop-operate nil) - (tags-loop-continue (or file-list-form t)))) + (unless (and (equal regexp "") + ;; FIXME: If some other multifile operation took place, + ;; rather than search for "", we should repeat the last search! + (eq multifile--operate-function + tags--last-search-operate-function)) + (multifile-initialize-search + regexp + (tags--compat-files (or files t)) + tags-case-fold-search) + ;; Store it, so we can detect if some other multifile operation took + ;; place since the last search! + (setq tags--last-search-operate-function multifile--operate-function)) + (multifile-continue)) ;;;###autoload -(defun tags-query-replace (from to &optional delimited file-list-form) +(defun tags-query-replace (from to &optional delimited files) "Do `query-replace-regexp' of FROM with TO on all files listed in tags table. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. -Fourth arg FILE-LIST-FORM non-nil means initialize the replacement loop. - -If FILE-LIST-FORM is non-nil, it is a form to evaluate to -produce the list of files to search. - -See also the documentation of the variable `tags-file-name'." +For non-interactive use, superceded by `multifile-initialize-replace'." + (declare (advertised-calling-convention (from to &optional delimited) "27.1")) (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) - (setq tags-loop-scan `(let ,(unless (equal from (downcase from)) - '((case-fold-search nil))) - (if (re-search-forward ',from nil t) - ;; When we find a match, move back - ;; to the beginning of it so perform-replace - ;; will see it. - (goto-char (match-beginning 0)))) - tags-loop-operate `(perform-replace ',from ',to t t ',delimited - nil multi-query-replace-map)) - (tags-loop-continue (or file-list-form t))) - + (multifile-initialize-replace + from to + (tags--compat-files (or files t)) + (if (equal from (downcase from)) nil 'default) + delimited) + (multifile-continue)) + (defun tags-complete-tags-table-file (string predicate what) ; Doc string? (save-excursion ;; If we need to ask for the tag table, allow that. @@ -1977,7 +1898,8 @@ directory specification." (funcall tags-apropos-function regexp)))) (etags-tags-apropos-additional regexp)) (with-current-buffer "*Tags List*" - (eval-and-compile (require 'apropos)) + (require 'apropos) + (declare-function apropos-mode "apropos") (apropos-mode) ;; apropos-mode is derived from fundamental-mode and it kills ;; all local variables. @@ -2007,14 +1929,14 @@ see the doc of that variable if you want to add names to the list." (when tags-table-list (setq desired-point (point-marker)) (setq b (point)) - (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) + (princ (mapcar #'abbreviate-file-name tags-table-list) (current-buffer)) (make-text-button b (point) 'type 'tags-select-tags-table 'etags-table (car tags-table-list)) (insert "\n")) (while set-list (unless (eq (car set-list) tags-table-list) (setq b (point)) - (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) + (princ (mapcar #'abbreviate-file-name (car set-list)) (current-buffer)) (make-text-button b (point) 'type 'tags-select-tags-table 'etags-table (car (car set-list))) (insert "\n")) @@ -2028,9 +1950,9 @@ see the doc of that variable if you want to add names to the list." 'etags-table tags-file-name) (insert "\n")) (setq set-list (delete tags-file-name - (apply 'nconc (cons (copy-sequence tags-table-list) - (mapcar 'copy-sequence - tags-table-set-list))))) + (apply #'nconc (cons (copy-sequence tags-table-list) + (mapcar #'copy-sequence + tags-table-set-list))))) (while set-list (setq b (point)) (insert (abbreviate-file-name (car set-list))) @@ -2060,7 +1982,7 @@ see the doc of that variable if you want to add names to the list." (define-derived-mode select-tags-table-mode special-mode "Select Tags Table" "Major mode for choosing a current tags table among those already loaded." - (setq buffer-read-only t)) + ) (defun select-tags-table-select (button) "Select the tags table named on this line." diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 2105377a165..c3e085dda5b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -123,7 +123,6 @@ ;; mechanism for treating multi-line directives (continued by \ ). ;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. ;; You are urged to use f90-do loops (with labels if you wish). -;; 8) The highlighting mode under XEmacs is not as complete as under Emacs. ;; List of user commands ;; f90-previous-statement f90-next-statement @@ -1847,10 +1846,8 @@ A block is a subroutine, if-endif, etc." (push-mark) (goto-char pos) (setq program (f90-beginning-of-subprogram)) - (if (featurep 'xemacs) - (zmacs-activate-region) - (setq mark-active t - deactivate-mark nil)) + (setq mark-active t + deactivate-mark nil) program)) (defun f90-comment-region (beg-region end-region) @@ -2042,9 +2039,7 @@ If run in the middle of a line, the line is not broken." (goto-char save-point) (set-marker end-region-mark nil) (set-marker save-point nil) - (if (featurep 'xemacs) - (zmacs-deactivate-region) - (deactivate-mark)))) + (deactivate-mark))) (defun f90-indent-subprogram () "Properly indent the subprogram containing point." @@ -2157,9 +2152,7 @@ Like `join-line', but handles F90 syntax." f90-cache-position (point))) (setq f90-cache-position nil) (set-marker end-region-mark nil) - (if (featurep 'xemacs) - (zmacs-deactivate-region) - (deactivate-mark)))) + (deactivate-mark))) (defun f90-fill-paragraph (&optional justify) "In a comment, fill it as a paragraph, else fill the current statement. diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el new file mode 100644 index 00000000000..ebcfd7d1f6e --- /dev/null +++ b/lisp/progmodes/flymake-cc.el @@ -0,0 +1,140 @@ +;;; flymake-cc.el --- Flymake support for GNU tools for C/C++ -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: João Távora <joaotavora@gmail.com> +;; Keywords: languages, c + +;; This program 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 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Flymake support for C/C++. + +;;; Code: + +(require 'cl-lib) + +(defcustom flymake-cc-command 'flymake-cc-use-special-make-target + "Command used by the `flymake-cc' backend. +A list of strings, or a symbol naming a function that produces one +such list when called with no arguments in the buffer where the +variable `flymake-mode' is active. + +The command should invoke a GNU-style compiler that checks the +syntax of a (Obj)C(++) program passed to it via its standard +input and prints the result on its standard output." + :type '(choice + (symbol :tag "Function") + ((repeat :) string)) + :group 'flymake-cc) + +(defun flymake-cc--make-diagnostics (source) + "Parse GNU-compatible compilation messages in current buffer. +Return a list of Flymake diagnostic objects for the source buffer +SOURCE." + ;; TODO: if you can understand it, use `compilation-mode's regexps + ;; or even some of its machinery here. + ;; + ;; (set (make-local-variable 'compilation-locs) + ;; (make-hash-table :test 'equal :weakness 'value)) + ;; (compilation-parse-errors (point-min) (point-max) + ;; 'gnu 'gcc-include) + ;; (while (next-single-property-change 'compilation-message) + ;; ...) + ;; + ;; For now, this works minimally well. + (cl-loop + while + (search-forward-regexp + "^\\(In file included from \\)?<stdin>:\\([0-9]+\\):\\([0-9]+\\):\n?\\(.*\\): \\(.*\\)$" + nil t) + for msg = (match-string 5) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 2)) + (string-to-number (match-string 3))) + for type = (if (match-string 1) + :error + (assoc-default + (match-string 4) + '(("error" . :error) + ("note" . :note) + ("warning" . :warning)) + #'string-match)) + collect (flymake-make-diagnostic source beg end type msg))) + +(defun flymake-cc-use-special-make-target () + "Command for checking a file via a CHK_SOURCES Make target." + (unless (executable-find "make") (error "Make not found")) + `("make" "check-syntax" "CHK_SOURCES=-x c -")) + +(defvar-local flymake-cc--proc nil "Internal variable for `flymake-gcc'") + +;; forward declare this to shoosh compiler (instead of requiring +;; flymake-proc) +;; +(defvar flymake-proc-allowed-file-name-masks) + +;;;###autoload +(defun flymake-cc (report-fn &rest _args) + "Flymake backend for GNU-style C compilers. +This backend uses `flymake-cc-command' (which see) to launch a +process that is passed the current buffer's contents via stdin. +REPORT-FN is Flymake's callback." + ;; HACK: XXX: Assuming this backend function is run before it in + ;; `flymake-diagnostic-functions', very hackingly convince the other + ;; backend `flymake-proc-legacy-backend', which is on by default, to + ;; disable itself. + ;; + (setq-local flymake-proc-allowed-file-name-masks nil) + (when (process-live-p flymake-cc--proc) + (kill-process flymake-cc--proc)) + (let ((source (current-buffer))) + (save-restriction + (widen) + (setq + flymake-cc--proc + (make-process + :name "gcc-flymake" + :buffer (generate-new-buffer "*gcc-flymake*") + :command (if (symbolp flymake-cc-command) + (funcall flymake-cc-command) + flymake-cc-command) + :noquery t :connection-type 'pipe + :sentinel + (lambda (p _ev) + (when (eq 'exit (process-status p)) + (unwind-protect + (when (with-current-buffer source (eq p flymake-cc--proc)) + (with-current-buffer (process-buffer p) + (goto-char (point-min)) + (let ((diags + (flymake-cc--make-diagnostics source))) + (if (or diags (zerop (process-exit-status p))) + (funcall report-fn diags) + ;; non-zero exit with no diags is cause + ;; for alarm + (funcall report-fn + :panic :explanation + (buffer-substring + (point-min) (progn (goto-char (point-min)) + (line-end-position)))))))) + ;; (display-buffer (process-buffer p)) ; uncomment to debug + (kill-buffer (process-buffer p))))))) + (process-send-region flymake-cc--proc (point-min) (point-max)) + (process-send-eof flymake-cc--proc)))) + +(provide 'flymake-cc) +;;; flymake-cc.el ends here diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 4792a945308..8600be9b97c 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2003-2018 Free Software Foundation, Inc. ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> -;; Maintainer: Leo Liu <sdl.web@gmail.com> -;; Version: 0.3 +;; Maintainer: João Távora <joaotavora@gmail.com> +;; Version: 1.0 ;; Keywords: c languages tools ;; This file is part of GNU Emacs. @@ -41,6 +41,8 @@ ;;; Code: +(require 'cl-lib) + (require 'flymake) (define-obsolete-variable-alias 'flymake-compilation-prevents-syntax-check @@ -77,6 +79,13 @@ :group 'flymake :type 'integer) +(defcustom flymake-proc-ignored-file-name-regexps '() + "Files syntax checking is forbidden for. +Overrides `flymake-proc-allowed-file-name-masks'." + :group 'flymake + :type '(repeat (regexp)) + :version "27.1") + (define-obsolete-variable-alias 'flymake-allowed-file-name-masks 'flymake-proc-allowed-file-name-masks "26.1") @@ -106,6 +115,7 @@ ;; ("\\.tex\\'" 1) ) "Files syntax checking is allowed for. +Variable `flymake-proc-ignored-file-name-regexps' overrides this variable. This is an alist with elements of the form: REGEXP INIT [CLEANUP [NAME]] REGEXP is a regular expression that matches a file name. @@ -148,6 +158,9 @@ Convert it to Flymake internal format." (setq converted-list (cons (list regexp file line col) converted-list))))) converted-list)) +(define-obsolete-variable-alias 'flymake-err-line-patterns + 'flymake-proc-err-line-patterns "26.1") + (defvar flymake-proc-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text (append '( @@ -183,11 +196,10 @@ from compile.el") 'flymake-proc-default-guess "Predicate matching against diagnostic text to detect its type. Takes a single argument, the diagnostic's text and should return -a value suitable for indexing -`flymake-diagnostic-types-alist' (which see). If the returned -value is nil, a type of `:error' is assumed. For some backward -compatibility, if a non-nil value is returned that doesn't -index that alist, a type of `:warning' is assumed. +a diagnostic symbol naming a type. If the returned value is nil, +a type of `:error' is assumed. For some backward compatibility, +if a non-nil value is returned that doesn't name a type, +`:warning' is assumed. Instead of a function, it can also be a string, a regular expression. A match indicates `:warning' type, otherwise @@ -203,17 +215,22 @@ expression. A match indicates `:warning' type, otherwise :error))) (defun flymake-proc--get-file-name-mode-and-masks (file-name) - "Return the corresponding entry from `flymake-proc-allowed-file-name-masks'." + "Return the corresponding entry from `flymake-proc-allowed-file-name-masks'. +If the FILE-NAME matches a regexp from `flymake-proc-ignored-file-name-regexps', +`flymake-proc-allowed-file-name-masks' is not searched." (unless (stringp file-name) (error "Invalid file-name")) - (let ((fnm flymake-proc-allowed-file-name-masks) - (mode-and-masks nil)) - (while (and (not mode-and-masks) fnm) - (if (string-match (car (car fnm)) file-name) - (setq mode-and-masks (cdr (car fnm)))) - (setq fnm (cdr fnm))) - (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) - mode-and-masks)) + (if (cl-find file-name flymake-proc-ignored-file-name-regexps + :test (lambda (fn rex) (string-match rex fn))) + (flymake-log 3 "file %s ignored") + (let ((fnm flymake-proc-allowed-file-name-masks) + (mode-and-masks nil)) + (while (and (not mode-and-masks) fnm) + (if (string-match (car (car fnm)) file-name) + (setq mode-and-masks (cdr (car fnm)))) + (setq fnm (cdr fnm))) + (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) + mode-and-masks))) (defun flymake-proc--get-init-function (file-name) "Return init function to be used for the file." @@ -320,6 +337,9 @@ to the beginning of the list (File.h -> File.cpp moved to top)." (file-name-base file-one)) (not (equal file-one file-two)))) +(define-obsolete-variable-alias 'flymake-check-file-limit + 'flymake-proc-check-file-limit "26.1") + (defvar flymake-proc-check-file-limit 8192 "Maximum number of chars to look at when checking possible master file. Nil means search the entire file.") @@ -495,8 +515,8 @@ Create parent directories as needed." :error)) ((functionp pred) (let ((probe (funcall pred message))) - (cond ((assoc-default probe - flymake-diagnostic-types-alist) + (cond ((and (symbolp probe) + (get probe 'flymake-category)) probe) (probe :warning) @@ -1133,12 +1153,8 @@ Use CREATE-TEMP-F for creating temp copy." ;;;; -(define-obsolete-variable-alias 'flymake-check-file-limit - 'flymake-proc-check-file-limit "26.1") (define-obsolete-function-alias 'flymake-reformat-err-line-patterns-from-compile-el 'flymake-proc-reformat-err-line-patterns-from-compile-el "26.1") -(define-obsolete-variable-alias 'flymake-err-line-patterns - 'flymake-proc-err-line-patterns "26.1") (define-obsolete-function-alias 'flymake-parse-line 'flymake-proc-parse-line "26.1") (define-obsolete-function-alias 'flymake-get-include-dirs diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 40eacdd1888..5831301a57c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2003-2018 Free Software Foundation, Inc. ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> -;; Maintainer: Leo Liu <sdl.web@gmail.com> -;; Version: 0.3 +;; Maintainer: João Távora <joaotavora@gmail.com> +;; Version: 1.0 ;; Keywords: c languages tools ;; This file is part of GNU Emacs. @@ -14,10 +14,10 @@ ;; 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. @@ -34,13 +34,77 @@ ;; results produced by these backends, as well as entry points for ;; backends to hook on to. ;; -;; The main entry points are `flymake-mode' and `flymake-start' +;; The main interactive entry point is the `flymake-mode' minor mode, +;; which periodically and automatically initiates checks as the user +;; is editing the buffer. The variables `flymake-no-changes-timeout', +;; `flymake-start-syntax-check-on-newline' and +;; `flymake-start-on-flymake-mode' give finer control over the events +;; triggering a check, as does the interactive command +;; `flymake-start', which immediately starts a check. ;; -;; The docstrings of these variables are relevant to understanding how -;; Flymake works for both the user and the backend programmer: +;; Shortly after each check, a summary of collected diagnostics should +;; appear in the mode-line. If it doesn't, there might not be a +;; suitable Flymake backend for the current buffer's major mode, in +;; which case Flymake will indicate this in the mode-line. The +;; indicator will be `!' (exclamation mark), if all the configured +;; backends errored (or decided to disable themselves) and `?' +;; (question mark) if no backends were even configured. ;; -;; * `flymake-diagnostic-functions' -;; * `flymake-diagnostic-types-alist' +;; For programmers interested in writing a new Flymake backend, the +;; docstring of `flymake-diagnostic-functions', the Flymake manual, +;; and the code of existing backends are probably a good starting +;; point. +;; +;; The user wishing to customize the appearance of error types should +;; set properties on the symbols associated with each diagnostic type. +;; The standard diagnostic symbols are `:error', `:warning' and +;; `:note' (though a specific backend may define and use more). The +;; following properties can be set: +;; +;; * `flymake-bitmap', an image displayed in the fringe according to +;; `flymake-fringe-indicator-position'. The value actually follows +;; the syntax of `flymake-error-bitmap' (which see). It is overridden +;; by any `before-string' overlay property. +;; +;; * `flymake-severity', a non-negative integer specifying the +;; diagnostic's severity. The higher, the more serious. If the +;; overlay property `priority' is not specified, `severity' is used to +;; set it and help sort overlapping overlays. +;; +;; * `flymake-overlay-control', an alist ((OVPROP . VALUE) ...) of +;; further properties used to affect the appearance of Flymake +;; annotations. With the exception of `category' and `evaporate', +;; these properties are applied directly to the created overlay. See +;; Info Node `(elisp)Overlay Properties'. +;; +;; * `flymake-category', a symbol whose property list is considered a +;; default for missing values of any other properties. This is useful +;; to backend authors when creating new diagnostic types that differ +;; from an existing type by only a few properties. The category +;; symbols `flymake-error', `flymake-warning' and `flymake-note' make +;; good candidates for values of this property. +;; +;; For instance, to omit the fringe bitmap displayed for the standard +;; `:note' type, set its `flymake-bitmap' property to nil: +;; +;; (put :note 'flymake-bitmap nil) +;; +;; To change the face for `:note' type, add a `face' entry to its +;; `flymake-overlay-control' property. +;; +;; (push '(face . highlight) (get :note 'flymake-overlay-control)) +;; +;; If you push another alist entry in front, it overrides the previous +;; one. So this effectively removes the face from `:note' +;; diagnostics. +;; +;; (push '(face . nil) (get :note 'flymake-overlay-control)) +;; +;; To erase customizations and go back to the original look for +;; `:note' types: +;; +;; (cl-remf (symbol-plist :note) 'flymake-overlay-control) +;; (cl-remf (symbol-plist :note) 'flymake-bitmap) ;; ;;; Code: @@ -132,11 +196,17 @@ If nil, never start checking buffer automatically like this." 'flymake-start-on-flymake-mode "26.1") (defcustom flymake-start-on-flymake-mode t - "Start syntax check when `flymake-mode' is enabled. + "If non-nil, start syntax check when `flymake-mode' is enabled. Specifically, start it when the buffer is actually displayed." :version "26.1" :type 'boolean) +(defcustom flymake-start-on-save-buffer t + "If non-nil start syntax check when a buffer is saved. +Specifically, start it when the saved buffer is actually displayed." + :version "27.1" + :type 'boolean) + (defcustom flymake-log-level -1 "Obsolete and ignored variable." :type 'integer) @@ -149,25 +219,24 @@ Specifically, start it when the buffer is actually displayed." :version "26.1" :type 'boolean) -(when (fboundp 'define-fringe-bitmap) - (define-fringe-bitmap 'flymake-double-exclamation-mark - (vector #b00000000 - #b00000000 - #b00000000 - #b00000000 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b01100110 - #b00000000 - #b01100110 - #b00000000 - #b00000000 - #b00000000))) +(define-fringe-bitmap 'flymake-double-exclamation-mark + (vector #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b00000000 + #b01100110 + #b00000000 + #b00000000 + #b00000000)) (defvar-local flymake-timer nil "Timer for starting syntax check.") @@ -222,18 +291,21 @@ generated it." (cl-defstruct (flymake--diag (:constructor flymake--diag-make)) - buffer beg end type text backend) + buffer beg end type text backend data overlay) ;;;###autoload (defun flymake-make-diagnostic (buffer beg end type - text) + text + &optional data) "Make a Flymake diagnostic for BUFFER's region from BEG to END. -TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a -description of the problem detected in this region." - (flymake--diag-make :buffer buffer :beg beg :end end :type type :text text)) +TYPE is a key to symbol and TEXT is a description of the problem +detected in this region. DATA is any object that the caller +wishes to attach to the created diagnostic for later retrieval." + (flymake--diag-make :buffer buffer :beg beg :end end + :type type :text text :data data)) ;;;###autoload (defun flymake-diagnostics (&optional beg end) @@ -257,6 +329,7 @@ diagnostics at BEG." (flymake--diag-accessor flymake-diagnostic-beg flymake--diag-beg beg) (flymake--diag-accessor flymake-diagnostic-end flymake--diag-end end) (flymake--diag-accessor flymake-diagnostic-backend flymake--diag-backend backend) +(flymake--diag-accessor flymake-diagnostic-data flymake--diag-data backend) (cl-defun flymake--overlays (&key beg end filter compare key) "Get flymake-related overlays. @@ -280,10 +353,6 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)." #'identity)) ovs)))) -(defun flymake-delete-own-overlays (&optional filter) - "Delete all Flymake overlays in BUFFER." - (mapc #'delete-overlay (flymake--overlays :filter filter))) - (defface flymake-error '((((supports :underline (:style wave))) :underline (:style wave :color "Red1")) @@ -370,9 +439,25 @@ number of arguments: detailed below; * the remaining arguments are keyword-value pairs in the - form (:KEY VALUE :KEY2 VALUE2...). Currently, Flymake provides - no such arguments, but backend functions must be prepared to - accept and possibly ignore any number of them. + form (:KEY VALUE :KEY2 VALUE2...). + +Currently, Flymake may provide these keyword-value pairs: + +* `:recent-changes', a list of recent changes since the last time + the backend function was called for the buffer. An empty list + indicates that no changes have been reocrded. If it is the + first time that this backend function is called for this + activation of `flymake-mode', then this argument isn't provided + at all (i.e. it's not merely nil). + + Each element is in the form (BEG END TEXT) where BEG and END + are buffer positions, and TEXT is a string containing the text + contained between those positions (if any) after the change was + performed. + +* `:changes-start' and `:changes-end', the minimum and maximum + buffer positions touched by the recent changes. These are only + provided if `:recent-changes' is also provided. Whenever Flymake or the user decides to re-check the buffer, backend functions are called as detailed above and are expected @@ -384,8 +469,9 @@ asynchronous processes or other asynchronous mechanisms. In any case, backend functions are expected to return quickly or signal an error, in which case the backend is disabled. Flymake will not try disabled backends again for any future checks of -this buffer. Certain commands, like turning `flymake-mode' off -and on again, reset the list of disabled backends. +this buffer. To reset the list of disabled backends, turn +`flymake-mode' off and on again, or interactively call +`flymake-start' with a prefix argument. If the function returns, Flymake considers the backend to be \"running\". If it has not done so already, the backend is @@ -396,8 +482,9 @@ pairs in the form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...). Currently accepted values for REPORT-ACTION are: * A (possibly empty) list of diagnostic objects created with - `flymake-make-diagnostic', causing Flymake to annotate the - buffer with this information. + `flymake-make-diagnostic', causing Flymake to delete all + previous diagnostic annotations in the buffer and create new + ones from this list. A backend may call REPORT-FN repeatedly in this manner, but only until Flymake considers that the most recently requested @@ -417,76 +504,71 @@ Currently accepted REPORT-KEY arguments are: the situation encountered, if any. * `:force': value should be a boolean suggesting that Flymake - consider the report even if it was somehow unexpected.") - -(defvar flymake-diagnostic-types-alist - `((:error - . ((flymake-category . flymake-error))) - (:warning - . ((flymake-category . flymake-warning))) - (:note - . ((flymake-category . flymake-note)))) - "Alist ((KEY . PROPS)*) of properties of Flymake diagnostic types. -KEY designates a kind of diagnostic can be anything passed as -`:type' to `flymake-make-diagnostic'. - -PROPS is an alist of properties that are applied, in order, to -the diagnostics of the type designated by KEY. The recognized -properties are: - -* Every property pertaining to overlays, except `category' and - `evaporate' (see Info Node `(elisp)Overlay Properties'), used - to affect the appearance of Flymake annotations. - -* `bitmap', an image displayed in the fringe according to - `flymake-fringe-indicator-position'. The value actually - follows the syntax of `flymake-error-bitmap' (which see). It - is overridden by any `before-string' overlay property. - -* `severity', a non-negative integer specifying the diagnostic's - severity. The higher, the more serious. If the overlay - property `priority' is not specified, `severity' is used to set - it and help sort overlapping overlays. - -* `flymake-category', a symbol whose property list is considered - a default for missing values of any other properties. This is - useful to backend authors when creating new diagnostic types - that differ from an existing type by only a few properties.") + consider the report even if it was somehow unexpected. + +* `:region': a cons (BEG . END) of buffer positions indicating + that the report applies to that region only. Specifically, + this means that Flymake will only delete diagnostic annotations + of past reports if they intersect the region by at least one + character.") + +(put 'flymake-diagnostic-functions 'safe-local-variable #'null) + +(put :error 'flymake-category 'flymake-error) +(put :warning 'flymake-category 'flymake-warning) +(put :note 'flymake-category 'flymake-note) + +(defvar flymake-diagnostic-types-alist `() "") +(make-obsolete-variable + 'flymake-diagnostic-types-alist + "Set properties on the diagnostic symbols instead. See Info +Node `(Flymake)Flymake error types'" + "27.1") (put 'flymake-error 'face 'flymake-error) -(put 'flymake-error 'bitmap 'flymake-error-bitmap) +(put 'flymake-error 'flymake-bitmap 'flymake-error-bitmap) (put 'flymake-error 'severity (warning-numeric-level :error)) (put 'flymake-error 'mode-line-face 'compilation-error) (put 'flymake-warning 'face 'flymake-warning) -(put 'flymake-warning 'bitmap 'flymake-warning-bitmap) +(put 'flymake-warning 'flymake-bitmap 'flymake-warning-bitmap) (put 'flymake-warning 'severity (warning-numeric-level :warning)) (put 'flymake-warning 'mode-line-face 'compilation-warning) (put 'flymake-note 'face 'flymake-note) -(put 'flymake-note 'bitmap 'flymake-note-bitmap) +(put 'flymake-note 'flymake-bitmap 'flymake-note-bitmap) (put 'flymake-note 'severity (warning-numeric-level :debug)) (put 'flymake-note 'mode-line-face 'compilation-info) (defun flymake--lookup-type-property (type prop &optional default) - "Look up PROP for TYPE in `flymake-diagnostic-types-alist'. -If TYPE doesn't declare PROP in either -`flymake-diagnostic-types-alist' or in the symbol of its + "Look up PROP for diagnostic TYPE. +If TYPE doesn't declare PROP in its plist or in the symbol of its associated `flymake-category' return DEFAULT." - (let ((alist-probe (assoc type flymake-diagnostic-types-alist))) - (cond (alist-probe - (let* ((alist (cdr alist-probe)) - (prop-probe (assoc prop alist))) - (if prop-probe - (cdr prop-probe) - (if-let* ((cat (assoc-default 'flymake-category alist)) - (plist (and (symbolp cat) - (symbol-plist cat))) - (cat-probe (plist-member plist prop))) - (cadr cat-probe) - default)))) - (t - default)))) + ;; This function also consults `flymake-diagnostic-types-alist' for + ;; backward compatibility. + ;; + (if (plist-member (symbol-plist type) prop) + ;; allow nil values to survive + (get type prop) + (let (alist) + (or + (alist-get + prop (setq + alist + (alist-get type flymake-diagnostic-types-alist))) + (when-let* ((cat (or + (get type 'flymake-category) + (alist-get 'flymake-category alist))) + (plist (and (symbolp cat) + (symbol-plist cat))) + (cat-probe (plist-member plist prop))) + (cadr cat-probe)) + default)))) + +(defun flymake--severity (type) + "Get the severity for diagnostic TYPE." + (flymake--lookup-type-property type 'severity + (warning-numeric-level :error))) (defun flymake--fringe-overlay-spec (bitmap &optional recursed) (if (and (symbolp bitmap) @@ -503,34 +585,38 @@ associated `flymake-category' return DEFAULT." (list bitmap))))))) (defun flymake--highlight-line (diagnostic) - "Highlight buffer with info in DIAGNOSTIC." - (when-let* ((ov (make-overlay + "Highlight buffer with info in DIGNOSTIC." + (when-let* ((type (flymake--diag-type diagnostic)) + (ov (make-overlay (flymake--diag-beg diagnostic) (flymake--diag-end diagnostic)))) - ;; First set `category' in the overlay, then copy over every other - ;; property. + ;; First set `category' in the overlay ;; - (let ((alist (assoc-default (flymake--diag-type diagnostic) - flymake-diagnostic-types-alist))) - (overlay-put ov 'category (assoc-default 'flymake-category alist)) - (cl-loop for (k . v) in alist - unless (eq k 'category) - do (overlay-put ov k v))) + (overlay-put ov 'category + (flymake--lookup-type-property type 'flymake-category)) + ;; Now "paint" the overlay with all the other non-category + ;; properties. + (cl-loop + for (ov-prop . value) in + (append (reverse ; ensure ealier props override later ones + (flymake--lookup-type-property type 'flymake-overlay-control)) + (alist-get type flymake-diagnostic-types-alist)) + do (overlay-put ov ov-prop value)) ;; Now ensure some essential defaults are set ;; (cl-flet ((default-maybe (prop value) - (unless (or (plist-member (overlay-properties ov) prop) - (let ((cat (overlay-get ov - 'flymake-category))) - (and cat - (plist-member (symbol-plist cat) prop)))) - (overlay-put ov prop value)))) - (default-maybe 'bitmap 'flymake-error-bitmap) + (unless (plist-member (overlay-properties ov) prop) + (overlay-put ov prop (flymake--lookup-type-property + type prop value))))) (default-maybe 'face 'flymake-error) (default-maybe 'before-string (flymake--fringe-overlay-spec - (overlay-get ov 'bitmap))) + (flymake--lookup-type-property + type + 'flymake-bitmap + (alist-get 'bitmap (alist-get type ; backward compat + flymake-diagnostic-types-alist))))) (default-maybe 'help-echo (lambda (window _ov pos) (with-selected-window window @@ -543,7 +629,8 @@ associated `flymake-category' return DEFAULT." ;; Some properties can't be overridden. ;; (overlay-put ov 'evaporate t) - (overlay-put ov 'flymake-diagnostic diagnostic))) + (overlay-put ov 'flymake-diagnostic diagnostic) + ov)) ;; Nothing in Flymake uses this at all any more, so this is just for ;; third-party compatibility. @@ -590,13 +677,15 @@ backend is operating normally.") (flymake-running-backends)) (cl-defun flymake--handle-report (backend token report-action - &key explanation force + &key explanation force region &allow-other-keys) "Handle reports from BACKEND identified by TOKEN. -BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the calling -convention described in `flymake-diagnostic-functions' (which -see). Optional FORCE says to handle a report even if TOKEN was -not expected." +BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the +calling convention described in +`flymake-diagnostic-functions' (which see). Optional FORCE says +to handle a report even if TOKEN was not expected. REGION is +a (BEG . END) pair of buffer positions indicating that this +report applies to that region." (let* ((state (gethash backend flymake--backend-state)) (first-report (not (flymake--backend-state-reported-p state)))) (setf (flymake--backend-state-reported-p state) t) @@ -628,16 +717,28 @@ not expected." (setq new-diags report-action) (save-restriction (widen) - ;; only delete overlays if this is the first report - (when first-report - (flymake-delete-own-overlays - (lambda (ov) - (eq backend - (flymake--diag-backend - (overlay-get ov 'flymake-diagnostic)))))) + ;; Before adding to backend's diagnostic list, decide if + ;; some or all must be deleted. When deleting, also delete + ;; the associated overlay. + (cond + (region + (dolist (diag (flymake--backend-state-diags state)) + (let ((diag-beg (flymake--diag-beg diag)) + (diag-end (flymake--diag-beg diag))) + (when (and (< diag-beg (cdr region)) + (> diag-end (car region))) + (delete-overlay (flymake--diag-overlay diag)) + (setf (flymake--backend-state-diags state) + (delq diag (flymake--backend-state-diags state))))))) + (first-report + (dolist (diag (flymake--backend-state-diags state)) + (delete-overlay (flymake--diag-overlay diag))) + (setf (flymake--backend-state-diags state) nil))) + ;; Now make new ones (mapc (lambda (diag) - (flymake--highlight-line diag) - (setf (flymake--diag-backend diag) backend)) + (let ((overlay (flymake--highlight-line diag))) + (setf (flymake--diag-backend diag) backend + (flymake--diag-overlay diag) overlay))) new-diags) (setf (flymake--backend-state-diags state) (append new-diags (flymake--backend-state-diags state))) @@ -709,14 +810,15 @@ If it is running also stop it." (flymake--backend-state-disabled state) explanation (flymake--backend-state-reported-p state) t))) -(defun flymake--run-backend (backend) - "Run the backend BACKEND, reenabling if necessary." +(defun flymake--run-backend (backend &optional args) + "Run the backend BACKEND, re-enabling if necessary. +ARGS is a keyword-value plist passed to the backend along +with a report function." (flymake-log :debug "Running backend %s" backend) (let ((run-token (cl-gensym "backend-token"))) (flymake--with-backend-state backend state (setf (flymake--backend-state-running state) run-token (flymake--backend-state-disabled state) nil - (flymake--backend-state-diags state) nil (flymake--backend-state-reported-p state) nil)) ;; FIXME: Should use `condition-case-unless-debug' here, but don't ;; for two reasons: (1) that won't let me catch errors from inside @@ -727,11 +829,14 @@ If it is running also stop it." ;; backend) will trigger an annoying backtrace. ;; (condition-case err - (funcall backend - (flymake-make-report-fn backend run-token)) + (apply backend (flymake-make-report-fn backend run-token) + args) (error (flymake--disable-backend backend err))))) +(defvar-local flymake--recent-changes nil + "Recent changes collected by `flymake-after-change-function'.") + (defun flymake-start (&optional deferred force) "Start a syntax check for the current buffer. DEFERRED is a list of symbols designating conditions to wait for @@ -777,18 +882,30 @@ Interactively, with a prefix arg, FORCE is t." 'append 'local)) (t (setq flymake-check-start-time (float-time)) - (run-hook-wrapped - 'flymake-diagnostic-functions - (lambda (backend) - (cond - ((and (not force) - (flymake--with-backend-state backend state - (flymake--backend-state-disabled state))) - (flymake-log :debug "Backend %s is disabled, not starting" - backend)) - (t - (flymake--run-backend backend))) - nil))))))) + (let ((backend-args + (and + flymake--recent-changes + (list :recent-changes + flymake--recent-changes + :changes-start + (cl-reduce + #'min (mapcar #'car flymake--recent-changes)) + :changes-end + (cl-reduce + #'max (mapcar #'cadr flymake--recent-changes)))))) + (setq flymake--recent-changes nil) + (run-hook-wrapped + 'flymake-diagnostic-functions + (lambda (backend) + (cond + ((and (not force) + (flymake--with-backend-state backend state + (flymake--backend-state-disabled state))) + (flymake-log :debug "Backend %s is disabled, not starting" + backend)) + (t + (flymake--run-backend backend backend-args))) + nil)))))))) (defvar flymake-mode-map (let ((map (make-sparse-keymap))) map) @@ -797,9 +914,6 @@ Interactively, with a prefix arg, FORCE is t." ;;;###autoload (define-minor-mode flymake-mode "Toggle Flymake mode on or off. -With a prefix argument ARG, enable Flymake mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. Flymake is an Emacs minor mode for on-the-fly syntax checking. Flymake collects diagnostic information from multiple sources, @@ -818,7 +932,9 @@ The commands `flymake-goto-next-error' and diagnostics annotated in the buffer. The visual appearance of each type of diagnostic can be changed -in the variable `flymake-diagnostic-types-alist'. +by setting properties `flymake-overlay-control', `flymake-bitmap' +and `flymake-severity' on the symbols of diagnostic types (like +`:error', `:warning' and `:note'). Activation or deactivation of backends used by Flymake in each buffer happens via the special hook @@ -839,6 +955,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) (setq flymake--backend-state (make-hash-table)) + (setq flymake--recent-changes nil) (when flymake-start-on-flymake-mode (flymake-start t))) @@ -849,7 +966,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - (flymake-delete-own-overlays) + (mapc #'delete-overlay (flymake--overlays)) (when flymake-timer (cancel-timer flymake-timer) @@ -891,15 +1008,17 @@ Do it only if `flymake-no-changes-timeout' is non-nil." (make-obsolete 'flymake-mode-off 'flymake-mode "26.1") (defun flymake-after-change-function (start stop _len) - "Start syntax check for current buffer if it isn't already running." + "Start syntax check for current buffer if it isn't already running. +START and STOP and LEN are as in `after-change-functions'." (let((new-text (buffer-substring start stop))) + (push (list start stop new-text) flymake--recent-changes) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log :debug "starting syntax check as new-line has been seen") (flymake-start t)) (flymake--schedule-timer-maybe))) (defun flymake-after-save-hook () - (when flymake-mode + (when flymake-start-on-save-buffer (flymake-log :debug "starting syntax check as buffer was saved") (flymake-start t))) @@ -922,9 +1041,9 @@ arg, skip any diagnostics with a severity less than `:warning'. If `flymake-wrap-around' is non-nil and no more next diagnostics, resumes search from top. -FILTER is a list of diagnostic types found in -`flymake-diagnostic-types-alist', or nil, if no filter is to be -applied." +FILTER is a list of diagnostic types. Only diagnostics with +matching severities matching are considered. If nil (the +default) no filter is applied." ;; TODO: let filter be a number, a severity below which diags are ;; skipped. (interactive (list 1 @@ -938,9 +1057,12 @@ applied." ov 'flymake-diagnostic))) (and diag - (or (not filter) - (memq (flymake--diag-type diag) - filter))))) + (or + (not filter) + (cl-find + (flymake--severity + (flymake--diag-type diag)) + filter :key #'flymake--severity))))) :compare (if (cl-plusp n) #'< #'>) :key #'overlay-start)) (tail (cl-member-if (lambda (ov) @@ -964,10 +1086,10 @@ applied." (funcall (overlay-get target 'help-echo) (selected-window) target (point))))) (interactive - (user-error "No more Flymake errors%s" + (user-error "No more Flymake diagnostics%s" (if filter - (format " of types %s" filter) - "")))))) + (format " of %s severity" + (mapconcat #'symbol-name filter ", ")) "")))))) (defun flymake-goto-prev-error (&optional n filter interactive) "Go to Nth previous Flymake diagnostic that matches FILTER. @@ -978,9 +1100,9 @@ prefix arg, skip any diagnostics with a severity less than If `flymake-wrap-around' is non-nil and no more previous diagnostics, resumes search from bottom. -FILTER is a list of diagnostic types found in -`flymake-diagnostic-types-alist', or nil, if no filter is to be -applied." +FILTER is a list of diagnostic types. Only diagnostics with +matching severities matching are considered. If nil (the +default) no filter is applied." (interactive (list 1 (if current-prefix-arg '(:error :warning)) t)) @@ -1063,12 +1185,10 @@ applied." (cl-loop for (type . severity) in (cl-sort (mapcar (lambda (type) - (cons type (flymake--lookup-type-property - type - 'severity - (warning-numeric-level :error)))) + (cons type (flymake--severity type))) (cl-union (hash-table-keys diags-by-type) - '(:error :warning))) + '(:error :warning) + :key #'flymake--severity)) #'> :key #'cdr) for diags = (gethash type diags-by-type) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 3fddf2392ea..bfbf6c09b27 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1040,13 +1040,9 @@ With non-nil ARG, uncomments the region." Any other key combination is executed normally." (interactive "*") (insert last-command-event) - (let* ((event (if (fboundp 'next-command-event) ; XEmacs - (next-command-event) - (read-event))) - (char (if (fboundp 'event-to-character) - (event-to-character event) event))) + (let ((event (read-event))) ;; Insert char if not equal to `?', or if abbrev-mode is off. - (if (and abbrev-mode (or (eq char ??) (eq char help-char) + (if (and abbrev-mode (or (eq event ??) (eq event help-char) (memq event help-event-list))) (fortran-abbrev-help) (push event unread-command-events)))) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 0506386a75d..32bdc315a42 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -792,7 +792,7 @@ detailed description of this mode. (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.") (gud-def gud-jump - (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l")) + (progn (gud-call "tbreak %f:%l" arg) (gud-call "jump %f:%l")) "\C-j" "Set execution address to current line.") (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") @@ -1138,9 +1138,7 @@ Changed values are highlighted with the face `font-lock-warning-face'." :version "22.2") (define-minor-mode gdb-speedbar-auto-raise - "Minor mode to automatically raise the speedbar for watch expressions. -With prefix argument ARG, automatically raise speedbar if ARG is -positive, otherwise don't automatically raise it." + "Minor mode to automatically raise the speedbar for watch expressions." :global t :group 'gdb :version "22.1") @@ -1743,16 +1741,12 @@ static char *magick[] = { (defvar breakpoint-disabled-icon nil "Icon for disabled breakpoint in display margin.") -(declare-function define-fringe-bitmap "fringe.c" - (bitmap bits &optional height width align)) - -(and (display-images-p) - ;; Bitmap for breakpoint in fringe - (define-fringe-bitmap 'breakpoint - "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") - ;; Bitmap for gud-overlay-arrow in fringe - (define-fringe-bitmap 'hollow-right-triangle - "\xe0\x90\x88\x84\x84\x88\x90\xe0")) +;; Bitmap for breakpoint in fringe +(define-fringe-bitmap 'breakpoint + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") +;; Bitmap for gud-overlay-arrow in fringe +(define-fringe-bitmap 'hollow-right-triangle + "\xe0\x90\x88\x84\x84\x88\x90\xe0") (defface breakpoint-enabled '((t @@ -2718,10 +2712,10 @@ If `default-directory' is remote, full file names are adapted accordingly." (insert "]")))))) (goto-char (point-min)) (insert "{") - (let ((re (concat "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|" - gdb--string-regexp "\\)"))) + (let ((re (concat "\\([[:alnum:]-_]+\\)="))) (while (re-search-forward re nil t) - (replace-match "\"\\1\":\\2" nil nil))) + (replace-match "\"\\1\":" nil nil) + (if (eq (char-after) ?\") (forward-sexp) (forward-char)))) (goto-char (point-max)) (insert "}"))) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index de176019a57..f2bf2099469 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -312,10 +312,9 @@ recognized according to the current value of the variable `glasses-separator'." ;;;###autoload (define-minor-mode glasses-mode "Minor mode for making identifiers likeThis readable. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When this mode is active, it tries to -add virtual separators (like underscores) at places they belong to." + +When this mode is active, it tries to add virtual +separators (like underscores) at places they belong to." :group 'glasses :lighter " o^o" (save-excursion (save-restriction @@ -326,10 +325,10 @@ add virtual separators (like underscores) at places they belong to." (if glasses-mode (progn (jit-lock-register 'glasses-change) - (add-hook 'local-write-file-hooks + (add-hook 'write-file-functions 'glasses-convert-to-unreadable nil t)) (jit-lock-unregister 'glasses-change) - (remove-hook 'local-write-file-hooks + (remove-hook 'write-file-functions 'glasses-convert-to-unreadable t))))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 0bfabd5f3fe..0ededb1b155 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -29,6 +29,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) (require 'compile) (defgroup grep nil @@ -286,6 +287,11 @@ See `compilation-error-screen-columns'" (define-key map [menu-bar grep] (cons "Grep" (make-sparse-keymap "Grep"))) + (define-key map [menu-bar grep grep-find-toggle-abbreviation] + '(menu-item "Toggle command abbreviation" + grep-find-toggle-abbreviation + :help "Toggle showing verbose command options")) + (define-key map [menu-bar grep compilation-separator3] '("----")) (define-key map [menu-bar grep compilation-kill-compilation] '(menu-item "Kill Grep" kill-compilation :help "Kill the currently running grep process")) @@ -308,7 +314,7 @@ See `compilation-error-screen-columns'" (define-key map [menu-bar grep compilation-recompile] '(menu-item "Repeat grep" recompile :help "Run grep again")) - (define-key map [menu-bar grep compilation-separator2] '("----")) + (define-key map [menu-bar grep compilation-separator1] '("----")) (define-key map [menu-bar grep compilation-first-error] '(menu-item "First Match" first-error :help "Restart at the first match, visit corresponding location")) @@ -348,17 +354,6 @@ See `compilation-error-screen-columns'" (defalias 'kill-grep 'kill-compilation) -;;;; TODO --- refine this!! - -;; (defcustom grep-use-compilation-buffer t -;; "When non-nil, grep specific commands update `compilation-last-buffer'. -;; This means that standard compile commands like \\[next-error] and \\[compile-goto-error] -;; can be used to navigate between grep matches (the default). -;; Otherwise, the grep specific commands like \\[grep-next-match] must -;; be used to navigate between grep matches." -;; :type 'boolean -;; :group 'grep) - ;; override compilation-last-buffer (defvar grep-last-buffer nil "The most recent grep buffer. @@ -435,6 +430,28 @@ See `compilation-error-regexp-alist' for format details.") help-echo "Number of matches so far") "]")) +(defcustom grep-find-abbreviate t + "If non-nil, hide part of rgrep/lgrep/zrgrep command line. +The hidden part contains a list of ignored directories and files. +Clicking on the button-like ellipsis unhides the abbreviated part +and reveals the entire command line. The visibility of the +abbreviated part can also be toggled with +`grep-find-toggle-abbreviation'." + :type 'boolean + :version "27.1" + :group 'grep) + +(defvar grep-find-abbreviate-properties + (let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]")) + (map (make-sparse-keymap))) + (define-key map [down-mouse-2] 'mouse-set-point) + (define-key map [mouse-2] 'grep-find-toggle-abbreviation) + (define-key map "\C-m" 'grep-find-toggle-abbreviation) + `(face nil display ,ellipsis mouse-face highlight + help-echo "RET, mouse-2: show unabbreviated command" + keymap ,map abbreviated-command t)) + "Properties of button-like ellipsis on part of rgrep command line.") + (defvar grep-mode-font-lock-keywords '(;; Command output lines. (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" @@ -452,9 +469,18 @@ See `compilation-error-regexp-alist' for format details.") (2 grep-error-face nil t)) ;; "filename-linenumber-" format is used for context lines in GNU grep, ;; "filename=linenumber=" for lines with function names in "git grep -p". - ("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" (0 grep-context-face) + ("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" + (0 grep-context-face) (1 (if (eq (char-after (match-beginning 1)) ?\0) - `(face nil display ,(match-string 2)))))) + `(face nil display ,(match-string 2))))) + ;; Hide excessive part of rgrep command + ("^find \\(\\. -type d .*\\\\)\\)" + (1 (if grep-find-abbreviate grep-find-abbreviate-properties + '(face nil abbreviated-command t)))) + ;; Hide excessive part of lgrep command + ("^grep \\( *--exclude.*--exclude[^ ]+\\)" + (1 (if grep-find-abbreviate grep-find-abbreviate-properties + '(face nil abbreviated-command t))))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") @@ -608,22 +634,22 @@ This function is called from `compilation-filter-hook'." ;; `grep-command' is already set, so ;; use that for testing. (grep-probe grep-command - `(nil t nil "^English" ,hello-file) + `(nil t nil "^Copyright" ,hello-file) #'call-process-shell-command) ;; otherwise use `grep-program' (grep-probe grep-program - `(nil t nil "-nH" "^English" ,hello-file))) + `(nil t nil "-nH" "^Copyright" ,hello-file))) (progn (goto-char (point-min)) (looking-at (concat (regexp-quote hello-file) - ":[0-9]+:English"))))))))) + ":[0-9]+:Copyright"))))))))) (when (eq grep-use-null-filename-separator 'auto-detect) (setq grep-use-null-filename-separator (with-temp-buffer (let* ((hello-file (expand-file-name "HELLO" data-directory)) - (args `("--null" "-ne" "^English" ,hello-file))) + (args `("--null" "-ne" "^Copyright" ,hello-file))) (if grep-use-null-device (setq args (append args (list null-device))) (push "-H" args)) @@ -632,7 +658,7 @@ This function is called from `compilation-filter-hook'." (goto-char (point-min)) (looking-at (concat (regexp-quote hello-file) - "\0[0-9]+:English")))))))) + "\0[0-9]+:Copyright")))))))) (when (eq grep-highlight-matches 'auto-detect) (setq grep-highlight-matches @@ -1048,6 +1074,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (concat command " " null-device) command) 'grep-mode)) + ;; Set default-directory if we started lgrep in the *grep* buffer. (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) @@ -1170,6 +1197,20 @@ to specify a command to run." (shell-quote-argument ")") " -prune -o "))))) +(defun grep-find-toggle-abbreviation () + "Toggle showing the hidden part of rgrep/lgrep/zrgrep command line." + (interactive) + (with-silent-modifications + (let* ((beg (next-single-property-change (point-min) 'abbreviated-command)) + (end (when beg + (next-single-property-change beg 'abbreviated-command)))) + (if end + (if (get-text-property beg 'display) + (remove-list-of-text-properties + beg end '(display help-echo mouse-face help-echo keymap)) + (add-text-properties beg end grep-find-abbreviate-properties)) + (user-error "No abbreviated part to hide/show"))))) + ;;;###autoload (defun zrgrep (regexp &optional files dir confirm template) "Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 9cf818e99ea..91b4a65edd9 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -378,6 +378,7 @@ we're in the GUD buffer)." (if (not gud-running) ,(if (stringp cmd) `(gud-call ,cmd arg) + ;; Unused lexical warning if cmd does not use "arg". cmd)))) ,(if key `(local-set-key ,(concat "\C-c" key) ',func)) ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) @@ -771,7 +772,7 @@ the buffer in which this command was invoked." (gud-def gud-cont "cont" "\C-r" "Continue with display.") (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") (gud-def gud-jump - (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l")) + (progn (gud-call "tbreak %f:%l" arg) (gud-call "jump %f:%l")) "\C-j" "Set execution address to current line.") (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") @@ -1605,7 +1606,7 @@ and source-file directory for your debugger." ;; Last group is for return value, e.g. "> test.py(2)foo()->None" ;; Either file or function name may be omitted: "> <string>(0)?()" (defvar gud-pdb-marker-regexp - "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]") + "^> \\([-a-zA-Z0-9_/.:@ \\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]") (defvar gud-pdb-marker-regexp-file-group 1) (defvar gud-pdb-marker-regexp-line-group 2) @@ -2604,7 +2605,12 @@ comint mode, which see." file-subst))) (filepart (and file-word (concat "-" (file-name-nondirectory file)))) (existing-buffer (get-buffer (concat "*gud" filepart "*")))) - (switch-to-buffer (concat "*gud" filepart "*")) + (select-window + (display-buffer + (get-buffer-create (concat "*gud" filepart "*")) + '(display-buffer-reuse-window + display-buffer-in-previous-window + display-buffer-same-window display-buffer-pop-up-window))) (when (and existing-buffer (get-buffer-process existing-buffer)) (error "This program is already being debugged")) ;; Set the dir, in case the buffer already existed with a different dir. @@ -3357,10 +3363,7 @@ Treats actions as defuns." ;;;###autoload (define-minor-mode gud-tooltip-mode - "Toggle the display of GUD tooltips. -With a prefix argument ARG, enable the feature if ARG is -positive, and disable it otherwise. If called from Lisp, enable -it if ARG is omitted or nil." + "Toggle the display of GUD tooltips." :global t :group 'gud :group 'tooltip @@ -3395,9 +3398,6 @@ it if ARG is omitted or nil." (kill-local-variable 'gdb-define-alist) (remove-hook 'after-save-hook 'gdb-create-define-alist t)))) -(define-obsolete-variable-alias 'tooltip-gud-modes - 'gud-tooltip-modes "22.1") - (defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode python-mode) "List of modes for which to enable GUD tooltips." @@ -3405,9 +3405,6 @@ it if ARG is omitted or nil." :group 'gud :group 'tooltip) -(define-obsolete-variable-alias 'tooltip-gud-display - 'gud-tooltip-display "22.1") - (defcustom gud-tooltip-display '((eq (tooltip-event-buffer gud-tooltip-event) (marker-buffer gud-overlay-arrow-position))) @@ -3499,8 +3496,6 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." (message "Dereferencing is now %s." (if gud-tooltip-dereference "on" "off"))) -(define-obsolete-function-alias 'tooltip-gud-toggle-dereference - 'gud-tooltip-dereference "22.1") (defvar tooltip-use-echo-area) (declare-function tooltip-show "tooltip" (text &optional use-echo-area)) (declare-function tooltip-strip-prompt "tooltip" (process output)) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 7ac1312d8dc..62e8c453389 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -263,9 +263,6 @@ This backup prevents any accidental clearance of `hide-fidef-env' by ;;;###autoload (define-minor-mode hide-ifdef-mode "Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -With a prefix argument ARG, enable Hide-Ifdef mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Hide-Ifdef mode is a buffer-local minor mode for use with C and C-like major modes. When enabled, code within #ifdef constructs @@ -1042,16 +1039,12 @@ preprocessing token" (defun hif-shiftleft (a b) (setq a (hif-mathify a)) (setq b (hif-mathify b)) - (if (< a 0) - (ash a b) - (lsh a b))) + (ash a b)) (defun hif-shiftright (a b) (setq a (hif-mathify a)) (setq b (hif-mathify b)) - (if (< a 0) - (ash a (- b)) - (lsh a (- b)))) + (ash a (- b))) (defalias 'hif-multiply (hif-mathify-binop *)) @@ -1628,7 +1621,7 @@ not be expanded." ((integerp result) (if (or (= 0 result) (= 1 result)) (message "%S <= `%s'" result exprstring) - (message "%S (0x%x) <= `%s'" result result exprstring))) + (message "%S (%#x) <= `%s'" result result exprstring))) ((null result) (message "%S <= `%s'" 'false exprstring)) ((eq t result) (message "%S <= `%s'" 'true exprstring)) (t (message "%S <= `%s'" result exprstring))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 799536cbf49..84b21473947 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -932,9 +932,6 @@ This can be useful if you have huge RCS logs in those comments." ;;;###autoload (define-minor-mode hs-minor-mode "Minor mode to selectively hide/show code and comment blocks. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index cbdca015e93..54e740be11f 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -1181,9 +1181,10 @@ Useful when source code is displayed as help. See the option (with-syntax-table idlwave-mode-syntax-table (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) - (if (fboundp 'font-lock-ensure) + (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1 (font-lock-ensure) - (font-lock-fontify-buffer)))))) + ;; Silence "interactive use only" warning on Emacs >= 25.1. + (with-no-warnings (font-lock-fontify-buffer))))))) (defun idlwave-help-error (name type class keyword) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 1b72eea09eb..46e2ecaa397 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1,4 +1,4 @@ -;; idlw-shell.el --- run IDL as an inferior process of Emacs. +;; idlw-shell.el --- run IDL as an inferior process of Emacs. -*- lexical-binding:t -*- ;; Copyright (C) 1999-2018 Free Software Foundation, Inc. @@ -92,7 +92,7 @@ (require 'comint) (require 'idlwave) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar idlwave-shell-have-new-custom nil) @@ -1115,8 +1115,7 @@ IDL has currently stepped.") (setq idlwave-shell-display-wframe (if (eq (selected-frame) idlwave-shell-idl-wframe) (or - (let ((flist (visible-frame-list)) - (frame (selected-frame))) + (let ((flist (visible-frame-list))) (catch 'exit (while flist (if (not (eq (car flist) @@ -1142,7 +1141,7 @@ IDL has currently stepped.") (make-frame idlwave-shell-frame-parameters))))) ;;;###autoload -(defun idlwave-shell (&optional arg quick) +(defun idlwave-shell (&optional arg) "Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'. If buffer exists but shell process is not running, start new IDL. If buffer exists and shell process is running, just switch to the buffer. @@ -1881,10 +1880,10 @@ directory." 'idlwave-shell-filter-directory 'hide 'wait)) -(defun idlwave-shell-retall (&optional arg) +(defun idlwave-shell-retall () "Return from the entire calling stack. Also get rid of widget events in the queue." - (interactive "P") + (interactive) (save-selected-window ;;if (widget_info(/MANAGED))[0] gt 0 then for i=0,n_elements(widget_info(/MANAGED))-1 do widget_control,(widget_info(/MANAGED))[i],/clear_events & (idlwave-shell-send-command "retall" nil @@ -1892,9 +1891,9 @@ Also get rid of widget events in the queue." nil t) (idlwave-shell-display-line nil))) -(defun idlwave-shell-closeall (&optional arg) +(defun idlwave-shell-closeall () "Close all open files." - (interactive "P") + (interactive) (idlwave-shell-send-command "close,/all" nil (idlwave-shell-hide-p 'misc) nil t)) @@ -2157,7 +2156,7 @@ keywords." (if entry (setq idlw-help-link (cdr entry)))) ; setting dynamic variable! (t (error "This should not happen"))))) -(defun idlwave-shell-complete-filename (&optional arg) +(defun idlwave-shell-complete-filename () "Complete a file name at point if after a file name. We assume that we are after a file name when completing one of the args of an executive .run, .rnew or .compile." @@ -2261,12 +2260,12 @@ overlays." (defun idlwave-shell-stack-up () "Display the source code one step up the calling stack." (interactive) - (incf idlwave-shell-calling-stack-index) + (cl-incf idlwave-shell-calling-stack-index) (idlwave-shell-display-level-in-calling-stack 'hide)) (defun idlwave-shell-stack-down () "Display the source code one step down the calling stack." (interactive) - (decf idlwave-shell-calling-stack-index) + (cl-decf idlwave-shell-calling-stack-index) (idlwave-shell-display-level-in-calling-stack 'hide)) (defun idlwave-shell-goto-frame (&optional frame) @@ -2739,10 +2738,9 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (bp-alist idlwave-shell-bp-alist) (orig-func (if (> dir 0) '> '<)) (closer-func (if (> dir 0) '< '>)) - bp got-bp bp-line cur-line) + bp bp-line cur-line) (while (setq bp (pop bp-alist)) (when (string= file (car (car bp))) - (setq got-bp 1) (setq cur-line (nth 1 (car bp))) (if (and (funcall orig-func cur-line orig-bp-line) @@ -2759,6 +2757,8 @@ Runs to the last statement and then steps 1 statement. Use the .out command." (interactive "P") (idlwave-shell-print arg 'help)) +(defvar zmacs-regions) + (defmacro idlwave-shell-mouse-examine (help &optional ev) "Create a function for generic examination of expressions." `(lambda (event) @@ -2782,7 +2782,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command." ;; Begin terrible hack section -- XEmacs tests for button2 explicitly ;; on drag events, calling drag-n-drop code if detected. Ughhh... -(defun idlwave-default-mouse-track-event-is-with-button (event n) +(defun idlwave-default-mouse-track-event-is-with-button (_event _n) t) (defun idlwave-xemacs-hack-mouse-track (event) @@ -3193,22 +3193,20 @@ size(___,/DIMENSIONS)" output-begin output-end buffer)))) (defun idlwave-shell-delete-output-overlay () - (unless (or (eq this-command 'idlwave-shell-mouse-nop) - (eq this-command 'handle-switch-frame)) + (unless (memql this-command '(ignore handle-switch-frame)) (condition-case nil (if idlwave-shell-output-overlay (delete-overlay idlwave-shell-output-overlay)) (error nil)) - (remove-hook 'pre-command-hook 'idlwave-shell-delete-output-overlay))) + (remove-hook 'pre-command-hook #'idlwave-shell-delete-output-overlay))) (defun idlwave-shell-delete-expression-overlay () - (unless (or (eq this-command 'idlwave-shell-mouse-nop) - (eq this-command 'handle-switch-frame)) + (unless (memql this-command '(ignore handle-switch-frame)) (condition-case nil (if idlwave-shell-expression-overlay (delete-overlay idlwave-shell-expression-overlay)) (error nil)) - (remove-hook 'pre-command-hook 'idlwave-shell-delete-expression-overlay))) + (remove-hook 'pre-command-hook #'idlwave-shell-delete-expression-overlay))) (defvar idlwave-shell-bp-alist nil "Alist of breakpoints. @@ -3591,13 +3589,13 @@ Existing overlays are recycled, in order to minimize consumption." (bp-list idlwave-shell-bp-alist) (use-glyph (and (memq idlwave-shell-mark-breakpoints '(t glyph)) idlwave-shell-bp-glyph)) - ov ov-list bp buf old-buffers win) + ov ov-list bp buf old-buffers) ;; Delete the old overlays from their buffers (if ov-alist (while (setq ov-list (pop ov-alist)) (while (setq ov (pop (cdr ov-list))) - (pushnew (overlay-buffer ov) old-buffers) + (cl-pushnew (overlay-buffer ov) old-buffers) (delete-overlay ov)))) (setq ov-alist idlwave-shell-bp-overlays @@ -3798,9 +3796,9 @@ only for glyphs)." (t (message "Unimplemented: %s" select)))))) -(defun idlwave-shell-edit-default-command-line (arg) +(defun idlwave-shell-edit-default-command-line () "Edit the current execute command." - (interactive "P") + (interactive) (setq idlwave-shell-command-line-to-execute (read-string "IDL> " idlwave-shell-command-line-to-execute))) @@ -4057,9 +4055,56 @@ Otherwise, just expand the file name." ;; Keybindings ------------------------------------------------------------ -(defvar idlwave-shell-mode-map (copy-keymap comint-mode-map) +(defvar idlwave-shell-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map comint-mode-map) + + ;;(define-key map "\M-?" 'comint-dynamic-list-completions) + ;;(define-key map "\t" 'comint-dynamic-complete) + + (define-key map "\C-w" 'comint-kill-region) + (define-key map "\t" 'idlwave-shell-complete) + (define-key map "\M-\t" 'idlwave-shell-complete) + (define-key map "\C-c\C-s" 'idlwave-shell) + (define-key map "\C-c?" 'idlwave-routine-info) + (define-key map "\C-g" 'idlwave-keyboard-quit) + (define-key map "\M-?" 'idlwave-context-help) + (define-key map [(control meta ?\?)] + 'idlwave-help-assistant-help-with-topic) + (define-key map "\C-c\C-i" 'idlwave-update-routine-info) + (define-key map "\C-c\C-y" 'idlwave-shell-char-mode-loop) + (define-key map "\C-c\C-x" 'idlwave-shell-send-char) + (define-key map "\C-c=" 'idlwave-resolve) + (define-key map "\C-c\C-v" 'idlwave-find-module) + (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) + (define-key map idlwave-shell-prefix-key + 'idlwave-shell-debug-map) + (define-key map [(up)] 'idlwave-shell-up-or-history) + (define-key map [(down)] 'idlwave-shell-down-or-history) + (define-key idlwave-shell-mode-map + (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) + 'idlwave-mouse-context-help) + map) "Keymap for `idlwave-mode'.") -(defvar idlwave-shell-electric-debug-mode-map (make-sparse-keymap)) + +(defvar idlwave-shell-electric-debug-mode-map + (let ((map (make-sparse-keymap))) + ;; A few extras in the electric debug map + (define-key map " " 'idlwave-shell-step) + (define-key map "+" 'idlwave-shell-stack-up) + (define-key map "=" 'idlwave-shell-stack-up) + (define-key map "-" 'idlwave-shell-stack-down) + (define-key map "_" 'idlwave-shell-stack-down) + (define-key map "e" (lambda () (interactive) (idlwave-shell-print '(16)))) + (define-key map "q" 'idlwave-shell-retall) + (define-key map "t" + (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) + (define-key map [(control ??)] 'idlwave-shell-electric-debug-help) + (define-key map "x" + (lambda (arg) (interactive "P") + (idlwave-shell-print arg nil nil t))) + map)) + (defvar idlwave-shell-mode-prefix-map (make-sparse-keymap)) (fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map) (defvar idlwave-mode-prefix-map (make-sparse-keymap)) @@ -4069,29 +4114,6 @@ Otherwise, just expand the file name." "Define a key in both the shell and buffer mode maps." (define-key idlwave-mode-map key hook) (define-key idlwave-shell-mode-map key hook)) - -;(define-key idlwave-shell-mode-map "\M-?" 'comint-dynamic-list-completions) -;(define-key idlwave-shell-mode-map "\t" 'comint-dynamic-complete) - -(define-key idlwave-shell-mode-map "\C-w" 'comint-kill-region) -(define-key idlwave-shell-mode-map "\t" 'idlwave-shell-complete) -(define-key idlwave-shell-mode-map "\M-\t" 'idlwave-shell-complete) -(define-key idlwave-shell-mode-map "\C-c\C-s" 'idlwave-shell) -(define-key idlwave-shell-mode-map "\C-c?" 'idlwave-routine-info) -(define-key idlwave-shell-mode-map "\C-g" 'idlwave-keyboard-quit) -(define-key idlwave-shell-mode-map "\M-?" 'idlwave-context-help) -(define-key idlwave-shell-mode-map [(control meta ?\?)] - 'idlwave-help-assistant-help-with-topic) -(define-key idlwave-shell-mode-map "\C-c\C-i" 'idlwave-update-routine-info) -(define-key idlwave-shell-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop) -(define-key idlwave-shell-mode-map "\C-c\C-x" 'idlwave-shell-send-char) -(define-key idlwave-shell-mode-map "\C-c=" 'idlwave-resolve) -(define-key idlwave-shell-mode-map "\C-c\C-v" 'idlwave-find-module) -(define-key idlwave-shell-mode-map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers) -(define-key idlwave-shell-mode-map idlwave-shell-prefix-key - 'idlwave-shell-debug-map) -(define-key idlwave-shell-mode-map [(up)] 'idlwave-shell-up-or-history) -(define-key idlwave-shell-mode-map [(down)] 'idlwave-shell-down-or-history) (define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop) (define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char) @@ -4112,22 +4134,12 @@ Otherwise, just expand the file name." [(control shift down-mouse-2)]) 'idlwave-shell-examine-select) ;; Add this one from the idlwave-mode-map -(define-key idlwave-shell-mode-map - (if (featurep 'xemacs) - [(shift button3)] - [(shift mouse-3)]) - 'idlwave-mouse-context-help) - ;; For Emacs, we need to turn off the button release events. -(defun idlwave-shell-mouse-nop (event) - (interactive "e")) + (unless (featurep 'xemacs) - (idlwave-shell-define-key-both - [(shift mouse-2)] 'idlwave-shell-mouse-nop) - (idlwave-shell-define-key-both - [(shift control mouse-2)] 'idlwave-shell-mouse-nop) - (idlwave-shell-define-key-both - [(control meta mouse-2)] 'idlwave-shell-mouse-nop)) + (idlwave-shell-define-key-both [(shift mouse-2)] 'ignore) + (idlwave-shell-define-key-both [(shift control mouse-2)] 'ignore) + (idlwave-shell-define-key-both [(control meta mouse-2)] 'ignore)) ;; The following set of bindings is used to bind the debugging keys. @@ -4207,26 +4219,6 @@ Otherwise, just expand the file name." (define-key idlwave-shell-electric-debug-mode-map (char-to-string c2) cmd)))) -;; A few extras in the electric debug map -(define-key idlwave-shell-electric-debug-mode-map " " 'idlwave-shell-step) -(define-key idlwave-shell-electric-debug-mode-map "+" 'idlwave-shell-stack-up) -(define-key idlwave-shell-electric-debug-mode-map "=" 'idlwave-shell-stack-up) -(define-key idlwave-shell-electric-debug-mode-map "-" - 'idlwave-shell-stack-down) -(define-key idlwave-shell-electric-debug-mode-map "_" - 'idlwave-shell-stack-down) -(define-key idlwave-shell-electric-debug-mode-map "e" - (lambda () (interactive) (idlwave-shell-print '(16)))) -(define-key idlwave-shell-electric-debug-mode-map "q" 'idlwave-shell-retall) -(define-key idlwave-shell-electric-debug-mode-map "t" - (lambda () (interactive) (idlwave-shell-send-command "help,/TRACE"))) -(define-key idlwave-shell-electric-debug-mode-map [(control ??)] - 'idlwave-shell-electric-debug-help) -(define-key idlwave-shell-electric-debug-mode-map "x" - (lambda (arg) (interactive "P") - (idlwave-shell-print arg nil nil t))) - - ; Enter the prefix map in two places. (fset 'idlwave-debug-map idlwave-mode-prefix-map) (fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map) @@ -4251,49 +4243,35 @@ Otherwise, just expand the file name." (define-minor-mode idlwave-shell-electric-debug-mode "Toggle Idlwave Shell Electric Debug mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When Idlwave Shell Electric Debug mode is enabled, the Idlwave Shell debugging commands are available as single key sequences." - nil " *Debugging*" idlwave-shell-electric-debug-mode-map) - -(add-hook - 'idlwave-shell-electric-debug-mode-on-hook - (lambda () - (set (make-local-variable 'idlwave-shell-electric-debug-read-only) - buffer-read-only) - (setq buffer-read-only t) - (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer)) - (if idlwave-shell-stop-line-overlay - (overlay-put idlwave-shell-stop-line-overlay 'face - idlwave-shell-electric-stop-line-face)) - (if (facep 'fringe) - (set-face-foreground 'fringe idlwave-shell-electric-stop-color - (selected-frame))))) - -(add-hook - 'idlwave-shell-electric-debug-mode-off-hook - (lambda () - ;; Return to previous read-only state - (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only) - idlwave-shell-electric-debug-read-only)) - (setq idlwave-shell-electric-debug-buffers - (delq (current-buffer) idlwave-shell-electric-debug-buffers)) - (if idlwave-shell-stop-line-overlay - (overlay-put idlwave-shell-stop-line-overlay 'face - idlwave-shell-stop-line-face) - (if (facep 'fringe) - (set-face-foreground 'fringe (face-foreground 'default)))))) - -;; easy-mmode defines electric-debug-mode for us, so we need to advise it. -(defadvice idlwave-shell-electric-debug-mode (after print-enter activate) - "Print out an entrance message." - (when idlwave-shell-electric-debug-mode + :lighter " *Debugging*" + (cond + (idlwave-shell-electric-debug-mode + (set (make-local-variable 'idlwave-shell-electric-debug-read-only) + buffer-read-only) + (setq buffer-read-only t) + (add-to-list 'idlwave-shell-electric-debug-buffers (current-buffer)) + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + idlwave-shell-electric-stop-line-face)) + (if (facep 'fringe) + (set-face-foreground 'fringe idlwave-shell-electric-stop-color + (selected-frame))) (message "Electric Debugging mode entered. Press [C-?] for help, [q] to quit")) - (force-mode-line-update)) + (t + ;; Return to previous read-only state + (setq buffer-read-only (if (boundp 'idlwave-shell-electric-debug-read-only) + idlwave-shell-electric-debug-read-only)) + (setq idlwave-shell-electric-debug-buffers + (delq (current-buffer) idlwave-shell-electric-debug-buffers)) + (if idlwave-shell-stop-line-overlay + (overlay-put idlwave-shell-stop-line-overlay 'face + idlwave-shell-stop-line-face) + (if (facep 'fringe) + (set-face-foreground 'fringe (face-foreground 'default))))))) ;; Turn it off in all relevant buffers (defvar idlwave-shell-electric-debug-buffers nil) diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 7595db98230..75f55827933 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -34,8 +34,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defun idlwave-toolbar-make-button (image) (if (featurep 'xemacs) (toolbar-make-button-list image) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 1d5dc7c7948..540931c9f2f 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -151,7 +151,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'idlw-help) ;; For XEmacs @@ -3898,7 +3898,7 @@ Buffers containing unsaved changes require confirmation before they are killed." (and (or (memq t reasons) (memq (cdr entry) reasons)) (kill-buffer (car entry)) - (incf cnt) + (cl-incf cnt) (setq idlwave-outlawed-buffers (delq entry idlwave-outlawed-buffers))) (setq idlwave-outlawed-buffers @@ -4104,14 +4104,14 @@ blank lines." (idlwave-sint-classes 10 10)))) ;; Make sure these are lists - (loop for entry in entries + (cl-loop for entry in entries for var = (car entry) do (if (not (consp (symbol-value var))) (set var (list nil)))) ;; Reset the system & library hash (when (or (eq what t) (eq what 'syslib) (null (cdr idlwave-sint-routines))) - (loop for entry in entries + (cl-loop for entry in entries for var = (car entry) for size = (nth 1 entry) do (setcdr (symbol-value var) (make-hash-table ':size size ':test 'equal))) @@ -4121,7 +4121,7 @@ blank lines." ;; Reset the buffer & shell hash (when (or (eq what t) (eq what 'bufsh) (null (car idlwave-sint-routines))) - (loop for entry in entries + (cl-loop for entry in entries for var = (car entry) for size = (nth 1 entry) do (setcar (symbol-value var) (make-hash-table ':size size ':test 'equal)))))) @@ -4680,7 +4680,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") (setq pref-list (if (match-string 1 kwd) '("X" "Y" "Z") '("X" "Y")) kwd (substring kwd (match-end 0))) - (loop for x in pref-list do + (cl-loop for x in pref-list do (push (list (concat x kwd) klink) kwds))) (push (list kwd klink) kwds))) @@ -4701,7 +4701,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") (cons (substring name 1) link) (if extra-kws (setq kwds (nconc kwds extra-kws))) (setq kwds (idlwave-rinfo-group-keywords kwds link)) - (loop for idx from 0 to 1 do + (cl-loop for idx from 0 to 1 do (if (aref syntax-vec idx) (push (append (list name (if (eq idx 0) 'pro 'fun) class '(system) @@ -4736,7 +4736,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") ;; Clean up the syntax of routines which are actually aliases by ;; removing the "OR" from the statements (let (syntax entry) - (loop for x in aliases do + (cl-loop for x in aliases do (setq entry (assoc x idlwave-system-routines)) (when entry (while (string-match " +or +" (setq syntax (nth 4 entry))) @@ -4746,7 +4746,7 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") ;; Duplicate and trim original routine aliases from rinfo list ;; This if for, e.g. OPENR/OPENW/OPENU (let (alias remove-list new parts all-parts) - (loop for x in aliases do + (cl-loop for x in aliases do (when (setq parts (split-string (cdr x) "/")) (setq new (assoc (cdr x) all-parts)) (unless new @@ -4755,30 +4755,30 @@ Gets set in cached XML rinfo, or `idlw-rinfo.el'.") (setcdr new (delete (car x) (cdr new))))) ;; Add any missing aliases (separate by slashes) - (loop for x in all-parts do + (cl-loop for x in all-parts do (if (cdr x) (push (cons (nth 1 x) (car x)) aliases))) - (loop for x in aliases do + (cl-loop for x in aliases do (when (setq alias (assoc (cdr x) idlwave-system-routines)) (unless (memq alias remove-list) (push alias remove-list)) (setq alias (copy-sequence alias)) (setcar alias (car x)) (push alias idlwave-system-routines))) - (loop for x in remove-list do + (cl-loop for x in remove-list do (delq x idlwave-system-routines)))) (defun idlwave-convert-xml-clean-sysvar-aliases (aliases) ;; Duplicate and trim original routine aliases from rinfo list ;; This if for, e.g. !X, !Y, !Z. (let (alias remove-list) - (loop for x in aliases do + (cl-loop for x in aliases do (when (setq alias (assoc (cdr x) idlwave-system-variables-alist)) (unless (memq alias remove-list) (push alias remove-list)) (setq alias (copy-sequence alias)) (setcar alias (car x)) (push alias idlwave-system-variables-alist))) - (loop for x in remove-list do + (cl-loop for x in remove-list do (delq x idlwave-system-variables-alist)))) @@ -4875,7 +4875,7 @@ Cache to disk for quick recovery." (while rinfo (setq elem (car rinfo) rinfo (cdr rinfo)) - (incf elem-cnt) + (cl-incf elem-cnt) (when (listp elem) (setq type (car elem) props (car (cdr elem))) @@ -5106,7 +5106,7 @@ Cache to disk for quick recovery." "Return the class alist - make it if necessary." (or idlwave-class-alist (let (class) - (loop for x in idlwave-routines do + (cl-loop for x in idlwave-routines do (when (and (setq class (nth 2 x)) (not (assq class idlwave-class-alist))) (push (list class) idlwave-class-alist))) @@ -5240,7 +5240,7 @@ Can run from `after-save-hook'." class (cond ((not (boundp 'idlwave-scanning-lib)) (list 'buffer (buffer-file-name))) -; ((string= (downcase (file-name-base)) +; ((string= (downcase (file-name-base (buffer-file-name)) ; (downcase name)) ; (list 'lib)) ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) @@ -6223,7 +6223,7 @@ If yes, return the index (>=1)." (let (file (cnt 0)) (catch 'exit (while entries - (incf cnt) + (cl-incf cnt) (setq file (idlwave-routine-source-file (nth 3 (car entries)))) (if (and file (idlwave-syslib-p file)) (throw 'exit cnt) @@ -6520,7 +6520,7 @@ ARROW: Location of the arrow" (progn (up-list -1) t) (error nil)) (setq pos (point)) - (incf cnt) + (cl-incf cnt) (when (and (= (following-char) ?\() (re-search-backward "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" @@ -8190,7 +8190,7 @@ demand _EXTRA in the keyword list." (while (setq re (pop regexps)) (if (string-match re name) (throw 'exit t)))))) - (loop for entry in (idlwave-routines) do + (cl-loop for entry in (idlwave-routines) do (and (nth 2 entry) ; non-nil class (memq (nth 2 entry) super-classes) ; an inherited class (eq (nth 1 entry) type) ; correct type @@ -8399,7 +8399,7 @@ If we do not know about MODULE, just return KEYWORD literally." "") (if (> total 1) "- " "")) entry props) - (incf cnt) + (cl-incf cnt) (when (and all (> cnt idlwave-rinfo-max-source-lines)) ;; No more source lines, please (insert (format @@ -8707,7 +8707,7 @@ can be used to detect possible name clashes during this process." (> (idlwave-count-memq 'lib (nth 2 (car dtwins))) 1) (> (idlwave-count-memq 'user (nth 2 (car dtwins))) 1) (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) - (incf cnt) + (cl-incf cnt) (insert (format "\n%s%s" (idlwave-make-full-name (nth 2 routine) (car routine)) @@ -8776,7 +8776,7 @@ routines, and may have been scanned." (cnt 0) source type type-cons file alist syslibp key) (while (setq entry (pop entries)) - (incf cnt) + (cl-incf cnt) (setq source (nth 3 entry) type (car source) type-cons (cons type (nth 3 source)) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 02512ae2de1..3ce5af4c49b 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2368,23 +2368,22 @@ i.e., customize JSX element indentation with `sgml-basic-offset', ;; FIXME: Such redefinitions are bad style. We should try and use some other ;; way to get the same result. -(defadvice c-forward-sws (around js-fill-paragraph activate) - (if js--filling-paragraph - (setq ad-return-value (js--forward-syntactic-ws (ad-get-arg 0))) - ad-do-it)) - -(defadvice c-backward-sws (around js-fill-paragraph activate) - (if js--filling-paragraph - (setq ad-return-value (js--backward-syntactic-ws (ad-get-arg 0))) - ad-do-it)) - -(defadvice c-beginning-of-macro (around js-fill-paragraph activate) - (if js--filling-paragraph - (setq ad-return-value (js--beginning-of-macro (ad-get-arg 0))) - ad-do-it)) - -(defun js-c-fill-paragraph (&optional justify) - "Fill the paragraph with `c-fill-paragraph'." +(defun js--fill-c-advice (js-fun) + (lambda (orig-fun &rest args) + (if js--filling-paragraph + (funcall js-fun (car args)) + (apply orig-fun args)))) + +(advice-add 'c-forward-sws + :around (js--fill-c-advice #'js--forward-syntactic-ws)) +(advice-add 'c-backward-sws + :around (js--fill-c-advice #'js--backward-syntactic-ws)) +(advice-add 'c-beginning-of-macro + :around (js--fill-c-advice #'js--beginning-of-macro)) + +(define-obsolete-function-alias 'js-c-fill-paragraph #'js-fill-paragraph "27.1") +(defun js-fill-paragraph (&optional justify) + "Fill the paragraph for Javascript code." (interactive "*P") (let ((js--filling-paragraph t) (fill-paragraph-function #'c-fill-paragraph)) @@ -3870,13 +3869,12 @@ If one hasn't been set, or if it's stale, prompt for a new one." (setq-local prettify-symbols-alist js--prettify-symbols-alist) (setq-local parse-sexp-ignore-comments t) - (setq-local parse-sexp-lookup-properties t) (setq-local which-func-imenu-joiner-function #'js--which-func-joiner) ;; Comments (setq-local comment-start "// ") (setq-local comment-end "") - (setq-local fill-paragraph-function #'js-c-fill-paragraph) + (setq-local fill-paragraph-function #'js-fill-paragraph) (setq-local normal-auto-fill-function #'js-do-auto-fill) ;; Parse cache diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index a1a66c09c63..f67407f48ee 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -557,6 +557,9 @@ This should identify a `make' command that can handle the `-q' option." :type 'string :group 'makefile) +(defvaralias 'makefile-query-one-target-method + 'makefile-query-one-target-method-function) + (defcustom makefile-query-one-target-method-function 'makefile-query-by-make-minus-q "Function to call to determine whether a make target is up to date. @@ -574,8 +577,6 @@ The function must satisfy this calling convention: makefile, any nonzero integer value otherwise." :type 'function :group 'makefile) -(defvaralias 'makefile-query-one-target-method - 'makefile-query-one-target-method-function) (defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*" "Name of the Up-to-date overview buffer." @@ -712,6 +713,7 @@ The function must satisfy this calling convention: (modify-syntax-entry ?# "< " st) (modify-syntax-entry ?\n "> " st) (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?$ "." st) st) "Syntax table used in `makefile-mode'.") diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index c768d8d6f4d..13510eef805 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -170,8 +170,8 @@ parenthetical grouping.") (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?_ "_" table) - ;; The "b" flag only applies to the second letter of the comstart - ;; and the first letter of the comend, i.e. the "4b" below is ineffective. + ;; The "b" flag only applies to the second letter of the comstart and + ;; the first letter of the comend, i.e. a "4b" below would be ineffective. ;; If we try to put `b' on the single-line comments, we get a similar ;; problem where the % and # chars appear as first chars of the 2-char ;; comend, so the multi-line ender is also turned into style-b. @@ -533,6 +533,27 @@ Non-nil means always go to the next Octave code line after sending." (defvar electric-layout-rules) +;; FIXME: cc-mode.el also adds an entry for .m files, mapping them to +;; objc-mode. We here rely on the fact that loaddefs.el is filled in +;; alphabetical order, so cc-mode.el comes before octave-mode.el, which lets +;; our entry come first! +;;;###autoload (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-maybe-mode)) + +;;;###autoload +(defun octave-maybe-mode () + "Select `octave-mode' if the current buffer seems to hold Octave code." + (if (save-excursion + (with-syntax-table octave-mode-syntax-table + (goto-char (point-min)) + (forward-comment (point-max)) + ;; FIXME: What about Octave files which don't start with "function"? + (looking-at "function"))) + (octave-mode) + (let ((x (rassq 'octave-maybe-mode auto-mode-alist))) + (when x + (let ((auto-mode-alist (remove x auto-mode-alist))) + (set-auto-mode)))))) + ;;;###autoload (define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code. @@ -639,6 +660,9 @@ mode, include \"-q\" and \"--traditional\"." :type '(repeat string) :version "24.4") +(define-obsolete-variable-alias 'inferior-octave-startup-hook + 'inferior-octave-mode-hook "24.4") + (defcustom inferior-octave-mode-hook nil "Hook to be run when Inferior Octave mode is started." :type 'hook) @@ -693,9 +717,6 @@ mode, include \"-q\" and \"--traditional\"." (defvar inferior-octave-output-string nil) (defvar inferior-octave-receive-in-progress nil) -(define-obsolete-variable-alias 'inferior-octave-startup-hook - 'inferior-octave-mode-hook "24.4") - (defvar inferior-octave-dynamic-complete-functions '(inferior-octave-completion-at-point comint-filename-completion) "List of functions called to perform completion for inferior Octave. @@ -1165,6 +1186,8 @@ q: Don't fix\n" func file)) "Face used to highlight function comment block.") (eval-when-compile (require 'texinfo)) +;; Undo the effects of texinfo loading tex-mode loading compile. +(declare-function compilation-forget-errors "compile" ()) (defun octave-font-lock-texinfo-comment () (let ((kws diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 737dd9ea8a8..6d13d328c5f 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1403,12 +1403,8 @@ 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 "22.1") (define-minor-mode pascal-outline-mode "Outline-line minor mode for Pascal mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. When enabled, portions of the text being edited may be made invisible.\\<pascal-outline-map> diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index c9bfb1acdfe..b96aad7a6ef 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -87,6 +87,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup perl nil "Major mode for editing Perl code." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) @@ -135,7 +137,7 @@ '(;; Functions (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1) ;;Variables - ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) + ("Variables" "^[ \t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") @@ -165,7 +167,7 @@ ;; Fontify function and package names in declarations. ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) - ("\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?" + ("\\(^\\|[^$@%&\\]\\)\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))) "Subdued level highlighting for Perl mode.") @@ -179,8 +181,9 @@ "BEGIN" "END" "return" "exec" "eval") t) "\\>") ;; - ;; Fontify local and my keywords as types. - ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ;; Fontify declarators and prefixes as types. + ("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" . font-lock-type-face) ; declarators + ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes ;; ;; Fontify function, variable and file name references. ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) @@ -744,8 +747,6 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." 0 ;Existing comment at bol stays there. comment-column)) -(define-obsolete-function-alias 'electric-perl-terminator - 'perl-electric-terminator "22.1") (defun perl-electric-noindent-p (_char) ;; To reproduce the old behavior, ;, {, }, and : are made electric, but ;; we only want them to be electric at EOL. diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 19269766c90..b1a17dfa3cc 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -196,9 +196,6 @@ on the symbol." ;;;###autoload (define-minor-mode prettify-symbols-mode "Toggle Prettify Symbols mode. -With a prefix argument ARG, enable Prettify Symbols mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. When Prettify Symbols mode and font-locking are enabled, symbols are prettified (displayed as composed characters) according to the rules diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index eab24e1ea60..f3f29cbac94 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -189,6 +189,18 @@ to find the list of ignores for each directory." (cl-defmethod project-roots ((project (head transient))) (list (cdr project))) +(cl-defgeneric project-files (project &optional dirs) + "Return a list of files in directories DIRS in PROJECT. +DIRS is a list of absolute directories; it should be some +subset of the project roots and external roots." + ;; This default implementation only works if project-file-completion-table + ;; returns a "flat" completion table. + ;; FIXME: Maybe we should do the reverse: implement the default + ;; `project-file-completion-table' on top of `project-files'. + (all-completions + "" (project-file-completion-table + project (or dirs (project-roots project))))) + (defgroup project-vc nil "Project implementation using the VC package." :version "25.1" @@ -389,12 +401,17 @@ recognized." ;; removing it when it has no matches. Neither seems natural ;; enough. Removal is confusing; early expansion makes the prompt ;; too long. - (let* ((new-prompt (if default + (let* (;; (initial-input + ;; (let ((common-prefix (try-completion "" collection))) + ;; (if (> (length common-prefix) 0) + ;; (file-name-directory common-prefix)))) + (new-prompt (if default (format "%s (default %s): " prompt default) (format "%s: " prompt))) (res (completing-read new-prompt collection predicate t - nil hist default inherit-input-method))) + nil ;; initial-input + hist default inherit-input-method))) (if (and (equal res default) (not (test-completion res collection predicate))) (completing-read (format "%s: " prompt) @@ -402,5 +419,30 @@ recognized." inherit-input-method) res))) +(declare-function multifile-continue "multifile" ()) + +;;;###autoload +(defun project-search (regexp) + "Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]." + (interactive "sSearch (regexp): ") + (multifile-initialize-search + regexp (project-files (project-current t)) 'default) + (multifile-continue)) + +;;;###autoload +(defun project-query-replace (from to) + "Search for REGEXP in all the files of the project. +Stops when a match is found. +To continue searching for next match, use command \\[multifile-continue]." + (interactive + (pcase-let ((`(,from ,to) + (query-replace-read-args "Query replace (regexp)" t t))) + (list from to))) + (multifile-initialize-replace + from to (project-files (project-current t)) 'default) + (multifile-continue)) + (provide 'project) ;;; project.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c7bb2d97c84..c55b69e33ec 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4,7 +4,7 @@ ;; Author: Fabián E. Gallina <fgallina@gnu.org> ;; URL: https://github.com/fgallina/python.el -;; Version: 0.25.2 +;; Version: 0.26.1 ;; Package-Requires: ((emacs "24.1") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 @@ -287,9 +287,20 @@ ;;; 24.x Compat -(unless (fboundp 'prog-first-column) - (defun prog-first-column () - 0)) +(eval-and-compile + (unless (fboundp 'prog-first-column) + (defun prog-first-column () + 0)) + (unless (fboundp 'file-local-name) + (defun file-local-name (file) + "Return the local name component of FILE. +It returns a file name which can be used directly as argument of +`process-file', `start-file-process', or `shell-command'." + (or (file-remote-p file 'localname) file)))) + +;; In Emacs 24.3 and earlier, `define-derived-mode' does not define +;; the hook variable, it only puts documentation on the symbol. +(defvar inferior-python-mode-hook) ;;; Bindings @@ -515,9 +526,19 @@ The type returned can be `comment', `string' or `paren'." font-lock-string-face) font-lock-comment-face)) -(defvar python-font-lock-keywords - ;; Keywords - `(,(rx symbol-start +(defvar python-font-lock-keywords-level-1 + `((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) + (1 font-lock-function-name-face)) + (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_)))) + (1 font-lock-type-face))) + "Font lock keywords to use in python-mode for level 1 decoration. + +This is the minimum decoration level, including function and +class declarations.") + +(defvar python-font-lock-keywords-level-2 + `(,@python-font-lock-keywords-level-1 + ,(rx symbol-start (or "and" "del" "from" "not" "while" "as" "elif" "global" "or" "with" "assert" "else" "if" "pass" "yield" "break" "except" "import" "class" @@ -537,12 +558,35 @@ The type returned can be `comment', `string' or `paren'." ;; Extra: "self") symbol-end) - ;; functions - (,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) - (1 font-lock-function-name-face)) - ;; classes - (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_)))) - (1 font-lock-type-face)) + ;; Builtins + (,(rx symbol-start + (or + "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod" + "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate" + "eval" "filter" "float" "format" "frozenset" "getattr" "globals" + "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance" + "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview" + "min" "next" "object" "oct" "open" "ord" "pow" "print" "property" + "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted" + "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip" + "__import__" + ;; Python 2: + "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce" + "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce" + "intern" + ;; Python 3: + "ascii" "bytearray" "bytes" "exec" + ;; Extra: + "__all__" "__doc__" "__name__" "__package__") + symbol-end) . font-lock-builtin-face)) + "Font lock keywords to use in python-mode for level 2 decoration. + +This is the medium decoration level, including everything in +`python-font-lock-keywords-level-1', as well as keywords and +builtins.") + +(defvar python-font-lock-keywords-maximum-decoration + `(,@python-font-lock-keywords-level-2 ;; Constants (,(rx symbol-start (or @@ -585,27 +629,6 @@ The type returned can be `comment', `string' or `paren'." "VMSError" "WindowsError" ) symbol-end) . font-lock-type-face) - ;; Builtins - (,(rx symbol-start - (or - "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod" - "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate" - "eval" "filter" "float" "format" "frozenset" "getattr" "globals" - "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance" - "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview" - "min" "next" "object" "oct" "open" "ord" "pow" "print" "property" - "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted" - "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip" - "__import__" - ;; Python 2: - "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce" - "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce" - "intern" - ;; Python 3: - "ascii" "bytearray" "bytes" "exec" - ;; Extra: - "__all__" "__doc__" "__name__" "__package__") - symbol-end) . font-lock-builtin-face) ;; assignments ;; support for a = b = c = 5 (,(lambda (limit) @@ -629,22 +652,41 @@ The type returned can be `comment', `string' or `paren'." (goto-char (match-end 1)) (python-syntax-context 'paren))) res)) - (1 font-lock-variable-name-face nil nil)))) + (1 font-lock-variable-name-face nil nil))) + "Font lock keywords to use in python-mode for maximum decoration. + +This decoration level includes everything in +`python-font-lock-keywords-level-2', as well as constants, +decorators, exceptions, and assignments.") + +(defvar python-font-lock-keywords + '(python-font-lock-keywords-level-1 ; When `font-lock-maximum-decoration' is nil. + python-font-lock-keywords-level-1 ; When `font-lock-maximum-decoration' is 1. + python-font-lock-keywords-level-2 ; When `font-lock-maximum-decoration' is 2. + python-font-lock-keywords-maximum-decoration ; When `font-lock-maximum-decoration' + ; is more than 1, or t (which it is, + ; by default). + ) + "List of font lock keyword specifications to use in python-mode. + +Which one will be chosen depends on the value of +`font-lock-maximum-decoration'.") + (defconst python-syntax-propertize-function (syntax-propertize-rules ((python-rx string-delimiter) (0 (ignore (python-syntax-stringify)))))) +(define-obsolete-variable-alias 'python--prettify-symbols-alist + 'python-prettify-symbols-alist "26.1") + (defvar python-prettify-symbols-alist '(("lambda" . ?λ) ("and" . ?∧) ("or" . ?∨)) "Value for `prettify-symbols-alist' in `python-mode'.") -(define-obsolete-variable-alias 'python--prettify-symbols-alist - 'python-prettify-symbols-alist "26.1") - (defsubst python-syntax-count-quotes (quote-char &optional point limit) "Count number of quotes around point (max is 3). QUOTE-CHAR is the quote char to count. Optional argument POINT is @@ -1474,7 +1516,7 @@ nested definitions." (defun python-nav-beginning-of-statement () "Move to start of current statement." (interactive "^") - (back-to-indentation) + (forward-line 0) (let* ((ppss (syntax-ppss)) (context-point (or @@ -1489,6 +1531,7 @@ nested definitions." (python-info-line-ends-backslash-p)) (forward-line -1) (python-nav-beginning-of-statement)))) + (back-to-indentation) (point-marker)) (defun python-nav-end-of-statement (&optional noend) @@ -1506,9 +1549,10 @@ of the statement." ;; are somehow out of whack. This has been ;; observed when using `syntax-ppss' during ;; narrowing. - (cl-assert (> string-start last-string-end) + (cl-assert (>= string-start last-string-end) :show-args - "Overlapping strings detected") + "\ +Overlapping strings detected (start=%d, last-end=%d)") (goto-char string-start) (if (python-syntax-context 'paren) ;; Ended up inside a paren, roll again. @@ -2147,7 +2191,7 @@ of `exec-path'." (defun python-shell-tramp-refresh-process-environment (vec env) "Update VEC's process environment with ENV." ;; Stolen from `tramp-open-connection-setup-interactive-shell'. - (let ((env (append (when (fboundp #'tramp-get-remote-locale) + (let ((env (append (when (fboundp 'tramp-get-remote-locale) ;; Emacs<24.4 compat. (list (tramp-get-remote-locale vec))) (copy-sequence env))) @@ -2829,10 +2873,12 @@ process buffer for a list of commands.)" (y-or-n-p "Make dedicated process? ") (= (prefix-numeric-value current-prefix-arg) 4)) (list (python-shell-calculate-command) nil t))) - (get-buffer-process - (python-shell-make-comint - (or cmd (python-shell-calculate-command)) - (python-shell-get-process-name dedicated) show))) + (let ((buffer + (python-shell-make-comint + (or cmd (python-shell-calculate-command)) + (python-shell-get-process-name dedicated) show))) + (pop-to-buffer buffer) + (get-buffer-process buffer))) (defun run-python-internal () "Run an inferior Internal Python process. @@ -2910,11 +2956,17 @@ be asked for their values." "Instead call `python-shell-get-process' and create one if returns nil." "25.1") +(define-obsolete-variable-alias + 'python-buffer 'python-shell-internal-buffer "24.3") + (defvar python-shell-internal-buffer nil "Current internal shell buffer for the current buffer. This is really not necessary at all for the code to work but it's there for compatibility with CEDET.") +(define-obsolete-variable-alias + 'python-preoutput-result 'python-shell-internal-last-output "24.3") + (defvar python-shell-internal-last-output nil "Last output captured by the internal shell. This is really not necessary at all for the code to work but it's @@ -2930,12 +2982,6 @@ there for compatibility with CEDET.") (define-obsolete-function-alias 'python-proc 'python-shell-internal-get-or-create-process "24.3") -(define-obsolete-variable-alias - 'python-buffer 'python-shell-internal-buffer "24.3") - -(define-obsolete-variable-alias - 'python-preoutput-result 'python-shell-internal-last-output "24.3") - (defun python-shell--save-temp-file (string) (let* ((temporary-file-directory (if (file-remote-p default-directory) @@ -3150,9 +3196,12 @@ t when called interactively." (beginning-of-line 1)) (> (current-indentation) 0))) (when (not arg) - (while (and (forward-line -1) - (looking-at (python-rx decorator)))) - (forward-line 1)) + (while (and + (eq (forward-line -1) 0) + (if (looking-at (python-rx decorator)) + t + (forward-line 1) + nil)))) (point-marker)) (progn (or (python-nav-end-of-defun) @@ -3183,10 +3232,10 @@ t when called interactively." (insert-file-contents (or temp-file-name file-name)) (python-info-encoding))) - (file-name (expand-file-name (file-local-name file-name))) + (file-name (file-local-name (expand-file-name file-name))) (temp-file-name (when temp-file-name - (expand-file-name - (file-local-name temp-file-name))))) + (file-local-name (expand-file-name + temp-file-name))))) (python-shell-send-string (format (concat @@ -5191,9 +5240,10 @@ be used." (defcustom python-flymake-msg-alist '(("\\(^redefinition\\|.*unused.*\\|used$\\)" . :warning)) "Alist used to associate messages to their types. -Each element should be a cons-cell (REGEXP . TYPE), where TYPE must be -one defined in the variable `flymake-diagnostic-types-alist'. -For example, when using `flake8' a possible configuration could be: +Each element should be a cons-cell (REGEXP . TYPE), where TYPE +should be a diagnostic type symbol like `:error', `:warning' or +`:note'. For example, when using `flake8' a possible +configuration could be: ((\"\\(^redefinition\\|.*unused.*\\|used$\\)\" . :warning) (\"^E999\" . :error) @@ -5286,6 +5336,7 @@ REPORT-FN is Flymake's callback function." (save-excursion (insert (make-string 2 last-command-event))))) (defvar electric-indent-inhibit) +(defvar prettify-symbols-alist) ;;;###autoload (define-derived-mode python-mode prog-mode "Python" @@ -5305,7 +5356,7 @@ REPORT-FN is Flymake's callback function." 'python-nav-forward-sexp) (set (make-local-variable 'font-lock-defaults) - '(python-font-lock-keywords + `(,python-font-lock-keywords nil nil nil nil (font-lock-syntactic-face-function . python-font-lock-syntactic-face-function))) @@ -5381,7 +5432,7 @@ REPORT-FN is Flymake's callback function." (1+ (/ (current-indentation) python-indent-offset)))) (set (make-local-variable 'prettify-symbols-alist) - python--prettify-symbols-alist) + python-prettify-symbols-alist) (python-skeleton-add-menu-items) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5abc29a6645..fad7bc1fb8b 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -39,6 +39,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup ruby nil "Major mode for editing Ruby code." :prefix "ruby-" @@ -255,8 +257,7 @@ the statement: qux end -Only has effect when `ruby-use-smie' is t. -" +Only has effect when `ruby-use-smie' is t." :type `(choice (const :tag "None" nil) (const :tag "All" t) @@ -2311,8 +2312,8 @@ See `font-lock-syntax-table'.") (process-send-eof ruby--flymake-proc)))) (defcustom ruby-flymake-use-rubocop-if-available t - "Non-nil to use the Rubocop Flymake backend. -Only takes effect if Rubocop is installed." + "Non-nil to use the RuboCop Flymake backend. +Only takes effect if RuboCop is installed." :version "26.1" :type 'boolean :group 'ruby @@ -2326,7 +2327,7 @@ Only takes effect if Rubocop is installed." :safe 'stringp) (defun ruby-flymake-rubocop (report-fn &rest _args) - "Rubocop backend for Flymake." + "RuboCop backend for Flymake." (unless (executable-find "rubocop") (error "Cannot find the rubocop executable")) @@ -2352,7 +2353,7 @@ Only takes effect if Rubocop is installed." (when (eq (process-exit-status proc) 127) ;; Not sure what to do in this case. Maybe ideally we'd ;; switch back to ruby-flymake-simple. - (flymake-log :warning "Rubocop returned status 127: %s" + (flymake-log :warning "RuboCop returned status 127: %s" (buffer-string))) (goto-char (point-min)) (cl-loop diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index a4cb4856a84..aaa86b5816f 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2392,7 +2392,6 @@ whose value is the shell name (don't quote it)." (funcall mksym "rules") :forward-token (funcall mksym "forward-token") :backward-token (funcall mksym "backward-token"))) - (setq-local parse-sexp-lookup-properties t) (unless sh-use-smie (setq-local sh-kw-alist (sh-feature sh-kw)) (let ((regexp (sh-feature sh-kws-for-done))) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index e7d7494d2ca..1cdae35ac30 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -213,7 +213,7 @@ ;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support ;; Harald Maier <maierh@myself.com> -- sql-send-string ;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; -;; code polish +;; code polish; on-going guidance and mentorship ;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement ;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug ;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines @@ -221,6 +221,8 @@ ;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation ;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored ;; Simen Heggestøyl <simenheg@gmail.com> -- Postgres database completion +;; Robert Cochran <robert-emacs@cochranmail.com> -- MariaDB support +;; Alex Harsanyi <alexharsanyi@gmail.com> -- sql-indent package and support ;; @@ -344,7 +346,8 @@ file. Since that is a plaintext file, this could be dangerous." (const :format "" :completion) (sexp :tag ":completion") (const :format "" :must-match) - (symbol :tag ":must-match"))) + (restricted-sexp + :match-alternatives (listp stringp)))) (const port))) ;; SQL Product support @@ -415,6 +418,21 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-regexp "^SQL>" :prompt-length 4) + (mariadb + :name "MariaDB" + :free-software t + :font-lock sql-mode-mariadb-font-lock-keywords + :sqli-program sql-mariadb-program + :sqli-options sql-mariadb-options + :sqli-login sql-mariadb-login-params + :sqli-comint-func sql-comint-mariadb + :list-all "SHOW TABLES;" + :list-table "DESCRIBE %s;" + :prompt-regexp "^MariaDB \\[.*]> " + :prompt-cont-regexp "^ [\"'`-]> " + :syntax-alist ((?# . "< b")) + :input-filter sql-remove-tabs-filter) + (ms :name "Microsoft" :font-lock sql-mode-ms-font-lock-keywords @@ -691,6 +709,8 @@ making new SQLi sessions." :version "24.1" :group 'SQL) +(defvaralias 'sql-dialect 'sql-product) + (defcustom sql-product 'ansi "Select the SQL database product used. This allows highlighting buffers properly when you open them." @@ -703,7 +723,30 @@ This allows highlighting buffers properly when you open them." sql-product-alist)) :group 'SQL :safe 'symbolp) -(defvaralias 'sql-dialect 'sql-product) + +;; SQL indent support + +(defcustom sql-use-indent-support t + "If non-nil then use the SQL indent support features of sql-indent. +The `sql-indent' package in ELPA provides indentation support for +SQL statements with easy customizations to support varied layout +requirements. + +The package must be available to be loaded and activated." + :group 'SQL + :link '(url-link "https://elpa.gnu.org/packages/sql-indent.html") + :type 'booleanp + :version "27.1") + +(defun sql-is-indent-available () + "Check if sql-indent module is available." + (when (locate-library "sql-indent") + (fboundp 'sqlind-minor-mode))) + +(defun sql-indent-enable () + "Enable `sqlind-minor-mode' if available and requested." + (when (sql-is-indent-available) + (sqlind-minor-mode (if sql-use-indent-support +1 -1)))) ;; misc customization of sql.el behavior @@ -759,16 +802,20 @@ Globally should be set to nil; it will be non-nil in `sql-mode', (defvar sql-login-delay 7.5 ;; Secs "Maximum number of seconds you are willing to wait for a login connection.") -(defcustom sql-pop-to-buffer-after-send-region nil - "When non-nil, pop to the buffer SQL statements are sent to. +(defvaralias 'sql-pop-to-buffer-after-send-region 'sql-display-sqli-buffer-function) -After a call to `sql-sent-string', `sql-send-region', -`sql-send-paragraph' or `sql-send-buffer', the window is split -and the SQLi buffer is shown. If this variable is not nil, that -buffer's window will be selected by calling `pop-to-buffer'. If -this variable is nil, that buffer is shown using -`display-buffer'." - :type 'boolean +(defcustom sql-display-sqli-buffer-function 'display-buffer + "Function to be called to display a SQLi buffer after `sql-send-*'. + +When set to a function, it will be called to display the buffer. +When set to t, the default function `pop-to-buffer' will be +called. If not set, no attempt will be made to display the +buffer." + + :type '(choice (const :tag "Default" t) + (const :tag "No display" nil) + (function :tag "Display Buffer function")) + :version "27.1" :group 'SQL) ;; imenu support for sql-mode. @@ -788,7 +835,7 @@ this variable is nil, that buffer is shown using This is used to set `imenu-generic-expression' when SQL mode is entered. Subsequent changes to `sql-imenu-generic-expression' will -not affect existing SQL buffers because imenu-generic-expression is +not affect existing SQL buffers because `imenu-generic-expression' is a local variable.") ;; history file @@ -828,15 +875,17 @@ commands when the input history is read, as if you had set ;; The usual hooks -(defcustom sql-interactive-mode-hook '() +(defcustom sql-interactive-mode-hook '(sql-indent-enable) "Hook for customizing `sql-interactive-mode'." :type 'hook - :group 'SQL) + :group 'SQL + :version "27.1") -(defcustom sql-mode-hook '() +(defcustom sql-mode-hook '(sql-indent-enable) "Hook for customizing `sql-mode'." :type 'hook - :group 'SQL) + :group 'SQL + :version "27.1") (defcustom sql-set-sqli-hook '() "Hook for reacting to changes of `sql-buffer'. @@ -953,10 +1002,19 @@ Starts `sql-interactive-mode' after doing some setup." :version "26.1" :group 'SQL) +;; Customization for MariaDB + +;; MariaDB is a drop-in replacement for MySQL, so just make the +;; MariaDB variables aliases of the MySQL ones. + +(defvaralias 'sql-mariadb-program 'sql-mysql-program) +(defvaralias 'sql-mariadb-options 'sql-mysql-options) +(defvaralias 'sql-mariadb-login-params 'sql-mysql-login-params) + ;; Customization for MySQL (defcustom sql-mysql-program "mysql" - "Command to start mysql by TcX. + "Command to start mysql by Oracle. Starts `sql-interactive-mode' after doing some setup." :type 'file @@ -1103,8 +1161,11 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." (when (executable-find sql-postgres-program) (let ((res '())) (ignore-errors - (dolist (row (process-lines sql-postgres-program "-ltX")) - (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row) + (dolist (row (process-lines sql-postgres-program + "--list" + "--no-psqlrc" + "--tuples-only")) + (when (string-match "^ \\([^ |]+\\) +|.*" row) (push (match-string 1 row) res)))) (nreverse res)))) @@ -1237,7 +1298,8 @@ specified, it's `sql-product' or `sql-connection' must match." (or (not product) (eq product sql-product)) (or (not connection) - (eq connection sql-connection))))))) + (and (stringp connection) + (string= connection sql-connection)))))))) ;; Keymap for sql-interactive-mode. @@ -2312,75 +2374,148 @@ regular expressions are created during compilation by calling the function `regexp-opt'. Therefore, take a look at the source before you define your own `sql-mode-solid-font-lock-keywords'.") +(defvaralias 'sql-mode-mariadb-font-lock-keywords 'sql-mode-mysql-font-lock-keywords + "MariaDB is SQL compatible with MySQL.") + (defvar sql-mode-mysql-font-lock-keywords (eval-when-compile (list ;; MySQL Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"ascii" "avg" "bdmpolyfromtext" "bdmpolyfromwkb" "bdpolyfromtext" -"bdpolyfromwkb" "benchmark" "bin" "bit_and" "bit_length" "bit_or" -"bit_xor" "both" "cast" "char_length" "character_length" "coalesce" -"concat" "concat_ws" "connection_id" "conv" "convert" "count" -"curdate" "current_date" "current_time" "current_timestamp" "curtime" -"elt" "encrypt" "export_set" "field" "find_in_set" "found_rows" "from" +"acos" "adddate" "addtime" "aes_decrypt" "aes_encrypt" "area" +"asbinary" "ascii" "asin" "astext" "aswkb" "aswkt" "atan" "atan2" +"avg" "bdmpolyfromtext" "bdmpolyfromwkb" "bdpolyfromtext" +"bdpolyfromwkb" "benchmark" "bin" "binlog_gtid_pos" "bit_and" +"bit_count" "bit_length" "bit_or" "bit_xor" "both" "boundary" "buffer" +"cast" "ceil" "ceiling" "centroid" "character_length" "char_length" +"charset" "coalesce" "coercibility" "column_add" "column_check" +"column_create" "column_delete" "column_exists" "column_get" +"column_json" "column_list" "compress" "concat" "concat_ws" +"connection_id" "conv" "convert" "convert_tz" "convexhull" "cos" "cot" +"count" "crc32" "crosses" "cume_dist" "cume_dist" "curdate" +"current_date" "current_time" "current_timestamp" "curtime" "date_add" +"datediff" "date_format" "date_sub" "dayname" "dayofmonth" "dayofweek" +"dayofyear" "decode" "decode_histogram" "degrees" "dense_rank" +"dense_rank" "des_decrypt" "des_encrypt" "dimension" "disjoint" "div" +"elt" "encode" "encrypt" "endpoint" "envelope" "exp" "export_set" +"exteriorring" "extractvalue" "field" "find_in_set" "floor" "format" +"found_rows" "from" "from_base64" "from_days" "from_unixtime" "geomcollfromtext" "geomcollfromwkb" "geometrycollectionfromtext" "geometrycollectionfromwkb" "geometryfromtext" "geometryfromwkb" -"geomfromtext" "geomfromwkb" "get_lock" "group_concat" "hex" "ifnull" -"instr" "interval" "isnull" "last_insert_id" "lcase" "leading" -"length" "linefromtext" "linefromwkb" "linestringfromtext" -"linestringfromwkb" "load_file" "locate" "lower" "lpad" "ltrim" -"make_set" "master_pos_wait" "max" "mid" "min" "mlinefromtext" -"mlinefromwkb" "mpointfromtext" "mpointfromwkb" "mpolyfromtext" -"mpolyfromwkb" "multilinestringfromtext" "multilinestringfromwkb" +"geometryn" "geometrytype" "geomfromtext" "geomfromwkb" "get_format" +"get_lock" "glength" "greatest" "group_concat" "hex" "ifnull" +"inet6_aton" "inet6_ntoa" "inet_aton" "inet_ntoa" "instr" +"interiorringn" "intersects" "interval" "isclosed" "isempty" +"is_free_lock" "is_ipv4" "is_ipv4_compat" "is_ipv4_mapped" "is_ipv6" +"isnull" "isring" "issimple" "is_used_lock" "json_array" +"json_array_append" "json_array_insert" "json_compact" "json_contains" +"json_contains_path" "json_depth" "json_detailed" "json_exists" +"json_extract" "json_insert" "json_keys" "json_length" "json_loose" +"json_merge" "json_object" "json_query" "json_quote" "json_remove" +"json_replace" "json_search" "json_set" "json_type" "json_unquote" +"json_valid" "json_value" "lag" "last_day" "last_insert_id" "lastval" +"last_value" "last_value" "lcase" "lead" "leading" "least" "length" +"linefromtext" "linefromwkb" "linestringfromtext" "linestringfromwkb" +"ln" "load_file" "locate" "log" "log10" "log2" "lower" "lpad" "ltrim" +"makedate" "make_set" "maketime" "master_gtid_wait" "master_pos_wait" +"max" "mbrcontains" "mbrdisjoint" "mbrequal" "mbrintersects" +"mbroverlaps" "mbrtouches" "mbrwithin" "md5" "median" +"mid" "min" "mlinefromtext" "mlinefromwkb" "monthname" +"mpointfromtext" "mpointfromwkb" "mpolyfromtext" "mpolyfromwkb" +"multilinestringfromtext" "multilinestringfromwkb" "multipointfromtext" "multipointfromwkb" "multipolygonfromtext" -"multipolygonfromwkb" "now" "nullif" "oct" "octet_length" "ord" -"pointfromtext" "pointfromwkb" "polyfromtext" "polyfromwkb" -"polygonfromtext" "polygonfromwkb" "position" "quote" "rand" -"release_lock" "repeat" "replace" "reverse" "rpad" "rtrim" "soundex" -"space" "std" "stddev" "substring" "substring_index" "sum" "sysdate" -"trailing" "trim" "ucase" "unix_timestamp" "upper" "user" "variance" +"multipolygonfromwkb" "name_const" "nextval" "now" "nth_value" "ntile" +"ntile" "nullif" "numgeometries" "numinteriorrings" "numpoints" "oct" +"octet_length" "old_password" "ord" "percentile_cont" +"percentile_disc" "percent_rank" "percent_rank" "period_add" +"period_diff" "pi" "pointfromtext" "pointfromwkb" "pointn" +"pointonsurface" "polyfromtext" "polyfromwkb" "polygonfromtext" +"polygonfromwkb" "position" "pow" "power" "quote" "radians" +"rand" "rank" "rank" "regexp" "regexp_instr" "regexp_replace" +"regexp_substr" "release_lock" "repeat" "replace" "reverse" "rlike" +"row_number" "row_number" "rpad" "rtrim" "sec_to_time" "setval" "sha" +"sha1" "sha2" "sign" "sin" "sleep" "soundex" "space" +"spider_bg_direct_sql" "spider_copy_tables" "spider_direct_sql" +"spider_flush_table_mon_cache" "sqrt" "srid" "st_area" "startpoint" +"st_asbinary" "st_astext" "st_aswkb" "st_aswkt" "st_boundary" +"st_buffer" "st_centroid" "st_contains" "st_convexhull" "st_crosses" +"std" "stddev" "stddev_pop" "stddev_samp" "st_difference" +"st_dimension" "st_disjoint" "st_distance" "st_endpoint" "st_envelope" +"st_equals" "st_exteriorring" "st_geomcollfromtext" +"st_geomcollfromwkb" "st_geometrycollectionfromtext" +"st_geometrycollectionfromwkb" "st_geometryfromtext" +"st_geometryfromwkb" "st_geometryn" "st_geometrytype" +"st_geomfromtext" "st_geomfromwkb" "st_interiorringn" +"st_intersection" "st_intersects" "st_isclosed" "st_isempty" +"st_isring" "st_issimple" "st_length" "st_linefromtext" +"st_linefromwkb" "st_linestringfromtext" "st_linestringfromwkb" +"st_numgeometries" "st_numinteriorrings" "st_numpoints" "st_overlaps" +"st_pointfromtext" "st_pointfromwkb" "st_pointn" "st_pointonsurface" +"st_polyfromtext" "st_polyfromwkb" "st_polygonfromtext" +"st_polygonfromwkb" "strcmp" "st_relate" "str_to_date" "st_srid" +"st_startpoint" "st_symdifference" "st_touches" "st_union" "st_within" +"st_x" "st_y" "subdate" "substr" "substring" "substring_index" +"subtime" "sum" "sysdate" "tan" "timediff" "time_format" +"timestampadd" "timestampdiff" "time_to_sec" "to_base64" "to_days" +"to_seconds" "touches" "trailing" "trim" "ucase" "uncompress" +"uncompressed_length" "unhex" "unix_timestamp" "updatexml" "upper" +"user" "utc_date" "utc_time" "utc_timestamp" "uuid" "uuid_short" +"variance" "var_pop" "var_samp" "version" "weekday" +"weekofyear" "weight_string" "within" ) ;; MySQL Keywords (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"action" "add" "after" "against" "all" "alter" "and" "as" "asc" -"auto_increment" "avg_row_length" "bdb" "between" "by" "cascade" -"case" "change" "character" "check" "checksum" "close" "collate" -"collation" "column" "columns" "comment" "committed" "concurrent" -"constraint" "create" "cross" "data" "database" "default" -"delay_key_write" "delayed" "delete" "desc" "directory" "disable" -"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else" "elseif" -"enable" "enclosed" "end" "escaped" "exists" "fields" "first" "for" -"force" "foreign" "from" "full" "fulltext" "global" "group" "handler" -"having" "heap" "high_priority" "if" "ignore" "in" "index" "infile" -"inner" "insert" "insert_method" "into" "is" "isam" "isolation" "join" -"key" "keys" "last" "left" "level" "like" "limit" "lines" "load" -"local" "lock" "low_priority" "match" "max_rows" "merge" "min_rows" -"mode" "modify" "mrg_myisam" "myisam" "natural" "next" "no" "not" -"null" "offset" "oj" "on" "open" "optionally" "or" "order" "outer" -"outfile" "pack_keys" "partial" "password" "prev" "primary" -"procedure" "quick" "raid0" "raid_type" "read" "references" "rename" -"repeatable" "restrict" "right" "rollback" "rollup" "row_format" -"savepoint" "select" "separator" "serializable" "session" "set" -"share" "show" "sql_big_result" "sql_buffer_result" "sql_cache" -"sql_calc_found_rows" "sql_no_cache" "sql_small_result" "starting" -"straight_join" "striped" "table" "tables" "temporary" "terminated" -"then" "to" "transaction" "truncate" "type" "uncommitted" "union" -"unique" "unlock" "update" "use" "using" "values" "when" "where" -"with" "write" "xor" +"accessible" "action" "add" "after" "against" "all" "alter" "analyze" +"and" "as" "asc" "auto_increment" "avg_row_length" "bdb" "between" +"body" "by" "cascade" "case" "change" "character" "check" "checksum" +"close" "collate" "collation" "column" "columns" "comment" "committed" +"concurrent" "condition" "constraint" "create" "cross" "data" +"database" "databases" "default" "delayed" "delay_key_write" "delete" +"desc" "directory" "disable" "distinct" "distinctrow" "do" "drop" +"dual" "dumpfile" "duplicate" "else" "elseif" "elsif" "enable" +"enclosed" "end" "escaped" "exists" "exit" "explain" "fields" "first" +"for" "force" "foreign" "from" "full" "fulltext" "global" "group" +"handler" "having" "heap" "high_priority" "history" "if" "ignore" +"ignore_server_ids" "in" "index" "infile" "inner" "insert" +"insert_method" "into" "is" "isam" "isolation" "join" "key" "keys" +"kill" "last" "leave" "left" "level" "like" "limit" "linear" "lines" +"load" "local" "lock" "long" "loop" "low_priority" +"master_heartbeat_period" "master_ssl_verify_server_cert" "match" +"max_rows" "maxvalue" "merge" "min_rows" "mode" "modify" "mrg_myisam" +"myisam" "natural" "next" "no" "not" "no_write_to_binlog" "null" +"offset" "oj" "on" "open" "optimize" "optionally" "or" "order" "outer" +"outfile" "over" "package" "pack_keys" "partial" "partition" +"password" "period" "prev" "primary" "procedure" "purge" "quick" +"raid0" "raid_type" "raise" "range" "read" "read_write" "references" +"release" "rename" "repeatable" "require" "resignal" "restrict" +"returning" "right" "rollback" "rollup" "row_format" "rowtype" +"savepoint" "schemas" "select" "separator" "serializable" "session" +"set" "share" "show" "signal" "slow" "spatial" "sql_big_result" +"sql_buffer_result" "sql_cache" "sql_calc_found_rows" "sql_no_cache" +"sql_small_result" "ssl" "starting" "straight_join" "striped" +"system_time" "table" "tables" "temporary" "terminated" "then" "to" +"transaction" "truncate" "type" "uncommitted" "undo" "union" "unique" +"unlock" "update" "use" "using" "values" "versioning" "when" "where" +"while" "window" "with" "write" "xor" ) ;; MySQL Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"bigint" "binary" "bit" "blob" "bool" "boolean" "char" "curve" "date" -"datetime" "dec" "decimal" "double" "enum" "fixed" "float" "geometry" -"geometrycollection" "int" "integer" "line" "linearring" "linestring" -"longblob" "longtext" "mediumblob" "mediumint" "mediumtext" +"bigint" "binary" "bit" "blob" "bool" "boolean" "byte" "char" "curve" +"date" "datetime" "day" "day_hour" "day_microsecond" "day_minute" +"day_second" "dec" "decimal" "double" "enum" "fixed" "float" "float4" +"float8" "geometry" "geometrycollection" "hour" "hour_microsecond" +"hour_minute" "hour_second" "int" "int1" "int2" "int3" "int4" "int8" +"integer" "json" "line" "linearring" "linestring" "longblob" +"longtext" "mediumblob" "mediumint" "mediumtext" "microsecond" +"middleint" "minute" "minute_microsecond" "minute_second" "month" "multicurve" "multilinestring" "multipoint" "multipolygon" "multisurface" "national" "numeric" "point" "polygon" "precision" -"real" "smallint" "surface" "text" "time" "timestamp" "tinyblob" -"tinyint" "tinytext" "unsigned" "varchar" "year" "year2" "year4" -"zerofill" +"quarter" "real" "second" "second_microsecond" "signed" "smallint" +"surface" "text" "time" "timestamp" "tinyblob" "tinyint" "tinytext" +"unsigned" "varbinary" "varchar" "varcharacter" "week" "year" "year2" +"year4" "year_month" "zerofill" ))) "MySQL SQL keywords used by font-lock. @@ -2712,18 +2847,52 @@ adds a fontification pattern to fontify identifiers ending in ;; Save product setting and fontify. (setq sql-product product) (sql-highlight-product)) +(defalias 'sql-set-dialect 'sql-set-product) - -;;; Compatibility functions - -(if (not (fboundp 'comint-line-beginning-position)) - ;; comint-line-beginning-position is defined in Emacs 21 - (defun comint-line-beginning-position () - "Return the buffer position of the beginning of the line, after any prompt. -The prompt is assumed to be any text at the beginning of the line -matching the regular expression `comint-prompt-regexp', a buffer -local variable." - (save-excursion (comint-bol nil) (point)))) +(defun sql-buffer-hidden-p (buf) + "Is the buffer hidden?" + (string-prefix-p " " + (cond + ((stringp buf) + (when (get-buffer buf) + buf)) + ((bufferp buf) + (buffer-name buf)) + (t nil)))) + +(defun sql-display-buffer (buf) + "Display a SQLi buffer based on `sql-display-sqli-buffer-function'. + +If BUF is hidden or `sql-display-sqli-buffer-function' is nil, +then the buffer will not be displayed. Otherwise the BUF is +displayed." + (unless (sql-buffer-hidden-p buf) + (cond + ((eq sql-display-sqli-buffer-function t) + (pop-to-buffer buf)) + ((not sql-display-sqli-buffer-function) + nil) + ((functionp sql-display-sqli-buffer-function) + (funcall sql-display-sqli-buffer-function buf)) + (t + (message "Invalid setting of `sql-display-sqli-buffer-function'") + (pop-to-buffer buf))))) + +(defun sql-make-progress-reporter (buf message &optional min-value max-value current-value min-change min-time) + "Make a progress reporter if BUF is not hidden." + (unless (or (sql-buffer-hidden-p buf) + (not sql-display-sqli-buffer-function)) + (make-progress-reporter message min-value max-value current-value min-change min-time))) + +(defun sql-progress-reporter-update (reporter &optional value) + "Report progress of an operation in the echo area." + (when reporter + (progress-reporter-update reporter value))) + +(defun sql-progress-reporter-done (reporter) + "Print reporter’s message followed by word \"done\" in echo area." + (when reporter + (progress-reporter-done reporter))) ;;; SMIE support @@ -2760,8 +2929,8 @@ local variable." (prod-stmt (sql-get-product-feature prod :statement))) (concat "^\\<" (if prod-stmt - ansi-stmt - (concat "\\(" ansi-stmt "\\|" prod-stmt "\\)")) + (concat "\\(" ansi-stmt "\\|" prod-stmt "\\)") + ansi-stmt) "\\>"))) (defun sql-beginning-of-statement (arg) @@ -2952,7 +3121,12 @@ regexp pattern specified in its value. The `:completion' property prompts for a string specified by its value. (The property value is used as the PREDICATE argument to -`completing-read'.)" +`completing-read'.) + +For both `:file' and `:completion', there can also be a +`:must-match' property that controls REQUIRE-MATCH parameter to +`completing-read'." + (set-default symbol (let* ((default (plist-get plist :default)) @@ -2972,7 +3146,9 @@ value. (The property value is used as the PREDICATE argument to (read-file-name prompt (file-name-directory last-value) default - (plist-get plist :must-match) + (if (plist-member plist :must-match) + (plist-get plist :must-match) + t) (file-name-nondirectory last-value) (when (plist-get plist :file) `(lambda (f) @@ -2989,7 +3165,9 @@ value. (The property value is used as the PREDICATE argument to (completing-read prompt-def (plist-get plist :completion) nil - (plist-get plist :must-match) + (if (plist-member plist :must-match) + (plist-get plist :must-match) + t) last-value history-var default)) @@ -3129,7 +3307,7 @@ See also `sql-help' on how to create such a buffer." (sql-set-sqli-buffer)) (display-buffer sql-buffer)) -(defun sql-make-alternate-buffer-name () +(defun sql-make-alternate-buffer-name (&optional product) "Return a string that can be used to rename a SQLi buffer. This is used to set `sql-alternate-buffer-name' within `sql-interactive-mode'. @@ -3151,7 +3329,7 @@ server/database name." (cdr (apply #'append nil (sql-for-each-login - (sql-get-product-feature sql-product :sqli-login) + (sql-get-product-feature (or product sql-product) :sqli-login) (lambda (token plist) (pcase token (`user @@ -3198,6 +3376,34 @@ server/database name." ;; Use the name we've got name)))) +(defun sql-generate-unique-sqli-buffer-name (product base) + "Generate a new, unique buffer name for a SQLi buffer. + +Append a sequence number until a unique name is found." + (let ((base-name (when (stringp base) + (substring-no-properties + (or base + (sql-get-product-feature product :name) + (symbol-name product))))) + buf-fmt-1st buf-fmt-rest) + + ;; Calculate buffer format + (if base-name + (setq buf-fmt-1st (format "*SQL: %s*" base-name) + buf-fmt-rest (format "*SQL: %s-%%d*" base-name)) + (setq buf-fmt-1st "*SQL*" + buf-fmt-rest "*SQL-%d*")) + + ;; See if we can find an unused buffer + (let ((buf-name buf-fmt-1st) + (i 1)) + (while (sql-buffer-live-p buf-name) + ;; Check a sequence number on the BASE + (setq buf-name (format buf-fmt-rest i) + i (1+ i))) + + buf-name))) + (defun sql-rename-buffer (&optional new-name) "Rename a SQL interactive buffer. @@ -3213,18 +3419,20 @@ NEW-NAME is empty, then the buffer name will be \"*SQL*\"." (user-error "Current buffer is not a SQL interactive buffer") (setq sql-alternate-buffer-name - (cond - ((stringp new-name) new-name) - ((consp new-name) - (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): " - sql-alternate-buffer-name)) - (t sql-alternate-buffer-name))) - - (setq sql-alternate-buffer-name (substring-no-properties sql-alternate-buffer-name)) - (rename-buffer (if (string= "" sql-alternate-buffer-name) - "*SQL*" - (format "*SQL: %s*" sql-alternate-buffer-name)) - t))) + (substring-no-properties + (cond + ((stringp new-name) + new-name) + ((consp new-name) + (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): " + sql-alternate-buffer-name)) + (t + sql-alternate-buffer-name)))) + + (rename-buffer + (sql-generate-unique-sqli-buffer-name sql-product + sql-alternate-buffer-name) + t))) (defun sql-copy-column () "Copy current column to the end of buffer. @@ -3439,15 +3647,14 @@ to avoid deleting non-prompt output." (sql-input-sender (get-buffer-process sql-buffer) s) ;; Send a command terminator if we must - (if sql-send-terminator - (sql-send-magic-terminator sql-buffer s sql-send-terminator)) + (when sql-send-terminator + (sql-send-magic-terminator sql-buffer s sql-send-terminator)) - (message "Sent string to buffer %s" sql-buffer))) + (when sql-pop-to-buffer-after-send-region + (message "Sent string to buffer %s" sql-buffer)))) ;; Display the sql buffer - (if sql-pop-to-buffer-after-send-region - (pop-to-buffer sql-buffer) - (display-buffer sql-buffer))) + (sql-display-buffer sql-buffer)) ;; We don't have no stinkin' sql (user-error "No SQL process started")))) @@ -3546,15 +3753,22 @@ of commands accepted by the SQLi program. COMMAND may also be a list of SQLi command strings." (let* ((visible (and outbuf - (not (string= " " (substring outbuf 0 1)))))) + (not (sql-buffer-hidden-p outbuf)))) + (this-save save-prior) + (next-save t)) + (when visible (message "Executing SQL command...")) + (if (consp command) - (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior)) - command) + (dolist (onecmd command) + (sql-redirect-one sqlbuf onecmd outbuf this-save) + (setq this-save next-save)) (sql-redirect-one sqlbuf command outbuf save-prior)) + (when visible - (message "Executing SQL command...done")))) + (message "Executing SQL command...done")) + nil)) (defun sql-redirect-one (sqlbuf command outbuf save-prior) (when command @@ -3603,7 +3817,7 @@ list of SQLi command strings." (replace-match "" t t)) (goto-char start)))))))) -(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups) +(defun sql-redirect-value (sqlbuf command &optional regexp regexp-groups) "Execute the SQL command and return part of result. SQLBUF must be an active SQL interactive buffer. COMMAND should @@ -3618,7 +3832,7 @@ for each match." (results nil)) (sql-redirect sqlbuf command outbuf nil) (with-current-buffer outbuf - (while (re-search-forward regexp nil t) + (while (re-search-forward (or regexp "^.+$") nil t) (push (cond ;; no groups-return all of them @@ -4031,15 +4245,16 @@ Writes the input history to a history file using This function is a sentinel watching the SQL interpreter process. Sentinels will always get the two parameters PROCESS and EVENT." - (with-current-buffer (process-buffer process) - (let - ((comint-input-ring-separator sql-input-ring-separator) - (comint-input-ring-file-name sql-input-ring-file-name)) - (comint-write-input-ring)) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (let + ((comint-input-ring-separator sql-input-ring-separator) + (comint-input-ring-file-name sql-input-ring-file-name)) + (comint-write-input-ring)) - (if (not buffer-read-only) - (insert (format "\nProcess %s %s\n" process event)) - (message "Process %s %s" process event)))) + (if (not buffer-read-only) + (insert (format "\nProcess %s %s\n" process event)) + (message "Process %s %s" process event))))) @@ -4215,31 +4430,30 @@ the call to \\[sql-product-interactive] with ;; Handle universal arguments if specified (when (not (or executing-kbd-macro noninteractive)) - (when (and (consp product) - (not (cdr product)) - (numberp (car product))) - (when (>= (prefix-numeric-value product) 16) - (when (not new-name) - (setq new-name '(4))) - (setq product '(4))))) + (when (>= (prefix-numeric-value product) 16) + (when (not new-name) + (setq new-name '(4))) + (setq product '(4)))) ;; Get the value of product that we need (setq product (cond ((= (prefix-numeric-value product) 4) ; C-u, prompt for product (sql-read-product "SQL product: " sql-product)) - ((and product ; Product specified - (symbolp product)) product) + ((assoc product sql-product-alist) ; Product specified + product) (t sql-product))) ; Default to sql-product ;; If we have a product and it has an interactive mode (if product (when (sql-get-product-feature product :sqli-comint-func) - ;; If no new name specified, try to pop to an active SQL - ;; interactive for the same product + ;; If no new name specified or new name in buffer name, + ;; try to pop to an active SQL interactive for the same product (let ((buf (sql-find-sqli-buffer product sql-connection))) - (if (and (not new-name) buf) - (pop-to-buffer buf) + (if (and buf (or (not new-name) + (and (stringp new-name) + (string-match-p (regexp-quote new-name) buf)))) + (sql-display-buffer buf) ;; We have a new name or sql-buffer doesn't exist or match ;; Start by remembering where we start @@ -4251,34 +4465,37 @@ the call to \\[sql-product-interactive] with (sql-get-product-feature product :sqli-login)) ;; Connect to database. - (setq rpt (make-progress-reporter "Login")) + (setq rpt (sql-make-progress-reporter nil "Login")) (let ((sql-user (default-value 'sql-user)) (sql-password (default-value 'sql-password)) (sql-server (default-value 'sql-server)) (sql-database (default-value 'sql-database)) (sql-port (default-value 'sql-port)) - (default-directory (or sql-default-directory - default-directory))) + (default-directory + (or sql-default-directory + default-directory))) + + ;; Call the COMINT service (funcall (sql-get-product-feature product :sqli-comint-func) product (sql-get-product-feature product :sqli-options) + ;; generate a buffer name (cond - ((null new-name) - "*SQL*") - ((stringp new-name) - (if (string-prefix-p "*SQL: " new-name t) - new-name - (concat "*SQL: " new-name "*"))) - ((equal new-name '(4)) - (concat - "*SQL: " + ((not new-name) + (sql-generate-unique-sqli-buffer-name product nil)) + ((consp new-name) + (sql-generate-unique-sqli-buffer-name product (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): " - sql-alternate-buffer-name) - "*")) + (sql-make-alternate-buffer-name product)))) + ((or (string-prefix-p " " new-name) + (string-match-p "\\`[*].*[*]\\'" new-name)) + new-name) + ((stringp new-name) + (sql-generate-unique-sqli-buffer-name product new-name)) (t - (format "*SQL: %s*" new-name))))) + (sql-generate-unique-sqli-buffer-name product nil))))) ;; Set SQLi mode. (let ((sql-interactive-product product)) @@ -4306,25 +4523,26 @@ the call to \\[sql-product-interactive] with (<= 0.0 (setq secs (- secs step)))) (progn (goto-char (point-max)) (not (re-search-backward sql-prompt-regexp 0 t)))) - (progress-reporter-update rpt))) + (sql-progress-reporter-update rpt))) (goto-char (point-max)) (when (re-search-backward sql-prompt-regexp nil t) (run-hooks 'sql-login-hook)) ;; All done. - (progress-reporter-done rpt) - (pop-to-buffer new-sqli-buffer) + (sql-progress-reporter-done rpt) (goto-char (point-max)) - (current-buffer))))) - (user-error "No default SQL product defined. Set `sql-product'."))) + (let ((sql-display-sqli-buffer-function t)) + (sql-display-buffer new-sqli-buffer)) + (get-buffer new-sqli-buffer))))) + (user-error "No default SQL product defined: set `sql-product'"))) (defun sql-comint (product params &optional buf-name) "Set up a comint buffer to run the SQL processor. PRODUCT is the SQL product. PARAMS is a list of strings which are passed as command line arguments. BUF-NAME is the name of the new -buffer. If nil, a name is chosen for it." +buffer. If nil, a name is chosen for it." (let ((program (sql-get-product-feature product :sqli-program))) ;; Make sure we can find the program. `executable-find' does not @@ -4337,15 +4555,10 @@ buffer. If nil, a name is chosen for it." ;; if not specified, try *SQL* then *SQL-product*, then *SQL-product1*, ... ;; otherwise, use *buf-name* (if buf-name - (unless (string-match-p "\\`[*].*[*]\\'" buf-name) + (unless (or (string-prefix-p " " buf-name) + (string-match-p "\\`[*].*[*]\\'" buf-name)) (setq buf-name (concat "*" buf-name "*"))) - (setq buf-name "*SQL*") - (when (sql-buffer-live-p buf-name) - (setq buf-name (format "*SQL-%s*" product))) - (let ((i 1)) - (while (sql-buffer-live-p buf-name) - (setq buf-name (format "*SQL-%s%d*" product i) - i (1+ i))))) + (setq buf-name (sql-generate-unique-sqli-buffer-name product nil))) (set-text-properties 0 (length buf-name) nil buf-name) ;; Start the command interpreter in the buffer @@ -4426,7 +4639,8 @@ The default comes from `process-coding-system-alist' and (or coding 'utf-8)) (when (string-match (format "\\.%s\\'" (car cs)) nlslang) (setq coding (cdr cs))))) - (set-buffer-process-coding-system coding coding))) + (set-process-coding-system (get-buffer-process (current-buffer)) + coding coding))) (defun sql-oracle-save-settings (sqlbuf) "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]." @@ -4787,6 +5001,46 @@ The default comes from `process-coding-system-alist' and (list sql-database))))) (sql-comint product params buf-name))) +;;;###autoload +(defun sql-mariadb (&optional buffer) + "Run mysql by MariaDB as an inferior process. + +MariaDB is free software. + +If buffer `*SQL*' exists but no process is running, make a new process. +If buffer exists and a process is running, just switch to buffer +`*SQL*'. + +Interpreter used comes from variable `sql-mariadb-program'. Login uses +the variables `sql-user', `sql-password', `sql-database', and +`sql-server' as defaults, if set. Additional command line parameters +can be stored in the list `sql-mariadb-options'. + +The buffer is put in SQL interactive mode, giving commands for sending +input. See `sql-interactive-mode'. + +To set the buffer name directly, use \\[universal-argument] +before \\[sql-mariadb]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + +To specify a coding system for converting non-ASCII characters +in the input and output to the process, use \\[universal-coding-system-argument] +before \\[sql-mariadb]. You can also specify this with \\[set-buffer-process-coding-system] +in the SQL buffer, after you start the process. +The default comes from `process-coding-system-alist' and +`default-process-coding-system'. + +\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" + (interactive "P") + (sql-product-interactive 'mariadb buffer)) + +(defun sql-comint-mariadb (product options &optional buf-name) + "Create comint buffer and connect to MariaDB. + +Use the MySQL comint driver since the two are compatible." + (sql-comint-mysql product options buf-name)) + ;;;###autoload diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index c09ba37c859..685e171dd64 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -93,9 +93,6 @@ ;;;###autoload (define-minor-mode subword-mode "Toggle subword movement and editing (Subword mode). -With a prefix argument ARG, enable Subword mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Subword mode is a buffer-local minor mode. Enabling it changes the definition of a word so that word-based commands stop inside @@ -267,9 +264,6 @@ Optional argument ARG is the same as for `capitalize-word'." ;;;###autoload (define-minor-mode superword-mode "Toggle superword movement and editing (Superword mode). -With a prefix argument ARG, enable Superword mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Superword mode is a buffer-local minor mode. Enabling it changes the definition of words such that symbols characters are treated diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 0d9322359c9..586d8cc0ed0 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -360,7 +360,7 @@ Add functions to the hook with `add-hook': (defvar tcl-proc-list - '("proc" "method" "itcl_class" "body" "configbody" "class") + '("proc" "method" "itcl_class" "body" "configbody" "class" "namespace") "List of commands whose first argument defines something. This exists because some people (eg, me) use `defvar' et al. Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords' @@ -611,6 +611,9 @@ already exist." (set (make-local-variable 'add-log-current-defun-function) 'tcl-add-log-defun) + (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function) + (setq-local end-of-defun-function #'tcl-end-of-defun-function) + (easy-menu-add tcl-mode-menu) ;; Append Tcl menu to popup menu for XEmacs. (if (boundp 'mode-popup-menu) @@ -993,15 +996,49 @@ Returns nil if line starts inside a string, t if in a comment." ;; Interfaces to other packages. ;; -;; FIXME Definition of function is very ad-hoc. Should use -;; beginning-of-defun. Also has incestuous knowledge about the -;; format of tcl-proc-regexp. +(defun tcl-beginning-of-defun-function (&optional arg) + "`beginning-of-defun-function' for Tcl mode." + (when (or (not arg) (= arg 0)) + (setq arg 1)) + (let* ((search-fn (if (> arg 0) + ;; Positive arg means to search backward. + #'re-search-backward + #'re-search-forward)) + (arg (abs arg)) + (result t)) + (while (and (> arg 0) result) + (unless (funcall search-fn tcl-proc-regexp nil t) + (setq result nil)) + (setq arg (1- arg))) + result)) + +(defun tcl-end-of-defun-function () + "`end-of-defun-function' for Tcl mode." + ;; Because we let users redefine tcl-proc-list, we don't really know + ;; too much about the exact arguments passed to the "proc"-defining + ;; command. Instead we just skip words and lists until we see + ;; either a ";" or a newline, either of which terminates a command. + (skip-syntax-forward "-") + (while (and (not (eobp)) + (not (looking-at-p "[\n;]"))) + (condition-case nil + (forward-sexp) + (scan-error + (goto-char (point-max)))) + ;; Note that here we do not want to skip \n. + (skip-chars-forward " \t"))) + (defun tcl-add-log-defun () "Return name of Tcl function point is in, or nil." (save-excursion - (end-of-line) - (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t) - (match-string 2)))) + (let ((orig-point (point))) + (when (beginning-of-defun) + ;; Only return the name when in the body of the function. + (when (save-excursion + (end-of-defun) + (>= (point) orig-point)) + (when (looking-at (concat tcl-proc-regexp "\\([^ \t\n{]+\\)")) + (match-string 2))))))) (defun tcl-outline-level () (save-excursion diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 48dee4bef31..66577619028 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3966,7 +3966,9 @@ Key bindings specific to `verilog-mode-map' are: #'verilog-completion-at-point nil 'local) ;; Stuff for autos - (add-hook 'write-contents-hooks 'verilog-auto-save-check nil 'local) + (add-hook (if (boundp 'write-contents-hooks) 'write-contents-hooks + 'write-contents-functions) ; Emacs >= 22.1 + 'verilog-auto-save-check nil 'local) ;; verilog-mode-hook call added by define-derived-mode ) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index a841f87f3c3..e17b7f504e9 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -4953,8 +4953,8 @@ Key bindings: (defun vhdl-write-file-hooks-init () "Add/remove hooks when buffer is saved." (if vhdl-modify-date-on-saving - (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t) - (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t)) + (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) + (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t)) (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) @@ -8707,17 +8707,11 @@ project is defined." ;; Enabling/disabling (define-minor-mode vhdl-electric-mode - "Toggle VHDL electric mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable it if ARG -is omitted or nil." + "Toggle VHDL electric mode." :global t :group 'vhdl-mode) (define-minor-mode vhdl-stutter-mode - "Toggle VHDL stuttering mode. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable it if ARG -is omitted or nil." + "Toggle VHDL stuttering mode." :global t :group 'vhdl-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 152f6d22937..7604be0c25f 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -247,9 +247,6 @@ It creates the Imenu index for the buffer, if necessary." ;;;###autoload (define-minor-mode which-function-mode "Toggle mode line display of current function (Which Function mode). -With a prefix argument ARG, enable Which Function mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. Which Function mode is a global minor mode. When enabled, the current function name is continuously displayed in the mode line, diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index abb2a93425d..c7ae40eb34e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -503,8 +503,9 @@ SELECT is `quit', also quit the *xref* window." (xref-buffer (current-buffer))) (cond (select (if (eq select 'quit) (quit-window nil nil)) - (with-current-buffer xref-buffer - (select-window (xref--show-pos-in-buf marker buf)))) + (select-window + (with-current-buffer xref-buffer + (xref--show-pos-in-buf marker buf)))) (t (save-selected-window (xref--with-dedicated-window @@ -541,9 +542,11 @@ SELECT is `quit', also quit the *xref* window." Non-interactively, non-nil QUIT means to first quit the *xref* buffer." (interactive) - (let ((xref (or (xref--item-at-point) + (let ((buffer (current-buffer)) + (xref (or (xref--item-at-point) (user-error "No reference at point")))) - (xref--show-location (xref-item-location xref) (if quit 'quit t)))) + (xref--show-location (xref-item-location xref) (if quit 'quit t)) + (next-error-found buffer (current-buffer)))) (defun xref-quit-and-goto-xref () "Quit *xref* buffer, then jump to xref on current line." @@ -876,6 +879,19 @@ is nil, prompt only if there's no usable symbol at point." (interactive (list (xref--read-identifier "Find references of: "))) (xref--find-xrefs identifier 'references identifier nil)) +;;;###autoload +(defun xref-find-definitions-at-mouse (event) + "Find the definition of identifier at or around mouse click. +This command is intended to be bound to a mouse event." + (interactive "e") + (let ((identifier + (save-excursion + (mouse-set-point event) + (xref-backend-identifier-at-point (xref-find-backend))))) + (if identifier + (xref-find-definitions identifier) + (user-error "No identifier here")))) + (declare-function apropos-parse-pattern "apropos" (pattern)) ;;;###autoload |