diff options
Diffstat (limited to 'lisp')
33 files changed, 2178 insertions, 1369 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1b42961f1a4..590db570c56 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1183,7 +1183,29 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (compilation-forget-errors) pt)))) +(defvar byte-compile-log-warning-function + #'byte-compile--log-warning-for-byte-compile + "Function called when encountering a warning or error. +Called with arguments (STRING POSITION FILL LEVEL). STRING is a +message describing the problem. POSITION is a buffer position +where the problem was detected. FILL is a prefix as in +`warning-fill-prefix'. LEVEL is the level of the +problem (`:warning' or `:error'). POSITION, FILL and LEVEL may be +nil.") + (defun byte-compile-log-warning (string &optional fill level) + "Log a byte-compilation warning. +STRING, FILL and LEVEL are as described in +`byte-compile-log-warning-function', which see." + (funcall byte-compile-log-warning-function + string byte-compile-last-position + fill + level)) + +(defun byte-compile--log-warning-for-byte-compile (string &optional + _position + fill + level) "Log a message STRING in `byte-compile-log-buffer'. Also log the current function and file if not already done. If FILL is non-nil, set `warning-fill-prefix' to four spaces. LEVEL diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 7997ba6014c..72f82f26f6f 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1147,14 +1147,27 @@ Prefix argument is the same as for `checkdoc-defun'" ;; features and behaviors, so we need some ways of specifying ;; them, and making them easier to use in the wacked-out interfaces ;; people are requesting -(defun checkdoc-create-error (text start end &optional unfixable) - "Used to create the return error text returned from all engines. +(defvar checkdoc-create-error-function #'checkdoc--create-error-for-checkdoc + "Function called when Checkdoc encounters an error. +Should accept as arguments (TEXT START END &optional UNFIXABLE). + TEXT is the descriptive text of the error. START and END define the region it is sensible to highlight when describing the problem. Optional argument UNFIXABLE means that the error has no auto-fix available. A list of the form (TEXT START END UNFIXABLE) is returned if we are not -generating a buffered list of errors." +generating a buffered list of errors.") + +(defun checkdoc-create-error (text start end &optional unfixable) + "Used to create the return error text returned from all engines. +TEXT, START, END and UNFIXABLE conform to +`checkdoc-create-error-function', which see." + (funcall checkdoc-create-error-function text start end unfixable)) + +(defun checkdoc--create-error-for-checkdoc (text start end &optional unfixable) + "Create an error for Checkdoc. +TEXT, START, END and UNFIXABLE conform to +`checkdoc-create-error-function', which see." (if checkdoc-generate-compile-warnings-flag (progn (checkdoc-error start text) nil) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 87c03280f77..4fc178c29aa 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -268,7 +268,7 @@ into a button whose action shows the function's disassembly.") Output is further controlled by the variables `cl-print-readably', `cl-print-compiled', along with output variables for the standard printing functions. See Info -node `(elisp)Output Variables'. " +node `(elisp)Output Variables'." (cond (cl-print-readably (prin1 object stream)) ((not print-circle) (cl-print-object object stream)) diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index f3597cc387d..3e9885900cf 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -142,8 +142,7 @@ the CPS state machinery. `(let ((,dynamic-var ,static-var)) (unwind-protect ; Update the static shadow after evaluation is done ,form - (setf ,static-var ,dynamic-var)) - ,form))) + (setf ,static-var ,dynamic-var))))) (defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body) "Evaluate BODY such that generated atomic evaluations run with diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index e940588db7b..d1d7c0a8042 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -329,6 +329,8 @@ Check the current row, the previous one and the next row." (string-width (if (stringp nt) nt (car nt))))) tabulated-list--near-rows))) +(defvar tabulated-list-entry-lnum-width nil) + (defun tabulated-list-print (&optional remember-pos update) "Populate the current Tabulated List mode buffer. This sorts the `tabulated-list-entries' list if sorting is @@ -371,6 +373,7 @@ changing `tabulated-list-sort-key'." (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) ;; Finally, print the resulting list. + (setq tabulated-list-entry-lnum-width (tabulated-list-line-number-width)) (while entries (let* ((elt (car entries)) (tabulated-list--near-rows @@ -383,7 +386,7 @@ changing `tabulated-list-sort-key'." (equal entry-id id) (setq entry-id nil saved-pt (point))) - ;; If the buffer this empty, simply print each elt. + ;; If the buffer is empty, simply print each elt. (if (or (not update) (eobp)) (apply tabulated-list-printer elt) (while (let ((local-id (tabulated-list-get-id))) @@ -424,12 +427,10 @@ of column descriptors." (let ((beg (point)) (x (max tabulated-list-padding 0)) (ncols (length tabulated-list-format)) - (lnum-width (tabulated-list-line-number-width)) (inhibit-read-only t)) - (if display-line-numbers - (setq x (+ x lnum-width))) + (setq x (+ x tabulated-list-entry-lnum-width)) (if (> tabulated-list-padding 0) - (insert (make-string (- x lnum-width) ?\s))) + (insert (make-string (- x tabulated-list-entry-lnum-width) ?\s))) (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506). (or (bound-and-true-p tabulated-list--near-rows) (list (or (tabulated-list-get-entry (point-at-bol 0)) diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index 0d4b268f169..c2e4846442a 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -9303,7 +9303,7 @@ * mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el: * mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el: * nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el: - * rfc1843.el, sieve-manage.el, smime.el, spam.el: + * gnus-rfc1843.el, sieve-manage.el, smime.el, spam.el: Fix comment for declare-function. 2010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -10470,7 +10470,7 @@ 2010-09-25 Julien Danjou <julien@danjou.info> - * rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function + * gnus-rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function variables. * nnheader.el: Remove useless variables news-reply-yank-from and @@ -14716,14 +14716,14 @@ * mml2015.el (gnus-buffer-live-p, gnus-get-buffer-create): * nnfolder.el (gnus-request-group): * nnheader.el (ietf-drums-unfold-fws): - * rfc1843.el (mail-header-parse-content-type, message-narrow-to-head): + * gnus-rfc1843.el (mail-header-parse-content-type, message-narrow-to-head): * smime.el (gnus-run-mode-hooks): * spam-stat.el (gnus-message): Autoload. * gnus-cache.el, gnus-fun.el, gnus-group.el, gnus.el, mail-source.el: * mm-bodies.el, mm-decode.el, mm-extern.el, mm-util.el: * mml-smime.el, mml.el, mml1991.el, mml2015.el, nndb.el, nnfolder.el: - * nnmail.el, nnmaildir.el, nnrss.el, rfc1843.el, spam.el: + * nnmail.el, nnmaildir.el, nnrss.el, gnus-rfc1843.el, spam.el: Add declare-function compatibility definition. * gnus-cache.el (nnvirtual-find-group-art): @@ -14753,7 +14753,7 @@ * nnmail.el (gnus-activate-group, gnus-group-mark-article-read): * nnmaildir.el (gnus-group-mark-article-read): * nnrss.el (w3-parse-buffer, gnus-group-make-rss-group): - * rfc1843.el (message-fetch-field): + * gnus-rfc1843.el (message-fetch-field): * spam.el (gnus-extract-address-components): Declare as functions. @@ -19139,7 +19139,7 @@ (mml-insert-parameter): Fold lines properly even if a parameter is segmented into two or more lines; change the max column to 76. - * rfc1843.el (rfc1843-decode-article-body): Don't use + * gnus-rfc1843.el (rfc1843-decode-article-body): Don't use ignore-errors when calling mail-header-parse-content-type. * rfc2231.el (rfc2231-parse-string): Return at least type if @@ -20525,7 +20525,7 @@ * mml1991.el (mc-pgp-always-sign): * mml2015.el (mc-pgp-always-sign): * nnheader.el (nnmail-extra-headers): - * rfc1843.el (gnus-decode-encoded-word-function) + * gnus-rfc1843.el (gnus-decode-encoded-word-function) (gnus-decode-header-function, gnus-newsgroup-name): * spam-stat.el (gnus-original-article-buffer): Add defvars. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index e2c211e0e29..0dea176ab64 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -13080,23 +13080,7 @@ to get the effect of a C-q. ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) -;;;*** - -;;;### (autoloads nil "flymake-proc" "progmodes/flymake-proc.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from progmodes/flymake-proc.el -(push (purecopy '(flymake-proc 0 3)) package--builtin-versions) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-"))) - -;;;*** - -;;;### (autoloads nil "flymake-ui" "progmodes/flymake-ui.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from progmodes/flymake-ui.el -(push (purecopy '(flymake-ui 0 3)) package--builtin-versions) - -(autoload 'flymake-mode "flymake-ui" "\ +(autoload 'flymake-mode "flymake" "\ 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 @@ -13105,22 +13089,22 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. \(fn &optional ARG)" t nil) -(autoload 'flymake-mode-on "flymake-ui" "\ +(autoload 'flymake-mode-on "flymake" "\ Turn flymake mode on. \(fn)" nil nil) -(autoload 'flymake-mode-off "flymake-ui" "\ +(autoload 'flymake-mode-off "flymake" "\ Turn flymake mode off. \(fn)" nil nil) -(autoload 'flymake-find-file-hook "flymake-ui" "\ +(autoload 'flymake-find-file-hook "flymake" "\ \(fn)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-ui" '("flymake-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-"))) ;;;*** @@ -33735,7 +33719,7 @@ Return a string giving the duration of the Emacs initialization. \(fn)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "zoneinfo-style-world-list"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "time--display-world-list" "legacy-style-world-list" "zoneinfo-style-world-list"))) ;;;*** @@ -34451,7 +34435,7 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 3 3 -1)) package--builtin-versions) +(push (purecopy '(tramp 2 3 3 26 1)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) @@ -38524,53 +38508,44 @@ Zone out, completely. ;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el" ;;;;;; "eshell/em-xtra.el" "facemenu.el" "faces.el" "files.el" "font-core.el" ;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el" -;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charprop.el" -;;;;;; "international/charscript.el" "international/cp51932.el" -;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" -;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" -;;;;;; "international/uni-brackets.el" "international/uni-category.el" -;;;;;; "international/uni-combining.el" "international/uni-comment.el" -;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" -;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" -;;;;;; "international/uni-mirrored.el" "international/uni-name.el" -;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" -;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el" -;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" -;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el" -;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el" -;;;;;; "language/european.el" "language/georgian.el" "language/greek.el" -;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el" -;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el" -;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el" -;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el" -;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el" -;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/leim-list.el" -;;;;;; "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el" -;;;;;; "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" "leim/quail/ECDICT.el" -;;;;;; "leim/quail/ETZY.el" "leim/quail/PY-b5.el" "leim/quail/PY.el" -;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el" -;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el" -;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el" -;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" -;;;;;; "leim/quail/czech.el" "leim/quail/georgian.el" "leim/quail/greek.el" -;;;;;; "leim/quail/hanja-jis.el" "leim/quail/hanja.el" "leim/quail/hanja3.el" -;;;;;; "leim/quail/hebrew.el" "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" -;;;;;; "leim/quail/latin-ltx.el" "leim/quail/latin-post.el" "leim/quail/latin-pre.el" -;;;;;; "leim/quail/persian.el" "leim/quail/programmer-dvorak.el" -;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" -;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sgml-input.el" -;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" -;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" -;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" -;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" -;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" -;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el" -;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el" -;;;;;; "obarray.el" "org/ob-core.el" "org/ob-keys.el" "org/ob-lob.el" -;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" -;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-clock.el" -;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el" -;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" +;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charscript.el" +;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/mule-cmds.el" +;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el" +;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el" +;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el" +;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el" +;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el" +;;;;;; "language/indian.el" "language/japanese.el" "language/khmer.el" +;;;;;; "language/korean.el" "language/lao.el" "language/misc-lang.el" +;;;;;; "language/romanian.el" "language/sinhala.el" "language/slovak.el" +;;;;;; "language/tai-viet.el" "language/thai.el" "language/tibetan.el" +;;;;;; "language/utf-8-lang.el" "language/vietnamese.el" "ldefs-boot.el" +;;;;;; "leim/ja-dic/ja-dic.el" "leim/leim-list.el" "leim/quail/4Corner.el" +;;;;;; "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el" "leim/quail/CTLau-b5.el" +;;;;;; "leim/quail/CTLau.el" "leim/quail/ECDICT.el" "leim/quail/ETZY.el" +;;;;;; "leim/quail/PY-b5.el" "leim/quail/PY.el" "leim/quail/Punct-b5.el" +;;;;;; "leim/quail/Punct.el" "leim/quail/QJ-b5.el" "leim/quail/QJ.el" +;;;;;; "leim/quail/SW.el" "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el" +;;;;;; "leim/quail/ZOZY.el" "leim/quail/arabic.el" "leim/quail/croatian.el" +;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el" +;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el" +;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el" +;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" +;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/persian.el" +;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el" +;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" "leim/quail/quick-cns.el" +;;;;;; "leim/quail/rfc1345.el" "leim/quail/sgml-input.el" "leim/quail/slovak.el" +;;;;;; "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el" +;;;;;; "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" "leim/quail/vnvni.el" +;;;;;; "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" +;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" +;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" +;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" +;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-keys.el" +;;;;;; "org/ob-lob.el" "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" +;;;;;; "org/org-archive.el" "org/org-attach.el" "org/org-bbdb.el" +;;;;;; "org/org-clock.el" "org/org-datetree.el" "org/org-element.el" +;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-id.el" "org/org-indent.el" ;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-mobile.el" ;;;;;; "org/org-plot.el" "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" ;;;;;; "org/ox-beamer.el" "org/ox-html.el" "org/ox-icalendar.el" diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 7af6148e473..260ada54222 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -470,6 +470,18 @@ size, and full-buffer size." (shr-insert sub) (shr-descend sub)))) +(defun shr-indirect-call (tag-name dom &rest args) + (let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray)) + ;; Allow other packages to override (or provide) rendering + ;; of elements. + (external (cdr (assq tag-name shr-external-rendering-functions)))) + (cond (external + (apply external dom args)) + ((fboundp function) + (apply function dom args)) + (t + (apply 'shr-generic dom args))))) + (defun shr-descend (dom) (let ((function (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray)) @@ -490,6 +502,11 @@ size, and full-buffer size." (setq style nil))) ;; If we have a display:none, then just ignore this part of the DOM. (unless (equal (cdr (assq 'display shr-stylesheet)) "none") + ;; We don't use shr-indirect-call here, since shr-descend is + ;; the central bit of shr.el, and should be as fast as + ;; possible. Having one more level of indirection with its + ;; negative effect on performance is deemed unjustified in + ;; this case. (cond (external (funcall external dom)) ((fboundp function) @@ -1404,7 +1421,7 @@ ones, in case fg and bg are nil." (when url (cond (image - (shr-tag-img dom url) + (shr-indirect-call 'img dom url) (setq dom nil)) (multimedia (shr-insert " [multimedia] ") @@ -1469,7 +1486,7 @@ The preference is a float determined from `shr-prefer-media-type'." (unless url (setq url (car (shr--extract-best-source dom)))) (if (> (length image) 0) - (shr-tag-img nil image) + (shr-indirect-call 'img nil image) (shr-insert " [video] ")) (shr-urlify start (shr-expand-url url)))) @@ -1964,9 +1981,9 @@ flags that control whether to collect or render objects." do (setq tag (dom-tag child)) and unless (memq tag '(comment style)) if (eq tag 'img) - do (shr-tag-img child) + do (shr-indirect-call 'img child) else if (eq tag 'object) - do (shr-tag-object child) + do (shr-indirect-call 'object child) else do (setq recurse t) and if (eq tag 'tr) @@ -1980,7 +1997,7 @@ flags that control whether to collect or render objects." do (setq flags nil) else if (car flags) do (setq recurse nil) - (shr-tag-table child) + (shr-indirect-call 'table child) end end end end end end end end end end when recurse append (shr-collect-extra-strings-in-table child flags))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 760d020f672..5268e80a33d 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -139,6 +139,7 @@ It is used for TCP/IP devices." (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . ignore) (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-adb-handle-file-system-info) (file-truename . tramp-adb-handle-file-truename) (file-writable-p . tramp-adb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -255,6 +256,30 @@ pass to the OPERATION." (file-attributes (file-truename filename))) t)) +(defun tramp-adb-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (ignore-errors + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-message v 5 "file system info: %s" localname) + (tramp-adb-send-command + v (format "df -k %s" (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (forward-line) + (when (looking-at + (concat "[[:space:]]*[^[:space:]]+" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) + ;; The values are given as 1k numbers, so we must change + ;; them to number of bytes. + (list (* 1024 (string-to-number (concat (match-string 1) "e0"))) + ;; The second value is the used size. We need the + ;; free size. + (* 1024 (- (string-to-number (concat (match-string 1) "e0")) + (string-to-number (concat (match-string 2) "e0")))) + (* 1024 (string-to-number (concat (match-string 3) "e0"))))))))) + ;; This is derived from `tramp-sh-handle-file-truename'. Maybe the ;; code could be shared? (defun tramp-adb-handle-file-truename (filename) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e55dd1178d2..237d6896e2a 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -448,6 +448,18 @@ Every entry is a list (NAME ADDRESS).") ":[[:blank:]]+\\(.*\\)$") "Regexp to parse GVFS file attributes with `gvfs-info'.") +(defconst tramp-gvfs-file-system-attributes + '("filesystem::free" + "filesystem::size" + "filesystem::used") + "GVFS file system attributes.") + +(defconst tramp-gvfs-file-system-attributes-regexp + (concat "^[[:blank:]]*" + (regexp-opt tramp-gvfs-file-system-attributes t) + ":[[:blank:]]+\\(.*\\)$") + "Regexp to parse GVFS file system attributes with `gvfs-info'.") + ;; New handlers should be added here. ;;;###tramp-autoload @@ -494,6 +506,7 @@ Every entry is a list (NAME ADDRESS).") (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . ignore) (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-gvfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-gvfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -825,7 +838,7 @@ file names." (let ((last-coding-system-used last-coding-system-used) result) (with-parsed-tramp-file-name directory nil - (with-tramp-file-property v localname "directory-gvfs-attributes" + (with-tramp-file-property v localname "directory-attributes" (tramp-message v 5 "directory gvfs attributes: %s" localname) ;; Send command. (tramp-gvfs-send-command @@ -860,23 +873,34 @@ file names." (forward-line))) result))))) -(defun tramp-gvfs-get-root-attributes (filename) - "Return GVFS attributes association list of FILENAME." +(defun tramp-gvfs-get-root-attributes (filename &optional file-system) + "Return GVFS attributes association list of FILENAME. +If FILE-SYSTEM is non-nil, return file system attributes." (ignore-errors ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used) result) (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-gvfs-attributes" - (tramp-message v 5 "file gvfs attributes: %s" localname) + (with-tramp-file-property + v localname + (if file-system "file-system-attributes" "file-attributes") + (tramp-message + v 5 "file%s gvfs attributes: %s" + (if file-system " system" "") localname) ;; Send command. - (tramp-gvfs-send-command - v "gvfs-info" (tramp-gvfs-url-file-name filename)) + (if file-system + (tramp-gvfs-send-command + v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename)) + (tramp-gvfs-send-command + v "gvfs-info" (tramp-gvfs-url-file-name filename))) ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (re-search-forward - tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t) + (if file-system + tramp-gvfs-file-system-attributes-regexp + tramp-gvfs-file-attributes-with-gvfs-info-regexp) + nil t) (push (cons (match-string 1) (match-string 2)) result)) result)))))) @@ -1127,6 +1151,22 @@ file-notify events." (with-tramp-file-property v localname "file-readable-p" (tramp-check-cached-permissions v ?r)))) +(defun tramp-gvfs-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (setq filename (directory-file-name (expand-file-name filename))) + (with-parsed-tramp-file-name filename nil + ;; We don't use cached values. + (tramp-set-file-property v localname "file-system-attributes" 'undef) + (let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system)) + (size (cdr (assoc "filesystem::size" attr))) + (used (cdr (assoc "filesystem::used" attr))) + (free (cdr (assoc "filesystem::free" attr)))) + (when (and (stringp size) (stringp used) (stringp free)) + (list (string-to-number (concat size "e0")) + (- (string-to-number (concat size "e0")) + (string-to-number (concat used "e0"))) + (string-to-number (concat free "e0"))))))) + (defun tramp-gvfs-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (with-parsed-tramp-file-name filename nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a744a53ca42..bdb7a132408 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1020,6 +1020,7 @@ of command line.") (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . tramp-sh-handle-file-selinux-context) (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-sh-handle-file-system-info) (file-truename . tramp-sh-handle-file-truename) (file-writable-p . tramp-sh-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -2739,6 +2740,17 @@ The method used must be an out-of-band method." beg 'noerror) (replace-match (file-relative-name filename) t)) + ;; Try to insert the amount of free space. + (goto-char (point-min)) + ;; First find the line to put it on. + (when (re-search-forward "^\\([[:space:]]*total\\)" nil t) + (let ((available (get-free-disk-space "."))) + (when available + ;; Replace "total" with "total used", to avoid confusion. + (replace-match "\\1 used in directory") + (end-of-line) + (insert " available " available)))) + (goto-char (point-max))))))) ;; Canonicalization of file names. @@ -3701,6 +3713,30 @@ file-notify events." 'file-notify-handle-event `(file-notify ,object file-notify-callback))))))) +(defun tramp-sh-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (ignore-errors + (with-parsed-tramp-file-name (expand-file-name filename) nil + (when (tramp-get-remote-df v) + (tramp-message v 5 "file system info: %s" localname) + (tramp-send-command + v (format + "%s --block-size=1 --output=size,used,avail %s" + (tramp-get-remote-df v) (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (forward-line) + (when (looking-at + (concat "[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) + (list (string-to-number (concat (match-string 1) "e0")) + ;; The second value is the used size. We need the + ;; free size. + (- (string-to-number (concat (match-string 1) "e0")) + (string-to-number (concat (match-string 2) "e0"))) + (string-to-number (concat (match-string 3) "e0"))))))))) + ;;; Internal Functions: (defun tramp-maybe-send-script (vec script name) @@ -5404,6 +5440,17 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." (delete-file tmpfile)) result))) +(defun tramp-get-remote-df (vec) + "Determine remote `df' command." + (with-tramp-connection-property vec "df" + (tramp-message vec 5 "Finding a suitable `df' command") + (let ((result (tramp-find-executable vec "df" (tramp-get-remote-path vec)))) + (and + result + (tramp-send-command-and-check + vec (format "%s --block-size=1 --output=size,used,avail /" result)) + result)))) + (defun tramp-get-remote-gvfs-monitor-dir (vec) "Determine remote `gvfs-monitor-dir' command." (with-tramp-connection-property vec "gvfs-monitor-dir" diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 35aa8110946..620c93828da 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -255,6 +255,7 @@ See `tramp-actions-before-shell' for more info.") (file-remote-p . tramp-handle-file-remote-p) ;; `file-selinux-context' performed by default handler. (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-smb-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -954,6 +955,38 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (nth 0 x)))) (tramp-smb-get-file-entries directory)))))))) +(defun tramp-smb-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (ignore-errors + (unless (file-directory-p filename) + (setq filename (file-name-directory filename))) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-message v 5 "file system info: %s" localname) + (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v))) + (with-current-buffer (tramp-get-connection-buffer v) + (let (total avail blocksize) + (goto-char (point-min)) + (forward-line) + (when (looking-at + (concat "[[:space:]]*\\([[:digit:]]+\\)" + " blocks of size \\([[:digit:]]+\\)" + "\\. \\([[:digit:]]+\\) blocks available")) + (setq blocksize (string-to-number (concat (match-string 2) "e0")) + total (* blocksize + (string-to-number (concat (match-string 1) "e0"))) + avail (* blocksize + (string-to-number (concat (match-string 3) "e0"))))) + (forward-line) + (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") + ;; The used number of bytes is not part of the result. As + ;; side effect, we store it as file property. + (tramp-set-file-property + v localname "used-bytes" + (string-to-number (concat (match-string 1) "e0")))) + ;; Result. + (when (and total avail) + (list total (- total avail) avail))))))) + (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (if (file-exists-p filename) @@ -984,7 +1017,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We should not destroy the cache entry. (entries (copy-sequence (tramp-smb-get-file-entries - (file-name-directory filename))))) + (file-name-directory filename)))) + (avail (get-free-disk-space filename)) + ;; `get-free-disk-space' calls `file-system-info', which + ;; sets file property "used-bytes" as side effect. + (used + (format + "%.0f" + (/ (tramp-get-file-property v localname "used-bytes" 0) 1024)))) (when wildcard (string-match "\\." base) @@ -1032,6 +1072,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar x (concat (car x) "*")))))) entries)) + ;; Insert size information. + (insert + (if avail + (format "total used in directory %s available %s\n" used avail) + (format "total %s\n" used))) + ;; Print entries. (mapc (lambda (x) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e253db0883c..c8b6e68f719 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1269,14 +1269,14 @@ entry does not exist, return nil." ;;;###tramp-autoload (defun tramp-tramp-file-p (name) "Return t if NAME is a string with Tramp file name syntax." - (save-match-data - (and (stringp name) - ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'. - (not (string-match - (if (memq system-type '(cygwin windows-nt)) - "^/[[:alpha:]]?:" "^/:") - name)) - (string-match tramp-file-name-regexp name)))) + (and (stringp name) + ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'. + (not (string-match-p + (if (memq system-type '(cygwin windows-nt)) + "^/[[:alpha:]]?:" "^/:") + name)) + (string-match-p tramp-file-name-regexp name) + t)) (defun tramp-find-method (method user host) "Return the right method string to use. @@ -2079,7 +2079,9 @@ ARGS are the arguments OPERATION has been called with." substitute-in-file-name unhandled-file-name-directory vc-registered ;; Emacs 26+ only. - file-name-case-insensitive-p)) + file-name-case-insensitive-p + ;; Emacs 27+ only. + file-system-info)) (if (file-name-absolute-p (nth 0 args)) (nth 0 args) default-directory)) diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el index 86276aad810..57ab8af4f30 100644 --- a/lisp/org/ob-hledger.el +++ b/lisp/org/ob-hledger.el @@ -1,4 +1,4 @@ -;; ob-ledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*- +;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index 8a52b57e52a..13f728f37f6 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -53,11 +53,15 @@ should not be inherited from a source block.") (let* ((info (org-babel-get-src-block-info 'light)) (source-name (nth 4 info))) (when source-name - (setq source-name (intern source-name) - org-babel-library-of-babel - (cons (cons source-name info) - (assq-delete-all source-name org-babel-library-of-babel)) - lob-ingest-count (1+ lob-ingest-count))))) + (setf (nth 1 info) + (if (org-babel-noweb-p (nth 2 info) :eval) + (org-babel-expand-noweb-references info) + (nth 1 info))) + (let ((source (intern source-name))) + (setq org-babel-library-of-babel + (cons (cons source info) + (assq-delete-all source org-babel-library-of-babel)))) + (cl-incf lob-ingest-count)))) (message "%d src block%s added to Library of Babel" lob-ingest-count (if (> lob-ingest-count 1) "s" "")) lob-ingest-count)) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 2eec817735a..9dc501500b1 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -2984,6 +2984,7 @@ The details of what will be saved are regulated by the variable ;; Local variables: ;; generated-autoload-file: "org-loaddefs.el" +;; coding: utf-8 ;; End: ;;; org-clock.el ends here diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 242bdc26550..eac29c50f65 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -464,7 +464,8 @@ for the duration of the command.") (kill-local-variable 'org-previous-header-line-format) (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) (set-marker org-columns-begin-marker nil) - (set-marker org-columns-top-level-marker nil) + (when (markerp org-columns-top-level-marker) + (set-marker org-columns-top-level-marker nil)) (org-with-silent-modifications (mapc #'delete-overlay org-columns-overlays) (setq org-columns-overlays nil) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 66907e2cd9c..8dc648eaecd 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1646,12 +1646,14 @@ In particular, this does handle wide and invisible characters." (if (not (org-at-table-p)) (user-error "Not at a table")) (let ((col (current-column)) - (dline (org-table-current-dline))) + (dline (and (not (org-match-line org-table-hline-regexp)) + (org-table-current-dline)))) (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (if (not (org-at-table-p)) (beginning-of-line 0)) (org-move-to-column col) - (when (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (when (and dline + (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? "))) (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) dline -1 dline)))) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 523afd1ad33..30318ba92c8 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.1.1")) + (let ((org-release "9.1.2")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.1.1-37-gb1e8b5")) + (let ((org-git-version "release_9.1.2-40-g6ca906")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index c5759cb537b..35405b4bf81 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -16071,7 +16071,9 @@ automatically performed, such drawers will be silently ignored." (when (memq (org-element-type element) '(keyword node-property)) (let ((value (org-element-property :value element)) (start 0)) - (while (string-match "%[0-9]*\\(\\S-+\\)" value start) + (while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\ +\\(?:{[^}]+}\\)?" + value start) (setq start (match-end 0)) (let ((p (match-string-no-properties 1 value))) (unless (member-ignore-case p org-special-properties) @@ -19481,7 +19483,6 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey org-mode-map [(shift return)] 'org-table-copy-down) (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) -(org-defkey org-mode-map [(meta return)] 'org-meta-return) (org-defkey org-mode-map (kbd "M-RET") #'org-meta-return) ;; Cursor keys with modifiers @@ -24204,16 +24205,25 @@ convenience: - On an affiliated keyword, jump to the first one. - On a table or a property drawer, move to its beginning. - - On a verse or source block, stop before blank lines." + - On comment, example, export, src and verse blocks, stop + before blank lines." (interactive) (unless (bobp) (let* ((deactivate-mark nil) (element (org-element-at-point)) (type (org-element-type element)) - (contents-begin (org-element-property :contents-begin element)) (contents-end (org-element-property :contents-end element)) (post-affiliated (org-element-property :post-affiliated element)) - (begin (org-element-property :begin element))) + (begin (org-element-property :begin element)) + (special? ;blocks handled specially + (memq type '(comment-block example-block export-block src-block + verse-block))) + (contents-begin + (if special? + ;; These types have no proper contents. Fake line + ;; below the block opening line as contents beginning. + (save-excursion (goto-char begin) (line-beginning-position 2)) + (org-element-property :contents-begin element)))) (cond ((not element) (goto-char (point-min))) ((= (point) begin) @@ -24224,11 +24234,8 @@ convenience: (goto-char (org-element-property :post-affiliated (org-element-property :parent element)))) ((memq type '(property-drawer table)) (goto-char begin)) - ((memq type '(src-block verse-block)) - (when (eq type 'src-block) - (setq contents-begin - (save-excursion (goto-char begin) (forward-line) (point)))) - (if (= (point) contents-begin) (goto-char post-affiliated) + (special? + (if (<= (point) contents-begin) (goto-char post-affiliated) ;; Inside a verse block, see blank lines as paragraph ;; separators. (let ((origin (point))) @@ -24237,7 +24244,6 @@ convenience: (skip-chars-forward " \r\t\n" origin) (if (= (point) origin) (goto-char contents-begin) (beginning-of-line)))))) - ((not contents-begin) (goto-char (or post-affiliated begin))) ((eq type 'paragraph) (goto-char contents-begin) ;; When at first paragraph in an item or a footnote definition, diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index fb8c61334f5..8ce4fb6adcd 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -174,7 +174,6 @@ (:html-klipsify-src nil nil org-html-klipsify-src) (:html-klipse-css nil nil org-html-klipse-css) (:html-klipse-js nil nil org-html-klipse-js) - (:html-klipse-keep-old-src nil nil org-html-keep-old-src) (:html-klipse-selection-script nil nil org-html-klipse-selection-script) (:infojs-opt "INFOJS_OPT" nil nil) ;; Redefine regular options. @@ -1572,12 +1571,6 @@ https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag" :package-version '(Org . "9.1") :type 'string) -(defcustom org-html-keep-old-src nil - "When non-nil, use <pre class=\"\"> instead of <pre><code class=\"\">." - :group 'org-export-html - :package-version '(Org . "9.1") - :type 'boolean) - ;;;; Todos @@ -3402,12 +3395,16 @@ contextual information." listing-number (org-trim (org-export-data caption info)))))) ;; Contents. - (let ((open (if org-html-keep-old-src "<pre" "<pre><code")) - (close (if org-html-keep-old-src "</pre>" "</code></pre>"))) - (format "%s class=\"src src-%s\"%s%s>%s%s" - open lang label (if (and klipsify (string= lang "html")) - " data-editor-type=\"html\"" "") - code close))))))) + (if klipsify + (format "<pre><code class=\"src src-%s\"%s%s>%s</code></pre>" + lang + label + (if (string= lang "html") + " data-editor-type=\"html\"" + "") + code) + (format "<pre class=\"src src-%s\"%s>%s</pre>" + lang label code))))))) ;;;; Statistics Cookie diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index a975abc4871..957b0da7c59 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -435,8 +435,8 @@ This splices all the components into the list." (let* ((base-dir (file-name-as-directory (org-publish-property :base-directory project))) (extension (or (org-publish-property :base-extension project) "org")) - (match (and (not (eq extension 'any)) - (concat "^[^\\.].*\\.\\(" extension "\\)$"))) + (match (if (eq extension 'any) "" + (format "^[^\\.].*\\.\\(%s\\)$" extension))) (base-files (cl-remove-if #'file-directory-p (if (org-publish-property :recursive project) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 05b391a3d38..37928357526 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -132,7 +132,7 @@ ;; ;; 'c-not-decl ;; Put on the brace which introduces a brace list and on the commas -;; which separate the element within it. +;; which separate the elements within it. ;; ;; 'c-awk-NL-prop ;; Used in AWK mode to mark the various kinds of newlines. See @@ -5403,15 +5403,14 @@ comment at the start of cc-engine.el for more info." (min c-bs-cache-limit pos))) (defun c-update-brace-stack (stack from to) - ;; Give a brace-stack which has the value STACK at position FROM, update it - ;; to it's value at position TO, where TO is after (or equal to) FROM. + ;; Given a brace-stack which has the value STACK at position FROM, update it + ;; to its value at position TO, where TO is after (or equal to) FROM. ;; Return a cons of either TO (if it is outside a literal) and this new ;; value, or of the next position after TO outside a literal and the new ;; value. (let (match kwd-sym (prev-match-pos 1) (s (cdr stack)) - (bound-<> (car stack)) - ) + (bound-<> (car stack))) (save-excursion (cond ((and bound-<> (<= to bound-<>)) @@ -5472,6 +5471,9 @@ comment at the start of cc-engine.el for more info." (setq s (cdr s)))) ((c-keyword-member kwd-sym 'c-flat-decl-block-kwds) (push 0 s)))) + ;; The failing `c-syntactic-re-search-forward' may have left us in the + ;; middle of a token, which might be a significant token. Fix this! + (c-beginning-of-current-token) (cons (point) (cons bound-<> s))))) @@ -5647,11 +5649,13 @@ comment at the start of cc-engine.el for more info." ;; Call CFD-FUN for each possible spot for a declaration, cast or ;; label from the point to CFD-LIMIT. ;; - ;; CFD-FUN is called with point at the start of the spot. It's passed two + ;; CFD-FUN is called with point at the start of the spot. It's passed three ;; arguments: The first is the end position of the token preceding the spot, ;; or 0 for the implicit match at bob. The second is a flag that is t when - ;; the match is inside a macro. Point should be moved forward by at least - ;; one token. + ;; the match is inside a macro. The third is a flag that is t when the + ;; match is at "top level", i.e. outside any brace block, or directly inside + ;; a class or namespace, etc. Point should be moved forward by at least one + ;; token. ;; ;; If CFD-FUN adds `c-decl-end' properties somewhere below the current spot, ;; it should return non-nil to ensure that the next search will find them. @@ -6038,6 +6042,8 @@ comment at the start of cc-engine.el for more info." (setq cfd-macro-end 0) nil)))) ; end of when condition + (when (> cfd-macro-end 0) + (setq cfd-top-level nil)) ; In a macro is "never" at top level. (c-debug-put-decl-spot-faces cfd-match-pos (point)) (if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0) cfd-top-level) (setq cfd-prop-match nil)) @@ -8575,7 +8581,13 @@ comment at the start of cc-engine.el for more info." (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)) - ((looking-at c-type-decl-suffix-key) + ((and (looking-at c-type-decl-suffix-key) + ;; We avoid recognizing foo(bar) or foo() at top level as a + ;; construct here in C, since we want to recognize this as a + ;; typeless function declaration. + (not (and (c-major-mode-is 'c-mode) + (eq context 'top) + (eq (char-after) ?\))))) (if (eq (char-after) ?\)) (when (> paren-depth 0) (setq paren-depth (1- paren-depth)) @@ -8618,7 +8630,12 @@ comment at the start of cc-engine.el for more info." (save-excursion (goto-char after-paren-pos) (c-forward-syntactic-ws) - (c-forward-type))))) + (or (c-forward-type) + ;; Recognize a top-level typeless + ;; function declaration in C. + (and (c-major-mode-is 'c-mode) + (eq context 'top) + (eq (char-after) ?\)))))))) (setq pos (c-up-list-forward (point))) (eq (char-before pos) ?\))) (c-fdoc-shift-type-backward) @@ -9035,9 +9052,12 @@ comment at the start of cc-engine.el for more info." ;; (in at least C++) that anything that can be parsed as a declaration ;; is a declaration. Now we're being more defensive and prefer to ;; highlight things like "foo (bar);" as a declaration only if we're - ;; inside an arglist that contains declarations. - ;; CASE 19 - (eq context 'decl)))) + ;; inside an arglist that contains declarations. Update (2017-09): We + ;; now recognize a top-level "foo(bar);" as a declaration in C. + ;; CASE 19 + (or (eq context 'decl) + (and (c-major-mode-is 'c-mode) + (eq context 'top)))))) ;; The point is now after the type decl expression. @@ -9545,6 +9565,7 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." ;; Note to maintainers: this function consumes a great mass of CPU cycles. ;; Its use should thus be minimized as far as possible. + ;; Consider instead using `c-bs-at-toplevel-p'. (let ((paren-state (c-parse-state))) (or (not (c-most-enclosing-brace paren-state)) (c-search-uplist-for-classkey paren-state)))) @@ -9574,8 +9595,15 @@ comment at the start of cc-engine.el for more info." (not (and (c-major-mode-is 'objc-mode) (c-forward-objc-directive))) + ;; Don't confuse #if .... defined(foo) for a function arglist. + (not (and (looking-at c-cpp-expr-functions-key) + (save-excursion + (save-restriction + (widen) + (c-beginning-of-macro lim))))) (setq id-start (car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))) + (numberp id-start) (< id-start beg) ;; There should not be a '=' or ',' between beg and the diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 9495d602e09..227b3e16485 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -952,6 +952,11 @@ expression, or nil if there aren't any in the language." '("defined")) pike '("defined" "efun" "constant")) +(c-lang-defconst c-cpp-expr-functions-key + ;; Matches a function in a cpp expression. + t (c-make-keywords-re t (c-lang-const c-cpp-expr-functions))) +(c-lang-defvar c-cpp-expr-functions-key (c-lang-const c-cpp-expr-functions-key)) + (c-lang-defconst c-assignment-operators "List of all assignment operators." t '("=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "^=" "|=") diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 8867453e85c..b0e5fe47a7c 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1571,6 +1571,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (and (c-beginning-of-macro) (progn (c-end-of-macro) (point)))))) (when (and (c-forward-declarator lim) + (or (not (eq (char-after) ?\()) + (c-go-list-forward nil lim)) (eq (c-forward-token-2 1 nil lim) 0)) (c-backward-syntactic-ws) (point)))))) @@ -1589,7 +1591,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) c-new-END (or (c-fl-decl-end c-new-END) - (c-point 'bonl (max (1- c-new-END) (point-min))))))) + (c-point 'bonl c-new-END))))) (defun c-context-expand-fl-region (beg end) ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2f8e081a295..3690f673832 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -243,7 +243,9 @@ Blank lines separate paragraphs. Semicolons start comments. (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-vc-external-roots-function #'elisp-load-path-roots) (add-hook 'completion-at-point-functions - #'elisp-completion-at-point nil 'local)) + #'elisp-completion-at-point nil 'local) + (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t) + (add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t)) ;; Font-locking support. @@ -810,7 +812,7 @@ non-nil result supercedes the xrefs produced by (apply #'nconc (let (lst) (dolist (sym (apropos-internal regexp)) - (push (elisp--xref-find-definitions sym) lst)) + (push (elisp--xref-find-definitions sym) lst)) (nreverse lst)))) (defvar elisp--xref-identifier-completion-table @@ -1109,7 +1111,7 @@ If CHAR is not a character, return nil." ;; interactive call would use it. ;; FIXME: Is it really the right place for this? (when (eq (car-safe expr) 'interactive) - (setq expr + (setq expr `(call-interactively (lambda (&rest args) ,expr args)))) expr))))) @@ -1174,7 +1176,7 @@ POS specifies the starting position where EXP was found and defaults to point." (and (not (special-variable-p var)) (save-excursion (zerop (car (syntax-ppss (match-beginning 0))))) - (push var vars)))) + (push var vars)))) `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) (defun eval-last-sexp (eval-last-sexp-arg-internal) @@ -1379,7 +1381,7 @@ or elsewhere, return a 1-line docstring." (t (help-function-arglist sym))))) ;; Stringify, and store before highlighting, downcasing, etc. (elisp--last-data-store sym (elisp-function-argstring args) - 'function)))))) + 'function)))))) ;; Highlight, truncate. (if argstring (elisp--highlight-function-argument @@ -1588,5 +1590,164 @@ ARGLIST is either a string, or a list of strings or symbols." (replace-match "(" t t str) str))) +;;; Flymake support + +;; Don't require checkdoc, but forward declare these checkdoc special +;; variables. Autoloading them on `checkdoc-current-buffer' is too +;; late, they won't be bound dynamically. +(defvar checkdoc-create-error-function) +(defvar checkdoc-autofix-flag) +(defvar checkdoc-generate-compile-warnings-flag) +(defvar checkdoc-diagnostic-buffer) +(defun elisp-flymake--checkdoc-1 () + "Do actual work for `elisp-flymake-checkdoc'." + (let (collected) + (let* ((checkdoc-create-error-function + (lambda (text start end &optional unfixable) + (push (list text start end unfixable) collected) + nil)) + (checkdoc-autofix-flag nil) + (checkdoc-generate-compile-warnings-flag nil) + (buf (generate-new-buffer " *checkdoc-temp*")) + (checkdoc-diagnostic-buffer buf)) + (unwind-protect + (save-excursion + (checkdoc-current-buffer t)) + (kill-buffer buf))) + collected)) + +;;;###autoload +(defun elisp-flymake-checkdoc (report-fn &rest _args) + "A Flymake backend for `checkdoc'. +Calls REPORT-FN directly." + (unless (derived-mode-p 'emacs-lisp-mode) + (error "Can only work on `emacs-lisp-mode' buffers")) + (funcall report-fn + (cl-loop for (text start end _unfixable) in + (elisp-flymake--checkdoc-1) + collect + (flymake-make-diagnostic + (current-buffer) + start end :note text)))) + +(defun elisp-flymake--byte-compile-done (report-fn + origin-buffer + output-buffer + temp-file) + (unwind-protect + (with-current-buffer + origin-buffer + (save-excursion + (save-restriction + (widen) + (funcall + report-fn + (cl-loop with data = + (with-current-buffer output-buffer + (goto-char (point-min)) + (search-forward ":elisp-flymake-output-start") + (read (point-marker))) + for (string pos _fill level) in data + do (goto-char pos) + for beg = (if (< (point) (point-max)) + (point) + (line-beginning-position)) + for end = (min + (line-end-position) + (or (cdr + (bounds-of-thing-at-point 'sexp)) + (point-max))) + collect (flymake-make-diagnostic + (current-buffer) + (if (= beg end) (1- beg) beg) + end + level + string)))))) + (kill-buffer output-buffer) + (ignore-errors (delete-file temp-file)))) + +(defvar-local elisp-flymake--byte-compile-process nil + "Buffer-local process started for byte-compiling the buffer.") + +;;;###autoload +(defun elisp-flymake-byte-compile (report-fn &rest _args) + "A Flymake backend for elisp byte compilation. +Spawn an Emacs process that byte-compiles a file representing the +current buffer state and calls REPORT-FN when done." + (interactive (list (lambda (stuff) + (message "aha %s" stuff)))) + (unless (derived-mode-p 'emacs-lisp-mode) + (error "Can only work on `emacs-lisp-mode' buffers")) + (when elisp-flymake--byte-compile-process + (process-put elisp-flymake--byte-compile-process 'elisp-flymake--obsolete t) + (when (process-live-p elisp-flymake--byte-compile-process) + (kill-process elisp-flymake--byte-compile-process))) + (let ((temp-file (make-temp-file "elisp-flymake-byte-compile")) + (origin-buffer (current-buffer))) + (save-restriction + (widen) + (write-region (point-min) (point-max) temp-file nil 'nomessage)) + (let* ((output-buffer (generate-new-buffer " *elisp-flymake-byte-compile*"))) + (setq + elisp-flymake--byte-compile-process + (make-process + :name "elisp-flymake-byte-compile" + :buffer output-buffer + :command (list (expand-file-name invocation-name invocation-directory) + "-Q" + "--batch" + ;; "--eval" "(setq load-prefer-newer t)" ; for testing + "-L" default-directory + "-f" "elisp-flymake--batch-compile-for-flymake" + temp-file) + :connection-type 'pipe + :sentinel + (lambda (proc _event) + (unless (process-live-p proc) + (unwind-protect + (cond + ((zerop (process-exit-status proc)) + (elisp-flymake--byte-compile-done report-fn + origin-buffer + output-buffer + temp-file)) + ((process-get proc 'elisp-flymake--obsolete) + (flymake-log :warning "byte-compile process %s obsolete" proc)) + (t + (funcall report-fn + :panic + :explanation + (format "byte-compile process %s died" proc))))))))) + :stderr null-device + :noquery t))) + +(defun elisp-flymake--batch-compile-for-flymake (&optional file) + "Helper for `elisp-flymake-byte-compile'. +Runs in a batch-mode Emacs. Interactively use variable +`buffer-file-name' for FILE." + (interactive (list buffer-file-name)) + (let* ((file (or file + (car command-line-args-left))) + (dummy-elc-file) + (byte-compile-log-buffer + (generate-new-buffer " *dummy-byte-compile-log-buffer*")) + (byte-compile-dest-file-function + (lambda (source) + (setq dummy-elc-file (make-temp-file (file-name-nondirectory source))))) + (collected) + (byte-compile-log-warning-function + (lambda (string &optional position fill level) + (push (list string position fill level) + collected) + t))) + (unwind-protect + (byte-compile-file file) + (ignore-errors + (delete-file dummy-elc-file) + (kill-buffer byte-compile-log-buffer))) + (prin1 :elisp-flymake-output-start) + (terpri) + (pp collected))) + (provide 'elisp-mode) ;;; elisp-mode.el ends here diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index df1a0750cfb..52cb1985327 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -1,4 +1,4 @@ -;;; flymake-proc.el --- Flymake for external syntax checker processes -*- lexical-binding: t; -*- +;;; flymake-proc.el --- Flymake backend for external tools -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2017 Free Software Foundation, Inc. @@ -20,15 +20,19 @@ ;; 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/>. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; ;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. ;; -;; This file contains the most original implementation of flymake's -;; main source of on-the-fly diagnostic info, the external syntax -;; checker backend. +;; This file contains a significant part of the original flymake's +;; implementation, a buffer-checking mechanism that parses the output +;; of an external syntax check tool with regular expressions. +;; +;; That work has been adapted into a flymake "backend" function, +;; `flymake-proc-legacy-flymake' suitable for adding to the +;; `flymake-diagnostic-functions' variable. ;; ;;; Bugs/todo: @@ -37,42 +41,45 @@ ;;; Code: -(require 'flymake-ui) +(require 'flymake) -(defcustom flymake-compilation-prevents-syntax-check t +(defcustom flymake-proc-compilation-prevents-syntax-check t "If non-nil, don't start syntax check if compilation is running." :group 'flymake :type 'boolean) -(defcustom flymake-xml-program +(defcustom flymake-proc-xml-program (if (executable-find "xmlstarlet") "xmlstarlet" "xml") "Program to use for XML validation." :type 'file :group 'flymake :version "24.4") -(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") +(defcustom flymake-proc-master-file-dirs '("." "./src" "./UnitTest") "Dirs where to look for master files." :group 'flymake :type '(repeat (string))) -(defcustom flymake-master-file-count-limit 32 +(defcustom flymake-proc-master-file-count-limit 32 "Max number of master files to check." :group 'flymake :type 'integer) -(defcustom flymake-allowed-file-name-masks - '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) - ("\\.xml\\'" flymake-xml-init) - ("\\.html?\\'" flymake-xml-init) - ("\\.cs\\'" flymake-simple-make-init) - ("\\.p[ml]\\'" flymake-perl-init) - ("\\.php[345]?\\'" flymake-php-init) - ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup) - ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup) - ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup) - ("\\.tex\\'" flymake-simple-tex-init) - ("\\.idl\\'" flymake-simple-make-init) +(defcustom flymake-proc-allowed-file-name-masks + '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" + flymake-proc-simple-make-init + nil + flymake-proc-real-file-name-considering-includes) + ("\\.xml\\'" flymake-proc-xml-init) + ("\\.html?\\'" flymake-proc-xml-init) + ("\\.cs\\'" flymake-proc-simple-make-init) + ("\\.p[ml]\\'" flymake-proc-perl-init) + ("\\.php[345]?\\'" flymake-proc-php-init) + ("\\.h\\'" flymake-proc-master-make-header-init flymake-proc-master-cleanup) + ("\\.java\\'" flymake-proc-simple-make-java-init flymake-proc-simple-java-cleanup) + ("[0-9]+\\.tex\\'" flymake-proc-master-tex-init flymake-proc-master-cleanup) + ("\\.tex\\'" flymake-proc-simple-tex-init) + ("\\.idl\\'" flymake-proc-simple-make-init) ;; ("\\.cpp\\'" 1) ;; ("\\.java\\'" 3) ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") @@ -85,98 +92,161 @@ ) "Files syntax checking is allowed for. This is an alist with elements of the form: - REGEXP [INIT [CLEANUP [NAME]]] + REGEXP INIT [CLEANUP [NAME]] REGEXP is a regular expression that matches a file name. -INIT is the init function to use, missing means disable `flymake-mode'. -CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. -NAME is the file name function to use, default `flymake-get-real-file-name'." +INIT is the init function to use. +CLEANUP is the cleanup function to use, default `flymake-proc-simple-cleanup'. +NAME is the file name function to use, default `flymake-proc-get-real-file-name'." :group 'flymake :type '(alist :key-type (regexp :tag "File regexp") :value-type (list :tag "Handler functions" - (choice :tag "Init function" - (const :tag "disable" nil) - function) + (function :tag "Init function") (choice :tag "Cleanup function" - (const :tag "flymake-simple-cleanup" nil) + (const :tag "flymake-proc-simple-cleanup" nil) function) (choice :tag "Name function" - (const :tag "flymake-get-real-file-name" nil) + (const :tag "flymake-proc-get-real-file-name" nil) function)))) -(defvar flymake-processes nil - "List of currently active flymake processes.") +(defvar-local flymake-proc--current-process nil + "Currently active Flymake process for a buffer, if any.") + +(defvar flymake-proc--report-fn nil + "If bound, function used to report back to Flymake's UI.") + +(defun flymake-proc-reformat-err-line-patterns-from-compile-el (original-list) + "Grab error line patterns from ORIGINAL-LIST in compile.el format. +Convert it to Flymake internal format." + (let* ((converted-list '())) + (dolist (item original-list) + (setq item (cdr item)) + (let ((regexp (nth 0 item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item))) + (if (consp file) (setq file (car file))) + (if (consp line) (setq line (car line))) + (if (consp col) (setq col (car col))) -(defvar-local flymake-output-residual nil) + (when (not (functionp line)) + (setq converted-list (cons (list regexp file line col) converted-list))))) + converted-list)) -(defun flymake-get-file-name-mode-and-masks (file-name) - "Return the corresponding entry from `flymake-allowed-file-name-masks'." +(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 + '( + ;; MS Visual C++ 6.0 + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; jikes + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; MS midl + ("midl[ ]*:[ ]*\\(command line error .*\\)" + nil nil nil 1) + ;; MS C# + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; perl + ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) + ;; PHP + ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) + ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) + ;; ant/javac. Note this also matches gcc warnings! + (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?:[ \t\n]*\\(.+\\)" + 2 4 5 6)) + ;; compilation-error-regexp-alist) + (flymake-proc-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) + "Patterns for matching error/warning lines. Each pattern has the form +\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). +Use `flymake-proc-reformat-err-line-patterns-from-compile-el' to add patterns +from compile.el") + +(define-obsolete-variable-alias 'flymake-warning-re 'flymake-proc-diagnostic-type-pred "26.1") +(defvar flymake-proc-diagnostic-type-pred + '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 that doesn't +index that alist, a type of `:warning' is assumed. + +Instead of a function, it can also be a string, a regular +expression. A match indicates `:warning' type, otherwise +`:error'") + +(defun flymake-proc-default-guess (text) + "Guess if TEXT means a warning, a note or an error." + (cond ((string-match "^[wW]arning" text) + :warning) + ((string-match "^[nN]ote" text) + :note) + (t + :error))) + +(defun flymake-proc--get-file-name-mode-and-masks (file-name) + "Return the corresponding entry from `flymake-proc-allowed-file-name-masks'." (unless (stringp file-name) (error "Invalid file-name")) - (let ((fnm flymake-allowed-file-name-masks) + (let ((fnm flymake-proc-allowed-file-name-masks) (mode-and-masks nil)) (while (and (not mode-and-masks) fnm) - (let ((item (pop fnm))) - (when (string-match (car item) file-name) - (setq mode-and-masks item)))) ; (cdr item) may be nil - (setq mode-and-masks (cdr mode-and-masks)) + (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-can-syntax-check-buffer () - "Determine whether we can syntax check current buffer. -Return nil if we cannot, non-nil if -we can." - (and buffer-file-name - (if (flymake-get-init-function buffer-file-name) t nil))) - -(defun flymake-get-init-function (file-name) +(defun flymake-proc--get-init-function (file-name) "Return init function to be used for the file." - (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) + (let* ((init-f (nth 0 (flymake-proc--get-file-name-mode-and-masks file-name)))) ;;(flymake-log 0 "calling %s" init-f) ;;(funcall init-f (current-buffer)) init-f)) -(defun flymake-get-cleanup-function (file-name) +(defun flymake-proc--get-cleanup-function (file-name) "Return cleanup function to be used for the file." - (or (nth 1 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-simple-cleanup)) + (or (nth 1 (flymake-proc--get-file-name-mode-and-masks file-name)) + 'flymake-proc-simple-cleanup)) -(defun flymake-get-real-file-name-function (file-name) - (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-get-real-file-name)) +(defun flymake-proc--get-real-file-name-function (file-name) + (or (nth 2 (flymake-proc--get-file-name-mode-and-masks file-name)) + 'flymake-proc-get-real-file-name)) -(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) +(defvar flymake-proc--find-buildfile-cache (make-hash-table :test #'equal)) -(defun flymake-get-buildfile-from-cache (dir-name) +(defun flymake-proc--get-buildfile-from-cache (dir-name) "Look up DIR-NAME in cache and return its associated value. If DIR-NAME is not found, return nil." - (gethash dir-name flymake-find-buildfile-cache)) + (gethash dir-name flymake-proc--find-buildfile-cache)) -(defun flymake-add-buildfile-to-cache (dir-name buildfile) +(defun flymake-proc--add-buildfile-to-cache (dir-name buildfile) "Associate DIR-NAME with BUILDFILE in the buildfile cache." - (puthash dir-name buildfile flymake-find-buildfile-cache)) + (puthash dir-name buildfile flymake-proc--find-buildfile-cache)) -(defun flymake-clear-buildfile-cache () +(defun flymake-proc--clear-buildfile-cache () "Clear the buildfile cache." - (clrhash flymake-find-buildfile-cache)) + (clrhash flymake-proc--find-buildfile-cache)) -(defun flymake-find-buildfile (buildfile-name source-dir-name) +(defun flymake-proc--find-buildfile (buildfile-name source-dir-name) "Find buildfile starting from current directory. Buildfile includes Makefile, build.xml etc. Return its file name if found, or nil if not found." - (or (flymake-get-buildfile-from-cache source-dir-name) + (or (flymake-proc--get-buildfile-from-cache source-dir-name) (let* ((file (locate-dominating-file source-dir-name buildfile-name))) (if file (progn (flymake-log 3 "found buildfile at %s" file) - (flymake-add-buildfile-to-cache source-dir-name file) + (flymake-proc--add-buildfile-to-cache source-dir-name file) file) (progn (flymake-log 3 "buildfile for %s not found" source-dir-name) nil))))) -(defun flymake-fix-file-name (name) +(defun flymake-proc--fix-file-name (name) "Replace all occurrences of `\\' with `/'." (when name (setq name (expand-file-name name)) @@ -184,18 +254,17 @@ Return its file name if found, or nil if not found." (setq name (directory-file-name name)) name)) -(defun flymake-same-files (file-name-one file-name-two) +(defun flymake-proc--same-files (file-name-one file-name-two) "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. Return t if so, nil if not." - (equal (flymake-fix-file-name file-name-one) - (flymake-fix-file-name file-name-two))) + (equal (flymake-proc--fix-file-name file-name-one) + (flymake-proc--fix-file-name file-name-two))) ;; This is bound dynamically to pass a parameter to a sort predicate below -(defvar flymake-included-file-name) +(defvar flymake-proc--included-file-name) -(defun flymake-find-possible-master-files (file-name master-file-dirs masks) +(defun flymake-proc--find-possible-master-files (file-name master-file-dirs masks) "Find (by name and location) all possible master files. - Name is specified by FILE-NAME and location is specified by MASTER-FILE-DIRS. Master files include .cpp and .c for .h. Files are searched for starting from the .h directory and max @@ -216,35 +285,35 @@ max-level parent dirs. File contents are not checked." (while (and (not done) dir-files) (when (not (file-directory-p (car dir-files))) (setq files (cons (car dir-files) files)) - (when (>= (length files) flymake-master-file-count-limit) - (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) + (when (>= (length files) flymake-proc-master-file-count-limit) + (flymake-log 3 "master file count limit (%d) reached" flymake-proc-master-file-count-limit) (setq done t))) (setq dir-files (cdr dir-files)))) (setq masks (cdr masks)))) (setq dirs (cdr dirs))) (when files - (let ((flymake-included-file-name (file-name-nondirectory file-name))) - (setq files (sort files 'flymake-master-file-compare)))) + (let ((flymake-proc--included-file-name (file-name-nondirectory file-name))) + (setq files (sort files 'flymake-proc--master-file-compare)))) (flymake-log 3 "found %d possible master file(s)" (length files)) files)) -(defun flymake-master-file-compare (file-one file-two) +(defun flymake-proc--master-file-compare (file-one file-two) "Compare two files specified by FILE-ONE and FILE-TWO. This function is used in sort to move most possible file names to the beginning of the list (File.h -> File.cpp moved to top)." - (and (equal (file-name-sans-extension flymake-included-file-name) + (and (equal (file-name-sans-extension flymake-proc--included-file-name) (file-name-base file-one)) (not (equal file-one file-two)))) -(defvar flymake-check-file-limit 8192 +(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.") -(defun flymake-check-patch-master-file-buffer - (master-file-temp-buffer - master-file-name patched-master-file-name - source-file-name patched-source-file-name - include-dirs regexp) +(defun flymake-proc--check-patch-master-file-buffer + (master-file-temp-buffer + master-file-name patched-master-file-name + source-file-name patched-source-file-name + include-dirs regexp) "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME instead of SOURCE-FILE-NAME. @@ -258,7 +327,7 @@ instead of reading master file from disk." (source-file-nonext (file-name-sans-extension source-file-nondir)) (found nil) (inc-name nil) - (search-limit flymake-check-file-limit)) + (search-limit flymake-proc-check-file-limit)) (setq regexp (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" ;; Hack for tex files, where \include often excludes .tex. @@ -294,18 +363,18 @@ instead of reading master file from disk." inc-name (- (length inc-name) (length source-file-nondir)) nil)) (flymake-log 3 "inc-name=%s" inc-name) - (when (flymake-check-include source-file-name inc-name - include-dirs) + (when (flymake-proc--check-include source-file-name inc-name + include-dirs) (setq found t) ;; replace-match is not used here as it fails in ;; XEmacs with 'last match not a buffer' error as ;; check-includes calls replace-in-string - (flymake-replace-region + (flymake-proc--replace-region match-beg match-end (file-name-nondirectory patched-source-file-name)))) (forward-line 1))) (when found - (flymake-save-buffer-in-file patched-master-file-name))) + (flymake-proc--save-buffer-in-file patched-master-file-name))) ;;+(flymake-log 3 "killing buffer %s" ;; (buffer-name master-file-temp-buffer)) (kill-buffer master-file-temp-buffer)) @@ -315,7 +384,7 @@ instead of reading master file from disk." found)) ;;; XXX: remove -(defun flymake-replace-region (beg end rep) +(defun flymake-proc--replace-region (beg end rep) "Replace text in BUFFER in region (BEG END) with REP." (save-excursion (goto-char end) @@ -323,14 +392,14 @@ instead of reading master file from disk." (insert rep) (delete-region beg end))) -(defun flymake-read-file-to-temp-buffer (file-name) +(defun flymake-proc--read-file-to-temp-buffer (file-name) "Insert contents of FILE-NAME into newly created temp buffer." (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) (with-current-buffer temp-buffer (insert-file-contents file-name)) temp-buffer)) -(defun flymake-copy-buffer-to-temp-buffer (buffer) +(defun flymake-proc--copy-buffer-to-temp-buffer (buffer) "Copy contents of BUFFER into newly created temp buffer." (with-current-buffer (get-buffer-create (generate-new-buffer-name @@ -338,13 +407,13 @@ instead of reading master file from disk." (insert-buffer-substring buffer) (current-buffer))) -(defun flymake-check-include (source-file-name inc-name include-dirs) +(defun flymake-proc--check-include (source-file-name inc-name include-dirs) "Check if SOURCE-FILE-NAME can be found in include path. Return t if it can be found via include path using INC-NAME." (if (file-name-absolute-p inc-name) - (flymake-same-files source-file-name inc-name) + (flymake-proc--same-files source-file-name inc-name) (while (and include-dirs - (not (flymake-same-files + (not (flymake-proc--same-files source-file-name (concat (file-name-directory source-file-name) "/" (car include-dirs) @@ -352,17 +421,17 @@ Return t if it can be found via include path using INC-NAME." (setq include-dirs (cdr include-dirs))) include-dirs)) -(defun flymake-find-buffer-for-file (file-name) +(defun flymake-proc--find-buffer-for-file (file-name) "Check if there exists a buffer visiting FILE-NAME. Return t if so, nil if not." (let ((buffer-name (get-file-buffer file-name))) (if buffer-name (get-buffer buffer-name)))) -(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) +(defun flymake-proc--create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) "Save SOURCE-FILE-NAME with a different name. Find master file, patch and save it." - (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) + (let* ((possible-master-files (flymake-proc--find-possible-master-files source-file-name flymake-proc-master-file-dirs masks)) (master-file-count (length possible-master-files)) (idx 0) (temp-buffer nil) @@ -373,11 +442,11 @@ Find master file, patch and save it." (while (and (not found) (< idx master-file-count)) (setq master-file-name (nth idx possible-master-files)) (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) - (if (flymake-find-buffer-for-file master-file-name) - (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) - (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name))) + (if (flymake-proc--find-buffer-for-file master-file-name) + (setq temp-buffer (flymake-proc--copy-buffer-to-temp-buffer (flymake-proc--find-buffer-for-file master-file-name))) + (setq temp-buffer (flymake-proc--read-file-to-temp-buffer master-file-name))) (setq found - (flymake-check-patch-master-file-buffer + (flymake-proc--check-patch-master-file-buffer temp-buffer master-file-name patched-master-file-name @@ -393,260 +462,185 @@ Find master file, patch and save it." (file-name-nondirectory source-file-name)) nil)))) -(defun flymake-save-buffer-in-file (file-name) +(defun flymake-proc--save-buffer-in-file (file-name) "Save the entire buffer contents into file FILE-NAME. Create parent directories as needed." (make-directory (file-name-directory file-name) 1) (write-region nil nil file-name nil 566) (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) -(defun flymake-process-filter (process output) - "Parse OUTPUT and highlight error lines. -It's flymake process filter." - (let ((source-buffer (process-buffer process))) - - (flymake-log 3 "received %d byte(s) of output from process %d" - (length output) (process-id process)) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (flymake-parse-output-and-residual output))))) - -(defun flymake-process-sentinel (process _event) +(defun flymake-proc--diagnostics-for-pattern (proc pattern) + (cl-flet ((guess-type + (pred message) + (cond ((null message) + :error) + ((stringp pred) + (if (string-match pred message) + :warning + :error)) + ((functionp pred) + (let ((probe (funcall pred message))) + (cond ((assoc-default probe + flymake-diagnostic-types-alist) + probe) + (probe + :warning) + (t + :error))))))) + (condition-case-unless-debug err + (cl-loop + with (regexp file-idx line-idx col-idx message-idx) = pattern + while (and + (search-forward-regexp regexp nil t) + ;; If the preceding search spanned more than one line, + ;; move to the start of the line we ended up in. This + ;; preserves the usefulness of the patterns in + ;; `flymake-proc-err-line-patterns', which were + ;; written primarily for flymake's original + ;; line-by-line parsing and thus never spanned + ;; multiple lines. + (if (/= (line-number-at-pos (match-beginning 0)) + (line-number-at-pos)) + (goto-char (line-beginning-position)) + t)) + for fname = (and file-idx (match-string file-idx)) + for message = (and message-idx (match-string message-idx)) + for line-string = (and line-idx (match-string line-idx)) + for line-number = (or (and line-string + (string-to-number line-string)) + 1) + for col-string = (and col-idx (match-string col-idx)) + for col-number = (and col-string + (string-to-number col-string)) + for full-file = (with-current-buffer (process-buffer proc) + (and fname + (funcall + (flymake-proc--get-real-file-name-function + fname) + fname))) + for buffer = (and full-file + (find-buffer-visiting full-file)) + if (and (eq buffer (process-buffer proc)) message) + collect (pcase-let ((`(,beg . ,end) + (flymake-diag-region buffer line-number col-number))) + (flymake-make-diagnostic + buffer beg end + (with-current-buffer buffer + (guess-type flymake-proc-diagnostic-type-pred message)) + message)) + else + do (flymake-log 2 "Reference to file %s is out of scope" fname)) + (error + (flymake-log 1 "Error parsing process output for pattern %s: %s" + pattern err) + nil)))) + +(defun flymake-proc--process-filter (proc string) + "Parse STRING and collect diagnostics info." + (flymake-log 3 "received %d byte(s) of output from process %d" + (length string) (process-id proc)) + (let ((output-buffer (process-get proc 'flymake-proc--output-buffer))) + (when (and (buffer-live-p (process-buffer proc)) + output-buffer) + (with-current-buffer output-buffer + (let ((moving (= (point) (process-mark proc))) + (inhibit-read-only t) + (unprocessed-mark + (or (process-get proc 'flymake-proc--unprocessed-mark) + (set-marker (make-marker) (point-min))))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc))) + + ;; check for new diagnostics + ;; + (save-excursion + (goto-char unprocessed-mark) + (dolist (pattern flymake-proc-err-line-patterns) + (let ((new (flymake-proc--diagnostics-for-pattern proc pattern))) + (process-put + proc + 'flymake-proc--collected-diagnostics + (append new + (process-get proc + 'flymake-proc--collected-diagnostics))))) + (process-put proc 'flymake-proc--unprocessed-mark + (point-marker)))))))) + +(defun flymake-proc--process-sentinel (proc _event) "Sentinel for syntax check buffers." - (when (memq (process-status process) '(signal exit)) - (let* ((exit-status (process-exit-status process)) - (command (process-command process)) - (source-buffer (process-buffer process)) - (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) - - (flymake-log 2 "process %d exited with code %d" - (process-id process) exit-status) - (condition-case err - (progn - (flymake-log 3 "cleaning up using %s" cleanup-f) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (funcall cleanup-f))) - - (delete-process process) - (setq flymake-processes (delq process flymake-processes)) - - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - - (flymake-parse-residual) - (flymake-post-syntax-check exit-status command) - (setq flymake-is-running nil)))) - (error - (let ((err-str (format "Error in process sentinel for buffer %s: %s" - source-buffer (error-message-string err)))) - (flymake-log 0 err-str) - (with-current-buffer source-buffer - (setq flymake-is-running nil)))))))) - -(defun flymake-post-syntax-check (exit-status command) - (save-restriction - (widen) - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (count-lines (point-min) (point-max)))) - (flymake-delete-own-overlays) - (flymake-highlight-err-lines flymake-err-info) - (let (err-count warn-count) - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name) err-count warn-count - (- (float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil) - - (if (and (equal 0 err-count) (equal 0 warn-count)) - (if (equal 0 exit-status) - (flymake-report-status "" "") ; PASSED - (if (not flymake-check-was-interrupted) - (flymake-report-fatal-status "CFGERR" - (format "Configuration error has occurred while running %s" command)) - (flymake-report-status nil ""))) ; "STOPPED" - (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) - -(defun flymake-parse-output-and-residual (output) - "Split OUTPUT into lines, merge in residual if necessary." - (let* ((buffer-residual flymake-output-residual) - (total-output (if buffer-residual (concat buffer-residual output) output)) - (lines-and-residual (flymake-split-output total-output)) - (lines (nth 0 lines-and-residual)) - (new-residual (nth 1 lines-and-residual))) - (setq flymake-output-residual new-residual) - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info lines)))) - -(defun flymake-parse-residual () - "Parse residual if it's non empty." - (when flymake-output-residual - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - (list flymake-output-residual))) - (setq flymake-output-residual nil))) - -(defun flymake-fix-line-numbers (err-info-list min-line max-line) - "Replace line numbers with fixed value. -If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. -If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. -The reason for this fix is because some compilers might report -line number outside the file being compiled." - (let* ((count (length err-info-list)) - (err-info nil) - (line 0)) - (while (> count 0) - (setq err-info (nth (1- count) err-info-list)) - (setq line (flymake-er-get-line err-info)) - (when (or (< line min-line) (> line max-line)) - (setq line (if (< line min-line) min-line max-line)) - (setq err-info-list (flymake-set-at err-info-list (1- count) - (flymake-er-make-er line - (flymake-er-get-line-err-info-list err-info))))) - (setq count (1- count)))) - err-info-list) - -(defun flymake-parse-err-lines (err-info-list lines) - "Parse err LINES, store info in ERR-INFO-LIST." - (let* ((count (length lines)) - (idx 0) - (line-err-info nil) - (real-file-name nil) - (source-file-name buffer-file-name) - (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) - - (while (< idx count) - (setq line-err-info (flymake-parse-line (nth idx lines))) - (when line-err-info - (setq real-file-name (funcall get-real-file-name-f - (flymake-ler-file line-err-info))) - (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) - - (when (flymake-same-files real-file-name source-file-name) - (setq line-err-info (flymake-ler-set-file line-err-info nil)) - (setq err-info-list (flymake-add-err-info err-info-list line-err-info)))) - (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) - (setq idx (1+ idx))) - err-info-list)) - -(defun flymake-split-output (output) - "Split OUTPUT into lines. -Return last one as residual if it does not end with newline char. -Returns ((LINES) RESIDUAL)." - (when (and output (> (length output) 0)) - (let* ((lines (split-string output "[\n\r]+" t)) - (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) - (residual nil)) - (when (not complete) - (setq residual (car (last lines))) - (setq lines (butlast lines))) - (list lines residual)))) - -(defun flymake-reformat-err-line-patterns-from-compile-el (original-list) - "Grab error line patterns from ORIGINAL-LIST in compile.el format. -Convert it to flymake internal format." - (let* ((converted-list '())) - (dolist (item original-list) - (setq item (cdr item)) - (let ((regexp (nth 0 item)) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item))) - (if (consp file) (setq file (car file))) - (if (consp line) (setq line (car line))) - (if (consp col) (setq col (car col))) - - (when (not (functionp line)) - (setq converted-list (cons (list regexp file line col) converted-list))))) - converted-list)) + (let (debug + (pid (process-id proc)) + (source-buffer (process-buffer proc))) + (unwind-protect + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (cond ((process-get proc 'flymake-proc--obsolete) + (flymake-log 3 "proc %s considered obsolete" + pid)) + ((process-get proc 'flymake-proc--interrupted) + (flymake-log 3 "proc %s interrupted by user" + pid)) + ((not (process-live-p proc)) + (let* ((exit-status (process-exit-status proc)) + (command (process-command proc)) + (diagnostics (process-get + proc + 'flymake-proc--collected-diagnostics))) + (flymake-log 2 "process %d exited with code %d" + pid exit-status) + (cond + ((equal 0 exit-status) + (funcall flymake-proc--report-fn diagnostics + :explanation (format "a gift from %s" (process-id proc)) + )) + (diagnostics + ;; non-zero exit but some diagnostics is quite + ;; normal... + (funcall flymake-proc--report-fn diagnostics + :explanation (format "a gift from %s" (process-id proc)))) + ((null diagnostics) + ;; ...but no diagnostics is strange, so panic. + (setq debug debug-on-error) + (flymake-proc--panic + :configuration-error + (format "Command %s errored, but no diagnostics" + command))))))))) + (let ((output-buffer (process-get proc 'flymake-proc--output-buffer))) + (cond (debug + (flymake-log 3 "Output buffer %s kept alive for debugging" + output-buffer)) + (t + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (let ((cleanup-f (flymake-proc--get-cleanup-function + (buffer-file-name)))) + (flymake-log 3 "cleaning up using %s" cleanup-f) + (funcall cleanup-f)))) + (kill-buffer output-buffer))))))) + +(defun flymake-proc--panic (problem explanation) + "Tell Flymake UI about a fatal PROBLEM with this backend. +May only be called in a dynamic environment where +`flymake-proc--report-fn' is bound." + (flymake-log 0 "%s: %s" problem explanation) + (if (and (boundp 'flymake-proc--report-fn) + flymake-proc--report-fn) + (funcall flymake-proc--report-fn :panic + :explanation (format "%s: %s" problem explanation)) + (flymake-error "Trouble telling flymake-ui about problem %s(%s)" + problem explanation))) (require 'compile) -(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text - (append - '( - ;; MS Visual C++ 6.0 - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; jikes - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; MS midl - ("midl[ ]*:[ ]*\\(command line error .*\\)" - nil nil nil 1) - ;; MS C# - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; perl - ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) - ;; PHP - ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) - ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) - ;; ant/javac. Note this also matches gcc warnings! - (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)" - 2 4 nil 5)) - ;; compilation-error-regexp-alist) - (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) - "Patterns for matching error/warning lines. Each pattern has the form -\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). -Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns -from compile.el") - -(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") -(defvar flymake-warning-predicate "^[wW]arning" - "Predicate matching against error text to detect a warning. -Takes a single argument, the error's text and should return non-nil -if it's a warning. -Instead of a function, it can also be a regular expression.") - -(defun flymake-parse-line (line) - "Parse LINE to see if it is an error or warning. -Return its components if so, nil otherwise." - (let ((raw-file-name nil) - (line-no 0) - (err-type "e") - (err-text nil) - (patterns flymake-err-line-patterns) - (matched nil)) - (while (and patterns (not matched)) - (when (string-match (car (car patterns)) line) - (let* ((file-idx (nth 1 (car patterns))) - (line-idx (nth 2 (car patterns)))) - - (setq raw-file-name (if file-idx (match-string file-idx line) nil)) - (setq line-no (if line-idx (string-to-number - (match-string line-idx line)) 0)) - (setq err-text (if (> (length (car patterns)) 4) - (match-string (nth 4 (car patterns)) line) - (flymake-patch-err-text - (substring line (match-end 0))))) - (if (null err-text) - (setq err-text "<no error text>") - (when (cond ((stringp flymake-warning-predicate) - (string-match flymake-warning-predicate err-text)) - ((functionp flymake-warning-predicate) - (funcall flymake-warning-predicate err-text))) - (setq err-type "w"))) - (flymake-log - 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" - file-idx line-idx raw-file-name line-no err-text) - (setq matched t))) - (setq patterns (cdr patterns))) - (if matched - (flymake-ler-make-ler raw-file-name line-no err-type err-text) - ()))) - -(defun flymake-get-project-include-dirs-imp (basedir) +(defun flymake-proc-get-project-include-dirs-imp (basedir) "Include dirs for the project current file belongs to." - (if (flymake-get-project-include-dirs-from-cache basedir) + (if (flymake-proc--get-project-include-dirs-from-cache basedir) (progn - (flymake-get-project-include-dirs-from-cache basedir)) + (flymake-proc--get-project-include-dirs-from-cache basedir)) ;;else (let* ((command-line (concat "make -C " (shell-quote-argument basedir) @@ -665,148 +659,170 @@ Return its components if so, nil otherwise." (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) (setq inc-count (1- inc-count))))) - (flymake-add-project-include-dirs-to-cache basedir inc-dirs) + (flymake-proc--add-project-include-dirs-to-cache basedir inc-dirs) inc-dirs))) -(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp +(defvar flymake-proc-get-project-include-dirs-function #'flymake-proc-get-project-include-dirs-imp "Function used to get project include dirs, one parameter: basedir name.") -(defun flymake-get-project-include-dirs (basedir) - (funcall flymake-get-project-include-dirs-function basedir)) +(defun flymake-proc--get-project-include-dirs (basedir) + (funcall flymake-proc-get-project-include-dirs-function basedir)) -(defun flymake-get-system-include-dirs () +(defun flymake-proc--get-system-include-dirs () "System include dirs - from the `INCLUDE' env setting." (let* ((includes (getenv "INCLUDE"))) (if includes (split-string includes path-separator t) nil))) -(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) +(defvar flymake-proc--project-include-dirs-cache (make-hash-table :test #'equal)) -(defun flymake-get-project-include-dirs-from-cache (base-dir) - (gethash base-dir flymake-project-include-dirs-cache)) +(defun flymake-proc--get-project-include-dirs-from-cache (base-dir) + (gethash base-dir flymake-proc--project-include-dirs-cache)) -(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs) - (puthash base-dir include-dirs flymake-project-include-dirs-cache)) +(defun flymake-proc--add-project-include-dirs-to-cache (base-dir include-dirs) + (puthash base-dir include-dirs flymake-proc--project-include-dirs-cache)) -(defun flymake-clear-project-include-dirs-cache () - (clrhash flymake-project-include-dirs-cache)) +(defun flymake-proc--clear-project-include-dirs-cache () + (clrhash flymake-proc--project-include-dirs-cache)) -(defun flymake-get-include-dirs (base-dir) +(defun flymake-proc-get-include-dirs (base-dir) "Get dirs to use when resolving local file names." - (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) + (let* ((include-dirs (append '(".") (flymake-proc--get-project-include-dirs base-dir) (flymake-proc--get-system-include-dirs)))) include-dirs)) -;; (defun flymake-restore-formatting () +;; (defun flymake-proc--restore-formatting () ;; "Remove any formatting made by flymake." ;; ) -;; (defun flymake-get-program-dir (buffer) +;; (defun flymake-proc--get-program-dir (buffer) ;; "Get dir to start program in." ;; (unless (bufferp buffer) ;; (error "Invalid buffer")) ;; (with-current-buffer buffer ;; default-directory)) -(defun flymake-safe-delete-file (file-name) +(defun flymake-proc--safe-delete-file (file-name) (when (and file-name (file-exists-p file-name)) (delete-file file-name) - (flymake-log 1 "deleted file %s" file-name))) + (flymake-log 2 "deleted file %s" file-name))) -(defun flymake-safe-delete-directory (dir-name) - (condition-case nil +(defun flymake-proc--safe-delete-directory (dir-name) + (condition-case-unless-debug nil (progn (delete-directory dir-name) - (flymake-log 1 "deleted dir %s" dir-name)) + (flymake-log 2 "deleted dir %s" dir-name)) (error (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) -(defun flymake-proc-start-syntax-check () - "Start syntax checking for current buffer." - (interactive) - (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (not flymake-is-running) - (when (or (not flymake-compilation-prevents-syntax-check) - (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") - (flymake-clear-buildfile-cache) - (flymake-clear-project-include-dirs-cache) - - (setq flymake-check-was-interrupted nil) - - (let* ((source-file-name buffer-file-name) - (init-f (flymake-get-init-function source-file-name)) - (cleanup-f (flymake-get-cleanup-function source-file-name)) - (cmd-and-args (funcall init-f)) - (cmd (nth 0 cmd-and-args)) - (args (nth 1 cmd-and-args)) - (dir (nth 2 cmd-and-args))) - (if (not cmd-and-args) - (progn - (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) - (funcall cleanup-f)) - (progn - (setq flymake-last-change-time nil) - (flymake-start-syntax-check-process cmd args dir))))))) - -(defun flymake-start-syntax-check-process (cmd args dir) - "Start syntax check process." - (condition-case err - (let* ((process - (let ((default-directory (or dir default-directory))) - (when dir - (flymake-log 3 "starting process on dir %s" dir)) - (apply 'start-file-process - "flymake-proc" (current-buffer) cmd args)))) - (set-process-sentinel process 'flymake-process-sentinel) - (set-process-filter process 'flymake-process-filter) - (set-process-query-on-exit-flag process nil) - (push process flymake-processes) - - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (float-time)) - - (flymake-report-status nil "*") - (flymake-log 2 "started process %d, command=%s, dir=%s" - (process-id process) (process-command process) - default-directory) - process) - (error - (let* ((err-str - (format-message - "Failed to launch syntax check process `%s' with args %s: %s" - cmd args (error-message-string err))) - (source-file-name buffer-file-name) - (cleanup-f (flymake-get-cleanup-function source-file-name))) - (flymake-log 0 err-str) - (funcall cleanup-f) - (flymake-report-fatal-status "PROCERR" err-str))))) - -(defun flymake-kill-process (proc) - "Kill process PROC." - (kill-process proc) - (let* ((buf (process-buffer proc))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq flymake-check-was-interrupted t)))) - (flymake-log 1 "killed process %d" (process-id proc))) - -(defun flymake-stop-all-syntax-checks () - "Kill all syntax check processes." - (interactive) - (while flymake-processes - (flymake-kill-process (pop flymake-processes)))) -(defun flymake-compilation-is-running () +(defun flymake-proc-legacy-flymake (report-fn &rest args) + "Flymake backend based on the original Flymake implementation. +This function is suitable for inclusion in +`flymake-diagnostic-functions'. For backward compatibility, it +can also be executed interactively independently of +`flymake-mode'." + ;; Interactively, behave as if flymake had invoked us through its + ;; `flymake-diagnostic-functions' with a suitable ID so flymake can + ;; clean up consistently + (interactive (list + (lambda (diags &rest args) + (apply (flymake-make-report-fn 'flymake-proc-legacy-flymake) + diags + (append args '(:force t)))) + :interactive t)) + (let ((interactive (plist-get args :interactive)) + (proc flymake-proc--current-process) + (flymake-proc--report-fn report-fn)) + (when (processp proc) + (process-put proc 'flymake-proc--obsolete t) + (flymake-log 3 "marking %s obsolete" (process-id proc)) + (when (process-live-p proc) + (when interactive + (user-error + "There's already a Flymake process running in this buffer") + (kill-process proc)))) + (when + ;; This particular situation make us not want to error right + ;; away (and disable ourselves), in case the situation changes + ;; in the near future. + (and (or (not flymake-proc-compilation-prevents-syntax-check) + (not (flymake-proc--compilation-is-running)))) + (let ((init-f + (and + buffer-file-name + ;; Since we write temp files in current dir, there's no point + ;; trying if the directory is read-only (bug#8954). + (file-writable-p (file-name-directory buffer-file-name)) + (flymake-proc--get-init-function buffer-file-name)))) + (unless init-f (error "Can find a suitable init function")) + (flymake-proc--clear-buildfile-cache) + (flymake-proc--clear-project-include-dirs-cache) + + (let* ((cleanup-f (flymake-proc--get-cleanup-function buffer-file-name)) + (cmd-and-args (funcall init-f)) + (cmd (nth 0 cmd-and-args)) + (args (nth 1 cmd-and-args)) + (dir (nth 2 cmd-and-args)) + (success nil)) + (unwind-protect + (cond + ((not cmd-and-args) + (flymake-log 0 "init function %s for %s failed, cleaning up" + init-f buffer-file-name)) + (t + (setq proc + (let ((default-directory (or dir default-directory))) + (when dir + (flymake-log 3 "starting process on dir %s" dir)) + (make-process + :name "flymake-proc" + :buffer (current-buffer) + :command (cons cmd args) + :noquery t + :filter + (lambda (proc string) + (let ((flymake-proc--report-fn report-fn)) + (flymake-proc--process-filter proc string))) + :sentinel + (lambda (proc event) + (let ((flymake-proc--report-fn report-fn)) + (flymake-proc--process-sentinel proc event)))))) + (process-put proc 'flymake-proc--output-buffer + (generate-new-buffer + (format " *flymake output for %s*" (current-buffer)))) + (setq flymake-proc--current-process proc) + (flymake-log 2 "started process %d, command=%s, dir=%s" + (process-id proc) (process-command proc) + default-directory) + (setq success t))) + (unless success + (funcall cleanup-f)))))))) + +(define-obsolete-function-alias 'flymake-start-syntax-check + 'flymake-proc-legacy-flymake "26.1") + +(defun flymake-proc-stop-all-syntax-checks (&optional reason) + "Kill all syntax check processes." + (interactive (list "Interrupted by user")) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (let (p flymake-proc--current-process) + (when (process-live-p p) + (kill-process p) + (process-put p 'flymake-proc--interrupted reason) + (flymake-log 2 "killed process %d" (process-id p))))))) + +(defun flymake-proc--compilation-is-running () (and (boundp 'compilation-in-progress) compilation-in-progress)) -(defun flymake-compile () - "Kill all flymake syntax checks, start compilation." +(defun flymake-proc-compile () + "Kill all Flymake syntax checks, start compilation." (interactive) - (flymake-stop-all-syntax-checks) + (flymake-proc-stop-all-syntax-checks "Stopping for proper compilation") (call-interactively 'compile)) ;;;; general init-cleanup and helper routines -(defun flymake-create-temp-inplace (file-name prefix) +(defun flymake-proc-create-temp-inplace (file-name prefix) (unless (stringp file-name) (error "Invalid file-name")) (or prefix @@ -819,7 +835,7 @@ Return its components if so, nil otherwise." (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) temp-name)) -(defun flymake-create-temp-with-folder-structure (file-name _prefix) +(defun flymake-proc-create-temp-with-folder-structure (file-name _prefix) (unless (stringp file-name) (error "Invalid file-name")) @@ -833,48 +849,47 @@ Return its components if so, nil otherwise." (file-truename (expand-file-name (file-name-nondirectory file-name) temp-dir)))) -(defun flymake-delete-temp-directory (dir-name) - "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." +(defun flymake-proc--delete-temp-directory (dir-name) + "Attempt to delete temp dir created by `flymake-proc-create-temp-with-folder-structure', do not fail on error." (let* ((temp-dir temporary-file-directory) (suffix (substring dir-name (1+ (length temp-dir))))) (while (> (length suffix) 0) (setq suffix (directory-file-name suffix)) ;;+(flymake-log 0 "suffix=%s" suffix) - (flymake-safe-delete-directory + (flymake-proc--safe-delete-directory (file-truename (expand-file-name suffix temp-dir))) (setq suffix (file-name-directory suffix))))) -(defvar-local flymake-temp-source-file-name nil) -(defvar-local flymake-master-file-name nil) -(defvar-local flymake-temp-master-file-name nil) -(defvar-local flymake-base-dir nil) +(defvar-local flymake-proc--temp-source-file-name nil) +(defvar-local flymake-proc--master-file-name nil) +(defvar-local flymake-proc--temp-master-file-name nil) +(defvar-local flymake-proc--base-dir nil) -(defun flymake-init-create-temp-buffer-copy (create-temp-f) +(defun flymake-proc-init-create-temp-buffer-copy (create-temp-f) "Make a temporary copy of the current buffer, save its name in buffer data and return the name." (let* ((source-file-name buffer-file-name) (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) - (flymake-save-buffer-in-file temp-source-file-name) - (setq flymake-temp-source-file-name temp-source-file-name) + (flymake-proc--save-buffer-in-file temp-source-file-name) + (setq flymake-proc--temp-source-file-name temp-source-file-name) temp-source-file-name)) -(defun flymake-simple-cleanup () - "Do cleanup after `flymake-init-create-temp-buffer-copy'. +(defun flymake-proc-simple-cleanup () + "Do cleanup after `flymake-proc-init-create-temp-buffer-copy'. Delete temp file." - (flymake-safe-delete-file flymake-temp-source-file-name) - (setq flymake-last-change-time nil)) + (flymake-proc--safe-delete-file flymake-proc--temp-source-file-name)) -(defun flymake-get-real-file-name (file-name-from-err-msg) +(defun flymake-proc-get-real-file-name (file-name-from-err-msg) "Translate file name from error message to \"real\" file name. Return full-name. Names are real, not patched." (let* ((real-name nil) (source-file-name buffer-file-name) - (master-file-name flymake-master-file-name) - (temp-source-file-name flymake-temp-source-file-name) - (temp-master-file-name flymake-temp-master-file-name) + (master-file-name flymake-proc--master-file-name) + (temp-source-file-name flymake-proc--temp-source-file-name) + (temp-master-file-name flymake-proc--temp-master-file-name) (base-dirs - (list flymake-base-dir + (list flymake-proc--base-dir (file-name-directory source-file-name) (if master-file-name (file-name-directory master-file-name)))) (files (list (list source-file-name source-file-name) @@ -885,17 +900,17 @@ Return full-name. Names are real, not patched." (when (equal 0 (length file-name-from-err-msg)) (setq file-name-from-err-msg source-file-name)) - (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) + (setq real-name (flymake-proc--get-full-patched-file-name file-name-from-err-msg base-dirs files)) ;; if real-name is nil, than file name from err msg is none of the files we've patched (if (not real-name) - (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) + (setq real-name (flymake-proc--get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) (if (not real-name) (setq real-name file-name-from-err-msg)) - (setq real-name (flymake-fix-file-name real-name)) + (setq real-name (flymake-proc--fix-file-name real-name)) (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) real-name)) -(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files) +(defun flymake-proc--get-full-patched-file-name (file-name-from-err-msg base-dirs files) (let* ((base-dirs-count (length base-dirs)) (file-count (length files)) (real-name nil)) @@ -907,7 +922,7 @@ Return full-name. Names are real, not patched." (this-file (nth 0 (nth (1- file-count) files))) (this-real-name (nth 1 (nth (1- file-count) files)))) ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) - (when (and this-dir this-file (flymake-same-files + (when (and this-dir this-file (flymake-proc--same-files (expand-file-name file-name-from-err-msg this-dir) this-file)) (setq real-name this-real-name))) @@ -915,7 +930,7 @@ Return full-name. Names are real, not patched." (setq base-dirs-count (1- base-dirs-count))) real-name)) -(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) +(defun flymake-proc--get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) (let* ((real-name nil)) (if (file-name-absolute-p file-name-from-err-msg) (setq real-name file-name-from-err-msg) @@ -928,41 +943,42 @@ Return full-name. Names are real, not patched." (setq base-dirs-count (1- base-dirs-count)))))) real-name)) -(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name) +(defun flymake-proc--init-find-buildfile-dir (source-file-name buildfile-name) "Find buildfile, store its dir in buffer data and return its dir, if found." (let* ((buildfile-dir - (flymake-find-buildfile buildfile-name - (file-name-directory source-file-name)))) + (flymake-proc--find-buildfile buildfile-name + (file-name-directory source-file-name)))) (if buildfile-dir - (setq flymake-base-dir buildfile-dir) - (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) - (flymake-report-fatal-status + (setq flymake-proc--base-dir buildfile-dir) + (flymake-proc--panic "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name))))) -(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) +(defun flymake-proc--init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) "Find master file (or buffer), create its copy along with a copy of the source file." (let* ((source-file-name buffer-file-name) - (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) - (master-and-temp-master (flymake-create-master-file + (temp-source-file-name (flymake-proc-init-create-temp-buffer-copy create-temp-f)) + (master-and-temp-master (flymake-proc--create-master-file source-file-name temp-source-file-name get-incl-dirs-f create-temp-f master-file-masks include-regexp))) (if (not master-and-temp-master) (progn - (flymake-log 1 "cannot find master file for %s" source-file-name) - (flymake-report-status "!" "") ; NOMASTER + (flymake-proc--panic + "NOMASTER" + (format-message "cannot find master file for %s" + source-file-name)) nil) - (setq flymake-master-file-name (nth 0 master-and-temp-master)) - (setq flymake-temp-master-file-name (nth 1 master-and-temp-master))))) + (setq flymake-proc--master-file-name (nth 0 master-and-temp-master)) + (setq flymake-proc--temp-master-file-name (nth 1 master-and-temp-master))))) -(defun flymake-master-cleanup () - (flymake-simple-cleanup) - (flymake-safe-delete-file flymake-temp-master-file-name)) +(defun flymake-proc-master-cleanup () + (flymake-proc-simple-cleanup) + (flymake-proc--safe-delete-file flymake-proc--temp-master-file-name)) ;;;; make-specific init-cleanup routines -(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) +(defun flymake-proc--get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) "Create a command line for syntax check using GET-CMD-LINE-F." (funcall get-cmd-line-f (if use-relative-source @@ -973,7 +989,7 @@ Return full-name. Names are real, not patched." (file-name-directory source-file-name)) base-dir))) -(defun flymake-get-make-cmdline (source base-dir) +(defun flymake-proc-get-make-cmdline (source base-dir) (list "make" (list "-s" "-C" @@ -982,119 +998,196 @@ Return full-name. Names are real, not patched." "SYNTAX_CHECK_MODE=1" "check-syntax"))) -(defun flymake-get-ant-cmdline (source base-dir) +(defun flymake-proc-get-ant-cmdline (source base-dir) (list "ant" (list "-buildfile" (concat base-dir "/" "build.xml") (concat "-DCHK_SOURCES=" source) "check-syntax"))) -(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) +(defun flymake-proc-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) "Create syntax check command line for a directly checked source file. Use CREATE-TEMP-F for creating temp copy." (let* ((args nil) (source-file-name buffer-file-name) - (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name))) + (buildfile-dir (flymake-proc--init-find-buildfile-dir source-file-name build-file-name))) (if buildfile-dir - (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))) - (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir - use-relative-base-dir use-relative-source - get-cmdline-f)))) + (let* ((temp-source-file-name (flymake-proc-init-create-temp-buffer-copy create-temp-f))) + (setq args (flymake-proc--get-syntax-check-program-args temp-source-file-name buildfile-dir + use-relative-base-dir use-relative-source + get-cmdline-f)))) args)) -(defun flymake-simple-make-init () - (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) +(defun flymake-proc-simple-make-init () + (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-inplace t t "Makefile" 'flymake-proc-get-make-cmdline)) -(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) +(defun flymake-proc-master-make-init (get-incl-dirs-f master-file-masks include-regexp) "Create make command line for a source file checked via master file compilation." (let* ((make-args nil) - (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - get-incl-dirs-f 'flymake-create-temp-inplace + (temp-master-file-name (flymake-proc--init-create-temp-source-and-master-buffer-copy + get-incl-dirs-f 'flymake-proc-create-temp-inplace master-file-masks include-regexp))) (when temp-master-file-name - (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) + (let* ((buildfile-dir (flymake-proc--init-find-buildfile-dir temp-master-file-name "Makefile"))) (if buildfile-dir - (setq make-args (flymake-get-syntax-check-program-args - temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline))))) + (setq make-args (flymake-proc--get-syntax-check-program-args + temp-master-file-name buildfile-dir nil nil 'flymake-proc-get-make-cmdline))))) make-args)) -(defun flymake-find-make-buildfile (source-dir) - (flymake-find-buildfile "Makefile" source-dir)) +(defun flymake-proc--find-make-buildfile (source-dir) + (flymake-proc--find-buildfile "Makefile" source-dir)) ;;;; .h/make specific -(defun flymake-master-make-header-init () - (flymake-master-make-init - 'flymake-get-include-dirs +(defun flymake-proc-master-make-header-init () + (flymake-proc-master-make-init + 'flymake-proc-get-include-dirs '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) +(defun flymake-proc-real-file-name-considering-includes (scraped) + (flymake-proc-get-real-file-name + (let ((case-fold-search t)) + (replace-regexp-in-string "^in file included from[ \t*]" + "" + scraped)))) + ;;;; .java/make specific -(defun flymake-simple-make-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)) +(defun flymake-proc-simple-make-java-init () + (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-with-folder-structure nil nil "Makefile" 'flymake-proc-get-make-cmdline)) -(defun flymake-simple-ant-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline)) +(defun flymake-proc-simple-ant-java-init () + (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-with-folder-structure nil nil "build.xml" 'flymake-proc-get-ant-cmdline)) -(defun flymake-simple-java-cleanup () - "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs." - (flymake-safe-delete-file flymake-temp-source-file-name) - (when flymake-temp-source-file-name - (flymake-delete-temp-directory - (file-name-directory flymake-temp-source-file-name)))) +(defun flymake-proc-simple-java-cleanup () + "Cleanup after `flymake-proc-simple-make-java-init' -- delete temp file and dirs." + (flymake-proc--safe-delete-file flymake-proc--temp-source-file-name) + (when flymake-proc--temp-source-file-name + (flymake-proc--delete-temp-directory + (file-name-directory flymake-proc--temp-source-file-name)))) ;;;; perl-specific init-cleanup routines -(defun flymake-perl-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) +(defun flymake-proc-perl-init () + (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy + 'flymake-proc-create-temp-inplace)) (local-file (file-relative-name temp-file (file-name-directory buffer-file-name)))) (list "perl" (list "-wc " local-file)))) ;;;; php-specific init-cleanup routines -(defun flymake-php-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) +(defun flymake-proc-php-init () + (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy + 'flymake-proc-create-temp-inplace)) (local-file (file-relative-name temp-file (file-name-directory buffer-file-name)))) (list "php" (list "-f" local-file "-l")))) ;;;; tex-specific init-cleanup routines -(defun flymake-get-tex-args (file-name) +(defun flymake-proc--get-tex-args (file-name) ;;(list "latex" (list "-c-style-errors" file-name)) (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) -(defun flymake-simple-tex-init () - (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) +(defun flymake-proc-simple-tex-init () + (flymake-proc--get-tex-args (flymake-proc-init-create-temp-buffer-copy 'flymake-proc-create-temp-inplace))) ;; Perhaps there should be a buffer-local variable flymake-master-file ;; that people can set to override this stuff. Could inherit from ;; the similar AUCTeX variable. -(defun flymake-master-tex-init () - (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace +(defun flymake-proc-master-tex-init () + (let* ((temp-master-file-name (flymake-proc--init-create-temp-source-and-master-buffer-copy + 'flymake-proc-get-include-dirs-dot 'flymake-proc-create-temp-inplace '("\\.tex\\'") "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) (when temp-master-file-name - (flymake-get-tex-args temp-master-file-name)))) + (flymake-proc--get-tex-args temp-master-file-name)))) -(defun flymake-get-include-dirs-dot (_base-dir) +(defun flymake-proc--get-include-dirs-dot (_base-dir) '(".")) ;;;; xml-specific init-cleanup routines -(defun flymake-xml-init () - (list flymake-xml-program - (list "val" (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)))) +(defun flymake-proc-xml-init () + (list flymake-proc-xml-program + (list "val" (flymake-proc-init-create-temp-buffer-copy + 'flymake-proc-create-temp-inplace)))) ;;;; Hook onto flymake-ui +(add-hook 'flymake-diagnostic-functions 'flymake-proc-legacy-flymake) + + +;;;; + +(progn + (define-obsolete-variable-alias 'flymake-compilation-prevents-syntax-check + 'flymake-proc-compilation-prevents-syntax-check "26.1") + (define-obsolete-variable-alias 'flymake-xml-program + 'flymake-proc-xml-program "26.1") + (define-obsolete-variable-alias 'flymake-master-file-dirs + 'flymake-proc-master-file-dirs "26.1") + (define-obsolete-variable-alias 'flymake-master-file-count-limit + 'flymake-proc-master-file-count-limit "26.1" + "Max number of master files to check.") + (define-obsolete-variable-alias 'flymake-allowed-file-name-masks + 'flymake-proc-allowed-file-name-masks "26.1") + (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 + 'flymake-proc-get-include-dirs "26.1") + (define-obsolete-function-alias 'flymake-stop-all-syntax-checks + 'flymake-proc-stop-all-syntax-checks "26.1") + (define-obsolete-function-alias 'flymake-compile + 'flymake-proc-compile "26.1") + (define-obsolete-function-alias 'flymake-create-temp-inplace + 'flymake-proc-create-temp-inplace "26.1") + (define-obsolete-function-alias 'flymake-create-temp-with-folder-structure + 'flymake-proc-create-temp-with-folder-structure "26.1") + (define-obsolete-function-alias 'flymake-init-create-temp-buffer-copy + 'flymake-proc-init-create-temp-buffer-copy "26.1") + (define-obsolete-function-alias 'flymake-simple-cleanup + 'flymake-proc-simple-cleanup "26.1") + (define-obsolete-function-alias 'flymake-get-real-file-name + 'flymake-proc-get-real-file-name "26.1") + (define-obsolete-function-alias 'flymake-master-cleanup + 'flymake-proc-master-cleanup "26.1") + (define-obsolete-function-alias 'flymake-get-make-cmdline + 'flymake-proc-get-make-cmdline "26.1") + (define-obsolete-function-alias 'flymake-get-ant-cmdline + 'flymake-proc-get-ant-cmdline "26.1") + (define-obsolete-function-alias 'flymake-simple-make-init-impl + 'flymake-proc-simple-make-init-impl "26.1") + (define-obsolete-function-alias 'flymake-simple-make-init + 'flymake-proc-simple-make-init "26.1") + (define-obsolete-function-alias 'flymake-master-make-init + 'flymake-proc-master-make-init "26.1") + (define-obsolete-function-alias 'flymake-find-make-buildfile + 'flymake-proc--find-make-buildfile "26.1") + (define-obsolete-function-alias 'flymake-master-make-header-init + 'flymake-proc-master-make-header-init "26.1") + (define-obsolete-function-alias 'flymake-simple-make-java-init + 'flymake-proc-simple-make-java-init "26.1") + (define-obsolete-function-alias 'flymake-simple-ant-java-init + 'flymake-proc-simple-ant-java-init "26.1") + (define-obsolete-function-alias 'flymake-simple-java-cleanup + 'flymake-proc-simple-java-cleanup "26.1") + (define-obsolete-function-alias 'flymake-perl-init + 'flymake-proc-perl-init "26.1") + (define-obsolete-function-alias 'flymake-php-init + 'flymake-proc-php-init "26.1") + (define-obsolete-function-alias 'flymake-simple-tex-init + 'flymake-proc-simple-tex-init "26.1") + (define-obsolete-function-alias 'flymake-master-tex-init + 'flymake-proc-master-tex-init "26.1") + (define-obsolete-function-alias 'flymake-xml-init + 'flymake-proc-xml-init "26.1")) + -(add-to-list 'flymake-backends - `(flymake-proc-can-syntax-check-buffer - . - flymake-proc-start-syntax-check)) (provide 'flymake-proc) ;;; flymake-proc.el ends here diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el deleted file mode 100644 index bf5218c41d2..00000000000 --- a/lisp/progmodes/flymake-ui.el +++ /dev/null @@ -1,634 +0,0 @@ -;;; flymake-ui.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*- - -;; Copyright (C) 2003-2017 Free Software Foundation, Inc. - -;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> -;; Maintainer: Leo Liu <sdl.web@gmail.com> -;; Version: 0.3 -;; Keywords: c languages tools - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 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. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.xo -;; -;; This file contains the UI for displaying and interacting with the -;; results of such checks, as well as entry points for backends to -;; hook on to. Backends are sources of diagnostic info. -;; -;;; Code: - -(eval-when-compile (require 'cl-lib)) - -(defgroup flymake nil - "Universal on-the-fly syntax checker." - :version "23.1" - :link '(custom-manual "(flymake) Top") - :group 'tools) - -(defcustom flymake-error-bitmap '(exclamation-mark error) - "Bitmap (a symbol) used in the fringe for indicating errors. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-warning-bitmap 'question-mark - "Bitmap (a symbol) used in the fringe for indicating warnings. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-fringe-indicator-position 'left-fringe - "The position to put flymake fringe indicator. -The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. -See `flymake-error-bitmap' and `flymake-warning-bitmap'." - :group 'flymake - :version "24.3" - :type '(choice (const left-fringe) - (const right-fringe) - (const :tag "No fringe indicators" nil))) - -(defcustom flymake-start-syntax-check-on-newline t - "Start syntax check if newline char was added/removed from the buffer." - :group 'flymake - :type 'boolean) - -(defcustom flymake-no-changes-timeout 0.5 - "Time to wait after last change before starting compilation." - :group 'flymake - :type 'number) - -(defcustom flymake-gui-warnings-enabled t - "Enables/disables GUI warnings." - :group 'flymake - :type 'boolean) -(make-obsolete-variable 'flymake-gui-warnings-enabled - "it no longer has any effect." "26.1") - -(defcustom flymake-start-syntax-check-on-find-file t - "Start syntax check on find file." - :group 'flymake - :type 'boolean) - -(defcustom flymake-log-level -1 - "Logging level, only messages with level lower or equal will be logged. --1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" - :group 'flymake - :type 'integer) - -(defcustom flymake-backends '() - "Ordered list of backends providing syntax check information for a buffer. -Value is an alist of conses (PREDICATE . CHECKER). Both PREDICATE -and CHECKER are functions called with a single argument, the -buffer in which `flymake-mode' was enabled. PREDICATE is expected -to (quickly) return t or nil if the buffer can be syntax checked -by CHECKER, which in can performs more morose operations, -possibly asynchronously." - :group 'flymake - :type 'alist) - -(defvar-local flymake-timer nil - "Timer for starting syntax check.") - -(defvar-local flymake-last-change-time nil - "Time of last buffer change.") - -(defvar-local flymake-check-start-time nil - "Time at which syntax check was started.") - -(defvar-local flymake-check-was-interrupted nil - "Non-nil if syntax check was killed by `flymake-compile'.") - -(defvar-local flymake-err-info nil - "Sorted list of line numbers and lists of err info in the form (file, err-text).") - -(defvar-local flymake-new-err-info nil - "Same as `flymake-err-info', effective when a syntax check is in progress.") - -(defun flymake-log (level text &rest args) - "Log a message at level LEVEL. -If LEVEL is higher than `flymake-log-level', the message is -ignored. Otherwise, it is printed using `message'. -TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see the function `format')." - (if (<= level flymake-log-level) - (let* ((msg (apply #'format-message text args))) - (message "%s" msg)))) - -(defun flymake-ins-after (list pos val) - "Insert VAL into LIST after position POS. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) - tmp)) - -(defun flymake-set-at (list pos val) - "Set VAL at position POS in LIST. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcar (nthcdr pos tmp) val) - tmp)) - -(defun flymake-er-make-er (line-no line-err-info-list) - (list line-no line-err-info-list)) - -(defun flymake-er-get-line (err-info) - (nth 0 err-info)) - -(defun flymake-er-get-line-err-info-list (err-info) - (nth 1 err-info)) - -(cl-defstruct (flymake-ler - (:constructor nil) - (:constructor flymake-ler-make-ler (file line type text &optional full-file))) - file line type text full-file) - -(defun flymake-ler-set-file (line-err-info file) - (flymake-ler-make-ler file - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-ler-set-full-file (line-err-info full-file) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - full-file)) - -(defun flymake-ler-set-line (line-err-info line) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - line - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-get-line-err-count (line-err-info-list type) - "Return number of errors of specified TYPE. -Value of TYPE is either \"e\" or \"w\"." - (let* ((idx 0) - (count (length line-err-info-list)) - (err-count 0)) - - (while (< idx count) - (when (equal type (flymake-ler-type (nth idx line-err-info-list))) - (setq err-count (1+ err-count))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-get-err-count (err-info-list type) - "Return number of errors of specified TYPE for ERR-INFO-LIST." - (let* ((idx 0) - (count (length err-info-list)) - (err-count 0)) - (while (< idx count) - (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-highlight-err-lines (err-info-list) - "Highlight error lines in BUFFER using info from ERR-INFO-LIST." - (save-excursion - (dolist (err err-info-list) - (flymake-highlight-line (car err) (nth 1 err))))) - -(defun flymake-overlay-p (ov) - "Determine whether overlay OV was created by flymake." - (and (overlayp ov) (overlay-get ov 'flymake-overlay))) - -(defun flymake-make-overlay (beg end tooltip-text face bitmap) - "Allocate a flymake overlay in range BEG and END." - (when (not (flymake-region-has-flymake-overlays beg end)) - (let ((ov (make-overlay beg end nil t)) - (fringe (and flymake-fringe-indicator-position - (propertize "!" 'display - (cons flymake-fringe-indicator-position - (if (listp bitmap) - bitmap - (list bitmap))))))) - (overlay-put ov 'face face) - (overlay-put ov 'help-echo tooltip-text) - (overlay-put ov 'flymake-overlay t) - (overlay-put ov 'priority 100) - (overlay-put ov 'evaporate t) - (overlay-put ov 'before-string fringe) - ;;+(flymake-log 3 "created overlay %s" ov) - ov) - (flymake-log 3 "created an overlay at (%d-%d)" beg end))) - -(defun flymake-delete-own-overlays () - "Delete all flymake overlays in BUFFER." - (dolist (ol (overlays-in (point-min) (point-max))) - (when (flymake-overlay-p ol) - (delete-overlay ol) - ;;+(flymake-log 3 "deleted overlay %s" ol) - ))) - -(defun flymake-region-has-flymake-overlays (beg end) - "Check if region specified by BEG and END has overlay. -Return t if it has at least one flymake overlay, nil if no overlay." - (let ((ov (overlays-in beg end)) - (has-flymake-overlays nil)) - (while (consp ov) - (when (flymake-overlay-p (car ov)) - (setq has-flymake-overlays t)) - (setq ov (cdr ov))) - has-flymake-overlays)) - -(defface flymake-errline - '((((supports :underline (:style wave))) - :underline (:style wave :color "Red1")) - (t - :inherit error)) - "Face used for marking error lines." - :version "24.4" - :group 'flymake) - -(defface flymake-warnline - '((((supports :underline (:style wave))) - :underline (:style wave :color "DarkOrange")) - (t - :inherit warning)) - "Face used for marking warning lines." - :version "24.4" - :group 'flymake) - -(defun flymake-highlight-line (line-no line-err-info-list) - "Highlight line LINE-NO in current buffer. -Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." - (goto-char (point-min)) - (forward-line (1- line-no)) - (pcase-let* ((beg (progn (back-to-indentation) (point))) - (end (progn - (end-of-line) - (skip-chars-backward " \t\f\t\n" beg) - (if (eq (point) beg) - (line-beginning-position 2) - (point)))) - (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) - (`(,face ,bitmap) - (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (list 'flymake-errline flymake-error-bitmap) - (list 'flymake-warnline flymake-warning-bitmap)))) - (flymake-make-overlay beg end tooltip-text face bitmap))) - -(defun flymake-find-err-info (err-info-list line-no) - "Find (line-err-info-list pos) for specified LINE-NO." - (if err-info-list - (let* ((line-err-info-list nil) - (pos 0) - (count (length err-info-list))) - - (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) - (setq pos (1+ pos))) - (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) - (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list)))) - (list line-err-info-list pos)) - '(nil 0))) - -(defun flymake-line-err-info-is-less-or-equal (line-one line-two) - (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) - (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) - -(defun flymake-add-line-err-info (line-err-info-list line-err-info) - "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. -The new element is inserted in the proper position, according to -the predicate `flymake-line-err-info-is-less-or-equal'. -The updated value of LINE-ERR-INFO-LIST is returned." - (if (not line-err-info-list) - (list line-err-info) - (let* ((count (length line-err-info-list)) - (idx 0)) - (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) - (setq idx (1+ idx))) - (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) - (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info)))) - line-err-info-list))) - -(defun flymake-add-err-info (err-info-list line-err-info) - "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order. -Returns the updated value of ERR-INFO-LIST. -For the format of ERR-INFO-LIST, see `flymake-err-info'. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." - (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) - (info-and-pos (flymake-find-err-info err-info-list line-no)) - (exists (car info-and-pos)) - (pos (nth 1 info-and-pos)) - (line-err-info-list nil) - (err-info nil)) - - (if exists - (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list))))) - (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) - - (setq err-info (flymake-er-make-er line-no line-err-info-list)) - (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) - ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) - (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info)))) - err-info-list)) - -(defvar-local flymake-is-running nil - "If t, flymake syntax check process is running for the current buffer.") - -(defun flymake-on-timer-event (buffer) - "Start a syntax check for buffer BUFFER if necessary." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and (not flymake-is-running) - flymake-last-change-time - (> (- (float-time) flymake-last-change-time) - flymake-no-changes-timeout)) - - (setq flymake-last-change-time nil) - (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake--start-syntax-check))))) - -(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line - 'flymake-popup-current-error-menu "24.4") - -(defun flymake-popup-current-error-menu (&optional event) - "Pop up a menu with errors/warnings for current line." - (interactive (list last-nonmenu-event)) - (let* ((line-no (line-number-at-pos)) - (errors (or (car (flymake-find-err-info flymake-err-info line-no)) - (user-error "No errors for current line"))) - (menu (mapcar (lambda (x) - (if (flymake-ler-file x) - (cons (format "%s - %s(%d)" - (flymake-ler-text x) - (flymake-ler-file x) - (flymake-ler-line x)) - x) - (list (flymake-ler-text x)))) - errors)) - (event (if (mouse-event-p event) - event - (list 'mouse-1 (posn-at-point)))) - (title (format "Line %d: %d error(s), %d warning(s)" - line-no - (flymake-get-line-err-count errors "e") - (flymake-get-line-err-count errors "w"))) - (choice (x-popup-menu event (list title (cons "" menu))))) - (flymake-log 3 "choice=%s" choice) - (when choice - (flymake-goto-file-and-line (flymake-ler-full-file choice) - (flymake-ler-line choice))))) - -(defun flymake-goto-file-and-line (file line) - "Try to get buffer for FILE and goto line LINE in it." - (if (not (file-exists-p file)) - (flymake-log 1 "File %s does not exist" file) - (find-file file) - (goto-char (point-min)) - (forward-line (1- line)))) - -;; flymake minor mode declarations -(defvar-local flymake-mode-line nil) -(defvar-local flymake-mode-line-e-w nil) -(defvar-local flymake-mode-line-status nil) - -(defun flymake-report-status (e-w &optional status) - "Show status in mode line." - (when e-w - (setq flymake-mode-line-e-w e-w)) - (when status - (setq flymake-mode-line-status status)) - (let* ((mode-line " Flymake")) - (when (> (length flymake-mode-line-e-w) 0) - (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) - (setq mode-line (concat mode-line flymake-mode-line-status)) - (setq flymake-mode-line mode-line) - (force-mode-line-update))) - -;; Nothing in flymake uses this at all any more, so this is just for -;; third-party compatibility. -(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") - -(defun flymake-report-fatal-status (status warning) - "Display a warning and switch flymake mode off." - ;; This first message was always shown by default, and flymake-log - ;; does nothing by default, hence the use of message. - ;; Another option is display-warning. - (if (< flymake-log-level 0) - (message "Flymake: %s. Flymake will be switched OFF" warning)) - (flymake-mode 0) - (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" - (buffer-name) status warning)) - -(defvar-local flymake--backend nil - "The currently active backend selected by `flymake-mode'") - -(defun flymake--can-syntax-check-buffer (buffer) - (let ((all flymake-backends) - (candidate)) - (catch 'done - (while (setq candidate (pop all)) - (when (with-current-buffer buffer (funcall (car candidate))) - (throw 'done (cdr candidate))))))) - -(defun flymake--start-syntax-check () - (funcall flymake--backend)) - -;;;###autoload -(define-minor-mode flymake-mode nil - :group 'flymake :lighter flymake-mode-line - (cond - - ;; Turning the mode ON. - (flymake-mode - (let* ((backend (flymake--can-syntax-check-buffer (current-buffer)))) - (cond - ((not backend) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) - (t - (setq flymake--backend backend) - - (add-hook 'after-change-functions 'flymake-after-change-function nil t) - (add-hook 'after-save-hook 'flymake-after-save-hook nil t) - (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - - (flymake-report-status "" "") - - (setq flymake-timer - (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - - (when (and flymake-start-syntax-check-on-find-file - ;; Since we write temp files in current dir, there's no point - ;; trying if the directory is read-only (bug#8954). - (file-writable-p (file-name-directory buffer-file-name))) - (with-demoted-errors - (flymake--start-syntax-check))))) - ) - ) - - ;; Turning the mode OFF. - (t - (setq flymake--backend nil) - - (remove-hook 'after-change-functions 'flymake-after-change-function t) - (remove-hook 'after-save-hook 'flymake-after-save-hook t) - (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) - - (when flymake-timer - (cancel-timer flymake-timer) - (setq flymake-timer nil)) - - (setq flymake-is-running nil)))) - -;; disabling flymake-mode is safe, enabling - not necessarily so -(put 'flymake-mode 'safe-local-variable 'null) - -;;;###autoload -(defun flymake-mode-on () - "Turn flymake mode on." - (flymake-mode 1) - (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name))) - -;;;###autoload -(defun flymake-mode-off () - "Turn flymake mode off." - (flymake-mode 0) - (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) - -(defun flymake-after-change-function (start stop _len) - "Start syntax check for current buffer if it isn't already running." - ;;+(flymake-log 0 "setting change time to %s" (float-time)) - (let((new-text (buffer-substring start stop))) - (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) - (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake--start-syntax-check)) - (setq flymake-last-change-time (float-time)))) - -(defun flymake-after-save-hook () - (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? - (progn - (flymake-log 3 "starting syntax check as buffer was saved") - (flymake--start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) - -(defun flymake-kill-buffer-hook () - (when flymake-timer - (cancel-timer flymake-timer) - (setq flymake-timer nil))) - -;;;###autoload -(defun flymake-find-file-hook () - ;;+(when flymake-start-syntax-check-on-find-file - ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake--start-syntax-check) - ;;+) - (when (and (not (local-variable-p 'flymake-mode (current-buffer))) - (flymake--can-syntax-check-buffer (current-buffer))) - (flymake-mode) - (flymake-log 3 "automatically turned ON flymake mode"))) - -(defun flymake-get-first-err-line-no (err-info-list) - "Return first line with error." - (when err-info-list - (flymake-er-get-line (car err-info-list)))) - -(defun flymake-get-last-err-line-no (err-info-list) - "Return last line with error." - (when err-info-list - (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)))) - -(defun flymake-get-next-err-line-no (err-info-list line-no) - "Return next line with error." - (when err-info-list - (let* ((count (length err-info-list)) - (idx 0)) - (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) - (setq idx (1+ idx))) - (if (< idx count) - (flymake-er-get-line (nth idx err-info-list)))))) - -(defun flymake-get-prev-err-line-no (err-info-list line-no) - "Return previous line with error." - (when err-info-list - (let* ((count (length err-info-list))) - (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) - (setq count (1- count))) - (if (> count 0) - (flymake-er-get-line (nth (1- count) err-info-list)))))) - -(defun flymake-skip-whitespace () - "Move forward until non-whitespace is reached." - (while (looking-at "[ \t]") - (forward-char))) - -(defun flymake-goto-line (line-no) - "Go to line LINE-NO, then skip whitespace." - (goto-char (point-min)) - (forward-line (1- line-no)) - (flymake-skip-whitespace)) - -(defun flymake-goto-next-error () - "Go to next error in err ring." - (interactive) - (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-first-err-line-no flymake-err-info)) - (flymake-log 1 "passed end of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-goto-prev-error () - "Go to previous error in err ring." - (interactive) - (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-last-err-line-no flymake-err-info)) - (flymake-log 1 "passed beginning of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-patch-err-text (string) - (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) - (match-string 1 string) - string)) - -(provide 'flymake-ui) -;;; flymake-ui.el ends here diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 059bce95eed..45f0adfeba1 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1,4 +1,4 @@ -;;; flymake.el --- a universal on-the-fly syntax checker -*- lexical-binding: t; -*- +;;; flymake.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2017 Free Software Foundation, Inc. @@ -20,22 +20,964 @@ ;; 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/>. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; ;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. ;; -;; It collects diagnostic information for multiple sources and -;; visually annotates the relevant lines in the buffer. +;; Flymake collects diagnostic information for multiple sources, +;; called backends, and visually annotates the relevant portions in +;; the buffer. +;; +;; This file contains the UI for displaying and interacting with the +;; 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 docstrings of these variables are relevant to understanding how +;; Flymake works for both the user and the backend programmer: +;; +;; * `flymake-diagnostic-functions' +;; * `flymake-diagnostic-types-alist' ;; -;; This file is just a stub for that loads the UI and backends, which -;; could also be loaded separately. - ;;; Code: -(require 'flymake-ui) -(require 'flymake-proc) +(require 'cl-lib) +(require 'thingatpt) ; end-of-thing +(require 'warnings) ; warning-numeric-level, display-warning +(require 'compile) ; for some faces +(require 'subr-x) ; when-let*, if-let*, hash-table-keys, hash-table-values + +(defgroup flymake nil + "Universal on-the-fly syntax checker." + :version "23.1" + :link '(custom-manual "(flymake) Top") + :group 'tools) + +(defcustom flymake-error-bitmap '(flymake-double-exclamation-mark + compilation-error) + "Bitmap (a symbol) used in the fringe for indicating errors. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-warning-bitmap '(exclamation-mark compilation-warning) + "Bitmap (a symbol) used in the fringe for indicating warnings. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-note-bitmap '(exclamation-mark compilation-info) + "Bitmap (a symbol) used in the fringe for indicating info notes. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :version "26.1" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-fringe-indicator-position 'left-fringe + "The position to put Flymake fringe indicator. +The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. +See `flymake-error-bitmap' and `flymake-warning-bitmap'." + :version "24.3" + :type '(choice (const left-fringe) + (const right-fringe) + (const :tag "No fringe indicators" nil))) + +(defcustom flymake-start-syntax-check-on-newline t + "Start syntax check if newline char was added/removed from the buffer." + :type 'boolean) + +(defcustom flymake-no-changes-timeout 0.5 + "Time to wait after last change before automatically checking buffer. +If nil, never start checking buffer automatically like this." + :type 'number) + +(defcustom flymake-gui-warnings-enabled t + "Enables/disables GUI warnings." + :type 'boolean) +(make-obsolete-variable 'flymake-gui-warnings-enabled + "it no longer has any effect." "26.1") + +(defcustom flymake-start-syntax-check-on-find-file t + "Start syntax check on find file." + :type 'boolean) + +(defcustom flymake-log-level -1 + "Obsolete and ignored variable." + :type 'integer) +(make-obsolete-variable 'flymake-log-level + "it is superseded by `warning-minimum-log-level.'" + "26.1") + +(defcustom flymake-wrap-around t + "If non-nil, moving to errors wraps around buffer boundaries." + :type 'boolean) + +(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.") + +(defvar-local flymake-check-start-time nil + "Time at which syntax check was started.") + +(defun flymake--log-1 (level sublog msg &rest args) + "Do actual work for `flymake-log'." + (let (;; never popup the log buffer + (warning-minimum-level :emergency) + (warning-type-format + (format " [%s %s]" + (or sublog 'flymake) + (current-buffer)))) + (display-warning (list 'flymake sublog) + (apply #'format-message msg args) + (if (numberp level) + (or (nth level + '(:emergency :error :warning :debug :debug) ) + :error) + level) + "*Flymake log*"))) + +(defun flymake-switch-to-log-buffer () + "Go to the *Flymake log* buffer." + (interactive) + (switch-to-buffer "*Flymake log*")) + +;;;###autoload +(defmacro flymake-log (level msg &rest args) + "Log, at level LEVEL, the message MSG formatted with ARGS. +LEVEL is passed to `display-warning', which is used to display +the warning. If this form is included in a byte-compiled file, +the generated warning contains an indication of the file that +generated it." + (let* ((compile-file (and (boundp 'byte-compile-current-file) + (symbol-value 'byte-compile-current-file))) + (sublog (if (and + compile-file + (not load-file-name)) + (intern + (file-name-nondirectory + (file-name-sans-extension compile-file)))))) + `(flymake--log-1 ,level ',sublog ,msg ,@args))) + +(defun flymake-error (text &rest args) + "Format TEXT with ARGS and signal an error for Flymake." + (let ((msg (apply #'format-message text args))) + (flymake-log :error msg) + (error (concat "[Flymake] " msg)))) + +(cl-defstruct (flymake--diag + (:constructor flymake--diag-make)) + buffer beg end type text backend) + +;;;###autoload +(defun flymake-make-diagnostic (buffer + beg + end + type + text) + "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)) + +(cl-defun flymake--overlays (&key beg end filter compare key) + "Get flymake-related overlays. +If BEG is non-nil and END is nil, consider only `overlays-at' +BEG. Otherwise consider `overlays-in' the region comprised by BEG +and END, defaulting to the whole buffer. Remove all that do not +verify FILTER, a function, and sort them by COMPARE (using KEY)." + (save-restriction + (widen) + (let ((ovs (cl-remove-if-not + (lambda (ov) + (and (overlay-get ov 'flymake) + (or (not filter) + (funcall filter ov)))) + (if (and beg (null end)) + (overlays-at beg t) + (overlays-in (or beg (point-min)) + (or end (point-max))))))) + (if compare + (cl-sort ovs compare :key (or 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")) + (t + :inherit error)) + "Face used for marking error regions." + :version "24.4") + +(defface flymake-warning + '((((supports :underline (:style wave))) + :underline (:style wave :color "deep sky blue")) + (t + :inherit warning)) + "Face used for marking warning regions." + :version "24.4") + +(defface flymake-note + '((((supports :underline (:style wave))) + :underline (:style wave :color "yellow green")) + (t + :inherit warning)) + "Face used for marking note regions." + :version "26.1") + +(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1") +(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1") + +;;;###autoload +(defun flymake-diag-region (buffer line &optional col) + "Compute BUFFER's region (BEG . END) corresponding to LINE and COL. +If COL is nil, return a region just for LINE. Return nil if the +region is invalid." + (condition-case-unless-debug _err + (with-current-buffer buffer + (let ((line (min (max line 1) + (line-number-at-pos (point-max) 'absolute)))) + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (cl-flet ((fallback-bol + () (progn (back-to-indentation) (point))) + (fallback-eol + (beg) + (progn + (end-of-line) + (skip-chars-backward " \t\f\t\n" beg) + (if (eq (point) beg) + (line-beginning-position 2) + (point))))) + (if (and col (cl-plusp col)) + (let* ((beg (progn (forward-char (1- col)) + (point))) + (sexp-end (ignore-errors (end-of-thing 'sexp))) + (end (or (and sexp-end + (not (= sexp-end beg)) + sexp-end) + (ignore-errors (goto-char (1+ beg))))) + (safe-end (or end + (fallback-eol beg)))) + (cons (if end beg (fallback-bol)) + safe-end)) + (let* ((beg (fallback-bol)) + (end (fallback-eol beg))) + (cons beg end))))))) + (error (flymake-error "Invalid region line=%s col=%s" line col)))) + +(defvar flymake-diagnostic-functions nil + "Special hook of Flymake backends that check a buffer. + +The functions in this hook diagnose problems in a buffer’s +contents and provide information to the Flymake user interface +about where and how to annotate problems diagnosed in a buffer. + +Whenever Flymake or the user decides to re-check the buffer, each +function is called with an arbitrary number of arguments: + +* the first argument is always REPORT-FN, a callback function + 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. + +Backend functions are expected to initiate the buffer check, but +aren't required to complete it check before exiting: if the +computation involved is expensive, especially for large buffers, +that task can be scheduled for the future using 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. + +If the function returns, Flymake considers the backend to be +\"running\". If it has not done so already, the backend is +expected to call the function REPORT-FN with a single argument +REPORT-ACTION also followed by an optional list of keyword-value +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. + + A backend may call REPORT-FN repeatedly in this manner, but + only until Flymake considers that the most recently requested + buffer check is now obsolete because, say, buffer contents have + changed in the meantime. The backend is only given notice of + this via a renewed call to the backend function. Thus, to + prevent making obsolete reports and wasting resources, backend + functions should first cancel any ongoing processing from + previous calls. + +* The symbol `:panic', signaling that the backend has encountered + an exceptional situation and should be disabled. + +Currently accepted REPORT-KEY arguments are: + +* ‘:explanation’: value should give user-readable details of + 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 + priority `priority' is not specified, `severity' is used to set + it and help sort overlapping overlays. + +* `flymake-category', a symbol whose property list is considered + as 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.") + +(put 'flymake-error 'face 'flymake-error) +(put 'flymake-error '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 '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 '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 +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)))) + +(defun flymake--fringe-overlay-spec (bitmap &optional recursed) + (if (and (symbolp bitmap) + (boundp bitmap) + (not recursed)) + (flymake--fringe-overlay-spec + (symbol-value bitmap) t) + (and flymake-fringe-indicator-position + bitmap + (propertize "!" 'display + (cons flymake-fringe-indicator-position + (if (listp bitmap) + bitmap + (list bitmap))))))) + +(defun flymake--highlight-line (diagnostic) + "Highlight buffer with info in DIAGNOSTIC." + (when-let* ((ov (make-overlay + (flymake--diag-beg diagnostic) + (flymake--diag-end diagnostic)))) + ;; First set `category' in the overlay, then copy over every other + ;; property. + ;; + (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))) + ;; 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) + (default-maybe 'face 'flymake-error) + (default-maybe 'before-string + (flymake--fringe-overlay-spec + (overlay-get ov 'bitmap))) + (default-maybe 'help-echo + (lambda (_window _ov pos) + (mapconcat + (lambda (ov) + (let ((diag (overlay-get ov 'flymake--diagnostic))) + (flymake--diag-text diag))) + (flymake--overlays :beg pos) + "\n"))) + (default-maybe 'severity (warning-numeric-level :error)) + (default-maybe 'priority (+ 100 (overlay-get ov 'severity)))) + ;; Some properties can't be overridden. + ;; + (overlay-put ov 'evaporate t) + (overlay-put ov 'flymake t) + (overlay-put ov 'flymake--diagnostic diagnostic))) + +;; Nothing in Flymake uses this at all any more, so this is just for +;; third-party compatibility. +(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") + +(defvar-local flymake--backend-state nil + "Buffer-local hash table of a Flymake backend's state. +The keys to this hash table are functions as found in +`flymake-diagnostic-functions'. The values are structures +of the type `flymake--backend-state', with these slots: + +`running', a symbol to keep track of a backend's replies via its +REPORT-FN argument. A backend is running if this key is +present. If nil, Flymake isn't expecting any replies from the +backend. + +`diags', a (possibly empty) list of recent diagnostic objects +created by the backend with `flymake-make-diagnostic'. + +`reported-p', a boolean indicating if the backend has replied +since it last was contacted. + +`disabled', a string with the explanation for a previous +exceptional situation reported by the backend, nil if the +backend is operating normally.") + +(cl-defstruct (flymake--backend-state + (:constructor flymake--make-backend-state)) + running reported-p disabled diags) + +(defmacro flymake--with-backend-state (backend state-var &rest body) + "Bind BACKEND's STATE-VAR to its state, run BODY." + (declare (indent 2) (debug (sexp sexp &rest form))) + (let ((b (make-symbol "b"))) + `(let* ((,b ,backend) + (,state-var + (or (gethash ,b flymake--backend-state) + (puthash ,b (flymake--make-backend-state) + flymake--backend-state)))) + ,@body))) + +(defun flymake-is-running () + "Tell if Flymake has running backends in this buffer" + (flymake-running-backends)) + +(cl-defun flymake--handle-report (backend token report-action + &key explanation force + &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." + (let* ((state (gethash backend flymake--backend-state)) + (first-report (not (flymake--backend-state-reported-p state)))) + (setf (flymake--backend-state-reported-p state) t) + (let (expected-token + new-diags) + (cond + ((null state) + (flymake-error + "Unexpected report from unknown backend %s" backend)) + ((flymake--backend-state-disabled state) + (flymake-error + "Unexpected report from disabled backend %s" backend)) + ((progn + (setq expected-token (flymake--backend-state-running state)) + (null expected-token)) + ;; should never happen + (flymake-error "Unexpected report from stopped backend %s" backend)) + ((and (not (eq expected-token token)) + (not force)) + (flymake-error "Obsolete report from backend %s with explanation %s" + backend explanation)) + ((eq :panic report-action) + (flymake--disable-backend backend explanation)) + ((not (listp report-action)) + (flymake--disable-backend backend + (format "Unknown action %S" report-action)) + (flymake-error "Expected report, but got unknown key %s" report-action)) + (t + (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)))))) + (mapc (lambda (diag) + (flymake--highlight-line diag) + (setf (flymake--diag-backend diag) backend)) + new-diags) + (setf (flymake--backend-state-diags state) + (append new-diags (flymake--backend-state-diags state))) + (when flymake-check-start-time + (flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)" + backend + (length new-diags) + (- (float-time) flymake-check-start-time))))))))) + +(defun flymake-make-report-fn (backend &optional token) + "Make a suitable anonymous report function for BACKEND. +BACKEND is used to help Flymake distinguish different diagnostic +sources. If provided, TOKEN helps Flymake distinguish between +different runs of the same backend." + (let ((buffer (current-buffer))) + (lambda (&rest args) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (apply #'flymake--handle-report backend token args)))))) + +(defun flymake--collect (fn) + (let (retval) + (maphash (lambda (backend state) + (when (funcall fn state) (push backend retval))) + flymake--backend-state) + retval)) + +(defun flymake-running-backends () + "Compute running Flymake backends in current buffer." + (flymake--collect #'flymake--backend-state-running)) + +(defun flymake-disabled-backends () + "Compute disabled Flymake backends in current buffer." + (flymake--collect #'flymake--backend-state-disabled)) + +(defun flymake-reporting-backends () + "Compute reporting Flymake backends in current buffer." + (flymake--collect #'flymake--backend-state-reported-p)) + +(defun flymake--disable-backend (backend &optional explanation) + "Disable BACKEND because EXPLANATION. +If it is running also stop it." + (flymake-log :warning "Disabling backend %s because %s" backend explanation) + (flymake--with-backend-state backend state + (setf (flymake--backend-state-running state) nil + (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." + (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 + ;; `ert-deftest' where `debug-on-error' appears to be always + ;; t. (2) In cases where the user is debugging elisp somewhere + ;; else, and using flymake, the presence of a frequently + ;; misbehaving backend in the global hook (most likely the legacy + ;; backend) will trigger an annoying backtrace. + ;; + (condition-case err + (funcall backend + (flymake-make-report-fn backend run-token)) + (error + (flymake--disable-backend backend err))))) + +(defun flymake-start (&optional deferred force) + "Start a syntax check. +Start it immediately, or after current command if DEFERRED is +non-nil. With optional FORCE run even disabled backends. + +Interactively, with a prefix arg, FORCE is t." + (interactive (list nil current-prefix-arg)) + (cl-labels + ((start + () + (remove-hook 'post-command-hook #'start 'local) + (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)))) + (if (and deferred + this-command) + (add-hook 'post-command-hook #'start 'append 'local) + (start)))) + +(defvar flymake-mode-map + (let ((map (make-sparse-keymap))) map) + "Keymap for `flymake-mode'") + +;;;###autoload +(define-minor-mode flymake-mode nil + :group 'flymake :lighter flymake--mode-line-format :keymap flymake-mode-map + (cond + ;; Turning the mode ON. + (flymake-mode + (add-hook 'after-change-functions 'flymake-after-change-function nil t) + (add-hook 'after-save-hook 'flymake-after-save-hook nil t) + (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + + (setq flymake--backend-state (make-hash-table)) + + (when flymake-start-syntax-check-on-find-file + (flymake-start))) + + ;; Turning the mode OFF. + (t + (remove-hook 'after-change-functions 'flymake-after-change-function t) + (remove-hook 'after-save-hook 'flymake-after-save-hook t) + (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) + + (when flymake-timer + (cancel-timer flymake-timer) + (setq flymake-timer nil))))) + +(defun flymake--schedule-timer-maybe () + "(Re)schedule an idle timer for checking the buffer. +Do it only if `flymake-no-changes-timeout' is non-nil." + (when flymake-timer (cancel-timer flymake-timer)) + (when flymake-no-changes-timeout + (setq + flymake-timer + (run-with-idle-timer + (seconds-to-time flymake-no-changes-timeout) + nil + (lambda (buffer) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (and flymake-mode + flymake-no-changes-timeout) + (flymake-log + :debug "starting syntax check after idle for %s seconds" + flymake-no-changes-timeout) + (flymake-start)) + (setq flymake-timer nil)))) + (current-buffer))))) + +;;;###autoload +(defun flymake-mode-on () + "Turn Flymake mode on." + (flymake-mode 1)) + +;;;###autoload +(defun flymake-mode-off () + "Turn Flymake mode off." + (flymake-mode 0)) + +(make-obsolete 'flymake-mode-on 'flymake-mode "26.1") +(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." + (let((new-text (buffer-substring start stop))) + (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 'deferred)) + (flymake--schedule-timer-maybe))) + +(defun flymake-after-save-hook () + (when flymake-mode + (flymake-log :debug "starting syntax check as buffer was saved") + (flymake-start))) + +(defun flymake-kill-buffer-hook () + (when flymake-timer + (cancel-timer flymake-timer) + (setq flymake-timer nil))) + +(defun flymake-find-file-hook () + (unless (or flymake-mode + (null flymake-diagnostic-functions)) + (flymake-mode) + (flymake-log :warning "Turned on in `flymake-find-file-hook'"))) + +(defun flymake-goto-next-error (&optional n filter interactive) + "Go to Nth next Flymake error in buffer matching FILTER. +Interactively, always move to the next error. With a prefix arg, +skip any diagnostics with a severity less than ‘:warning’. + +If ‘flymake-wrap-around’ is non-nil and no more next errors, +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." + ;; TODO: let filter be a number, a severity below which diags are + ;; skipped. + (interactive (list 1 + (if current-prefix-arg + '(:error :warning)) + t)) + (let* ((n (or n 1)) + (ovs (flymake--overlays :filter + (lambda (ov) + (let ((diag (overlay-get + ov + 'flymake--diagnostic))) + (and diag + (or (not filter) + (memq (flymake--diag-type diag) + filter))))) + :compare (if (cl-plusp n) #'< #'>) + :key #'overlay-start)) + (tail (cl-member-if (lambda (ov) + (if (cl-plusp n) + (> (overlay-start ov) + (point)) + (< (overlay-start ov) + (point)))) + ovs)) + (chain (if flymake-wrap-around + (if tail + (progn (setcdr (last tail) ovs) tail) + (and ovs (setcdr (last ovs) ovs))) + tail)) + (target (nth (1- n) chain))) + (cond (target + (goto-char (overlay-start target)) + (when interactive + (message + (funcall (overlay-get target 'help-echo) + nil nil (point))))) + (interactive + (user-error "No more Flymake errors%s" + (if filter + (format " of types %s" filter) + "")))))) + +(defun flymake-goto-prev-error (&optional n filter interactive) + "Go to Nth previous Flymake error in buffer matching FILTER. +Interactively, always move to the previous error. With a prefix +arg, skip any diagnostics with a severity less than ‘:warning’. + +If ‘flymake-wrap-around’ is non-nil and no more previous errors, +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." + (interactive (list 1 (if current-prefix-arg + '(:error :warning)) + t)) + (flymake-goto-next-error (- (or n 1)) filter interactive)) + + +;;; Mode-line and menu +;;; +(easy-menu-define flymake-menu flymake-mode-map "Flymake" + `("Flymake" + [ "Go to next error" flymake-goto-next-error t ] + [ "Go to previous error" flymake-goto-prev-error t ] + [ "Check now" flymake-start t ] + [ "Go to log buffer" flymake-switch-to-log-buffer t ] + "--" + [ "Turn off Flymake" flymake-mode t ])) + +(defvar flymake--mode-line-format `(:eval (flymake--mode-line-format))) + +(put 'flymake--mode-line-format 'risky-local-variable t) + +(defun flymake--mode-line-format () + "Produce a pretty minor mode indicator." + (let* ((known (hash-table-keys flymake--backend-state)) + (running (flymake-running-backends)) + (disabled (flymake-disabled-backends)) + (reported (flymake-reporting-backends)) + (diags-by-type (make-hash-table)) + (all-disabled (and disabled (null running))) + (some-waiting (cl-set-difference running reported))) + (maphash (lambda (_b state) + (mapc (lambda (diag) + (push diag + (gethash (flymake--diag-type diag) + diags-by-type))) + (flymake--backend-state-diags state))) + flymake--backend-state) + `((:propertize " Flymake" + mouse-face mode-line-highlight + help-echo + ,(concat (format "%s known backends\n" (length known)) + (format "%s running\n" (length running)) + (format "%s disabled\n" (length disabled)) + "mouse-1: go to log buffer ") + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] + flymake-menu) + map)) + ,@(pcase-let ((`(,ind ,face ,explain) + (cond ((null known) + `("?" mode-line "No known backends")) + (some-waiting + `("Wait" compilation-mode-line-run + ,(format "Waiting for %s running backend(s)" + (length some-waiting)))) + (all-disabled + `("!" compilation-mode-line-run + "All backends disabled")) + (t + `(nil nil nil))))) + (when ind + `((":" + (:propertize ,ind + face ,face + help-echo ,explain + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + 'flymake-switch-to-log-buffer) + map)))))) + ,@(unless (or all-disabled + (null known)) + (cl-loop + for (type . severity) + in (cl-sort (mapcar (lambda (type) + (cons type (flymake--lookup-type-property + type + 'severity + (warning-numeric-level :error)))) + (cl-union (hash-table-keys diags-by-type) + '(:error :warning))) + #'> + :key #'cdr) + for diags = (gethash type diags-by-type) + for face = (flymake--lookup-type-property type + 'mode-line-face + 'compilation-error) + when (or diags + (>= severity (warning-numeric-level :warning))) + collect `(:propertize + ,(format "%d" (length diags)) + face ,face + mouse-face mode-line-highlight + keymap + ,(let ((map (make-sparse-keymap)) + (type type)) + (define-key map [mode-line mouse-4] + (lambda (_event) + (interactive "e") + (flymake-goto-prev-error 1 (list type) t))) + (define-key map [mode-line mouse-5] + (lambda (_event) + (interactive "e") + (flymake-goto-next-error 1 (list type) t))) + map) + help-echo + ,(concat (format "%s diagnostics of type %s\n" + (propertize (format "%d" + (length diags)) + 'face face) + (propertize (format "%s" type) + 'face face)) + "mouse-4/mouse-5: previous/next of this type\n")) + into forms + finally return + `((:propertize "[") + ,@(cl-loop for (a . rest) on forms by #'cdr + collect a when rest collect + '(:propertize " ")) + (:propertize "]"))))))) (provide 'flymake) + +(require 'flymake-proc) + ;;; flymake.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 365191c56b0..9aa5134ca0d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3442,6 +3442,8 @@ def __PYTHON_EL_native_completion_setup(): instance.rlcomplete = new_completer if readline.__doc__ and 'libedit' in readline.__doc__: + raise Exception('''libedit based readline is known not to work, + see etc/PROBLEMS under \"In Inferior Python mode, input is echoed\".''') readline.parse_and_bind('bind ^I rl_complete') else: readline.parse_and_bind('tab: complete') @@ -3450,7 +3452,9 @@ def __PYTHON_EL_native_completion_setup(): print ('python.el: native completion setup loaded') except: - print ('python.el: native completion setup failed') + import sys + print ('python.el: native completion setup failed, %s: %s' + % sys.exc_info()[:2]) __PYTHON_EL_native_completion_setup()" process) (when (and diff --git a/lisp/ses.el b/lisp/ses.el index 9221476e7a1..4c19c70c5da 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1254,8 +1254,7 @@ preceding cell has spilled over." ((< len width) ;; Fill field to length with spaces. (setq len (make-string (- width len) ?\s) - text (if (or (stringp value) - (eq ses-call-printer-return t)) + text (if (eq ses-call-printer-return t) (concat text len) (concat len text)))) ((> len width) diff --git a/lisp/time.el b/lisp/time.el index 5c0eac0c208..c8726a9a1b0 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -160,24 +160,33 @@ LABEL is a string to display as the label of that TIMEZONE's time." :type '(repeat (list string string)) :version "23.1") -(defcustom display-time-world-list - ;; Determine if zoneinfo style timezones are supported by testing that - ;; America/New York and Europe/London return different timezones. - (let ((nyt (format-time-string "%z" nil "America/New_York")) - (gmt (format-time-string "%z" nil "Europe/London"))) - (if (string-equal nyt gmt) - legacy-style-world-list - zoneinfo-style-world-list)) +(defcustom display-time-world-list t "Alist of time zones and places for `display-time-world' to display. Each element has the form (TIMEZONE LABEL). TIMEZONE should be in a format supported by your system. See the documentation of `zoneinfo-style-world-list' and `legacy-style-world-list' for two widely used formats. LABEL is -a string to display as the label of that TIMEZONE's time." +a string to display as the label of that TIMEZONE's time. + +If the value is t instead of an alist, use the value of +`zoneinfo-style-world-list' if it works on this platform, and of +`legacy-style-world-list' otherwise." + :group 'display-time :type '(repeat (list string string)) :version "23.1") +(defun time--display-world-list () + (if (listp display-time-world-list) + display-time-world-list + ;; Determine if zoneinfo style timezones are supported by testing that + ;; America/New York and Europe/London return different timezones. + (let ((nyt (format-time-string "%z" nil "America/New_York")) + (gmt (format-time-string "%z" nil "Europe/London"))) + (if (string-equal nyt gmt) + legacy-style-world-list + zoneinfo-style-world-list)))) + (defcustom display-time-world-time-format "%A %d %B %R %Z" "Format of the time displayed, see `format-time-string'." :group 'display-time @@ -548,7 +557,7 @@ To turn off the world time display, go to that window and type `q'." (not (get-buffer display-time-world-buffer-name))) (run-at-time t display-time-world-timer-second 'display-time-world-timer)) (with-current-buffer (get-buffer-create display-time-world-buffer-name) - (display-time-world-display display-time-world-list) + (display-time-world-display (time--display-world-list)) (display-buffer display-time-world-buffer-name (cons nil '((window-height . fit-window-to-buffer)))) (display-time-world-mode))) @@ -556,7 +565,7 @@ To turn off the world time display, go to that window and type `q'." (defun display-time-world-timer () (if (get-buffer display-time-world-buffer-name) (with-current-buffer (get-buffer display-time-world-buffer-name) - (display-time-world-display display-time-world-list)) + (display-time-world-display (time--display-world-list))) ;; cancel timer (let ((list timer-list)) (while list diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 772a72d5c50..d268e1a3fe7 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -288,8 +288,10 @@ which is the \"1006\" extension implemented in Xterm >= 277." (string-match "down-" last-name) (equal name (replace-match "" t t last-name))) (xterm-mouse--set-click-count event click-count))) - ((not last-time) nil) - ((and (> double-click-time (* 1000 (- this-time last-time))) + ((and last-time + double-click-time + (or (eq double-click-time t) + (> double-click-time (* 1000 (- this-time last-time)))) (equal last-name (replace-match "" t t name))) (setq click-count (1+ click-count)) (xterm-mouse--set-click-count event click-count)) |