diff options
Diffstat (limited to 'lisp')
41 files changed, 518 insertions, 299 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index 689bed5efc1..2cdac99f90a 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -6051,8 +6051,8 @@ See `allout-toggle-current-subtree-encryption' for more details." (declare-function epg-decrypt-string "epg" (context cipher)) (declare-function epg-encrypt-string "epg" (context plain recipients &optional sign always-trust)) -(declare-function epg-user-id-string "epg" (user-id)) -(declare-function epg-key-user-id-list "epg" (key)) +(declare-function epg-user-id-string "epg" (user-id) t) +(declare-function epg-key-user-id-list "epg" (key) t) ;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue ;;; &optional rejected) diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el index 2ff83418f78..a076c46513c 100644 --- a/lisp/cedet/ede/locate.el +++ b/lisp/cedet/ede/locate.el @@ -353,7 +353,7 @@ that created this EDE locate object." (cl-defmethod ede-locate-create/update-root-database ((loc (subclass ede-locate-cscope)) root) - "Create or update the GNU Global database for the current project." + "Create or update the Cscope database for the current project." (require 'cedet-cscope) (cedet-cscope-create/update-database root)) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index 89d44c20a6f..07882efd632 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -133,7 +133,8 @@ Return t if there is more drift to do, nil if completed." (let* ((frame (color-values (face-background 'default))) (start (color-values (face-background (get 'pulse-highlight-face - :startface)))) + :startface) + nil t))) (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations) (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations) (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations))) @@ -154,7 +155,7 @@ Return t if there is more drift to do, nil if completed." "Reset the pulse highlighting FACE." (set-face-background 'pulse-highlight-face (if face - (face-background face) + (face-background face nil t) (face-background 'pulse-highlight-start-face) )) (put 'pulse-highlight-face :startface (or face @@ -224,6 +225,7 @@ Optional argument FACE specifies the face to do the highlighting." ;; Remove this hook. (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight)) +;;;###autoload (defun pulse-momentary-highlight-one-line (point &optional face) "Highlight the line around POINT, unhighlighting before next command. Optional argument FACE specifies the face to do the highlighting." @@ -237,6 +239,7 @@ Optional argument FACE specifies the face to do the highlighting." (point)))) (pulse-momentary-highlight-region start end face)))) +;;;###autoload (defun pulse-momentary-highlight-region (start end &optional face) "Highlight between START and END, unhighlighting before next command. Optional argument FACE specifies the face to do the highlighting." diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 19d149112c6..b186e7bd6ee 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -86,13 +86,11 @@ to give to the program." (let ((chars (append line nil))) (when (= 32 (nth 0 chars)) (let ((path (substring line 1))) - (when (file-accessible-directory-p path) - (when (if (memq system-type '(windows-nt)) - (/= ?/ (nth 1 chars)) - (= ?/ (nth 1 chars))) - (add-to-list 'inc-path - (expand-file-name (substring line 1)) - t))))))))) + (when (and (file-accessible-directory-p path) + (file-name-absolute-p path)) + (add-to-list 'inc-path + (expand-file-name path) + t)))))))) inc-path)) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 7a92a12ed53..15ad9872446 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1659,12 +1659,6 @@ Select the buffer containing the tag's definition, and move point there." ) "Association of syntax elements, and the corresponding help.") -(declare-function eldoc-function-argstring "eldoc") -(declare-function eldoc-docstring-format-sym-doc "eldoc") -(declare-function eldoc-last-data-store "eldoc") -(declare-function eldoc-get-fnsym-args-string "eldoc") -(declare-function eldoc-get-var-docstring "eldoc") - (defvar semantic-grammar-eldoc-last-data (cons nil nil)) (defun semantic-grammar-eldoc-get-macro-docstring (macro expander) diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 981dab8a8b5..d57b50fb98f 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -105,17 +105,26 @@ GREPPATTERN is the pattern used by grep." ;; We have grep-compute-defaults. Let's use it. (grep-compute-defaults) (let* ((grep-expand-keywords semantic-symref-grep-expand-keywords) - (cmd (grep-expand-template grep-find-template - greppattern - filepattern - rootdir))) + (cmd (grep-expand-template + (if (memq system-type '(windows-nt ms-dos)) + ;; grep-find uses '--color=always' on MS-Windows + ;; because it wants the colorized output, to show + ;; it to the user. By contrast, here we don't show + ;; the output, and the SGR escapes get in the way + ;; of parsing the output. + (replace-regexp-in-string "--color=always" "" + grep-find-template t t) + grep-find-template) + greppattern + filepattern + rootdir))) ;; For some reason, my default has no <D> in it. (when (string-match "find \\(\\.\\)" cmd) (setq cmd (replace-match rootdir t t cmd 1))) ;;(message "New command: %s" cmd) cmd)) -(defcustom semantic-symref-grep-shell "sh" +(defcustom semantic-symref-grep-shell shell-file-name "The shell command to use for executing find/grep. This shell should support pipe redirect syntax." :group 'semantic @@ -140,7 +149,8 @@ This shell should support pipe redirect syntax." (greppat (cond ((eq (oref tool :searchtype) 'regexp) (oref tool searchfor)) (t - (concat "'\\<" (oref tool searchfor) "\\>'")))) + (shell-quote-argument + (concat "\\<" (oref tool searchfor) "\\>"))))) ;; Misc (b (get-buffer-create "*Semantic SymRef*")) (ans nil) @@ -158,10 +168,12 @@ This shell should support pipe redirect syntax." (let ((cmd (concat "find " default-directory " -type f " filepattern " -print0 " "| xargs -0 grep -H " grepflags "-e " greppat))) ;;(message "Old command: %s" cmd) - (call-process semantic-symref-grep-shell nil b nil "-c" cmd) + (call-process semantic-symref-grep-shell nil b nil + shell-command-switch cmd) ) (let ((cmd (semantic-symref-grep-use-template rootdir filepattern grepflags greppat))) - (call-process semantic-symref-grep-shell nil b nil "-c" cmd)) + (call-process semantic-symref-grep-shell nil b nil + shell-command-switch cmd)) )) (setq ans (semantic-symref-parse-tool-output tool b)) ;; Return the answer diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el index c22a6a3b7fb..655b000ccdd 100644 --- a/lisp/cedet/semantic/symref/idutils.el +++ b/lisp/cedet/semantic/symref/idutils.el @@ -60,7 +60,7 @@ Moves cursor to end of the match." (when (re-search-forward "^\\([^ ]+\\) " nil t) (match-string 1))) (t - (when (re-search-forward "^\\([^ :]+\\):+\\([0-9]+\\):" nil t) + (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t) (cons (string-to-number (match-string 2)) (expand-file-name (match-string 1) default-directory)) )))) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index a7045ad8f22..7269b83b619 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -157,6 +157,7 @@ is a string giving details of the error." (setq re (format (if cflag "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" "^[ \t]*(\\(fset[ \t]+'\\|\ +cl-def\\(?:generic\\|method\\)\\|\ def\\(?:un\\|subst\\|foo\\|method\\|class\\|\ ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\ \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\ @@ -200,8 +201,8 @@ ine-overloadable-function\\)\\)\ type) 'obsolete) ;; Can't easily check arguments in these cases. - ((string-match "\\`\\(def\\(alias\\|\ -method\\|class\\)\\|fset\\)\\>" type) + ((string-match "\\`\\(def\\(alias\\|class\\)\\|\ +fset\\|\\(?:cl-\\)?defmethod\\)\\>" type) t) ((looking-at "\\((\\|nil\\)") (byte-compile-arglist-signature diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index ce5c7863c3c..9d32ba241de 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -731,7 +731,8 @@ Complete list of commands: (buffer-substring (line-beginning-position 0) (line-end-position 0))))) -(declare-function help-xref-interned "help-mode" (symbol)) +(declare-function help-xref-interned "help-mode" + (symbol &optional buffer frame)) (defun debug-help-follow (&optional pos) "Follow cross-reference at POS, defaulting to point. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 92d7234bc73..bf3f44206c4 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -730,7 +730,7 @@ Argument FN is the function calling this verifier." (cl-check-type slot symbol) (cl-check-type obj (or eieio-object class)) (let* ((class (cond ((symbolp obj) - (error "eieio-oref called on a class!") + (error "eieio-oref called on a class: %s" obj) (let ((c (eieio--class-v obj))) (if (eieio--class-p c) (eieio-class-un-autoload obj)) c)) diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 26fc452f7b1..31d0b85c55a 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -223,6 +223,7 @@ Optional argument IGNORE is an extraneous parameter." ;; Loop over all the slots, creating child widgets. (dotimes (i (length slots)) (let* ((slot (aref slots i)) + (sname (eieio-slot-descriptor-name slot)) (props (cl--slot-descriptor-props slot))) ;; Output this slot if it has a customize flag associated with it. (when (and (alist-get :custom props) @@ -261,13 +262,13 @@ Optional argument IGNORE is an extraneous parameter." (or (eieio--class-slot-initarg (eieio--object-class obj) - (car slots)) - (car slots))))) + sname) + sname)))) (capitalize (if (string-match "^:" s) (substring s (match-end 0)) s))))) - :value (slot-value obj (car slots)) + :value (slot-value obj sname) :doc (or (alist-get :documentation props) "Slot not Documented.") :eieio-custom-visibility 'visible @@ -297,6 +298,13 @@ Optional argument IGNORE is an extraneous parameter." (let* ((slot (aref slots i)) (props (cl--slot-descriptor-props slot)) (cust (alist-get :custom props))) + ;; + ;; Shouldn't I be incremented unconditionally? Or + ;; better shouldn't we simply mapc on the slots vector + ;; avoiding use of this integer variable? PLN Sat May + ;; 2 07:35:45 2015 + ;; + (setq i (+ i 1)) (if (and cust (or eieio-custom-ignore-eieio-co (not master-group) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c2c0f34d1ae..7968ecde127 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -888,14 +888,12 @@ untar into a directory named DIR; otherwise, signal an error." (defvar generated-autoload-file) (defvar version-control) -(defvar package--silence nil) - (defun package-generate-autoloads (name pkg-dir) (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) ;; Silence `autoload-generate-file-autoloads'. - (noninteractive package--silence) + (noninteractive inhibit-message) (backup-inhibited t) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) @@ -915,10 +913,13 @@ untar into a directory named DIR; otherwise, signal an error." ) ;;;; Compilation +(defvar warning-minimum-level) (defun package--compile (pkg-desc) "Byte-compile installed package PKG-DESC." - (package-activate-1 pkg-desc) - (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)) + (let ((warning-minimum-level :error) + (save-silently inhibit-message)) + (package-activate-1 pkg-desc) + (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) ;;;; Inferring package from current buffer (defun package-read-from-string (str) @@ -1078,7 +1079,7 @@ The return result is a `package-desc'." (declare-function epg-verify-string "epg" (context signature &optional signed-text)) (declare-function epg-context-result-for "epg" (context name)) -(declare-function epg-signature-status "epg" (signature)) +(declare-function epg-signature-status "epg" (signature) t) (declare-function epg-signature-to-string "epg" (signature)) (defun package--display-verify-error (context sig-file) @@ -1377,13 +1378,6 @@ it to the file." (declare-function epg-configuration "epg-config" ()) (declare-function epg-import-keys-from-file "epg" (context keys)) -(defun package--message (format &rest args) - "Like `message', except sometimes don't print to minibuffer. -If the variable `package--silence' is non-nil, the message is not -displayed on the echo area." - (let ((inhibit-message package--silence)) - (apply #'message format args))) - ;;;###autoload (defun package-import-keyring (&optional file) "Import keys from FILE." @@ -1394,9 +1388,9 @@ displayed on the echo area." (with-file-modes 448 (make-directory homedir t)) (setf (epg-context-home-directory context) homedir) - (package--message "Importing %s..." (file-name-nondirectory file)) + (message "Importing %s..." (file-name-nondirectory file)) (epg-import-keys-from-file context file) - (package--message "Importing %s...done" (file-name-nondirectory file)))) + (message "Importing %s...done" (file-name-nondirectory file)))) (defvar package--post-download-archives-hook nil "Hook run after the archive contents are downloaded. @@ -1488,14 +1482,14 @@ downloads in the background." (make-directory package-user-dir t)) (let ((default-keyring (expand-file-name "package-keyring.gpg" data-directory)) - (package--silence async)) + (inhibit-message async)) (when (and package-check-signature (file-exists-p default-keyring)) (condition-case-unless-debug error (progn (epg-check-configuration (epg-configuration)) (package-import-keyring default-keyring)) - (error (message "Cannot import default keyring: %S" (cdr error))))) - (package--download-and-read-archives async))) + (error (message "Cannot import default keyring: %S" (cdr error)))))) + (package--download-and-read-archives async)) ;;; Dependency Management @@ -1537,7 +1531,7 @@ SEEN is used internally to detect infinite recursion." ;; we re-add it (along with its dependencies) at an earlier place ;; below (bug#16994). (if (memq already seen) ;Avoid inf-loop on dependency cycles. - (package--message "Dependency cycle going through %S" + (message "Dependency cycle going through %S" (package-desc-full-name already)) (setq packages (delq already packages)) (setq already nil)) @@ -1603,7 +1597,7 @@ Used to populate `package-selected-packages'." (defun package--save-selected-packages (value) "Set and save `package-selected-packages' to VALUE." - (let ((save-silently package--silence)) + (let ((save-silently inhibit-message)) (customize-save-variable 'package-selected-packages (setq package-selected-packages value)))) @@ -1724,7 +1718,8 @@ operation is done." package-unsigned-archives)) ;; If we don't care about the signature, unpack and we're ;; done. - (progn (let ((save-silently async)) + (progn (let ((save-silently async) + (inhibit-message async)) (package-unpack pkg-desc)) (funcall callback)) ;; If we care, check it and *then* write the file. @@ -1740,7 +1735,8 @@ operation is done." (package-desc-name pkg-desc))) ;; Signature checked, unpack now. (with-temp-buffer (insert content) - (let ((save-silently async)) + (let ((save-silently async) + (inhibit-message async)) (package-unpack pkg-desc))) ;; Here the package has been installed successfully, mark it as ;; signed if appropriate. @@ -1886,7 +1882,8 @@ to install it but still mark it as selected." (package-desc-reqs pkg))) (package-compute-transaction () (list (list pkg)))))) (package-download-transaction transaction async callback) - (package--message "`%s' is already installed" (package-desc-full-name pkg)))) + (message "`%s' is already installed" (package-desc-full-name pkg)) + (funcall callback))) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. @@ -2028,7 +2025,7 @@ If NOSAVE is non-nil, the package is not removed from (delete pkg-desc pkgs) (unless (cdr pkgs) (setq package-alist (delq pkgs package-alist)))) - (package--message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))) + (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))) ;;;###autoload (defun package-reinstall (pkg) @@ -2908,19 +2905,19 @@ asynchronously." (package-install pkg dont-mark async (lambda () (package-menu--perform-transaction rest delete-list async)))) - ;; Once there are no more packages to install, proceed to - ;; deletion. - (let ((package--silence async)) + (let ((inhibit-message async)) + ;; Once there are no more packages to install, proceed to + ;; deletion. (dolist (elt (package--sort-by-dependence delete-list)) (condition-case-unless-debug err (package-delete elt) - (error (message (cadr err))))) - (when package-selected-packages - (when-let ((removable (package--removable-packages))) - (package--message "These %d packages are no longer needed, type `M-x package-autoremove' to remove them (%s)" - (length removable) - (mapconcat #'symbol-name removable ", "))))) + (error (message (cadr err)))))) (message "Transaction done") + (when package-selected-packages + (when-let ((removable (package--removable-packages))) + (message "These %d packages are no longer needed, type `M-x package-autoremove' to remove them (%s)" + (length removable) + (mapconcat #'symbol-name removable ", ")))) (package-menu--post-refresh))) (defun package-menu-execute (&optional noquery) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 978c3f0dd30..5a81bb20e57 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -91,6 +91,10 @@ (def-edebug-spec pcase-MACRO pcase--edebug-match-macro) +;; Only called from edebug. +(declare-function get-edebug-spec "edebug" (symbol)) +(declare-function edebug-match "edebug" (cursor specs)) + (defun pcase--edebug-match-macro (cursor) (let (specs) (mapatoms @@ -158,12 +162,18 @@ Currently, the following patterns are provided this way:" ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2) expansion)))) +(declare-function help-fns--signature "help-fns" + (function doc real-def real-function)) + ;; FIXME: Obviously, this will collide with nadvice's use of ;; function-documentation if we happen to advise `pcase'. (put 'pcase 'function-documentation '(pcase--make-docstring)) (defun pcase--make-docstring () (let* ((main (documentation (symbol-function 'pcase) 'raw)) (ud (help-split-fundoc main 'pcase))) + ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works, + ;; where cl-lib is anything using pcase-defmacro. + (require 'help-fns) (with-temp-buffer (insert (or (cdr ud) main)) (mapatoms diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 39389454adf..f1633ce8cd7 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -388,6 +388,7 @@ If no element is found, return nil." (defalias 'seq-do #'mapc) (defalias 'seq-each #'seq-do) (defalias 'seq-map #'mapcar) +(defalias 'seq-p #'sequencep) (unless (fboundp 'elisp--font-lock-flush-elisp-buffers) ;; In Emacsā„25, (via elisp--font-lock-flush-elisp-buffers and a few others) diff --git a/lisp/files.el b/lisp/files.el index 045eeaf154c..ef6ac7b8c92 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -654,10 +654,14 @@ the value of `default-directory'." 'file-directory-p)) -(defun pwd () - "Show the current default directory." - (interactive nil) - (message "Directory %s" default-directory)) +(defun pwd (&optional insert) + "Show the current default directory. +With prefix argument INSERT, insert the current default directory +at point instead." + (interactive "P") + (if insert + (insert default-directory) + (message "Directory %s" default-directory))) (defvar cd-path nil "Value of the CDPATH environment variable, as a list. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 96b290e34f4..b1455131114 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1350,7 +1350,7 @@ delimit the region to fontify." deactivate-mark) ;; Make sure we have the right `font-lock-keywords' etc. (if (not font-lock-mode) (font-lock-set-defaults)) - (save-excursion + (save-mark-and-excursion (save-match-data (condition-case error-data (if (or arg (not font-lock-mark-block-function)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 14f9adca85d..989a4247800 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -7027,8 +7027,7 @@ If given a prefix, show the hidden text instead." (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) -(eval-when-compile - (autoload 'nneething-get-file-name "nneething")) +(declare-function nneething-get-file-name "nneething" (id)) (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index b1b3af9658e..d4d3dba2417 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -226,9 +226,6 @@ that was fetched." `(lambda (arg) (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next))) -(eval-when-compile - (autoload 'gnus-html-prefetch-images "gnus-html")) - (defun gnus-async-article-callback (arg group article mark summary next) "Function called when an async article is done being fetched." (save-excursion diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el index 3c0025f0df2..c9ccc3ec69d 100644 --- a/lisp/gnus/gnus-sync.el +++ b/lisp/gnus/gnus-sync.el @@ -90,10 +90,7 @@ (require 'gnus-util) (defvar gnus-topic-alist) ;; gnus-group.el -(eval-when-compile - (autoload 'gnus-group-topic "gnus-topic") - (autoload 'gnus-topic-create-topic "gnus-topic" nil t) - (autoload 'gnus-topic-enter-dribble "gnus-topic")) +(autoload 'gnus-group-topic "gnus-topic") (defgroup gnus-sync nil "The Gnus synchronization facility." @@ -605,6 +602,10 @@ unwanted groups via the LeSync URL." loc name gnus-sync-lesync-name (or sources ""))) nil))) +(declare-function gnus-topic-create-topic "gnus-topic" + (topic parent &optional previous full-topic)) +(declare-function gnus-topic-enter-dribble "gnus-topic" ()) + (defun gnus-sync-lesync-install-group-entry (name) (let* ((master (assoc name gnus-newsrc-alist)) (old-topic-name (gnus-group-topic name)) diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el index d88e159900b..9c86c4ac4f3 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -23,9 +23,8 @@ ;;; Code: (require 'mm-decode) -(eval-when-compile - (autoload 'gnus-recursive-directory-files "gnus-util") - (autoload 'mailcap-extension-to-mime "mailcap")) +(autoload 'gnus-recursive-directory-files "gnus-util") +(autoload 'mailcap-extension-to-mime "mailcap") (defvar mm-archive-decoders '(("application/ms-tnef" t "tnef" "-f" "-" "-C") diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 0b7590114c4..ab9145f8b1c 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1058,11 +1058,10 @@ This affects whether coding conversion should be attempted generally." (length (memq (coding-system-base b) priorities))) t)))) -(eval-when-compile - (autoload 'latin-unity-massage-name "latin-unity") - (autoload 'latin-unity-maybe-remap "latin-unity") - (autoload 'latin-unity-representations-feasible-region "latin-unity") - (autoload 'latin-unity-representations-present-region "latin-unity")) +(declare-function latin-unity-massage-name "ext:latin-unity") +(declare-function latin-unity-maybe-remap "ext:latin-unity") +(declare-function latin-unity-representations-feasible-region "ext:latin-unity") +(declare-function latin-unity-representations-present-region "ext:latin-unity") (defvar latin-unity-coding-systems) (defvar latin-unity-ucs-list) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index a3d6e74fbcb..edc2d39cd0f 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -629,6 +629,8 @@ If MODE is not set, try to find mode automatically." (replace-match "\n")) t) +(autoload 'epg-decrypt-string "epg") + (defun mm-view-pkcs7-decrypt (handle &optional from) (insert-buffer-substring (mm-handle-buffer handle)) (goto-char (point-min)) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 58d3b4680b9..3f0809edbe8 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -317,24 +317,25 @@ Whether the passphrase is cached at all is controlled by (defvar inhibit-redisplay) (defvar password-cache-expiry) -(eval-when-compile - (autoload 'epg-make-context "epg") - (autoload 'epg-context-set-armor "epg") - (autoload 'epg-context-set-signers "epg") - (autoload 'epg-context-result-for "epg") - (autoload 'epg-new-signature-digest-algorithm "epg") - (autoload 'epg-verify-result-to-string "epg") - (autoload 'epg-list-keys "epg") - (autoload 'epg-decrypt-string "epg") - (autoload 'epg-verify-string "epg") - (autoload 'epg-sign-string "epg") - (autoload 'epg-encrypt-string "epg") - (autoload 'epg-passphrase-callback-function "epg") - (autoload 'epg-context-set-passphrase-callback "epg") - (autoload 'epg-sub-key-fingerprint "epg") - (autoload 'epg-configuration "epg-config") - (autoload 'epg-expand-group "epg-config") - (autoload 'epa-select-keys "epa")) +(autoload 'epg-make-context "epg") +(autoload 'epg-passphrase-callback-function "epg") +(declare-function epg-context-set-signers "epg" (context signers)) +(declare-function epg-context-result-for "epg" (context name)) +(declare-function epg-new-signature-digest-algorithm "epg" (cl-x) t) +(declare-function epg-verify-result-to-string "epg" (verify-result)) +(declare-function epg-list-keys "epg" (context &optional name mode)) +(declare-function epg-verify-string "epg" + (context signature &optional signed-text)) +(declare-function epg-sign-string "epg" (context plain &optional mode)) +(declare-function epg-encrypt-string "epg" + (context plain recipients &optional sign always-trust)) +(declare-function epg-context-set-passphrase-callback "epg" + (context passphrase-callback)) +(declare-function epg-sub-key-fingerprint "epg" (cl-x) t) +(declare-function epg-configuration "epg-config" ()) +(declare-function epg-expand-group "epg-config" (config group)) +(declare-function epa-select-keys "epa" + (context prompt &optional names secret)) (defvar mml-smime-epg-secret-key-id-list nil) @@ -359,9 +360,9 @@ Whether the passphrase is cached at all is controlled by (cons key-id mml-smime-epg-secret-key-id-list)) (copy-sequence passphrase))))) -(declare-function epg-key-sub-key-list "ext:epg" (key)) -(declare-function epg-sub-key-capability "ext:epg" (sub-key)) -(declare-function epg-sub-key-validity "ext:epg" (sub-key)) +(declare-function epg-key-sub-key-list "epg" (key) t) +(declare-function epg-sub-key-capability "epg" (sub-key) t) +(declare-function epg-sub-key-validity "epg" (sub-key) t) (defun mml-smime-epg-find-usable-key (keys usage) (catch 'found diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 08ca7c7e06b..15ccc4725d7 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -281,16 +281,6 @@ is `(valuefunc member)'." (require 'gnus-sum) -(eval-when-compile - (autoload 'nnimap-buffer "nnimap") - (autoload 'nnimap-command "nnimap") - (autoload 'nnimap-change-group "nnimap") - (autoload 'nnimap-make-thread-query "nnimap") - (autoload 'gnus-registry-action "gnus-registry") - (autoload 'gnus-registry-get-id-key "gnus-registry") - (autoload 'gnus-group-topic-name "gnus-topic")) - - (nnoo-declare nnir) (nnoo-define-basics nnir) @@ -586,6 +576,8 @@ Add an entry here when adding a new search engine.") ;; Gnus glue. +(declare-function gnus-group-topic-name "gnus-topic" ()) + (defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs) "Create an nnir group. Prompt for a search query and determine the groups to search as follows: if called from the *Server* @@ -948,6 +940,10 @@ ready to be added to the list of search results." ;;; Search Engine Interfaces: +(autoload 'nnimap-change-group "nnimap") +(declare-function nnimap-buffer "nnimap" ()) +(declare-function nnimap-command "nnimap" (&rest args)) + ;; imap interface (defun nnir-run-imap (query srv &optional groups) "Run a search against an IMAP back-end server. @@ -1774,6 +1770,9 @@ environment unless `not-global' is non-nil." (let ((backend (car (gnus-server-to-method server)))) (nnoo-current-server-p (or backend 'nnir) server))) +(autoload 'nnimap-make-thread-query "nnimap") +(declare-function gnus-registry-get-id-key "gnus-registry" (id key)) + (defun nnir-search-thread (header) "Make an nnir group based on the thread containing the article header. The current server will be searched. If the registry is @@ -1841,6 +1840,10 @@ article came from is also searched." (forward-line))))) groups)) +;; Behind gnus-registry-enabled test. +(declare-function gnus-registry-action "gnus-registry" + (action data-header from &optional to method)) + (defun nnir-registry-action (action data-header from &optional to method) "Call `gnus-registry-action' with the original article group." (gnus-registry-action diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 5c5481095e2..71bc916a927 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -36,8 +36,7 @@ (autoload 'gnus-add-buffer "gnus") (autoload 'gnus-kill-buffer "gnus") -(eval-when-compile - (autoload 'mail-send-and-exit "sendmail" nil t)) +(autoload 'mail-send-and-exit "sendmail" nil t) (defgroup nnmail nil "Reading mail with Gnus." diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 500f34139be..02ec69516c1 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2232,15 +2232,6 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." ;;{{{ spam-stat -(eval-when-compile - (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat") - (autoload 'spam-stat-buffer-change-to-spam "spam-stat") - (autoload 'spam-stat-buffer-is-non-spam "spam-stat") - (autoload 'spam-stat-buffer-is-spam "spam-stat") - (autoload 'spam-stat-load "spam-stat") - (autoload 'spam-stat-save "spam-stat") - (autoload 'spam-stat-split-fancy "spam-stat")) - (require 'spam-stat) (defun spam-check-stat () diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 5e422bf5fdb..90a540aae30 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -793,9 +793,10 @@ you type is correctly handled." keyseq))) (defun quail-insert-kbd-layout (kbd-layout) -"Insert the visual keyboard layout table according to KBD-LAYOUT. + "Insert the visual keyboard layout table according to KBD-LAYOUT. The format of KBD-LAYOUT is the same as `quail-keyboard-layout'." (let (done-list layout i ch) + (setq bidi-paragraph-direction 'left-to-right) ;; At first, convert KBD-LAYOUT to the same size vector that ;; contains translated character or string. (setq layout (string-to-vector kbd-layout) diff --git a/lisp/isearch.el b/lisp/isearch.el index c714ba0055d..dc10502309f 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -452,7 +452,7 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-\C-s" 'isearch-repeat-forward) (define-key map "\M-\C-r" 'isearch-repeat-backward) (define-key map "\177" 'isearch-delete-char) - (define-key map [backspace] 'isearch-delete-char) + (define-key map [backspace] 'undefined) ;bug#20466. (define-key map "\C-g" 'isearch-abort) ;; This assumes \e is the meta-prefix-char. diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index c1b107932c3..087ae439f3f 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -265,18 +265,22 @@ Currently there are 'threads and 'flags.") (mail-fetch-field field))))) ;;; Gnus -(eval-when-compile - (defvar gnus-article-buffer) - (autoload 'gnus-summary-toggle-header "gnus-sum") - (autoload 'gnus-buffer-exists-p "gnus-util") - (autoload 'message-field-value "message") - (autoload 'gnus-group-read-ephemeral-group "gnus-group") - (autoload 'gnus-alive-p "gnus-util")) + +;; For gnus-buffer-exists-p, although it seems that could be replaced by: +;; (and buffer (get-buffer buffer)) +(eval-when-compile (require 'gnus-util)) +(defvar gnus-article-buffer) +(declare-function gnus-group-read-ephemeral-group "gnus-group" + (group method &optional activate quit-config + request-only select-articles parameters number)) +(declare-function gnus-summary-toggle-header "gnus-sum" (&optional arg)) +(declare-function message-field-value "message" (header &optional not-all)) ;; Display function: (defun mairix-gnus-ephemeral-nndoc (folder) "Create ephemeral nndoc group for reading mbox file FOLDER in Gnus." - (unless (gnus-alive-p) + (unless (and (fboundp 'gnus-alive-p) + (gnus-alive-p)) (error "Gnus is not running")) (gnus-group-read-ephemeral-group ;; add randomness to group string to prevent Gnus from using a @@ -289,26 +293,29 @@ Currently there are 'threads and 'flags.") ;; Fetching mail header field: (defun mairix-gnus-fetch-field (field) "Get mail header FIELD for current message using Gnus." - (unless (gnus-alive-p) + (unless (and (fboundp 'gnus-alive-p) + (gnus-alive-p)) (error "Gnus is not running")) (unless (gnus-buffer-exists-p gnus-article-buffer) (error "No article buffer available")) (with-current-buffer gnus-article-buffer + ;; gnus-art requires gnus-sum and message. (gnus-summary-toggle-header 1) (message-field-value field))) ;;; VM ;;; written by Ulrich Mueller -(eval-when-compile - (autoload 'vm-quit "vm-folder") - (autoload 'vm-visit-folder "vm") - (autoload 'vm-select-folder-buffer "vm-macro") - (autoload 'vm-check-for-killed-summary "vm-misc") - (autoload 'vm-get-header-contents "vm-summary") - (autoload 'vm-check-for-killed-summary "vm-misc") - (autoload 'vm-error-if-folder-empty "vm-misc") - (autoload 'vm-select-marked-or-prefixed-messages "vm-folder")) +(declare-function vm-quit "ext:vm-folder" (&optional no-change)) +(declare-function vm-visit-folder "ext:vm-startup" + (folder &optional read-only)) +(declare-function vm-select-folder-buffer "ext:vm-macro" ()) ; defsubst +(declare-function vm-check-for-killed-summary "ext:vm-misc" ()) +(declare-function vm-error-if-folder-empty "ext:vm-misc" ()) +(declare-function vm-get-header-contents "ext:vm-summary" + (message header-name-regexp &optional clump-sep)) +(declare-function vm-select-marked-or-prefixed-messages "ext:vm-folder" + (prefix)) ;; Display function (defun mairix-vm-display (folder) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index c8db77bc689..73f24ce7bd8 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -431,7 +431,7 @@ group 4: description tag") (context (org-list-context)) (lim-up (car context)) (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") + (mapconcat #'regexp-quote org-drawers "\\|") "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) @@ -550,7 +550,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." ;; Can't use org-drawers-regexp as this function might ;; be called in buffers not in Org mode. (beg-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") + (mapconcat #'regexp-quote org-drawers "\\|") "\\):[ \t]*$"))) (when (save-excursion (and (not (looking-at beg-re)) @@ -636,12 +636,12 @@ Assume point is at an item." (text-min-ind 10000) (item-re (org-item-re)) (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") + (mapconcat #'regexp-quote org-drawers "\\|") "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (beg-cell (cons (point) (org-get-indentation))) - ind itm-lst itm-lst-2 end-lst end-lst-2 struct + itm-lst itm-lst-2 end-lst end-lst-2 struct (assoc-at-point (function ;; Return association at point. @@ -926,13 +926,13 @@ Value returned is the position of the first child of ITEM." (< ind (org-list-get-ind child-maybe struct))) child-maybe))) -(defun org-list-get-next-item (item struct prevs) +(defun org-list-get-next-item (item _struct prevs) "Return next item in same sub-list as ITEM, or nil. STRUCT is the list structure. PREVS is the alist of previous items, as returned by `org-list-prevs-alist'." (car (rassq item prevs))) -(defun org-list-get-prev-item (item struct prevs) +(defun org-list-get-prev-item (item _struct prevs) "Return previous item in same sub-list as ITEM, or nil. STRUCT is the list structure. PREVS is the alist of previous items, as returned by `org-list-prevs-alist'." @@ -964,7 +964,7 @@ items, as returned by `org-list-prevs-alist'." (push next-item after-item)) (append before-item (list item) (nreverse after-item)))) -(defun org-list-get-children (item struct parents) +(defun org-list-get-children (item _struct parents) "List all children of ITEM, or nil. STRUCT is the list structure. PARENTS is the alist of parents, as returned by `org-list-parents-alist'." @@ -982,7 +982,7 @@ STRUCT is the list structure." (defun org-list-get-bottom-point (struct) "Return point at bottom of list. STRUCT is the list structure." - (apply 'max + (apply #'max (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) (defun org-list-get-list-begin (item struct prevs) @@ -1630,8 +1630,7 @@ as returned by `org-list-prevs-alist'." ;; Pretend that bullets are uppercase and check if alphabet ;; is sufficient, taking counters into account. (while item - (let ((bul (org-list-get-bullet item struct)) - (count (org-list-get-counter item struct))) + (let ((count (org-list-get-counter item struct))) ;; Virtually determine current bullet (if (and count (string-match "[a-zA-Z]" count)) ;; Counters are not case-sensitive. @@ -1728,7 +1727,7 @@ This function modifies STRUCT." (replace-match "1" nil nil bullet)) ;; Not an ordered list: keep bullet. (t bullet))))))))) - (mapc fix-bul (mapcar 'car struct)))) + (mapc fix-bul (mapcar #'car struct)))) (defun org-list-struct-fix-ind (struct parents &optional bullet-size) "Verify and correct indentation in STRUCT. @@ -1756,7 +1755,7 @@ This function modifies STRUCT." org-list-indent-offset)) ;; If no parent, indent like top-point. (org-list-set-ind item struct top-ind)))))) - (mapc new-ind (mapcar 'car (cdr struct))))) + (mapc new-ind (mapcar #'car (cdr struct))))) (defun org-list-struct-fix-box (struct parents prevs &optional ordered) "Verify and correct checkboxes in STRUCT. @@ -1771,7 +1770,7 @@ break this rule, the function will return the blocking item. In all others cases, the return value will be nil. This function modifies STRUCT." - (let ((all-items (mapcar 'car struct)) + (let ((all-items (mapcar #'car struct)) (set-parent-box (function (lambda (item) @@ -1942,8 +1941,8 @@ Initial position of cursor is restored after the changes." ;; same amount of indentation. Each slice follow the pattern ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in ;; reverse order. - (setq all-ends (sort (append (mapcar 'car itm-shift) - (org-uniquify (mapcar 'car end-list))) + (setq all-ends (sort (append (mapcar #'car itm-shift) + (org-uniquify (mapcar #'car end-list))) '<)) (while (cdr all-ends) (let* ((up (pop all-ends)) @@ -2327,7 +2326,7 @@ in subtree, ignoring drawers." lim-up lim-down (drawer-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") + (mapconcat #'regexp-quote org-drawers "\\|") "\\):[ \t]*$")) (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string "\\|" org-deadline-string @@ -2335,7 +2334,7 @@ in subtree, ignoring drawers." "\\|" org-clock-string "\\)" " *[[<]\\([^]>]+\\)[]>]")) (orderedp (org-entry-get nil "ORDERED")) - (bounds + (_bounds ;; In a region, start at first item in region. (cond ((org-region-active-p) @@ -2391,7 +2390,7 @@ in subtree, ignoring drawers." (bottom (copy-marker (org-list-get-bottom-point struct))) (items-to-toggle (org-remove-if (lambda (e) (or (< e lim-up) (> e lim-down))) - (mapcar 'car struct)))) + (mapcar #'car struct)))) (mapc (lambda (e) (org-list-set-checkbox e struct ;; If there is no box at item, leave as-is @@ -2473,7 +2472,7 @@ With optional prefix argument ALL, do this for the whole buffer." (items (cond ((and recursivep item) (org-list-get-subtree item s)) - (recursivep (mapcar 'car s)) + (recursivep (mapcar #'car s)) (item (org-list-get-children item s par)) (t (org-list-get-all-items (org-list-get-top-point s) s pre)))) @@ -2486,7 +2485,7 @@ With optional prefix argument ALL, do this for the whole buffer." structs) (cons c-on c-all))))) (backup-end 1) - cookies-list structs-bak box-num) + cookies-list structs-bak) (goto-char (car bounds)) ;; 1. Build an alist for each cookie found within BOUNDS. The ;; key will be position at beginning of cookie and values @@ -2749,6 +2748,7 @@ If a region is active, all items inside will be moved." (t (error "Not at an item"))))) (defvar org-tab-ind-state) +(defvar org-adapt-indentation) (defun org-cycle-item-indentation () "Cycle levels of indentation of an empty item. The first run indents the item, if applicable. Subsequent runs @@ -2940,13 +2940,13 @@ will be parsed as: \(3 \"last item\"\)\) Point is left at list end." + (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'. (let* ((struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) (parents (org-list-parents-alist struct)) (top (org-list-get-top-point struct)) (bottom (org-list-get-bottom-point struct)) out - parse-item ; for byte-compiler (get-text (function ;; Return text between BEG and END, trimmed, with @@ -3072,7 +3072,7 @@ for this list." (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) (plain-list (buffer-substring-no-properties top-point bottom-point)) - beg txt) + beg) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform plain-list))) @@ -3082,7 +3082,8 @@ for this list." (unless (re-search-forward (concat "BEGIN RECEIVE ORGLST +" name - "\\([ \t]\\|$\\)") nil t) + "\\([ \t]\\|$\\)") + nil t) (error "Don't know where to insert translated list")) (goto-char (match-beginning 0)) (beginning-of-line 2) @@ -3230,7 +3231,7 @@ items." items (or (eval isep) "")))))))) (concat (funcall export-sublist list 0) "\n"))) -(defun org-list-to-latex (list &optional params) +(defun org-list-to-latex (list &optional _params) "Convert LIST into a LaTeX list. LIST is as string representing the list to transform, as Org syntax. Return converted list as a string." @@ -3244,7 +3245,7 @@ syntax. Return converted list as a string." (require 'ox-html) (org-export-string-as list 'html t)) -(defun org-list-to-texinfo (list &optional params) +(defun org-list-to-texinfo (list &optional _params) "Convert LIST into a Texinfo list. LIST is as string representing the list to transform, as Org syntax. Return converted list as a string." @@ -3255,14 +3256,15 @@ syntax. Return converted list as a string." "Convert LIST into an Org subtree. LIST is as returned by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." + (defvar get-stars) (defvar org--blankp) (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) (level (org-reduced-level (or (org-current-level) 0))) - (blankp (or (eq rule t) + (org--blankp (or (eq rule t) (and (eq rule 'auto) (save-excursion (outline-previous-heading) (org-previous-line-empty-p))))) - (get-stars + (get-stars ;FIXME: Can't rename without renaming it in org.el as well! (function ;; Return the string for the heading, depending on depth D ;; of current sub-list. @@ -3277,12 +3279,12 @@ with overruling parameters for `org-list-to-generic'." list (org-combine-plists '(:splice t - :dtstart " " :dtend " " - :istart (funcall get-stars depth) - :icount (funcall get-stars depth) - :isep (if blankp "\n\n" "\n") - :csep (if blankp "\n\n" "\n") - :cbon "DONE" :cboff "TODO" :cbtrans "TODO") + :dtstart " " :dtend " " + :istart (funcall get-stars depth) + :icount (funcall get-stars depth) + :isep (if org--blankp "\n\n" "\n") + :csep (if org--blankp "\n\n" "\n") + :cbon "DONE" :cboff "TODO" :cbtrans "TODO") params)))) (provide 'org-list) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 23c30178080..db09909f404 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -33,7 +33,7 @@ (eval-and-compile (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly) + (defmacro declare-function (fn file &optional _arglist _fileonly) `(autoload ',fn ,file))) (if (>= emacs-major-version 23) @@ -48,13 +48,14 @@ (declare-function org-string-match-p "org-compat" (&rest args)) (defmacro org-with-gensyms (symbols &rest body) + (declare (debug (sexp body)) (indent 1)) `(let ,(mapcar (lambda (s) - `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols) + `(,s (make-symbol (concat "--" (symbol-name ',s))))) + symbols) ,@body)) -(def-edebug-spec org-with-gensyms (sexp body)) -(put 'org-with-gensyms 'lisp-indent-function 1) (defmacro org-called-interactively-p (&optional kind) + (declare (debug (&optional ("quote" symbolp)))) ;Why not just `t'? (if (featurep 'xemacs) `(interactive-p) (if (or (> emacs-major-version 23) @@ -63,12 +64,11 @@ ;; defined with no argument in <=23.1 `(with-no-warnings (called-interactively-p ,kind)) `(interactive-p)))) -(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." + (declare (debug (symbolp))) `(and (boundp (quote ,var)) ,var)) -(def-edebug-spec org-bound-and-true-p (symbolp)) (defun org-string-nw-p (s) "Is S a string with a non-white character?" @@ -97,10 +97,11 @@ Otherwise return nil." (defmacro org-re (s) "Replace posix classes in regular expression." + (declare (debug (form))) (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s)) -(def-edebug-spec org-re (form)) (defmacro org-preserve-lc (&rest body) + (declare (debug (body))) (org-with-gensyms (line col) `(let ((,line (org-current-line)) (,col (current-column))) @@ -108,12 +109,12 @@ Otherwise return nil." (progn ,@body) (org-goto-line ,line) (org-move-to-column ,col))))) -(def-edebug-spec org-preserve-lc (body)) ;; Use `org-with-silent-modifications' to ignore cosmetic changes and ;; `org-unmodified' to ignore real text modifications (defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." + (declare (debug (body))) (org-with-gensyms (was-modified) `(let ((,was-modified (buffer-modified-p))) (unwind-protect @@ -121,9 +122,9 @@ Otherwise return nil." (inhibit-modification-hooks t)) ,@body) (set-buffer-modified-p ,was-modified))))) -(def-edebug-spec org-unmodified (body)) (defmacro org-without-partial-completion (&rest body) + (declare (debug (body))) `(if (and (boundp 'partial-completion-mode) partial-completion-mode (fboundp 'partial-completion-mode)) @@ -133,7 +134,6 @@ Otherwise return nil." ,@body) (partial-completion-mode 1)) ,@body)) -(def-edebug-spec org-without-partial-completion (body)) ;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 (defmacro org-maybe-intangible (props) @@ -150,6 +150,7 @@ We use a macro so that the test can happen at compilation time." (defmacro org-with-point-at (pom &rest body) "Move to buffer and point of point-or-marker POM for the duration of BODY." + (declare (debug (form body)) (indent 1)) (org-with-gensyms (mpom) `(let ((,mpom ,pom)) (save-excursion @@ -157,15 +158,14 @@ We use a macro so that the test can happen at compilation time." (org-with-wide-buffer (goto-char (or ,mpom (point))) ,@body))))) -(def-edebug-spec org-with-point-at (form body)) -(put 'org-with-point-at 'lisp-indent-function 1) (defmacro org-no-warnings (&rest body) + (declare (debug (body))) (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) -(def-edebug-spec org-no-warnings (body)) (defmacro org-with-remote-undo (buffer &rest body) "Execute BODY while recording undo information in two buffers." + (declare (debug (form body)) (indent 1)) (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) `(let ((,cline (org-current-line)) (,cmd this-command) @@ -187,13 +187,11 @@ We use a macro so that the test can happen at compilation time." ;; remember which buffer to undo (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2) org-agenda-undo-list)))))) -(def-edebug-spec org-with-remote-undo (form body)) -(put 'org-with-remote-undo 'lisp-indent-function 1) (defmacro org-no-read-only (&rest body) "Inhibit read-only for BODY." + (declare (debug (body))) `(let ((inhibit-read-only t)) ,@body)) -(def-edebug-spec org-no-read-only (body)) (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t rear-nonsticky t mouse-map t fontified t @@ -313,7 +311,7 @@ This means that the buffer may change while running BODY, but it also means that the buffer should stay alive during the operation, because otherwise all these markers will point nowhere." - (declare (indent 1)) + (declare (debug (form body)) (indent 1)) (org-with-gensyms (data rtn) `(let ((,data (org-outline-overlay-data ,use-markers)) ,rtn) @@ -327,24 +325,28 @@ point nowhere." (and (markerp (cdr c)) (move-marker (cdr c) nil))) ,data))) ,rtn))) -(def-edebug-spec org-save-outline-visibility (form body)) (defmacro org-with-wide-buffer (&rest body) "Execute body while temporarily widening the buffer." + (declare (debug (body))) `(save-excursion (save-restriction (widen) ,@body))) -(def-edebug-spec org-with-wide-buffer (body)) (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." - `(let* ((org-called-with-limited-levels t) - (org-outline-regexp (org-get-limited-outline-regexp)) - (outline-regexp org-outline-regexp) - (org-outline-regexp-bol (concat "^" org-outline-regexp))) - ,@body)) -(def-edebug-spec org-with-limited-levels (body)) + (declare (debug (body))) + `(progn + (defvar org-called-with-limited-levels) + (defvar org-outline-regexp) + (defvar outline-regexp) + (defvar org-outline-regexp-bol) + (let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) + (outline-regexp org-outline-regexp) + (org-outline-regexp-bol (concat "^" org-outline-regexp))) + ,@body))) (defvar org-outline-regexp) ; defined in org.el (defvar org-odd-levels-only) ; defined in org.el @@ -365,9 +367,8 @@ The number of levels is controlled by `org-inlinetask-min-level'" (format-time-string string (seconds-to-time seconds)))) (defmacro org-eval-in-environment (environment form) + (declare (debug (form form)) (indent 1)) `(eval (list 'let ,environment ',form))) -(def-edebug-spec org-eval-in-environment (form form)) -(put 'org-eval-in-environment 'lisp-indent-function 1) (defun org-make-parameter-alist (flat) "Return alist based on FLAT. diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index ef55015a999..2c68c40d893 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -248,8 +248,8 @@ This value is simply the outline heading level of the current line." ;;;; outline layout (defsubst gametree-show-children-and-entry () - (show-children) - (show-entry)) + (outline-show-children) + (outline-show-entry)) (defun gametree-entry-shown-p () (save-excursion @@ -307,7 +307,7 @@ This value is simply the outline heading level of the current line." (if (not first-time) (outline-next-visible-heading 1)) (setq first-time nil) - (hide-subtree) + (outline-hide-subtree) (if (nth 0 layout) (funcall (nth 0 layout))) (if (not (and (nth 1 layout) (listp (nth 1 layout)))) @@ -393,7 +393,7 @@ depth AT-DEPTH or smaller is found." (outline-up-heading 1))) (beginning-of-line 1) (let ((parent-depth (gametree-current-branch-depth))) - (show-entry) + (outline-show-entry) (condition-case nil (outline-next-visible-heading 1) (error @@ -601,11 +601,11 @@ shogi, etc.) players, it is a slightly modified version of Outline mode. (defun gametree-mouse-show-subtree (event) (interactive "e") (mouse-set-point event) - (show-subtree)) + (outline-show-subtree)) (defun gametree-mouse-hide-subtree (event) (interactive "e") (mouse-set-point event) - (hide-subtree)) + (outline-hide-subtree)) (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] 'gametree-mouse-break-line-here) (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 357625d10cf..19d0473c42d 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -364,8 +364,8 @@ Optional arg DISPLAY non-nil means show messages in the echo area." ;; Find and delete the mark of the start of the expansion. ;; Look for `# nn "file.c"' lines and delete them. (goto-char (point-min)) - (search-forward startmarker) - (delete-region 1 (point))) + (if (search-forward startmarker nil t) + (delete-region 1 (point)))) (while (re-search-forward (concat "^# [0-9]+ \"" (regexp-quote filename) "\"") nil t) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index f2890686e79..dac807e4334 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -475,11 +475,12 @@ It can be quoted, or be inside a quoted form." (point))) (scan-error pos)))) ;; t if in function position. - (funpos (eq (char-before beg) ?\())) + (funpos (eq (char-before beg) ?\()) + (quoted (elisp--form-quoted-p beg))) (when (and end (or (not (nth 8 (syntax-ppss))) (eq (char-before beg) ?`))) (let ((table-etc - (if (not funpos) + (if (or (not funpos) quoted) ;; FIXME: We could look at the first element of the list and ;; use it to provide a more specific completion table in some ;; cases. E.g. filter out keywords that are not understood by @@ -491,7 +492,7 @@ It can be quoted, or be inside a quoted form." :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string :company-location #'elisp--company-location)) - ((elisp--form-quoted-p beg) + (quoted (list nil obarray ;; Don't include all symbols (bug#16646). :predicate (lambda (sym) @@ -543,10 +544,11 @@ It can be quoted, or be inside a quoted form." (< (point) beg))))) (list t obarray :predicate (lambda (sym) (get sym 'error-conditions)))) - ((and ?\( + ((and (or ?\( `let `let*) (guard (save-excursion (goto-char (1- beg)) - (up-list -1) + (when (eq parent ?\() + (up-list -1)) (forward-symbol -1) (looking-at "\\_<let\\*?\\_>")))) (list t obarray @@ -579,6 +581,7 @@ It can be quoted, or be inside a quoted form." (declare-function xref-make-elisp-location "xref" (symbol type file)) (declare-function xref-make-bogus-location "xref" (message)) (declare-function xref-make "xref" (description location)) +(declare-function xref-collect-references "xref" (name dir)) (defun elisp-xref-find (action id) (require 'find-func) @@ -587,6 +590,8 @@ It can be quoted, or be inside a quoted form." (let ((sym (intern-soft id))) (when sym (elisp--xref-find-definitions sym)))) + (`references + (elisp--xref-find-references id)) (`apropos (elisp--xref-find-apropos id)))) @@ -599,12 +604,16 @@ It can be quoted, or be inside a quoted form." (setq sym (car fun-lib)) (cdr fun-lib)))) (`defvar (and (boundp sym) - ;; Don't show minor modes twice. - ;; TODO: If TYPE ever becomes dependent on the - ;; context, move this check outside. - (not (fboundp sym)) - (or (symbol-file sym 'defvar) - (help-C-file-name sym 'var)))) + (let ((el-file (symbol-file sym 'defvar))) + (if el-file + (and + ;; Don't show minor modes twice. + ;; TODO: If TYPE ever becomes dependent on the + ;; context, move this check outside. + (not (and (fboundp sym) + (memq sym minor-mode-list))) + el-file) + (help-C-file-name sym 'var))))) (`feature (and (featurep sym) ;; Skip when a function with the same name ;; is defined, because it's probably in the @@ -619,6 +628,12 @@ It can be quoted, or be inside a quoted form." (setq file (substring file 0 -1))) (xref-make-elisp-location sym type file)))) +(defvar elisp--xref-format + (let ((str "(%s %s)")) + (put-text-property 1 3 'face 'font-lock-keyword-face str) + (put-text-property 4 6 'face 'font-lock-function-name-face str) + str)) + (defun elisp--xref-find-definitions (symbol) (save-excursion (let (lst) @@ -630,11 +645,30 @@ It can be quoted, or be inside a quoted form." (xref-make-bogus-location (error-message-string err)))))) (when loc (push - (xref-make (format "(%s %s)" type symbol) + (xref-make (format elisp--xref-format type symbol) loc) lst)))) lst))) +(defun elisp--xref-find-references (symbol) + (let* ((dirs (sort + (mapcar + (lambda (dir) + (file-name-as-directory (expand-file-name dir))) + (cons package-user-dir load-path)) + #'string<)) + (ref dirs)) + ;; Delete subdirectories from the list. + (while (cdr ref) + (if (string-prefix-p (car ref) (cadr ref)) + (setcdr ref (cddr ref)) + (setq ref (cdr ref)))) + (cl-mapcan + (lambda (dir) + (and (file-exists-p dir) + (xref-collect-references symbol dir))) + dirs))) + (defun elisp--xref-find-apropos (regexp) (apply #'nconc (let (lst) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b4ce8b11c9c..6acafdbaba0 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2082,6 +2082,15 @@ for \\[find-tag] (which see)." (defun etags-xref-find (action id) (pcase action (`definitions (etags--xref-find-definitions id)) + (`references + (let ((dirs (if tags-table-list + (mapcar #'file-name-directory tags-table-list) + ;; If no tags files are loaded, prompt for the dir. + (list (read-directory-name "In directory: " nil nil t))))) + (cl-mapcan + (lambda (dir) + (xref-collect-references id dir)) + dirs))) (`apropos (etags--xref-find-definitions id t)))) (defun etags--xref-find-definitions (pattern &optional regexp?) @@ -2134,6 +2143,10 @@ for \\[find-tag] (which see)." (etags-goto-tag-location tag-info) (point-marker))))) +(cl-defmethod xref-location-line ((l xref-etags-location)) + (with-slots (tag-info) l + (nth 1 tag-info))) + (provide 'etags) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index fc27c268845..f11dff1d08e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -73,13 +73,17 @@ "Return a string used to group a set of locations. This is typically the filename.") +(cl-defgeneric xref-location-line (_location) + "Return the line number corresponding to the location." + nil) + ;;;; Commonly needed location classes are defined here: ;; FIXME: might be useful to have an optional "hint" i.e. a string to ;; search for in case the line number is sightly out of date. (defclass xref-file-location (xref-location) ((file :type string :initarg :file) - (line :type fixnum :initarg :line) + (line :type fixnum :initarg :line :reader xref-location-line) (column :type fixnum :initarg :column)) :documentation "A file location is a file/line/column triple. Line numbers start from 1 and columns from 0.") @@ -285,6 +289,11 @@ or when the command has been called with the prefix argument." (const :tag "auto" nil)) :version "25.1") +(defcustom xref-pulse-on-jump t + "When non-nil, momentarily highlight jump locations." + :type 'boolean + :version "25.1") + (defvar xref--marker-ring (make-ring xref-marker-ring-length) "Ring of markers to implement the marker stack.") @@ -303,7 +312,20 @@ or when the command has been called with the prefix argument." (switch-to-buffer (or (marker-buffer marker) (error "The marked buffer has been deleted"))) (goto-char (marker-position marker)) - (set-marker marker nil nil)))) + (set-marker marker nil nil) + (xref--maybe-pulse)))) + +(defun xref--maybe-pulse () + (when xref-pulse-on-jump + (let (beg end) + (save-excursion + (back-to-indentation) + (if (eolp) + (setq beg (line-beginning-position) + end (1+ (point))) + (setq beg (point) + end (line-end-position)))) + (pulse-momentary-highlight-region beg end 'next-error)))) ;; etags.el needs this (defun xref-clear-marker-stack () @@ -338,7 +360,8 @@ WINDOW controls how the buffer is displayed: (cl-ecase window ((nil) (switch-to-buffer (current-buffer))) (window (pop-to-buffer (current-buffer) t)) - (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))) + (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t)))) + (xref--maybe-pulse)) ;;; XREF buffer (part of the UI) @@ -374,6 +397,7 @@ Used for temporary buffers.") (with-selected-window (display-buffer (current-buffer) other-window) (goto-char pos) (recenter recenter-arg) + (xref--maybe-pulse) (let ((buf (current-buffer)) (win (selected-window))) (with-current-buffer xref-buf @@ -415,7 +439,9 @@ Used for temporary buffers.") (xref-show-location-at-point)) (defun xref--location-at-point () - (get-text-property (point) 'xref-location)) + (save-excursion + (back-to-indentation) + (get-text-property (point) 'xref-location))) (defvar-local xref--window nil "ACTION argument to call `display-buffer' with.") @@ -423,7 +449,6 @@ Used for temporary buffers.") (defun xref-goto-xref () "Jump to the xref on the current line and bury the xref buffer." (interactive) - (back-to-indentation) (let ((loc (or (xref--location-at-point) (user-error "No reference at point"))) (window xref--window)) @@ -509,22 +534,35 @@ meantime are preserved." XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where GROUP is a string for decoration purposes and XREF is an `xref--xref' object." - (cl-loop for ((group . xrefs) . more1) on xref-alist do - (xref--insert-propertized '(face bold) group "\n") + (require 'compile) ; For the compilation faces. + (cl-loop for ((group . xrefs) . more1) on xref-alist + for max-line-width = + (cl-loop for xref in xrefs + maximize (let ((line (xref-location-line + (oref xref :location)))) + (length (and line (format "%d" line))))) + for line-format = (and max-line-width + (format "%%%dd: " max-line-width)) + do + (xref--insert-propertized '(face compilation-info) group "\n") (cl-loop for (xref . more2) on xrefs do - (insert " ") (with-slots (description location) xref - (xref--insert-propertized - (list 'xref-location location - 'face 'font-lock-keyword-face - 'mouse-face 'highlight - 'keymap xref--button-map - 'help-echo - (concat "mouse-2: display in another window, " - "RET or mouse-1: follow reference")) - description)) - (when (or more1 more2) - (insert "\n"))))) + (let* ((line (xref-location-line location)) + (prefix + (if line + (propertize (format line-format line) + 'face 'compilation-line-number) + " "))) + (xref--insert-propertized + (list 'xref-location location + ;; 'face 'font-lock-keyword-face + 'mouse-face 'highlight + 'keymap xref--button-map + 'help-echo + (concat "mouse-2: display in another window, " + "RET or mouse-1: follow reference")) + prefix description))) + (insert "\n")))) (defun xref--analyze (xrefs) "Find common filenames in XREFS. @@ -674,6 +712,46 @@ and just use etags." (setq-local xref-identifier-completion-table-function (cdr xref-etags-mode--saved)))) +(declare-function semantic-symref-find-references-by-name "semantic/symref") +(declare-function semantic-find-file-noselect "semantic/fw") + +(defun xref-collect-references (name dir) + "Collect mentions of NAME inside DIR. +Uses the Semantic Symbol Reference API, see +`semantic-symref-find-references-by-name' for details on which +tools are used, and when." + (require 'semantic/symref) + (defvar semantic-symref-tool) + (cl-assert (directory-name-p dir)) + (let* ((default-directory dir) + (semantic-symref-tool 'detect) + (res (semantic-symref-find-references-by-name name 'subdirs)) + (hits (and res (oref res :hit-lines))) + (orig-buffers (buffer-list))) + (unwind-protect + (delq nil + (mapcar (lambda (hit) (xref--collect-reference hit name)) hits)) + (mapc #'kill-buffer + (cl-set-difference (buffer-list) orig-buffers))))) + +(defun xref--collect-reference (hit name) + (pcase-let* ((`(,line . ,file) hit) + (buf (or (find-buffer-visiting file) + (semantic-find-file-noselect file)))) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (when (re-search-forward (format "\\_<%s\\_>" + (regexp-quote name)) + (line-end-position) t) + (goto-char (match-beginning 0)) + (xref-make (buffer-substring + (line-beginning-position) + (line-end-position)) + (xref-make-file-location file line + (current-column)))))))) + (provide 'xref) diff --git a/lisp/simple.el b/lisp/simple.el index cf1912ade4f..47c9cd30c17 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4870,6 +4870,45 @@ store it in a Lisp variable. Example: (setq mark-active nil) (set-marker (mark-marker) nil))) +(defun save-mark-and-excursion--save () + (cons + (let ((mark (mark-marker))) + (and (marker-position mark) (copy-marker mark))) + mark-active)) + +(defun save-mark-and-excursion--restore (saved-mark-info) + (let ((saved-mark (car saved-mark-info)) + (omark (marker-position (mark-marker))) + (nmark nil) + (saved-mark-active (cdr saved-mark-info))) + ;; Mark marker + (if (null saved-mark) + (set-marker (mark-marker) nil) + (setf nmark (marker-position saved-mark)) + (set-marker (mark-marker) nmark) + (set-marker saved-mark nil)) + ;; Mark active + (let ((cur-mark-active mark-active)) + (setq mark-active saved-mark-active) + ;; If mark is active now, and either was not active or was at a + ;; different place, run the activate hook. + (if saved-mark-active + (when (or (not cur-mark-active) + (not (eq omark nmark))) + (run-hooks 'activate-mark-hook)) + ;; If mark has ceased to be active, run deactivate hook. + (when cur-mark-active + (run-hooks 'deactivate-mark-hook)))))) + +(defmacro save-mark-and-excursion (&rest body) + "Like `save-excursion', but also save and restore the mark state. +This macro does what `save-excursion' did before Emacs 25.1." + (let ((saved-marker-sym (make-symbol "saved-marker"))) + `(let ((,saved-marker-sym (save-mark-and-excursion--save))) + (unwind-protect + (save-excursion ,@body) + (save-mark-and-excursion--restore ,saved-marker-sym))))) + (defcustom use-empty-active-region nil "Whether \"region-aware\" commands should act on empty regions. If nil, region-aware commands treat empty regions as inactive. @@ -6992,8 +7031,9 @@ The function should return non-nil if the two tokens do not match.") (buffer-substring blinkpos (1+ blinkpos)))) ;; There is nothing to show except the char itself. (t (buffer-substring blinkpos (1+ blinkpos)))))) - (message "Matches %s" - (substring-no-properties open-paren-line-string))))))))) + (minibuffer-message + "Matches %s" + (substring-no-properties open-paren-line-string))))))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. diff --git a/lisp/term/screen.el b/lisp/term/screen.el index 3587c4f95e5..41fd916a785 100644 --- a/lisp/term/screen.el +++ b/lisp/term/screen.el @@ -1,9 +1,22 @@ ;;; screen.el --- terminal initialization for screen and tmux -*- lexical-binding: t -*- ;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc. +(require 'term/xterm) + +(defcustom xterm-screen-extra-capabilities '(modifyOtherKeys) + "Extra capabilities supported under \"screen\". +Some features of screen depend on the terminal emulator in which +it runs, which can change when the screen session is moved to another tty." + :type xterm--extra-capabilities-type + :group 'xterm) + (defun terminal-init-screen () "Terminal initialization function for screen." - ;; Treat a screen terminal similar to an xterm. - (tty-run-terminal-initialization (selected-frame) "xterm")) + ;; Treat a screen terminal similar to an xterm, but don't use + ;; xterm-extra-capabilities's `check' setting since that doesn't seem + ;; to work so well (it depends too much on the surrounding terminal + ;; emulator, which can change during the session, bug#20356). + (let ((xterm-extra-capabilities xterm-screen-extra-capabilities)) + (tty-run-terminal-initialization (selected-frame) "xterm"))) ;; screen.el ends here diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 726ecf91f85..79699c6fe43 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -29,6 +29,13 @@ :version "24.1" :group 'terminals) +(defconst xterm--extra-capabilities-type + ;; NOTE: If you add entries here, make sure to update + ;; `terminal-init-xterm' as well. + '(set (const :tag "modifyOtherKeys support" modifyOtherKeys) + (const :tag "report background" reportBackground) + (const :tag "set X selection" setSelection))) + (defcustom xterm-extra-capabilities 'check "Whether Xterm supports some additional, more modern, features. If nil, just assume that it does not. @@ -40,13 +47,8 @@ The relevant features are: reportBackground -- if supported, Xterm reports its background color setSelection -- if supported, Xterm saves yanked text to the X selection" :version "24.1" - :type '(choice (const :tag "No" nil) - (const :tag "Check" check) - ;; NOTE: If you add entries here, make sure to update - ;; `terminal-init-xterm' as well. - (set (const :tag "modifyOtherKeys support" modifyOtherKeys) - (const :tag "report background" reportBackground) - (const :tag "set X selection" setSelection)))) + :type `(choice (const :tag "Check" check) + ,xterm--extra-capabilities-type)) (defcustom xterm-max-cut-length 100000 "Maximum number of bytes to cut into xterm using the OSC 52 sequence. @@ -623,8 +625,11 @@ string bytes that can be copied is 3/4 of this value." (setq version 200)) (when (equal (match-string 1 str) "83") ;; `screen' (which returns 83;40003;0) seems to also lack support for - ;; some of these (bug#17607). - (setq version 240)) + ;; some of these (bug#17607, bug#20356). + ;; Note: this code path should normally not be used any more + ;; since term/screen.el now binds xterm-extra-capabilities + ;; to a fixed value, rather than using the dynamic checking. + (setq version 200)) ;; If version is 242 or higher, assume the xterm supports ;; reporting the background color (TODO: maybe earlier ;; versions do too...) @@ -925,6 +930,6 @@ versions of xterm." (set-terminal-parameter nil 'background-mode 'dark) t)) -(provide 'xterm) - +(provide 'xterm) ;Backward compatibility. +(provide 'term/xterm) ;;; xterm.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index bb4dd607bdd..1a997a4d183 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2224,8 +2224,10 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (lambda (_bk _files-arg ret) (vc-print-log-setup-buttons working-revision is-start-revision limit ret)) - (lambda (bk) - (vc-call-backend bk 'show-log-entry working-revision)) + ;; When it's nil, point really shouldn't move (bug#15322). + (when working-revision + (lambda (bk) + (vc-call-backend bk 'show-log-entry working-revision))) (lambda (_ignore-auto _noconfirm) (vc-print-log-internal backend files working-revision is-start-revision limit))))) @@ -2263,8 +2265,9 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (let ((inhibit-read-only t)) (funcall setup-buttons-func backend files retval) (shrink-window-if-larger-than-buffer) - (funcall goto-location-func backend) - (setq vc-sentinel-movepoint (point)) + (when goto-location-func + (funcall goto-location-func backend) + (setq vc-sentinel-movepoint (point))) (set-buffer-modified-p nil))))) (defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) @@ -2273,7 +2276,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (lambda (bk buf type-arg _files) (vc-call-backend bk type-arg buf remote-location)) (lambda (_bk _files-arg _ret) nil) - (lambda (_bk) (goto-char (point-min))) + nil ;; Don't move point. (lambda (_ignore-auto _noconfirm) (vc-incoming-outgoing-internal backend remote-location buffer-name type)))) @@ -2328,16 +2331,15 @@ When called interactively with a prefix argument, prompt for LIMIT." (list (when (> vc-log-show-limit 0) vc-log-show-limit))))) (let ((backend (vc-deduce-backend)) (default-directory default-directory) - rootdir working-revision) + rootdir) (if backend (setq rootdir (vc-call-backend backend 'root default-directory)) (setq rootdir (read-directory-name "Directory for VC root-log: ")) (setq backend (vc-responsible-backend rootdir)) (unless backend (error "Directory is not version controlled"))) - (setq working-revision (vc-working-revision rootdir) - default-directory rootdir) - (vc-print-log-internal backend (list rootdir) working-revision nil limit))) + (setq default-directory rootdir) + (vc-print-log-internal backend (list rootdir) nil nil limit))) ;;;###autoload (defun vc-log-incoming (&optional remote-location) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index b4cd67ff6b9..fad3e2f3ea6 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -538,31 +538,34 @@ cleaning up a buffer. See `whitespace-cleanup' and `whitespace-cleanup-region' for documentation. See also `whitespace-display-mappings' for documentation." - :type '(repeat :tag "Kind of Blank" - (choice :tag "Kind of Blank Face" - (const :tag "(Face) Face visualization" - face) - (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs" - trailing) - (const :tag "(Face) SPACEs and HARD SPACEs" - spaces) - (const :tag "(Face) TABs" tabs) - (const :tag "(Face) Lines" lines) - (const :tag "(Face) SPACEs before TAB" - space-before-tab) - (const :tag "(Face) NEWLINEs" newline) - (const :tag "(Face) Indentation SPACEs" - indentation) - (const :tag "(Face) Too much line indentation" - big-indent) - (const :tag "(Face) Empty Lines At BOB And/Or EOB" - empty) - (const :tag "(Face) SPACEs after TAB" - space-after-tab) - (const :tag "(Mark) SPACEs and HARD SPACEs" - space-mark) - (const :tag "(Mark) TABs" tab-mark) - (const :tag "(Mark) NEWLINEs" newline-mark))) + :type '(set :tag "Kind of Blank" + (const :tag "(Face) Face visualization" face) + (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs" + trailing) + (const :tag "(Face) TABs" tabs) + (const :tag "(Face) SPACEs and HARD SPACEs" spaces) + (const :tag "(Face) Lines" lines) + (const :tag "(Face) Lines, only overlong part" lines-tail) + (const :tag "(Face) NEWLINEs" newline) + (const :tag "(Face) Empty Lines At BOB And/Or EOB" empty) + (const :tag "(Face) Indentation SPACEs" indentation::tab) + (const :tag "(Face) Indentation TABs" + indentation::space) + (const :tag "(Face) Indentation TABs or SPACEs" indentation) + (const :tag "(Face) Too much line indentation" big-indent) + (const :tag "(Face) SPACEs after TAB: SPACEs" + space-after-tab::tab) + (const :tag "(Face) SPACEs after TAB: TABs" + space-after-tab::space) + (const :tag "(Face) SPACEs after TAB" space-after-tab) + (const :tag "(Face) SPACEs before TAB: SPACEs" + space-before-tab::tab) + (const :tag "(Face) SPACEs before TAB: TABs" + space-before-tab::space) + (const :tag "(Face) SPACEs before TAB" space-before-tab) + (const :tag "(Mark) SPACEs and HARD SPACEs" space-mark) + (const :tag "(Mark) TABs" tab-mark) + (const :tag "(Mark) NEWLINEs" newline-mark)) :group 'whitespace) (defvar whitespace-space 'whitespace-space |