diff options
Diffstat (limited to 'lisp')
54 files changed, 862 insertions, 688 deletions
diff --git a/lisp/battery.el b/lisp/battery.el index 71268e59ecd..b1834f06ff8 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -542,6 +542,9 @@ The following %-sequences are provided: (t "N/A")))))) +(declare-function dbus-get-property "dbus.el" + (bus service path interface property)) + ;;; `upowerd' interface. (defsubst battery-upower-prop (pname &optional device) (dbus-get-property diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 7b7a7208aaa..e6af0920639 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -623,7 +623,7 @@ loaded and the keystroke automatically re-typed." (unwind-protect (progn (sit-for 2) - (identity 1) ; this forces a call to QUIT; in bytecode.c. + (identity 1) ; This forces a call to maybe_quit in bytecode.c. (setq okay t)) (progn (delete-region savemax (point-max)) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index cabcfcdbd3f..caa3b45705b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -987,6 +987,8 @@ corresponding command. Within CMD, %i denotes the input file(s), and %o denotes the output file. %i path(s) are relative, while %o is absolute.") +(declare-function format-spec "format-spec.el" (format specification)) + ;;;###autoload (defun dired-do-compress-to () "Compress selected files and directories to an archive. diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 94c561cba0a..bb877dd2c97 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -247,4 +247,14 @@ LEVEL is only used internally and indicates the nesting level: tail)) (t (cons 'list heads))))) + +;; Give `,' and `,@' documentation strings which can be examined by C-h f. +(put '\, 'function-documentation + "See `\\=`' (also `pcase') for the usage of `,'.") +(put '\, 'reader-construct t) + +(put '\,@ 'function-documentation + "See `\\=`' for the usage of `,@'.") +(put '\,@ 'reader-construct t) + ;;; backquote.el ends here diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 8d141d7a646..6cc70c4c2f5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -226,7 +226,13 @@ DEFAULT-BODY, if present, is used as the body of a default method. (when (eq 'setf (car-safe name)) (require 'gv) (setq name (gv-setter (cadr name)))) - `(progn + `(prog1 + (progn + (defalias ',name + (cl-generic-define ',name ',args ',(nreverse options)) + ,(help-add-fundoc-usage doc args)) + ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) + (nreverse methods))) ,@(mapcar (lambda (declaration) (let ((f (cdr (assq (car declaration) defun-declarations-alist)))) @@ -235,12 +241,7 @@ DEFAULT-BODY, if present, is used as the body of a default method. (t (message "Warning: Unknown defun property `%S' in %S" (car declaration) name) nil)))) - (cdr declarations)) - (defalias ',name - (cl-generic-define ',name ',args ',(nreverse options)) - ,(help-add-fundoc-usage doc args)) - ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) - (nreverse methods))))) + (cdr declarations))))) ;;;###autoload (defun cl-generic-define (name args options) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index b1db07fe165..5aa8f1bf652 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -413,125 +413,30 @@ Signal an error if X is not a list." (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (nth 9 x)) -(defun cl-caaar (x) - "Return the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (car x)))) - -(defun cl-caadr (x) - "Return the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (cdr x)))) - -(defun cl-cadar (x) - "Return the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (car x)))) - -(defun cl-caddr (x) - "Return the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (cdr x)))) - -(defun cl-cdaar (x) - "Return the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (car x)))) - -(defun cl-cdadr (x) - "Return the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (cdr x)))) - -(defun cl-cddar (x) - "Return the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (car x)))) - -(defun cl-cdddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (cdr x)))) - -(defun cl-caaaar (x) - "Return the `car' of the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (car (car x))))) - -(defun cl-caaadr (x) - "Return the `car' of the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (car (cdr x))))) - -(defun cl-caadar (x) - "Return the `car' of the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (cdr (car x))))) - -(defun cl-caaddr (x) - "Return the `car' of the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (car (cdr (cdr x))))) - -(defun cl-cadaar (x) - "Return the `car' of the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (car (car x))))) - -(defun cl-cadadr (x) - "Return the `car' of the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (car (cdr x))))) - -(defun cl-caddar (x) - "Return the `car' of the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (cdr (car x))))) - -(defun cl-cadddr (x) - "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (car (cdr (cdr (cdr x))))) - -(defun cl-cdaaar (x) - "Return the `cdr' of the `car' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (car (car x))))) - -(defun cl-cdaadr (x) - "Return the `cdr' of the `car' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (car (cdr x))))) - -(defun cl-cdadar (x) - "Return the `cdr' of the `car' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (cdr (car x))))) - -(defun cl-cdaddr (x) - "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (car (cdr (cdr x))))) - -(defun cl-cddaar (x) - "Return the `cdr' of the `cdr' of the `car' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (car (car x))))) - -(defun cl-cddadr (x) - "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (car (cdr x))))) - -(defun cl-cdddar (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (cdr (car x))))) - -(defun cl-cddddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (compiler-macro internal--compiler-macro-cXXr)) - (cdr (cdr (cdr (cdr x))))) +(defalias 'cl-caaar 'caaar) +(defalias 'cl-caadr 'caadr) +(defalias 'cl-cadar 'cadar) +(defalias 'cl-caddr 'caddr) +(defalias 'cl-cdaar 'cdaar) +(defalias 'cl-cdadr 'cdadr) +(defalias 'cl-cddar 'cddar) +(defalias 'cl-cdddr 'cdddr) +(defalias 'cl-caaaar 'caaaar) +(defalias 'cl-caaadr 'caaadr) +(defalias 'cl-caadar 'caadar) +(defalias 'cl-caaddr 'caaddr) +(defalias 'cl-cadaar 'cadaar) +(defalias 'cl-cadadr 'cadadr) +(defalias 'cl-caddar 'caddar) +(defalias 'cl-cadddr 'cadddr) +(defalias 'cl-cdaaar 'cdaaar) +(defalias 'cl-cdaadr 'cdaadr) +(defalias 'cl-cdadar 'cdadar) +(defalias 'cl-cdaddr 'cdaddr) +(defalias 'cl-cddaar 'cddaar) +(defalias 'cl-cddadr 'cddadr) +(defalias 'cl-cdddar 'cdddar) +(defalias 'cl-cddddr 'cddddr) ;;(defun last* (x &optional n) ;; "Returns the last link in the list LIST. diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index e33a603d1b0..73eb9a4e866 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -258,30 +258,6 @@ copy-list ldiff list* - cddddr - cdddar - cddadr - cddaar - cdaddr - cdadar - cdaadr - cdaaar - cadddr - caddar - cadadr - cadaar - caaddr - caadar - caaadr - caaaar - cdddr - cddar - cdadr - cdaar - caddr - cadar - caadr - caaar tenth ninth eighth diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 762c7624577..fffe972460c 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -216,6 +216,7 @@ No problems result if this variable is not bound. (purecopy ,(format "Keymap for `%s'." child)))) ,(if declare-syntax `(progn + (defvar ,syntax) (unless (boundp ',syntax) (put ',syntax 'definition-name ',child) (defvar ,syntax (make-syntax-table))) @@ -224,6 +225,7 @@ No problems result if this variable is not bound. (purecopy ,(format "Syntax table for `%s'." child)))))) ,(if declare-abbrev `(progn + (defvar ,abbrev) (unless (boundp ',abbrev) (put ',abbrev 'definition-name ',child) (defvar ,abbrev diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index eadf79ffd4f..b6b49b1bfa2 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -412,8 +412,13 @@ of column descriptors." (inhibit-read-only t)) (if (> tabulated-list-padding 0) (insert (make-string x ?\s))) - (dotimes (n ncols) - (setq x (tabulated-list-print-col n (aref cols n) x))) + (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)) + cols) + cols)))) + (dotimes (n ncols) + (setq x (tabulated-list-print-col n (aref cols n) x)))) (insert ?\n) ;; Ever so slightly faster than calling `put-text-property' twice. (add-text-properties diff --git a/lisp/ffap.el b/lisp/ffap.el index 068897b21b8..d7222bfb681 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -171,7 +171,7 @@ this to nil will disable recognition of URLs that are not well-formed, such as \"user@host\" or \"<user@host>\"." :type 'boolean :group 'ffap - :version "25.1") + :version "25.2") ; nil -> t (defcustom ffap-ftp-default-user "anonymous" "User name in FTP file names generated by `ffap-host-to-path'. diff --git a/lisp/files.el b/lisp/files.el index b57e35b9a0a..25392fdcc71 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3723,7 +3723,8 @@ Return the new variables list." (let* ((file-name (or (buffer-file-name) ;; Handle non-file buffers, too. (expand-file-name default-directory))) - (sub-file-name (if file-name + (sub-file-name (if (and file-name + (file-name-absolute-p file-name)) ;; FIXME: Why not use file-relative-name? (substring file-name (length root))))) (condition-case err @@ -6074,8 +6075,8 @@ See also `auto-save-file-name-p'." ;; Make sure auto-save file names don't contain characters ;; invalid for the underlying filesystem. (if (and (memq system-type '(ms-dos windows-nt cygwin)) - ;; Don't modify remote (ange-ftp) filenames - (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result))) + ;; Don't modify remote filenames + (not (file-remote-p result))) (convert-standard-filename result) result)))) @@ -6112,8 +6113,8 @@ See also `auto-save-file-name-p'." ((file-writable-p "/var/tmp/") "/var/tmp/") ("~/"))))) (if (and (memq system-type '(ms-dos windows-nt cygwin)) - ;; Don't modify remote (ange-ftp) filenames - (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname))) + ;; Don't modify remote filenames + (not (file-remote-p fname))) ;; The call to convert-standard-filename is in case ;; buffer-name includes characters not allowed by the ;; DOS/Windows filesystems. make-temp-file writes to the diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index e1af859516c..43e1231914c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -251,7 +251,12 @@ This can also be a list of the above values." (integer :value 200) (number :value 4.0) function - (regexp :value ".*")) + (regexp :value ".*") + (repeat (choice (const nil) + (integer :value 200) + (number :value 4.0) + function + (regexp :value ".*")))) :group 'gnus-article-signature) (defcustom gnus-hidden-properties @@ -6841,17 +6846,21 @@ then we display only bindings that start with that prefix." (let ((keymap (copy-keymap gnus-article-mode-map)) (map (copy-keymap gnus-article-send-map)) (sumkeys (where-is-internal 'gnus-article-read-summary-keys)) + (summap (make-sparse-keymap)) parent agent draft) (define-key keymap "S" map) (define-key map [t] nil) + (define-key summap [t] 'undefined) (with-current-buffer gnus-article-current-summary + (dolist (key sumkeys) + (define-key summap key (key-binding key (current-local-map)))) (set-keymap-parent keymap (if (setq parent (keymap-parent gnus-article-mode-map)) (prog1 (setq parent (copy-keymap parent)) - (set-keymap-parent parent (current-local-map))) - (current-local-map))) + (set-keymap-parent parent summap)) + summap)) (set-keymap-parent map (key-binding "S")) (let (key def gnus-pick-mode) (while sumkeys diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 19111171198..a193ab41348 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -546,7 +546,8 @@ instead." (gnus-setup-message 'message (message-mail to subject other-headers continue nil yank-action send-actions return-action))) - (setq gnus-newsgroup-name group-name)) + (with-current-buffer buf + (setq gnus-newsgroup-name group-name))) (when switch-action (setq mail-buf (current-buffer)) (switch-to-buffer buf) @@ -1534,11 +1535,7 @@ If YANK is non-nil, include the original article." (message-pop-to-buffer "*Gnus Bug*")) (let ((message-this-is-mail t)) (message-setup `((To . ,gnus-maintainer) - (Subject . "") - (X-Debbugs-Package - . ,(format "%s" gnus-bug-package)) - (X-Debbugs-Version - . ,(format "%s" (gnus-continuum-version)))))) + (Subject . "")))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 5361c2b86fc..7037328b7a4 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -131,9 +131,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." (defvar gnus-pick-line-number 1) (defun gnus-pick-line-number () "Return the current line number." - (if (bobp) - (setq gnus-pick-line-number 1) - (incf gnus-pick-line-number))) + (incf gnus-pick-line-number)) (defun gnus-pick-start-reading (&optional catch-up) "Start reading the picked articles. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 47e33af96e8..be46339cd38 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2801,8 +2801,13 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-run-hooks 'gnus-save-newsrc-hook) (if gnus-slave (gnus-slave-save-newsrc) - ;; Save .newsrc. - (when gnus-save-newsrc-file + ;; Save .newsrc only if the select method is an NNTP method. + ;; The .newsrc file is for interoperability with other + ;; newsreaders, so saving non-NNTP groups there doesn't make + ;; much sense. + (when (and gnus-save-newsrc-file + (eq (car (gnus-server-to-method gnus-select-method)) + 'nntp)) (gnus-message 8 "Saving %s..." gnus-current-startup-file) (gnus-gnus-to-newsrc-format) (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 72e902a11f8..2631514e425 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1895,6 +1895,7 @@ increase the score of each group you read." "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number "\C-c\C-s\C-l" gnus-summary-sort-by-lines "\C-c\C-s\C-c" gnus-summary-sort-by-chars + "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks "\C-c\C-s\C-a" gnus-summary-sort-by-author "\C-c\C-s\C-t" gnus-summary-sort-by-recipient "\C-c\C-s\C-s" gnus-summary-sort-by-subject @@ -2748,6 +2749,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Sort by score" gnus-summary-sort-by-score t] ["Sort by lines" gnus-summary-sort-by-lines t] ["Sort by characters" gnus-summary-sort-by-chars t] + ["Sort by marks" gnus-summary-sort-by-marks t] ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" @@ -3976,6 +3978,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The group was successfully selected. (t (gnus-set-global-variables) + (when (boundp 'gnus-pick-line-number) + (setq gnus-pick-line-number 0)) (when (boundp 'spam-install-hooks) (spam-initialize)) ;; Save the active value in effect when the group was entered. @@ -4037,6 +4041,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) (gnus-summary-auto-select-subject) + ;; Don't mark any articles as selected if we haven't done that. + (when no-article + (setq overlay-arrow-position nil)) ;; Show first unread article if requested. (if (and (not no-article) (not no-display) @@ -4941,6 +4948,16 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-chars (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-marks (h1 h2) + "Sort articles by octet length." + (< (gnus-article-mark (mail-header-number h1)) + (gnus-article-mark (mail-header-number h2)))) + +(defun gnus-thread-sort-by-marks (h1 h2) + "Sort threads by root article octet length." + (gnus-article-sort-by-marks + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (gnus-string< @@ -11925,6 +11942,12 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'chars reverse)) +(defun gnus-summary-sort-by-mark (&optional reverse) + "Sort the summary buffer by article marks. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'marks reverse)) + (defun gnus-summary-sort-by-original (&optional reverse) "Sort the summary buffer using the default sorting method. Argument REVERSE means reverse order." @@ -11970,7 +11993,10 @@ save those articles instead. The variable `gnus-default-article-saver' specifies the saver function. If the optional second argument NOT-SAVED is non-nil, articles saved -will not be marked as saved." +will not be marked as saved. + +The `gnus-prompt-before-saving' variable says how prompting is +performed." (interactive "P") (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 8ab8f462885..6d6e20dc129 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1564,7 +1564,7 @@ If UNINDENT, remove an indentation." (parent (gnus-topic-parent-topic topic)) (grandparent (gnus-topic-parent-topic parent))) (unless grandparent - (error "Nothing to indent %s into" topic)) + (error "Can't unindent %s further" topic)) (when topic (gnus-topic-goto-topic topic) (gnus-topic-kill-group) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index ef6bd89c36e..bbf85fe584a 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2654,10 +2654,6 @@ such as a mark that says whether an article is stored in the cache "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") -(defconst gnus-bug-package - "gnus" - "The package to use in the bug submission.") - (defvar gnus-info-nodes '((gnus-group-mode "(gnus)Group Buffer") (gnus-summary-mode "(gnus)Summary Buffer") diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4d4ba089434..ce0dad9cb05 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2286,13 +2286,15 @@ body, set `message-archive-note' to nil." "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP. With prefix-argument just set Follow-Up, don't cross-post." (interactive - (list ; Completion based on Gnus - (completing-read "Followup To: " - (if (boundp 'gnus-newsrc-alist) - gnus-newsrc-alist) - nil nil '("poster" . 0) - (if (boundp 'gnus-group-history) - 'gnus-group-history)))) + (list ; Completion based on Gnus + (replace-regexp-in-string + "\\`.*:" "" + (completing-read "Followup To: " + (if (boundp 'gnus-newsrc-alist) + gnus-newsrc-alist) + nil nil '("poster" . 0) + (if (boundp 'gnus-group-history) + 'gnus-group-history))))) (message-remove-header "Follow[Uu]p-[Tt]o" t) (message-goto-newsgroups) (beginning-of-line) @@ -2361,13 +2363,15 @@ been made to before the user asked for a Crosspost." "Crossposts message and set Followup-To to TARGET-GROUP. With prefix-argument just set Follow-Up, don't cross-post." (interactive - (list ; Completion based on Gnus - (completing-read "Followup To: " - (if (boundp 'gnus-newsrc-alist) - gnus-newsrc-alist) - nil nil '("poster" . 0) - (if (boundp 'gnus-group-history) - 'gnus-group-history)))) + (list ; Completion based on Gnus + (replace-regexp-in-string + "\\`.*:" "" + (completing-read "Followup To: " + (if (boundp 'gnus-newsrc-alist) + gnus-newsrc-alist) + nil nil '("poster" . 0) + (if (boundp 'gnus-group-history) + 'gnus-group-history))))) (when (fboundp 'gnus-group-real-name) (setq target-group (gnus-group-real-name target-group))) (cond ((not (or (null target-group) ; new subject not empty @@ -3108,18 +3112,29 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (looking-at "[ \t]*\n")) (expand-abbrev)) (push-mark) + (message-goto-body-1)) + +(defun message-goto-body-1 () + "Go to the body and return point." (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) + ;; If the message is mangled, find the end of the headers the + ;; hard way. + (progn + ;; Skip past all headers and continuation lines. + (while (looking-at "[^:]+:\\|[\t ]+[^\t ]") + (forward-line 1)) + ;; We're now at the first empty line, so perhaps move past it. + (when (and (eolp) + (not (eobp))) + (forward-line 1)) + (point)))) (defun message-in-body-p () "Return t if point is in the message body." (>= (point) (save-excursion - (goto-char (point-min)) - (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)) - (point)))) + (message-goto-body-1)))) (defun message-goto-eoh () "Move point to the end of the headers." @@ -3330,6 +3345,8 @@ of lines before the signature intact." "Insert four newlines, and then reformat if inside quoted text. Prefix arg means justify as well." (interactive (list (if current-prefix-arg 'full))) + (unless (message-in-body-p) + (error "This command only works in the body of the message")) (let (quoted point beg end leading-space bolp fill-paragraph-function) (setq point (point)) (beginning-of-line) @@ -4102,8 +4119,8 @@ It should typically alter the sending method in some way or other." (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) (message-fix-before-sending) - (mml-secure-bcc-is-safe) (run-hooks 'message-send-hook) + (mml-secure-bcc-is-safe) (when message-confirm-send (or (y-or-n-p "Send message? ") (keyboard-quit))) @@ -4539,6 +4556,9 @@ This function could be useful in `message-setup-hook'." (forward-line 1) (unless (y-or-n-p "Send anyway? ") (error "Failed to send the message"))))) + ;; Fold too-long header lines. They should be no longer than + ;; 998 octets long. + (message--fold-long-headers) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (setq options message-options) @@ -4635,6 +4655,14 @@ If you always want Gnus to send messages in one piece, set (setq message-options options) (push 'mail message-sent-message-via))) +(defun message--fold-long-headers () + (goto-char (point-min)) + (while (not (eobp)) + (when (and (looking-at "[^:]+:") + (> (- (line-end-position) (point)) 998)) + (mail-header-fold-field)) + (forward-line 1))) + (defvar sendmail-program) (defvar smtpmail-smtp-server) (defvar smtpmail-smtp-service) @@ -5380,16 +5408,13 @@ Otherwise, generate and save a value for `canlock-password' first." "Process Fcc headers in the current buffer." (let ((case-fold-search t) (buf (current-buffer)) - list file - (mml-externalize-attachments message-fcc-externalize-attachments)) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (setq file (message-fetch-field "fcc" t))) - (when file - (set-buffer (get-buffer-create " *message temp*")) - (erase-buffer) + (mml-externalize-attachments message-fcc-externalize-attachments) + (file (message-field-value "fcc" t)) + list) + (when file + (with-temp-buffer (insert-buffer-substring buf) + (message-clone-locals buf) (message-encode-message-body) (save-restriction (message-narrow-to-headers) @@ -5429,8 +5454,7 @@ Otherwise, generate and save a value for `canlock-password' first." (if (and (file-readable-p file) (mail-file-babyl-p file)) (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer)))))) + (rmail-output file 1 t t)))))))))) (defun message-output (filename) "Append this article to Unix/babyl mail file FILENAME." @@ -5761,7 +5785,7 @@ give as trustworthy answer as possible." (not (string-match message-bogus-system-names message-user-fqdn))) ;; `message-user-fqdn' seems to be valid message-user-fqdn) - ((and (string-match message-bogus-system-names sysname)) + ((not (string-match message-bogus-system-names sysname)) ;; `system-name' returned the right result. sysname) ;; Try `mail-host-address'. @@ -6644,29 +6668,27 @@ OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION is a function used to switch to and display the mail buffer." (interactive) - (let ((message-this-is-mail t)) - (unless (message-mail-user-agent) - (message-pop-to-buffer - ;; Search for the existing message buffer if `continue' is non-nil. - (let ((message-generate-new-buffers - (when (or (not continue) - (eq message-generate-new-buffers 'standard) - (functionp message-generate-new-buffers)) - message-generate-new-buffers))) - (message-buffer-name "mail" to)) - switch-function)) - (message-setup - (nconc - `((To . ,(or to "")) (Subject . ,(or subject ""))) - ;; C-h f compose-mail says that headers should be specified as - ;; (string . value); however all the rest of message expects - ;; headers to be symbols, not strings (eg message-header-format-alist). - ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html - ;; We need to convert any string input, eg from rmail-start-mail. - (dolist (h other-headers other-headers) - (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) - yank-action send-actions continue switch-function - return-action))) + (let ((message-this-is-mail t) + message-buffers) + ;; Search for the existing message buffer if `continue' is non-nil. + (if (and continue + (setq message-buffers (message-buffers))) + (pop-to-buffer (car message-buffers)) + ;; Start a new buffer. + (unless (message-mail-user-agent) + (message-pop-to-buffer (message-buffer-name "mail" to) switch-function)) + (message-setup + (nconc + `((To . ,(or to "")) (Subject . ,(or subject ""))) + ;; C-h f compose-mail says that headers should be specified as + ;; (string . value); however all the rest of message expects + ;; headers to be symbols, not strings (eg message-header-format-alist). + ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html + ;; We need to convert any string input, eg from rmail-start-mail. + (dolist (h other-headers other-headers) + (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) + yank-action send-actions continue switch-function + return-action)))) ;;;###autoload (defun message-news (&optional newsgroups subject) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 6d13d892b5a..3a31349d378 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -486,7 +486,8 @@ be \"related\" or \"alternate\"." (equal (cdr (assq 'type (car cont))) "text/html")) (setq cont (mml-expand-html-into-multipart-related (car cont)))) (prog1 - (mm-with-multibyte-buffer + (with-temp-buffer + (set-buffer-multibyte nil) (setq message-options options) (cond ((and (consp (car cont)) @@ -605,28 +606,38 @@ be \"related\" or \"alternate\"." (intern (downcase charset)))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) + ;; We have a text-like MIME part, so we need to do + ;; charset encoding. (progn (with-temp-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and filename - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read coding)) - (mm-insert-file-contents filename))) - ((eq 'mml (car cont)) - (insert (cdr (assq 'contents cont)))) - (t - (save-restriction - (narrow-to-region (point) (point)) - (insert (cdr (assq 'contents cont))) - ;; Remove quotes from quoted tags. - (goto-char (point-min)) - (while (re-search-forward - "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" - nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3)))))) + (set-buffer-multibyte nil) + ;; First insert the data into the buffer. + (if (and filename + (not (equal (cdr (assq 'nofile cont)) "yes"))) + (mm-insert-file-contents filename) + (insert + (with-temp-buffer + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((eq 'mml (car cont)) + (insert (cdr (assq 'contents cont)))) + (t + (insert (cdr (assq 'contents cont))) + ;; Remove quotes from quoted tags. + (goto-char (point-min)) + (while (re-search-forward + "<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)" + nil t) + (delete-region (+ (match-beginning 0) 2) + (+ (match-beginning 0) 3))))) + (setq charset + (mm-coding-system-to-mime-charset + (detect-coding-region + (point-min) (point-max) t))) + (encode-coding-region (point-min) (point-max) + charset) + (buffer-string)))) (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) @@ -667,21 +678,22 @@ be \"related\" or \"alternate\"." ;; insert a "; format=flowed" string unless the ;; user has already specified it. (setq flowed (null (assq 'format cont))))) - ;; Prefer `utf-8' for text/calendar parts. - (if (or charset - (not (string= type "text/calendar"))) - (setq charset (mm-encode-body charset)) - (let ((mm-coding-system-priorities - (cons 'utf-8 mm-coding-system-priorities))) - (setq charset (mm-encode-body)))) - (mm-disable-multibyte) + (unless charset + (setq charset + ;; Prefer `utf-8' for text/calendar parts. + (if (string= type "text/calendar") + 'utf-8 + (mm-coding-system-to-mime-charset + (detect-coding-region + (point-min) (point-max) t))))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) (mml-insert-mime-headers cont type charset encoding flowed) (insert "\n") (insert coded)) - (mm-with-unibyte-buffer + (with-temp-buffer + (set-buffer-multibyte nil) (cond ((cdr (assq 'buffer cont)) (insert (string-as-unibyte @@ -690,11 +702,7 @@ be \"related\" or \"alternate\"." ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) - (mm-insert-file-contents filename nil nil nil nil t)) - (unless charset - (setq charset (mm-coding-system-to-mime-charset - (mm-find-buffer-file-coding-system - filename))))) + (mm-insert-file-contents filename nil nil nil nil t))) (t (let ((contents (cdr (assq 'contents cont)))) (if (multibyte-string-p contents) @@ -1244,6 +1252,7 @@ If not set, `default-directory' will be used." (defun mml-minibuffer-read-file (prompt) (let* ((completion-ignored-extensions nil) + (buffer-file-name nil) (file (read-file-name prompt (or mml-default-directory default-directory) nil t))) @@ -1378,12 +1387,23 @@ content-type, a string of the form \"type/subtype\". DESCRIPTION is a one-line description of the attachment. The DISPOSITION specifies how the attachment is intended to be displayed. It can be either \"inline\" (displayed automatically within the message -body) or \"attachment\" (separate from the body)." +body) or \"attachment\" (separate from the body). + +If given a prefix interactively, no prompting will be done for +the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults +will be computed and used." (interactive (let* ((file (mml-minibuffer-read-file "Attach file: ")) - (type (mml-minibuffer-read-type file)) - (description (mml-minibuffer-read-description)) - (disposition (mml-minibuffer-read-disposition type nil file))) + (type (if current-prefix-arg + (or (mm-default-file-encoding file) + "application/octet-stream") + (mml-minibuffer-read-type file))) + (description (if current-prefix-arg + nil + (mml-minibuffer-read-description))) + (disposition (if current-prefix-arg + (mml-content-disposition type file) + (mml-minibuffer-read-disposition type nil file)))) (list file type description disposition))) ;; If in the message header, attach at the end and leave point unchanged. (let ((head (unless (message-in-body-p) (point)))) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index ede118d6eb6..7f7db8721db 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -356,14 +356,18 @@ from the document.") (setq nndoc-dissection-alist nil) (with-current-buffer nndoc-current-buffer (erase-buffer) - (if (and (stringp nndoc-address) - (string-match nndoc-binary-file-names nndoc-address)) - (let ((coding-system-for-read 'binary)) - (mm-insert-file-contents nndoc-address)) - (if (stringp nndoc-address) - (nnheader-insert-file-contents nndoc-address) - (insert-buffer-substring nndoc-address)) - (run-hooks 'nndoc-open-document-hook))))) + (condition-case error + (if (and (stringp nndoc-address) + (string-match nndoc-binary-file-names nndoc-address)) + (let ((coding-system-for-read 'binary)) + (mm-insert-file-contents nndoc-address)) + (if (stringp nndoc-address) + (nnheader-insert-file-contents nndoc-address) + (insert-buffer-substring nndoc-address)) + (run-hooks 'nndoc-open-document-hook)) + (file-error + (nnheader-report 'nndoc "Couldn't open %s: %s" + group error)))))) ;; Initialize the nndoc structures according to this new document. (when (and nndoc-current-buffer (not nndoc-dissection-alist)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 700e86a0c57..2943c8dc7d2 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -67,7 +67,11 @@ back on `network'.") (if (listp imap-shell-program) (car imap-shell-program) imap-shell-program) - "ssh %s imapd")) + "ssh %s imapd") + "What command to execute to connect to an IMAP server. +This will only be used if the connection type is `shell'. See +the `open-network-stream' documentation for an explanation of +the format.") (defvoo nnimap-inbox nil "The mail box where incoming mail arrives and should be split out of. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index fa16fa0bb67..742c66919af 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -115,13 +115,15 @@ When called from lisp, FUNCTION may also be a function object." (if fn (format "Describe function (default %s): " fn) "Describe function: ") - #'help--symbol-completion-table #'fboundp t nil nil + #'help--symbol-completion-table + (lambda (f) (or (fboundp f) (get f 'function-documentation))) + t nil nil (and fn (symbol-name fn))))) (unless (equal val "") (setq fn (intern val))) (unless (and fn (symbolp fn)) (user-error "You didn't specify a function symbol")) - (unless (fboundp fn) + (unless (or (fboundp fn) (get fn 'function-documentation)) (user-error "Symbol's function definition is void: %s" fn)) (list fn))) @@ -144,7 +146,9 @@ When called from lisp, FUNCTION may also be a function object." (save-excursion (with-help-window (help-buffer) - (prin1 function) + (if (get function 'reader-construct) + (princ function) + (prin1 function)) ;; Use " is " instead of a colon so that ;; it is easier to get out the function name using forward-sexp. (princ " is ") @@ -469,7 +473,8 @@ suitable file is found, return nil." (let ((fill-begin (point)) (high-usage (car high)) (high-doc (cdr high))) - (insert high-usage "\n") + (unless (get function 'reader-construct) + (insert high-usage "\n")) (fill-region fill-begin (point)) high-doc))))) @@ -565,18 +570,21 @@ FILE is the file where FUNCTION was probably defined." (or (and advised (advice--cd*r (advice--symbol-function function))) function)) - ;; Get the real definition. + ;; Get the real definition, if any. (def (if (symbolp real-function) - (or (symbol-function real-function) - (signal 'void-function (list real-function))) + (cond ((symbol-function real-function)) + ((get real-function 'function-documentation) + nil) + (t (signal 'void-function (list real-function)))) real-function)) - (aliased (or (symbolp def) - ;; Advised & aliased function. - (and advised (symbolp real-function) - (not (eq 'autoload (car-safe def)))) - (and (subrp def) - (not (string= (subr-name def) - (symbol-name function)))))) + (aliased (and def + (or (symbolp def) + ;; Advised & aliased function. + (and advised (symbolp real-function) + (not (eq 'autoload (car-safe def)))) + (and (subrp def) + (not (string= (subr-name def) + (symbol-name function))))))) (real-def (cond ((and aliased (not (subrp def))) (let ((f real-function)) @@ -605,6 +613,8 @@ FILE is the file where FUNCTION was probably defined." ;; Print what kind of function-like object FUNCTION is. (princ (cond ((or (stringp def) (vectorp def)) "a keyboard macro") + ((get function 'reader-construct) + "a reader construct") ;; Aliases are Lisp functions, so we need to check ;; aliases before functions. (aliased @@ -842,7 +852,7 @@ it is displayed along with the global value." (terpri) (pp val) ;; Remove trailing newline. - (delete-char -1)) + (and (= (char-before) ?\n) (delete-char -1))) (let* ((sv (get variable 'standard-value)) (origval (and (consp sv) (condition-case nil diff --git a/lisp/help-mode.el b/lisp/help-mode.el index a8d7294a5cc..3fb793e7aa5 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -328,7 +328,7 @@ Commands: "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" "[ \t\n]+\\)?" ;; Note starting with word-syntax character: - "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")) + "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]")) "Regexp matching doc string references to symbols. The words preceding the quoted symbol can be used in doc strings to diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 4cf0573089f..38fe683785a 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -189,7 +189,8 @@ Specifically, when `hl-line-sticky-flag' is nil deactivate all such overlays in all buffers except the current one." (let ((hlob hl-line-overlay-buffer) (curbuf (current-buffer))) - (when (and (not hl-line-sticky-flag) + (when (and (buffer-live-p hlob) + (not hl-line-sticky-flag) (not (eq curbuf hlob)) (not (minibufferp))) (with-current-buffer hlob diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 21aac1ab216..74393ffbaeb 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -365,9 +365,15 @@ commands in `hfy-etags-cmd-alist'." (defun hfy-which-etags () "Return a string indicating which flavor of etags we are using." - (let ((v (shell-command-to-string (concat hfy-etags-bin " --version")))) - (cond ((string-match "exube" v) "exuberant ctags") - ((string-match "GNU E" v) "emacs etags" )) )) + (with-temp-buffer + (condition-case nil + (when (eq (call-process hfy-etags-bin nil t nil "--version") 0) + (goto-char (point-min)) + (cond + ((looking-at-p "exube") "exuberant ctags") + ((looking-at-p "GNU E") "emacs etags"))) + ;; Return nil if the etags binary isn't executable (Bug#25468). + (file-error nil)))) (defcustom hfy-etags-cmd ;; We used to wrap this in a `eval-and-compile', but: diff --git a/lisp/info-look.el b/lisp/info-look.el index 1f3c50870e0..694bcb462ce 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -43,6 +43,7 @@ ;;; Code: (require 'info) +(require 'subr-x) (defgroup info-lookup nil "Major mode sensitive help agent." @@ -648,6 +649,26 @@ Return nil if there is nothing appropriate in the buffer near point." (buffer-substring-no-properties beg end))))) (error nil))) +(defun info-lookup-guess-gdb-script-symbol () + "Get symbol at point in GDB script buffers." + (condition-case nil + (save-excursion + (back-to-indentation) + ;; Try to find the current line's full command in the index; + ;; and default to the longest subset that is found. + (when (looking-at "[-a-z]+\\(\\s-[-a-z]+\\)*") + (let ((str-list (split-string (match-string-no-properties 0) + "\\s-+" t)) + (completions (info-lookup->completions 'symbol + 'gdb-script-mode))) + (catch 'result + (while str-list + (let ((str (string-join str-list " "))) + (when (assoc str completions) + (throw 'result str)) + (nbutlast str-list))))))) + (error nil))) + ;;;###autoload (defun info-complete-symbol (&optional mode) "Perform completion on symbol preceding point." @@ -1051,6 +1072,14 @@ Return nil if there is nothing appropriate in the buffer near point." :mode 'help-mode :regexp "[^][()`'‘’,:\" \t\n]+" :other-modes '(emacs-lisp-mode)) + +(info-lookup-maybe-add-help + :mode 'gdb-script-mode + :ignore-case nil + :regexp "\\([-a-z]+\\(\\s-+[-a-z]+\\)*\\)" + :doc-spec '(("(gdb)Command and Variable Index" nil + nil nil)) + :parse-rule 'info-lookup-guess-gdb-script-symbol) (provide 'info-look) diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index a3e53cfe793..fd793a28309 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -192,6 +192,17 @@ the Content-Transfer-Encoding header of a mail." (ietf-drums-init string) (while (not (eobp)) (setq c (char-after)) + ;; If we have an uneven number of quote characters, + ;; `forward-sexp' will fail. In these cases, just delete the + ;; final of these quote characters. + (when (and (eq c ?\") + (not + (save-excursion + (ignore-errors + (forward-sexp 1) + t)))) + (delete-char 1) + (setq c (char-after))) (cond ((or (eq c ? ) (eq c ?\t)) diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 2a8160921a6..bcbdc17631d 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -281,17 +281,7 @@ Should be called narrowed to the head of the message." (encode-coding-region (point-min) (point-max) (mm-charset-to-coding-system - (car message-posting-charset)))) - ;; No encoding necessary, but folding is nice - (when nil - (rfc2047-fold-region - (save-excursion - (goto-char (point-min)) - (skip-chars-forward "^:") - (when (looking-at ": ") - (forward-char 2)) - (point)) - (point-max)))) + (car message-posting-charset))))) ;; We found something that may perhaps be encoded. (re-search-forward "^[^:]+: *" nil t) (cond diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d42180719dc..f7e06341443 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -59,7 +59,7 @@ "Directory where files will downloaded." :version "24.4" :group 'eww - :type 'string) + :type 'directory) ;;;###autoload (defcustom eww-suggest-uris @@ -81,7 +81,7 @@ duplicate entries (if any) removed." "Directory where bookmark files will be stored." :version "25.1" :group 'eww - :type 'string) + :type 'directory) (defcustom eww-desktop-remove-duplicates t "Whether to remove duplicates from the history when saving desktop data. @@ -251,6 +251,29 @@ word(s) will be searched for via `eww-search-prefix'." (if uris (format " (default %s)" (car uris)) "") ": "))) (list (read-string prompt nil nil uris)))) + (setq url (eww--dwim-expand-url url)) + (pop-to-buffer-same-window + (if (eq major-mode 'eww-mode) + (current-buffer) + (get-buffer-create "*eww*"))) + (eww-setup-buffer) + ;; Check whether the domain only uses "Highly Restricted" Unicode + ;; IDNA characters. If not, transform to punycode to indicate that + ;; there may be funny business going on. + (let ((parsed (url-generic-parse-url url))) + (unless (puny-highly-restrictive-domain-p (url-host parsed)) + (setf (url-host parsed) (puny-encode-domain (url-host parsed))) + (setq url (url-recreate-url parsed)))) + (plist-put eww-data :url url) + (plist-put eww-data :title "") + (eww-update-header-line-format) + (let ((inhibit-read-only t)) + (insert (format "Loading %s..." url)) + (goto-char (point-min))) + (url-retrieve url 'eww-render + (list url nil (current-buffer)))) + +(defun eww--dwim-expand-url (url) (setq url (string-trim url)) (cond ((string-match-p "\\`file:/" url)) ;; Don't mangle file: URLs at all. @@ -275,26 +298,7 @@ word(s) will be searched for via `eww-search-prefix'." (setq url (concat url "/")))) (setq url (concat eww-search-prefix (replace-regexp-in-string " " "+" url)))))) - (pop-to-buffer-same-window - (if (eq major-mode 'eww-mode) - (current-buffer) - (get-buffer-create "*eww*"))) - (eww-setup-buffer) - ;; Check whether the domain only uses "Highly Restricted" Unicode - ;; IDNA characters. If not, transform to punycode to indicate that - ;; there may be funny business going on. - (let ((parsed (url-generic-parse-url url))) - (unless (puny-highly-restrictive-domain-p (url-host parsed)) - (setf (url-host parsed) (puny-encode-domain (url-host parsed))) - (setq url (url-recreate-url parsed)))) - (plist-put eww-data :url url) - (plist-put eww-data :title "") - (eww-update-header-line-format) - (let ((inhibit-read-only t)) - (insert (format "Loading %s..." url)) - (goto-char (point-min))) - (url-retrieve url 'eww-render - (list url nil (current-buffer)))) + url) ;;;###autoload (defalias 'browse-web 'eww) @@ -351,16 +355,25 @@ Currently this means either text/html or application/xhtml+xml." "utf-8")))) (data-buffer (current-buffer)) last-coding-system-used) - ;; Save the https peer status. (with-current-buffer buffer - (plist-put eww-data :peer (plist-get status :peer))) + ;; Save the https peer status. + (plist-put eww-data :peer (plist-get status :peer)) + ;; Make buffer listings more informative. + (setq list-buffers-directory url)) (unwind-protect (progn (cond ((and eww-use-external-browser-for-content-type (string-match-p eww-use-external-browser-for-content-type (car content-type))) - (eww-browse-with-external-browser url)) + (erase-buffer) + (insert "<title>Unsupported content type</title>") + (insert (format "<h1>Content-type %s is unsupported</h1>" + (car content-type))) + (insert (format "<a href=%S>Direct link to the document</a>" + url)) + (goto-char (point-min)) + (eww-display-html charset url nil point buffer encode)) ((eww-html-p (car content-type)) (eww-display-html charset url nil point buffer encode)) ((equal (car content-type) "application/pdf") @@ -804,7 +817,10 @@ the like." ;;;###autoload (defun eww-browse-url (url &optional new-window) (when new-window - (pop-to-buffer-same-window (generate-new-buffer "*eww*")) + (pop-to-buffer-same-window + (generate-new-buffer + (format "*eww-%s*" (url-host (url-generic-parse-url + (eww--dwim-expand-url url)))))) (eww-mode)) (eww url)) @@ -835,6 +851,8 @@ the like." (erase-buffer) (insert text) (goto-char (plist-get elem :point)) + ;; Make buffer listings more informative. + (setq list-buffers-directory (plist-get elem :url)) (eww-update-header-line-format)))) (defun eww-next-url () @@ -1483,6 +1501,7 @@ Differences in #targets are ignored." (defun eww-download () "Download URL under point to `eww-download-directory'." (interactive) + (access-file eww-download-directory "Download failed") (let ((url (get-text-property (point) 'shr-url))) (if (not url) (message "No URL under point") diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 93e1bae5fc2..bf60eee673c 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -139,6 +139,10 @@ a greeting from the server. :nowait, if non-nil, says the connection should be made asynchronously, if possible. +:shell-command is a format-spec string that can be used if :type +is `shell'. It has two specs, %s for host and %p for port +number. Example: \"ssh gateway nc %s %p\". + :tls-parameters is a list that should be supplied if you're opening a TLS connection. The first element is the TLS type (either `gnutls-x509pki' or `gnutls-anon'), and the diff --git a/lisp/net/shr.el b/lisp/net/shr.el index e0bb3dbb2b7..b7c48288494 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -96,8 +96,9 @@ If nil, don't draw horizontal table lines." (defcustom shr-width nil "Frame width to use for rendering. May either be an integer specifying a fixed width in characters, -or nil, meaning that the full width of the window should be -used." +or nil, meaning that the full width of the window should be used. +If `shr-use-fonts' is set, the mean character width is used to +compute the pixel width, which is used instead." :version "25.1" :type '(choice (integer :tag "Fixed width in characters") (const :tag "Use the width of the window" nil)) @@ -978,7 +979,7 @@ element is the data blob and the second element is the content-type." (create-image data nil t :ascent 100 :format content-type)) ((eq content-type 'image/svg+xml) - (create-image data 'svg t :ascent 100)) + (create-image data 'imagemagick t :ascent 100)) ((eq size 'full) (ignore-errors (shr-rescale-image data content-type @@ -1011,18 +1012,25 @@ element is the data blob and the second element is the content-type." image) (insert (or alt "")))) -(defun shr-rescale-image (data content-type width height) +(defun shr-rescale-image (data content-type width height + &optional max-width max-height) "Rescale DATA, if too big, to fit the current buffer. -WIDTH and HEIGHT are the sizes given in the HTML data, if any." +WIDTH and HEIGHT are the sizes given in the HTML data, if any. + +The size of the displayed image will not exceed +MAX-WIDTH/MAX-HEIGHT. If not given, use the current window +width/height instead." (if (or (not (fboundp 'imagemagick-types)) (not (get-buffer-window (current-buffer)))) (create-image data nil t :ascent 100) (let* ((edges (window-inside-pixel-edges (get-buffer-window (current-buffer)))) (max-width (truncate (* shr-max-image-proportion - (- (nth 2 edges) (nth 0 edges))))) + (or max-width + (- (nth 2 edges) (nth 0 edges)))))) (max-height (truncate (* shr-max-image-proportion - (- (nth 3 edges) (nth 1 edges))))) + (or max-height + (- (nth 3 edges) (nth 1 edges)))))) (scaling (image-compute-scaling-factor image-scaling-factor))) (when (or (and width (> width max-width)) @@ -1059,8 +1067,7 @@ Return a string with image data." (when (ignore-errors (url-cache-extract (url-cache-create-filename (shr-encode-url url))) t) - (when (or (search-forward "\n\n" nil t) - (search-forward "\r\n\r\n" nil t)) + (when (re-search-forward "\r?\n\r?\n" nil t) (shr-parse-image-data))))) (declare-function libxml-parse-xml-region "xml.c" @@ -1079,9 +1086,12 @@ Return a string with image data." obarray))))))) ;; SVG images may contain references to further images that we may ;; want to block. So special-case these by parsing the XML data - ;; and remove the blocked bits. - (when (eq content-type 'image/svg+xml) + ;; and remove anything that looks like a blocked bit. + (when (and shr-blocked-images + (eq content-type 'image/svg+xml)) (setq data + ;; Note that libxml2 doesn't parse everything perfectly, + ;; so glitches may occur during this transformation. (shr-dom-to-xml (libxml-parse-xml-region (point) (point-max))))) (list data content-type))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3697d50429d..fc7fdd30850 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4063,7 +4063,11 @@ this file, if that variable is non-nil." (file-exists-p tramp-auto-save-directory)) (make-directory tramp-auto-save-directory t)) - (let ((system-type 'not-windows) + (let ((system-type + (if (and (stringp tramp-auto-save-directory) + (file-remote-p tramp-auto-save-directory)) + 'not-windows + system-type)) (auto-save-file-name-transforms (if (null tramp-auto-save-directory) auto-save-file-name-transforms)) diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 37816bb8881..393f3a549f9 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -256,7 +256,7 @@ supported keys depend on the service type.") "Returns all discovered Avahi service names as list." (let (result) (maphash - (lambda (key value) (add-to-list 'result (zeroconf-service-name value))) + (lambda (_key value) (add-to-list 'result (zeroconf-service-name value))) zeroconf-services-hash) result)) @@ -264,7 +264,7 @@ supported keys depend on the service type.") "Returns all discovered Avahi service types as list." (let (result) (maphash - (lambda (key value) (add-to-list 'result (zeroconf-service-type value))) + (lambda (_key value) (add-to-list 'result (zeroconf-service-type value))) zeroconf-services-hash) result)) @@ -276,7 +276,7 @@ The service type is one of the returned values of format of SERVICE." (let (result) (maphash - (lambda (key value) + (lambda (_key value) (when (equal type (zeroconf-service-type value)) (add-to-list 'result value))) zeroconf-services-hash) diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 6cbd84a9cf3..ed5b4c65068 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -50,7 +50,7 @@ (make-local-variable 'scroll-step) (setq scroll-step 2)) -(defun dun-parse (arg) +(defun dun-parse (_arg) "Function called when return is pressed in interactive mode to parse line." (interactive "*p") (beginning-of-line) @@ -210,13 +210,13 @@ disk bursts into flames, and disintegrates.") (dun-score nil) (setq dun-dead t)) -(defun dun-quit (args) +(defun dun-quit (_args) (dun-die nil)) ;;; Print every object in player's inventory. Special case for the jar, ;;; as we must also print what is in it. -(defun dun-inven (args) +(defun dun-inven (_args) (dun-mprinc "You currently have:") (dun-mprinc "\n") (dolist (curobj dun-inventory) @@ -265,9 +265,9 @@ on your head.") (defun dun-drop (obj) (if dun-inbus (dun-mprincl "You can't drop anything while on the bus.") - (let (objnum ptr) + (let (objnum) (when (setq objnum (dun-objnum-from-args-std obj)) - (if (not (setq ptr (member objnum dun-inventory))) + (if (not (member objnum dun-inventory)) (dun-mprincl "You don't have that.") (progn (dun-remove-obj-from-inven objnum) @@ -412,10 +412,10 @@ For an explosive time, go to Fourth St. and Vermont.") ;;; We try to take an object that is untakable. Print a message ;;; depending on what it is. -(defun dun-try-take (obj) +(defun dun-try-take (_obj) (dun-mprinc "You cannot take that.")) -(defun dun-dig (args) +(defun dun-dig (_args) (if dun-inbus (dun-mprincl "Digging here reveals nothing.") (if (not (member 0 dun-inventory)) @@ -557,7 +557,7 @@ with a bang. The key seems to have vanished!") just try dropping it.") (dun-mprincl"You can't put that there."))))))))))) -(defun dun-type (args) +(defun dun-type (_args) (if (not (= dun-current-room computer-room)) (dun-mprincl "There is nothing here on which you could type.") (if (not dun-computer) @@ -567,40 +567,40 @@ just try dropping it.") ;;; Various movement directions -(defun dun-n (args) +(defun dun-n (_args) (dun-move north)) -(defun dun-s (args) +(defun dun-s (_args) (dun-move south)) -(defun dun-e (args) +(defun dun-e (_args) (dun-move east)) -(defun dun-w (args) +(defun dun-w (_args) (dun-move west)) -(defun dun-ne (args) +(defun dun-ne (_args) (dun-move northeast)) -(defun dun-se (args) +(defun dun-se (_args) (dun-move southeast)) -(defun dun-nw (args) +(defun dun-nw (_args) (dun-move northwest)) -(defun dun-sw (args) +(defun dun-sw (_args) (dun-move southwest)) -(defun dun-up (args) +(defun dun-up (_args) (dun-move up)) -(defun dun-down (args) +(defun dun-down (_args) (dun-move down)) -(defun dun-in (args) +(defun dun-in (_args) (dun-move in)) -(defun dun-out (args) +(defun dun-out (_args) (dun-move out)) (defun dun-go (args) @@ -774,7 +774,7 @@ engulf you, and you burn to death.") huge rocks sliding down from the ceiling, and blocking your way out.\n") (setq dun-current-room misty-room))))) -(defun dun-long (args) +(defun dun-long (_args) (setq dun-mode "long")) (defun dun-turn (obj) @@ -867,7 +867,7 @@ as you release it, the passageway closes.")) (dun-mprincl "The button is now in the on position.") (setq dun-black t)))))))) -(defun dun-swim (args) +(defun dun-swim (_args) (if (not (member dun-current-room (list lakefront-north lakefront-south))) (dun-mprincl "I see no water!") (if (not (member obj-life dun-inventory)) @@ -882,7 +882,7 @@ to swim.") (setq dun-current-room lakefront-north))))) -(defun dun-score (args) +(defun dun-score (_args) (if (not dun-endgame) (let (total) (setq total (dun-reg-score)) @@ -896,7 +896,7 @@ to swim.") (dun-mprincl "\n\nCongratulations. You have won. The wizard password is ‘moby’")))) -(defun dun-help (args) +(defun dun-help (_args) (dun-mprincl "Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). Here is some useful information (read carefully because there are one @@ -937,14 +937,14 @@ If you have questions or comments, please contact ronnie@driver-aces.com My home page is http://www.driver-aces.com/ronnie.html ")) -(defun dun-flush (args) +(defun dun-flush (_args) (if (not (= dun-current-room bathroom)) (dun-mprincl "I see nothing to flush.") (dun-mprincl "Whoooosh!!") (dun-put-objs-in-treas (nth urinal dun-room-objects)) (dun-replace dun-room-objects urinal nil))) -(defun dun-piss (args) +(defun dun-piss (_args) (if (not (= dun-current-room bathroom)) (dun-mprincl "You can't do that here, don't even bother trying.") (if (not dun-gottago) @@ -956,7 +956,7 @@ My home page is http://www.driver-aces.com/ronnie.html (list obj-URINE)))))) -(defun dun-sleep (args) +(defun dun-sleep (_args) (if (not (= dun-current-room bedroom)) (dun-mprincl "You try to go to sleep while standing up here, but can't seem to do it.") @@ -1012,12 +1012,12 @@ for a moment, then straighten yourself up. (dun-mprincl "Your axe breaks it into a million pieces.") (dun-remove-obj-from-room dun-current-room objnum))))))))) -(defun dun-drive (args) +(defun dun-drive (_args) (if (not dun-inbus) (dun-mprincl "You cannot drive when you aren't in a vehicle.") (dun-mprincl "To drive while you are in the bus, just give a direction."))) -(defun dun-superb (args) +(defun dun-superb (_args) (setq dun-mode 'dun-superb)) (defun dun-reg-score () @@ -1073,7 +1073,7 @@ for a moment, then straighten yourself up. (setq i (1+ i))) (setq dun-endgame-questions newques)))) -(defun dun-power (args) +(defun dun-power (_args) (if (not (= dun-current-room pc-area)) (dun-mprincl "That operation is not applicable here.") (if (not dun-floppy) @@ -1113,7 +1113,7 @@ for a moment, then straighten yourself up. (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) (if (not (cdr (assq (intern verb) dun-verblist))) -1 (setq dun-numcmds (1+ dun-numcmds)) - (eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest))))))) + (funcall (cdr (assq (intern verb) dun-verblist)) rest))))) ;;; Function to take a string and change it into a list of lowercase words. @@ -1221,11 +1221,10 @@ for a moment, then straighten yourself up. ;;; words in the command, except for the verb. (defun dun-objnum-from-args (obj) - (let (objnum) - (setq obj (dun-firstword obj)) - (if (not obj) - obj-special - (setq objnum (cdr (assq (intern obj) dun-objnames)))))) + (setq obj (dun-firstword obj)) + (if (not obj) + obj-special + (cdr (assq (intern obj) dun-objnames)))) (defun dun-objnum-from-args-std (obj) (let (result) @@ -1251,7 +1250,7 @@ for a moment, then straighten yourself up. ;;; Given a unix style pathname, build a list of path components (recursive) (defun dun-get-path (dirstring startlist) - (let (slash pos) + (let (slash) (if (= (length dirstring) 0) startlist (if (string= (substring dirstring 0 1) "/") @@ -2480,7 +2479,7 @@ treasures for points?" "4" "four") ;;;; This section defines the UNIX emulation functions for dunnet. ;;;; -(defun dun-unix-parse (args) +(defun dun-unix-parse (_args) (interactive "*p") (beginning-of-line) (let (beg esign) @@ -2687,13 +2686,13 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-mprinc var) (dun-mprinc ": Permission denied") (setq nomore t)) - (eval (list 'dun-mprinc var)) + (dun-mprinc var) (dun-mprinc " "))))))) (dun-mprinc "\n"))) (defun dun-ftp (args) - (let (host username passwd ident newlist) + (let (host username ident newlist) (if (not (car args)) (dun-mprincl "ftp: hostname required on command line.") (setq host (intern (car args))) @@ -2768,15 +2767,15 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-fascii 'nil) (dun-mprincl "Unknown type."))))) -(defun dun-bin (args) +(defun dun-bin (_args) (dun-mprincl "Type set to binary.") (setq dun-ftptype 'binary)) -(defun dun-fascii (args) +(defun dun-fascii (_args) (dun-mprincl "Type set to ascii.") (setq dun-ftptype 'ascii)) -(defun dun-ftpquit (args) +(defun dun-ftpquit (_args) (setq dun-exitf t)) (defun dun-send (args) @@ -2831,18 +2830,18 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (if (not foo) (dun-mprincl "No such file.")))))) -(defun dun-ftphelp (args) +(defun dun-ftphelp (_args) (dun-mprincl "Possible commands are:\nsend quit type ascii binary help")) -(defun dun-uexit (args) +(defun dun-uexit (_args) (setq dungeon-mode 'dungeon) (dun-mprincl "\nYou step back from the console.") (define-key dun-mode-map "\r" 'dun-parse) (if (not dun-batch-mode) (dun-messages))) -(defun dun-pwd (args) +(defun dun-pwd (_args) (dun-mprincl dun-cdpath)) (defun dun-uncompress (args) @@ -3009,7 +3008,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") ;;;; This section defines the DOS emulation functions for dunnet ;;;; -(defun dun-dos-parse (args) +(defun dun-dos-parse (_args) (interactive "*p") (beginning-of-line) (let (beg) @@ -3047,7 +3046,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dun-mprincl (upcase args)))) (dun-mprincl "Must supply file name"))) -(defun dun-dos-invd (args) +(defun dun-dos-invd (_args) (sleep-for 1) (dun-mprincl "Invalid drive specification")) @@ -3084,11 +3083,11 @@ File not found"))) (if (not dun-batch-mode) (dun-mprinc "\n"))) -(defun dun-dos-spawn (args) +(defun dun-dos-spawn (_args) (sleep-for 1) (dun-mprincl "Cannot spawn subshell")) -(defun dun-dos-exit (args) +(defun dun-dos-exit (_args) (setq dungeon-mode 'dungeon) (dun-mprincl "\nYou power down the machine and step back.") (define-key dun-mode-map "\r" 'dun-parse) @@ -3106,7 +3105,7 @@ File not found"))) (dun-mprinc dun-combination) (dun-mprinc ".\n")) -(defun dun-dos-nil (args)) +(defun dun-dos-nil (_args)) ;;;; @@ -3177,9 +3176,7 @@ File not found"))) (defun dun-save-val (varname) - (let (value) - (setq varname (intern varname)) - (setq value (eval varname)) + (let ((value (symbol-value (intern varname)))) (dun-minsert "(setq ") (dun-minsert varname) (dun-minsert " ") @@ -3205,7 +3202,7 @@ File not found"))) (defun dun-do-logfile (type how) - (let (ferror newscore) + (let (ferror) (setq ferror nil) (switch-to-buffer (get-buffer-create "*score*")) (erase-buffer) @@ -3231,8 +3228,8 @@ File not found"))) (dun-minsert (cadr (nth (abs room) dun-rooms))) (dun-minsert ". score: ") (if (> (dun-endgame-score) 0) - (dun-minsert (setq newscore (+ 90 (dun-endgame-score)))) - (dun-minsert (setq newscore (dun-reg-score)))) + (dun-minsert (+ 90 (dun-endgame-score))) + (dun-minsert (dun-reg-score))) (dun-minsert " saves: ") (dun-minsert dun-numsaves) (dun-minsert " commands: ") @@ -3318,7 +3315,7 @@ File not found"))) (goto-char (point-max)) (dun-mprinc "\n")))) -(defun dungeon-nil (arg) +(defun dungeon-nil (_arg) "noop" (interactive "*p") nil) @@ -3329,7 +3326,7 @@ File not found"))) (dun-mprinc "\n") (dun-batch-loop)) -(unless (not noninteractive) +(when noninteractive (fset 'dun-mprinc 'dun-batch-mprinc) (fset 'dun-mprincl 'dun-batch-mprincl) (fset 'dun-vparse 'dun-batch-parse) @@ -3343,8 +3340,8 @@ File not found"))) (provide 'dunnet) -;;; dunnet.el ends here - ;; Local Variables: ;; byte-compile-warnings: (not free-vars lexical) ;; End: + +;;; dunnet.el ends here diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index e84c4cebf69..fd7aa50840f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -313,7 +313,8 @@ comment at the start of cc-engine.el for more info." (c-macro-is-genuine-p)) (progn (setq c-macro-cache (cons (point) nil) - c-macro-cache-start-pos here) + c-macro-cache-start-pos here + c-macro-cache-syntactic nil) t) (goto-char here) nil)))))) @@ -344,7 +345,8 @@ comment at the start of cc-engine.el for more info." (forward-char) t))) (when (car c-macro-cache) - (setcdr c-macro-cache (point))))) + (setcdr c-macro-cache (point)) + (setq c-macro-cache-syntactic nil)))) (defun c-syntactic-end-of-macro () ;; Go to the end of a CPP directive, or a "safe" pos just before. @@ -364,7 +366,8 @@ comment at the start of cc-engine.el for more info." (goto-char c-macro-cache-syntactic) (setq s (parse-partial-sexp here there)) (while (and (or (nth 3 s) ; in a string - (nth 4 s)) ; in a comment (maybe at end of line comment) + (and (nth 4 s) ; in a comment (maybe at end of line comment) + (not (eq (nth 7 s) 'syntax-table)))) ; Not a pseudo comment (> there here)) ; No infinite loops, please. (setq there (1- (nth 8 s))) (setq s (parse-partial-sexp here there))) @@ -389,7 +392,8 @@ comment at the start of cc-engine.el for more info." (> there here)) ; No infinite loops, please. (setq here (1+ (nth 8 s))) (setq s (parse-partial-sexp here there))) - (when (nth 4 s) + (when (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table))) ; no pseudo comments. (goto-char (1- (nth 8 s)))) (setq c-macro-cache-no-comment (point))) (point))) @@ -2407,7 +2411,9 @@ comment at the start of cc-engine.el for more info." (s (parse-partial-sexp base here nil nil s)) ty) (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment + ((or (nth 3 s) + (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) ((nth 7 s) 'c++) @@ -2453,7 +2459,9 @@ comment at the start of cc-engine.el for more info." (s (parse-partial-sexp base here nil nil s)) ty start) (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment + ((or (nth 3 s) + (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) ((nth 7 s) 'c++) @@ -2479,7 +2487,7 @@ comment at the start of cc-engine.el for more info." (t (list s)))))))) -(defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) +(defun c-state-pp-to-literal (from to &optional not-in-delimiter) ;; Do a parse-partial-sexp from FROM to TO, returning either ;; (STATE TYPE (BEG . END)) if TO is in a literal; or ;; (STATE) otherwise, @@ -2498,7 +2506,9 @@ comment at the start of cc-engine.el for more info." (let ((s (parse-partial-sexp from to)) ty co-st) (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment + ((or (nth 3 s) + (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) ((nth 7 s) 'c++) @@ -2560,7 +2570,8 @@ comment at the start of cc-engine.el for more info." (cond ((nth 3 state) ; A string (list (point) (nth 3 state) (nth 8 state))) - ((nth 4 state) ; A comment + ((and (nth 4 state) ; A comment + (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment. (list (point) (if (eq (nth 7 state) 1) 'c++ 'c) (nth 8 state))) @@ -2697,7 +2708,7 @@ comment at the start of cc-engine.el for more info." (widen) (save-excursion (let ((pos (c-state-safe-place here))) - (car (cddr (c-state-pp-to-literal pos here))))))) + (car (cddr (c-state-pp-to-literal pos here))))))) (defsubst c-state-lit-beg (pos) ;; Return the start of the literal containing POS, or POS itself. @@ -2708,7 +2719,8 @@ comment at the start of cc-engine.el for more info." ;; Return a position outside of a string/comment/macro at or before POS. ;; STATE is the parse-partial-sexp state at POS. (let ((res (if (or (nth 3 state) ; in a string? - (nth 4 state)) ; in a comment? + (and (nth 4 state) + (not (eq (nth 7 state) 'syntax-table)))) ; in a comment? (nth 8 state) pos))) (save-excursion @@ -3467,7 +3479,7 @@ comment at the start of cc-engine.el for more info." ((and (consp (car c-state-cache)) (> (cdar c-state-cache) here)) ;; CASE 1: The top of the cache is a brace pair which now encloses - ;; `here'. As good-pos, return the address. of the "{". Since we've no + ;; `here'. As good-pos, return the address of the "{". Since we've no ;; knowledge of what's inside these braces, we have no alternative but ;; to direct the caller to scan the buffer from the opening brace. (setq pos (caar c-state-cache)) @@ -4952,7 +4964,8 @@ comment at the start of cc-engine.el for more info." (lit-limits (if lim (let ((s (parse-partial-sexp lim (point)))) - (when (or (nth 3 s) (nth 4 s)) + (when (or (nth 3 s) + (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))) (cons (nth 8 s) (progn (parse-partial-sexp (point) (point-max) nil nil @@ -5005,7 +5018,8 @@ point isn't in one. SAFE-POS, if non-nil, is a position before point which is a known \"safe position\", i.e. outside of any string or comment." (if safe-pos (let ((s (parse-partial-sexp safe-pos (point)))) - (and (or (nth 3 s) (nth 4 s)) + (and (or (nth 3 s) + (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))) (nth 8 s))) (car (cddr (c-state-semi-pp-to-literal (point)))))) @@ -5106,7 +5120,8 @@ comment at the start of cc-engine.el for more info." 'syntax-table)) ; stop-comment ;; Gather details of the non-literal-bit - starting pos and size. - (setq size (- (if (or (nth 4 s) (nth 3 s)) + (setq size (- (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))) + (nth 3 s)) (nth 8 s) (point)) pos)) @@ -5114,7 +5129,8 @@ comment at the start of cc-engine.el for more info." (setq stack (cons (cons pos size) stack))) ;; Move forward to the end of the comment/string. - (if (or (nth 4 s) (nth 3 s)) + (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))) + (nth 3 s)) (setq s (parse-partial-sexp (point) start diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 7e3c6ba15a5..e2969c607a5 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1068,7 +1068,8 @@ Note that the style variables are always made local to the buffer." (parse-partial-sexp pps-position (point) nil nil pps-state) pps-position (point)) (or (nth 3 pps-state) ; in a string? - (nth 4 pps-state)))) ; in a comment? + (and (nth 4 pps-state) + (not (eq (nth 7 pps-state) 'syntax-table)))))) ; in a comment? (goto-char (match-beginning 1)) (setq mbeg (point)) (if (> (c-no-comment-end-of-macro) mbeg) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 0e4e67018ed..5328526abd9 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -582,7 +582,7 @@ and then further adjusted to be at the end of the line." (setq p (line-end-position))) ;; `q' is the point at the end of the block (hs-forward-sexp mdata 1) - (setq q (if (looking-back hs-block-end-regexp) + (setq q (if (looking-back hs-block-end-regexp nil) (match-beginning 0) (point))) (when (and (< p q) (> (count-lines p q) 1)) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 54df3913fc6..74dd4add9e2 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -574,8 +574,8 @@ then the \".\"s will be lined up: (define-key keymap [(control ?c) (control ?j)] #'js-set-js-context) (define-key keymap [(control meta ?x)] #'js-eval-defun) (define-key keymap [(meta ?.)] #'js-find-symbol) - (easy-menu-define nil keymap "Javascript Menu" - '("Javascript" + (easy-menu-define nil keymap "JavaScript Menu" + '("JavaScript" ["Select New Mozilla Context..." js-set-js-context (fboundp #'inferior-moz-process)] ["Evaluate Expression in Mozilla Context..." js-eval @@ -1712,7 +1712,7 @@ This performs fontification according to `js--class-styles'." nil)))))) (defun js-syntax-propertize (start end) - ;; Javascript allows immediate regular expression objects, written /.../. + ;; JavaScript allows immediate regular expression objects, written /.../. (goto-char start) (js-syntax-propertize-regexp end) (funcall @@ -1720,10 +1720,10 @@ This performs fontification according to `js--class-styles'." ;; Distinguish /-division from /-regexp chars (and from /-comment-starter). ;; FIXME: Allow regexps after infix ops like + ... ;; https://developer.mozilla.org/en/JavaScript/Reference/Operators - ;; We can probably just add +, -, !, <, >, %, ^, ~, |, &, ?, : at which + ;; We can probably just add +, -, <, >, %, ^, ~, ?, : at which ;; point I think only * and / would be missing which could also be added, ;; but need care to avoid affecting the // and */ comment markers. - ("\\(?:^\\|[=([{,:;]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]" + ("\\(?:^\\|[=([{,:;|&!]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]" (1 (ignore (forward-char -1) (when (or (not (memq (char-after (match-beginning 0)) '(?\s ?\t))) @@ -2710,7 +2710,7 @@ current buffer. Pushes a mark onto the tag ring just like ;;; MozRepl integration (define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error)) -(define-error 'js-js-error "Javascript Error") ;; '(js-error error)) +(define-error 'js-js-error "JavaScript Error") ;; '(js-error error)) (defun js--wait-for-matching-output (process regexp timeout &optional start) @@ -3214,7 +3214,7 @@ with `js--js-encode-value'." Inside the lexical scope of `with-js', `js?', `js!', `js-new', `js-eval', `js-list', `js<', `js>', `js-get-service', `js-create-instance', and `js-qi' are defined." - + (declare (indent 0) (debug t)) `(progn (js--js-enter-repl) (unwind-protect @@ -3391,7 +3391,7 @@ With argument, run even if no intervening GC has happened." (defun js-eval (js) "Evaluate the JavaScript in JS and return JSON-decoded result." - (interactive "MJavascript to evaluate: ") + (interactive "MJavaScript to evaluate: ") (with-js (let* ((content-window (js--js-content-window (js--get-js-context))) @@ -3431,11 +3431,8 @@ left-to-right." (eq (cl-fifth window-info) 2)) do (push window-info windows)) - (cl-loop for window-info in windows - for window = (cl-first window-info) - collect (list (cl-second window-info) - (cl-third window-info) - window) + (cl-loop for (window title location) in windows + collect (list title location window) for gbrowser = (js< window "gBrowser") if (js-handle? gbrowser) @@ -3668,7 +3665,7 @@ Change with `js-set-js-context'.") (defun js-set-js-context (context) "Set the JavaScript context to CONTEXT. When called interactively, prompt for CONTEXT." - (interactive (list (js--read-tab "Javascript Context: "))) + (interactive (list (js--read-tab "JavaScript Context: "))) (setq js--js-context context)) (defun js--get-js-context () @@ -3682,7 +3679,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." (`browser (not (js? (js< (cdr js--js-context) "contentDocument")))) (x (error "Unmatched case in js--get-js-context: %S" x)))) - (setq js--js-context (js--read-tab "Javascript Context: "))) + (setq js--js-context (js--read-tab "JavaScript Context: "))) js--js-context)) (defun js--js-content-window (context) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d8262dd0a75..90b5e4e0dc6 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4693,7 +4693,8 @@ likely an invalid python file." (let ((dedenter-pos (python-info-dedenter-statement-p))) (when dedenter-pos (goto-char dedenter-pos) - (let* ((pairs '(("elif" "elif" "if") + (let* ((cur-line (line-beginning-position)) + (pairs '(("elif" "elif" "if") ("else" "if" "elif" "except" "for" "while") ("except" "except" "try") ("finally" "else" "except" "try"))) @@ -4709,7 +4710,22 @@ likely an invalid python file." (let ((indentation (current-indentation))) (when (and (not (memq indentation collected-indentations)) (or (not collected-indentations) - (< indentation (apply #'min collected-indentations)))) + (< indentation (apply #'min collected-indentations))) + ;; There must be no line with indentation + ;; smaller than `indentation' (except for + ;; blank lines) between the found opening + ;; block and the current line, otherwise it + ;; is not an opening block. + (save-excursion + (forward-line) + (let ((no-back-indent t)) + (save-match-data + (while (and (< (point) cur-line) + (setq no-back-indent + (or (> (current-indentation) indentation) + (python-info-current-line-empty-p)))) + (forward-line))) + no-back-indent))) (setq collected-indentations (cons indentation collected-indentations)) (when (member (match-string-no-properties 0) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 71563486ecd..88683431290 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2790,7 +2790,7 @@ local variable." ;; Iterate until we've moved the desired number of stmt ends (while (not (= (cl-signum arg) 0)) ;; if we're looking at the terminator, jump by 2 - (if (or (and (> 0 arg) (looking-back term)) + (if (or (and (> 0 arg) (looking-back term nil)) (and (< 0 arg) (looking-at term))) (setq n 2) (setq n 1)) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 0e8ff525e62..6c76d7e4ad2 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -126,6 +126,14 @@ ;;; Code: +(eval-when-compile (require 'cl)) +(eval-and-compile + ;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin' + ;; even for relatively simple cases such as used here. We only test <25 + ;; because it's easier and sufficient. + (when (or (featurep 'xemacs) (< emacs-major-version 25)) + (require 'cl))) + ;; Emacs 21+ handling (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) "Non-nil if GNU Emacs 21, 22, ... is used.") @@ -14314,7 +14322,7 @@ of PROJECT." (vhdl-scan-directory-contents dir-name project nil (format "(%s/%s) " act-dir num-dir) (cdr dir-list)) - (add-to-list 'dir-list-tmp (file-name-directory dir-name)) + (pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal) (setq dir-list (cdr dir-list) act-dir (1+ act-dir))) (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) @@ -16406,8 +16414,8 @@ component instantiation." (if (or (member constant-name single-list) (member constant-name multi-list)) (progn (setq single-list (delete constant-name single-list)) - (add-to-list 'multi-list constant-name)) - (add-to-list 'single-list constant-name)) + (pushnew constant-name multi-list :test #'equal)) + (pushnew constant-name single-list :test #'equal)) (unless (match-string 1) (setq generic-alist (cdr generic-alist))) (vhdl-forward-syntactic-ws)) @@ -16433,12 +16441,12 @@ component instantiation." (member signal-name multi-out-list)) (setq single-out-list (delete signal-name single-out-list)) (setq multi-out-list (delete signal-name multi-out-list)) - (add-to-list 'local-list signal-name)) + (pushnew signal-name local-list :test #'equal)) ((member signal-name single-in-list) (setq single-in-list (delete signal-name single-in-list)) - (add-to-list 'multi-in-list signal-name)) + (pushnew signal-name multi-in-list :test #'equal)) ((not (member signal-name multi-in-list)) - (add-to-list 'single-in-list signal-name))) + (pushnew signal-name single-in-list :test #'equal))) ;; output signal (cond ((member signal-name local-list) @@ -16447,17 +16455,18 @@ component instantiation." (member signal-name multi-in-list)) (setq single-in-list (delete signal-name single-in-list)) (setq multi-in-list (delete signal-name multi-in-list)) - (add-to-list 'local-list signal-name)) + (pushnew signal-name local-list :test #'equal)) ((member signal-name single-out-list) (setq single-out-list (delete signal-name single-out-list)) - (add-to-list 'multi-out-list signal-name)) + (pushnew signal-name multi-out-list :test #'equal)) ((not (member signal-name multi-out-list)) - (add-to-list 'single-out-list signal-name)))) + (pushnew signal-name single-out-list :test #'equal)))) (unless (match-string 1) (setq port-alist (cdr port-alist))) (vhdl-forward-syntactic-ws)) (push (list inst-name (nreverse constant-alist) - (nreverse signal-alist)) inst-alist)) + (nreverse signal-alist)) + inst-alist)) ;; prepare signal insertion (vhdl-goto-marker arch-decl-pos) (forward-line 1) @@ -16534,14 +16543,14 @@ component instantiation." generic-end-pos (vhdl-compose-insert-generic constant-entry))) (setq generic-pos (point-marker)) - (add-to-list 'written-list constant-name)) + (pushnew constant-name written-list :test #'equal)) (t (vhdl-goto-marker (vhdl-max-marker generic-inst-pos generic-pos)) (setq generic-end-pos (vhdl-compose-insert-generic constant-entry)) (setq generic-inst-pos (point-marker)) - (add-to-list 'written-list constant-name)))) + (pushnew constant-name written-list :test #'equal)))) (setq constant-alist (cdr constant-alist))) (when (/= constant-temp-pos generic-inst-pos) (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) @@ -16560,14 +16569,14 @@ component instantiation." (vhdl-max-marker port-end-pos (vhdl-compose-insert-port signal-entry))) (setq port-in-pos (point-marker)) - (add-to-list 'written-list signal-name)) + (pushnew signal-name written-list :test #'equal)) ((member signal-name multi-out-list) (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) (setq port-end-pos (vhdl-max-marker port-end-pos (vhdl-compose-insert-port signal-entry))) (setq port-out-pos (point-marker)) - (add-to-list 'written-list signal-name)) + (pushnew signal-name written-list :test #'equal)) ((or (member signal-name single-in-list) (member signal-name single-out-list)) (vhdl-goto-marker @@ -16576,12 +16585,12 @@ component instantiation." (vhdl-max-marker port-out-pos port-in-pos))) (setq port-end-pos (vhdl-compose-insert-port signal-entry)) (setq port-inst-pos (point-marker)) - (add-to-list 'written-list signal-name)) + (pushnew signal-name written-list :test #'equal)) ((equal (upcase (nth 2 signal-entry)) "OUT") (vhdl-goto-marker signal-pos) (vhdl-compose-insert-signal signal-entry) (setq signal-pos (point-marker)) - (add-to-list 'written-list signal-name))) + (pushnew signal-name written-list :test #'equal))) (setq signal-alist (cdr signal-alist))) (when (/= port-temp-pos port-inst-pos) (vhdl-goto-marker @@ -16932,7 +16941,7 @@ no project is defined." "Remove duplicate elements from IN-LIST." (let (out-list) (while in-list - (add-to-list 'out-list (car in-list)) + (pushnew (car in-list) out-list :test #'equal) (setq in-list (cdr in-list))) out-list)) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index d8098c5a54a..a507755d42e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -918,6 +918,10 @@ IGNORES is a list of glob patterns." (grep-compute-defaults) (defvar grep-find-template) (defvar grep-highlight-matches) + ;; 'grep -E -foo' results in 'grep: oo: No such file or directory'. + ;; while 'grep -e -foo' inexplicably doesn't. + (when (eq (aref regexp 0) ?-) + (setq regexp (concat "\\" regexp))) (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " grep-find-template t t)) (grep-highlight-matches nil) diff --git a/lisp/recentf.el b/lisp/recentf.el index 2b1d22bb907..4f0573911b9 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -82,7 +82,7 @@ See the command `recentf-save-list'." recentf-mode (recentf-load-list))))) -(defcustom recentf-save-file-modes 384 ;; 0600 +(defcustom recentf-save-file-modes #o600 "Mode bits of recentf save file, as an integer, or nil. If non-nil, after writing `recentf-save-file', set its mode bits to this value. By default give R/W access only to the user who owns that diff --git a/lisp/shell.el b/lisp/shell.el index 133771aeb32..c8a8555d632 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -544,11 +544,14 @@ control whether input and output cause the window to scroll to the end of the buffer." (setq comint-prompt-regexp shell-prompt-pattern) (shell-completion-vars) - (set (make-local-variable 'paragraph-separate) "\\'") - (set (make-local-variable 'paragraph-start) comint-prompt-regexp) - (set (make-local-variable 'font-lock-defaults) '(shell-font-lock-keywords t)) - (set (make-local-variable 'shell-dirstack) nil) - (set (make-local-variable 'shell-last-dir) nil) + (setq-local paragraph-separate "\\'") + (setq-local paragraph-start comint-prompt-regexp) + (setq-local font-lock-defaults '(shell-font-lock-keywords t)) + (setq-local shell-dirstack nil) + (setq-local shell-last-dir nil) + ;; People expect Shell mode to keep the last line of output at + ;; window bottom. + (setq-local scroll-conservatively 101) (shell-dirtrack-mode 1) ;; By default, ansi-color applies faces using overlays. This is diff --git a/lisp/simple.el b/lisp/simple.el index f798cd43847..441713a18b8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5410,11 +5410,15 @@ also checks the value of `use-empty-active-region'." ;; region is active when there's no mark. (progn (cl-assert (mark)) t))) +(defun region-bounds () + "Return the boundaries of the region as a list of (START . END) positions." + (funcall region-extract-function 'bounds)) + (defun region-noncontiguous-p () "Return non-nil if the region contains several pieces. An example is a rectangular region handled as a list of separate contiguous regions for each line." - (> (length (funcall region-extract-function 'bounds)) 1)) + (> (length (region-bounds)) 1)) (defvar redisplay-unhighlight-region-function (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) @@ -7568,7 +7572,7 @@ More precisely, a char with closeparen syntax is self-inserted.") ;; This executes C-g typed while Emacs is waiting for a command. ;; Quitting out of a program does not go through here; -;; that happens in the QUIT macro at the C code level. +;; that happens in the maybe_quit function at the C code level. (defun keyboard-quit () "Signal a `quit' condition. During execution of Lisp code, this character causes a quit directly. diff --git a/lisp/subr.el b/lisp/subr.el index 53774169b42..a6ba05c2021 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -384,6 +384,126 @@ configuration." (declare (compiler-macro internal--compiler-macro-cXXr)) (cdr (cdr x))) +(defun caaar (x) + "Return the `car' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (car x)))) + +(defun caadr (x) + "Return the `car' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (cdr x)))) + +(defun cadar (x) + "Return the `car' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (car x)))) + +(defun caddr (x) + "Return the `car' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (cdr x)))) + +(defun cdaar (x) + "Return the `cdr' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (car x)))) + +(defun cdadr (x) + "Return the `cdr' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (cdr x)))) + +(defun cddar (x) + "Return the `cdr' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (car x)))) + +(defun cdddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (cdr x)))) + +(defun caaaar (x) + "Return the `car' of the `car' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (car (car x))))) + +(defun caaadr (x) + "Return the `car' of the `car' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (car (cdr x))))) + +(defun caadar (x) + "Return the `car' of the `car' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (cdr (car x))))) + +(defun caaddr (x) + "Return the `car' of the `car' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (car (cdr (cdr x))))) + +(defun cadaar (x) + "Return the `car' of the `cdr' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (car (car x))))) + +(defun cadadr (x) + "Return the `car' of the `cdr' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (car (cdr x))))) + +(defun caddar (x) + "Return the `car' of the `cdr' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (cdr (car x))))) + +(defun cadddr (x) + "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (car (cdr (cdr (cdr x))))) + +(defun cdaaar (x) + "Return the `cdr' of the `car' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (car (car x))))) + +(defun cdaadr (x) + "Return the `cdr' of the `car' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (car (cdr x))))) + +(defun cdadar (x) + "Return the `cdr' of the `car' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (cdr (car x))))) + +(defun cdaddr (x) + "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (car (cdr (cdr x))))) + +(defun cddaar (x) + "Return the `cdr' of the `cdr' of the `car' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (car (car x))))) + +(defun cddadr (x) + "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (car (cdr x))))) + +(defun cdddar (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (cdr (car x))))) + +(defun cddddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (compiler-macro internal--compiler-macro-cXXr)) + (cdr (cdr (cdr (cdr x))))) + (defun last (list &optional n) "Return the last link of LIST. Its car is the last element. If LIST is nil, return nil. diff --git a/lisp/term.el b/lisp/term.el index 5259571eb6d..063a6ea592f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2901,15 +2901,16 @@ See `term-prompt-regexp'." ((eq char ?\017)) ; Shift In - ignored ((eq char ?\^G) ;; (terminfo: bel) (beep t)) - ((and (eq char ?\032) - (not handled-ansi-message)) + ((eq char ?\032) (let ((end (string-match "\r?\n" str i))) (if end - (funcall term-command-hook - (decode-coding-string - (prog1 (substring str (1+ i) end) - (setq i (1- (match-end 0)))) - locale-coding-system)) + (progn + (unless handled-ansi-message + (funcall term-command-hook + (decode-coding-string + (substring str (1+ i) end) + locale-coding-system))) + (setq i (1- (match-end 0)))) (setq term-terminal-parameter (substring str i)) (setq term-terminal-state 4) (setq i str-length)))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index dfe1cf0c341..c81c3f62e16 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -27,7 +27,6 @@ ;;; Todo: -;; - electric ; and } ;; - filling code with auto-fill-mode ;; - fix font-lock errors with multi-line selectors @@ -667,6 +666,8 @@ cannot be completed sensibly: `custom-ident', ;; Variables. (,(concat "--" css-ident-re) (0 font-lock-variable-name-face)) ;; Selectors. + ;; Allow plain ":root" as a selector. + ("^[ \t]*\\(:root\\)\\(?:[\n \t]*\\)*{" (1 'css-selector keep)) ;; FIXME: attribute selectors don't work well because they may contain ;; strings which have already been highlighted as f-l-string-face and ;; thus prevent this highlighting from being applied (actually now that diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 63abd048e9d..03da584e96f 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -164,6 +164,8 @@ distribution. Mixed-case symbols are convenience aliases.") (?U . "\\autocite*[][]{%l}") (?a . "\\citeauthor{%l}") (?A . "\\citeauthor*{%l}") + (?i . "\\citetitle{%l}") + (?I . "\\citetitle*{%l}") (?y . "\\citeyear{%l}") (?Y . "\\citeyear*{%l}") (?n . "\\nocite{%l}"))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 06f969d2784..261e98eabce 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -109,7 +109,7 @@ (def-edebug-spec push (&or [form symbolp] [form gv-place])) -;; Correct wrong declaration. This still doesn't support dotted desctructuring +;; Correct wrong declaration. This still doesn't support dotted destructuring ;; though. (def-edebug-spec cl-lambda-list (([&rest cl-macro-arg] @@ -1006,7 +1006,7 @@ BEG-UND are the starting points of the overline or underline, respectively. They may be nil if the respective thing is missing. BEG-TXT is the beginning of the title line or the transition and must be given. The end of the line is used as the end point. TXT -is the title text or nil. If TXT is given the indendation of the +is the title text or nil. If TXT is given the indentation of the line containing BEG-TXT is used as indentation. Match group 0 is derived from the remaining information." (cl-check-type beg-txt integer-or-marker) @@ -1845,8 +1845,7 @@ Uses and sets `rst-all-ttls-cache'." HDRS reflects the order in which the headers appear in the buffer. Return a `rst-Hdr' list representing the hierarchy of headers in the buffer. Indentation is unified." - (let (ado2indents) ; Asscociates `rst-Ado' with the set of indents seen for - ; it. + (let (ado2indents) ; Associates `rst-Ado' with the set of indents seen for it. (dolist (hdr hdrs) (let* ((ado (rst-Hdr-ado hdr)) (indent (rst-Hdr-indent hdr)) @@ -2451,7 +2450,7 @@ also arranged by `rst-insert-list-new-tag'." (defun rst-insert-list-continue (ind tag tab prefer-roman) ;; testcover: ok. "Insert a new list tag after the current line according to style. -Style is defined by indentaton IND, TAG and suffix TAB. If +Style is defined by indentation IND, TAG and suffix TAB. If PREFER-ROMAN roman numbering is preferred over using letters." (end-of-line) (insert @@ -2551,8 +2550,8 @@ roman numerical list, just use a prefix to set PREFER-ROMAN." "Return the positions of begs in region BEG to END. RST-RE-BEG is a `rst-re' argument and matched at the beginning of a line. Return a list of (POINT . COLUMN) where POINT gives the -point after indentaton and COLUMN gives its column. The list is -ordererd by POINT." +point after indentation and COLUMN gives its column. The list is +ordered by POINT." (let (r) (save-match-data (save-excursion @@ -2963,7 +2962,7 @@ error if there is no working link at the given position." (unless link-buf (setq link-buf (current-buffer))) ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is - ;; suppressed and invisible in interactve use. + ;; suppressed and invisible in interactive use. (let ((mrkr (rst-toc-get-link link-buf link-pnt))) (condition-case nil (rst-toc-mode-return kill) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 9dfcd944bbd..e609ca9f943 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -498,22 +498,57 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") ;; The return value is used by easy-mmode-define-navigation. (goto-char (or end (point-max))))) +;; "index ", "old mode", "new mode", "new file mode" and +;; "deleted file mode" are output by git-diff. +(defconst diff-file-junk-re + (concat "Index: \\|=\\{20,\\}\\|" ; SVN + "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file")) + +;; If point is in a diff header, then return beginning +;; of hunk position otherwise return nil. +(defun diff--at-diff-header-p () + "Return non-nil if point is inside a diff header." + (let ((regexp-hunk diff-hunk-header-re) + (regexp-file diff-file-header-re) + (regexp-junk diff-file-junk-re) + (orig (point))) + (catch 'headerp + (save-excursion + (forward-line 0) + (when (looking-at regexp-hunk) ; Hunk header. + (throw 'headerp (point))) + (forward-line -1) + (when (re-search-forward regexp-file (point-at-eol 4) t) ; File header. + (forward-line 0) + (throw 'headerp (point))) + (goto-char orig) + (forward-line 0) + (when (looking-at regexp-junk) ; Git diff junk. + (while (and (looking-at regexp-junk) + (not (bobp))) + (forward-line -1)) + (re-search-forward regexp-file nil t) + (forward-line 0) + (throw 'headerp (point)))) nil))) + (defun diff-beginning-of-hunk (&optional try-harder) "Move back to the previous hunk beginning, and return its position. If point is in a file header rather than a hunk, advance to the next hunk if TRY-HARDER is non-nil; otherwise signal an error." (beginning-of-line) - (if (looking-at diff-hunk-header-re) + (if (looking-at diff-hunk-header-re) ; At hunk header. (point) - (forward-line 1) - (condition-case () - (re-search-backward diff-hunk-header-re) - (error - (unless try-harder - (error "Can't find the beginning of the hunk")) - (diff-beginning-of-file-and-junk) - (diff-hunk-next) - (point))))) + (let ((pos (diff--at-diff-header-p)) + (regexp diff-hunk-header-re)) + (cond (pos ; At junk diff header. + (if try-harder + (goto-char pos) + (error "Can't find the beginning of the hunk"))) + ((re-search-backward regexp nil t)) ; In the middle of a hunk. + ((re-search-forward regexp nil t) ; At first hunk header. + (forward-line 0) + (point)) + (t (error "Can't find the beginning of the hunk")))))) (defun diff-unified-hunk-p () (save-excursion @@ -551,124 +586,26 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." ;; Define diff-{hunk,file}-{prev,next} (easy-mmode-define-navigation - diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view) + diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view + (when diff-auto-refine-mode + (unless (prog1 diff--auto-refine-data + (setq diff--auto-refine-data + (cons (current-buffer) (point-marker)))) + (run-at-time 0.0 nil + (lambda () + (when diff--auto-refine-data + (let ((buffer (car diff--auto-refine-data)) + (point (cdr diff--auto-refine-data))) + (setq diff--auto-refine-data nil) + (with-local-quit + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (goto-char point) + (diff-refine-hunk)))))))))))) (easy-mmode-define-navigation - diff--internal-file diff-file-header-re "file" diff-end-of-file) - -(defun diff--wrap-navigation (skip-hunk-start - what orig - header-re goto-start-func count) - "Wrap diff-{hunk,file}-{next,prev} for more intuitive behavior. -Override the default diff-{hunk,file}-{next,prev} implementation -by skipping any lines that are associated with this hunk/file but -precede the hunk-start marker. For instance, a diff file could -contain - -diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el -index 923de9a..6b1c24f 100644 ---- a/lisp/vc/diff-mode.el -+++ b/lisp/vc/diff-mode.el -@@ -590,6 +590,22 @@ -....... - -If a point is on 'index', then the point is considered to be in -this first hunk. Move the point to the @@... marker before -executing the default diff-hunk-next/prev implementation to move -to the NEXT marker." - (if (not skip-hunk-start) - (funcall orig count) - - (let ((start (point))) - (funcall goto-start-func) - - ;; Trap the error. - (condition-case nil - (funcall orig count) - (error nil)) - - (when (not (looking-at header-re)) - (goto-char start) - (user-error (format "No %s" what))) - - ;; We successfully moved to the next/prev hunk/file. Apply the - ;; auto-refinement if needed - (when diff-auto-refine-mode - (unless (prog1 diff--auto-refine-data - (setq diff--auto-refine-data - (cons (current-buffer) (point-marker)))) - (run-at-time 0.0 nil - (lambda () - (when diff--auto-refine-data - (let ((buffer (car diff--auto-refine-data)) - (point (cdr diff--auto-refine-data))) - (setq diff--auto-refine-data nil) - (with-local-quit - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-excursion - (goto-char point) - (diff-refine-hunk)))))))))))))) - -;; These functions all take a skip-hunk-start argument which controls -;; whether we skip pre-hunk-start text or not. In interactive uses we -;; always want to do this, but the simple behavior is still necessary -;; to, for example, avoid an infinite loop: -;; -;; diff-hunk-next calls -;; diff--wrap-navigation calls -;; diff-bounds-of-hunk calls -;; diff-beginning-of-hunk calls -;; diff-hunk-next -;; -;; Here the outer diff-hunk-next has skip-hunk-start set to t, but the -;; inner one does not, which breaks the loop. -(defun diff-hunk-prev (&optional count skip-hunk-start) - "Go to the previous COUNT'th hunk." - (interactive (list (prefix-numeric-value current-prefix-arg) t)) - (diff--wrap-navigation - skip-hunk-start - "prev hunk" - 'diff--internal-hunk-prev - diff-hunk-header-re - (lambda () (goto-char (car (diff-bounds-of-hunk)))) - count)) - -(defun diff-hunk-next (&optional count skip-hunk-start) - "Go to the next COUNT'th hunk." - (interactive (list (prefix-numeric-value current-prefix-arg) t)) - (diff--wrap-navigation - skip-hunk-start - "next hunk" - 'diff--internal-hunk-next - diff-hunk-header-re - (lambda () (goto-char (car (diff-bounds-of-hunk)))) - count)) - -(defun diff-file-prev (&optional count skip-hunk-start) - "Go to the previous COUNT'th file." - (interactive (list (prefix-numeric-value current-prefix-arg) t)) - (diff--wrap-navigation - skip-hunk-start - "prev file" - 'diff--internal-file-prev - diff-file-header-re - (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next)) - count)) - -(defun diff-file-next (&optional count skip-hunk-start) - "Go to the next COUNT'th file." - (interactive (list (prefix-numeric-value current-prefix-arg) t)) - (diff--wrap-navigation - skip-hunk-start - "next file" - 'diff--internal-file-next - diff-file-header-re - (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next)) - count)) - - - + diff-file diff-file-header-re "file" diff-end-of-file) (defun diff-bounds-of-hunk () "Return the bounds of the diff hunk at point. @@ -679,13 +616,12 @@ point is in a file header, return the bounds of the next hunk." (let ((pos (point)) (beg (diff-beginning-of-hunk t)) (end (diff-end-of-hunk))) - (cond ((> end pos) + (cond ((>= end pos) (list beg end)) ;; If this hunk ends above POS, consider the next hunk. ((re-search-forward diff-hunk-header-re nil t) (list (match-beginning 0) (diff-end-of-hunk))) - ;; There's no next hunk, so just take the one we have. - (t (list beg end)))))) + (t (error "No hunk found")))))) (defun diff-bounds-of-file () "Return the bounds of the file segment at point. @@ -731,12 +667,8 @@ If the prefix ARG is given, restrict the view to the current file instead." hunk-bounds)) (inhibit-read-only t)) (apply 'kill-region bounds) - (goto-char (car bounds)))) - -;; "index ", "old mode", "new mode", "new file mode" and -;; "deleted file mode" are output by git-diff. -(defconst diff-file-junk-re - "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file") + (goto-char (car bounds)) + (diff-beginning-of-hunk t))) (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -771,7 +703,7 @@ data such as \"Index: ...\" and such." (setq prevfile nextfile)) (if (and previndex (numberp prevfile) (< previndex prevfile)) (setq prevfile previndex)) - (if (numberp prevfile) + (if (and (numberp prevfile) (<= prevfile start)) (progn (goto-char prevfile) ;; Now skip backward over the leading junk we may have before the @@ -789,7 +721,8 @@ data such as \"Index: ...\" and such." "Kill current file's hunks." (interactive) (let ((inhibit-read-only t)) - (apply 'kill-region (diff-bounds-of-file)))) + (apply 'kill-region (diff-bounds-of-file))) + (diff-beginning-of-hunk t)) (defun diff-kill-junk () "Kill spurious empty diffs." @@ -1373,7 +1306,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN." ;; it's safer not to do it on big changes, e.g. when yanking a big ;; diff, or when the user edits the header, since we might then ;; screw up perfectly correct values. --Stef - (diff-beginning-of-hunk) + (diff-beginning-of-hunk t) (let* ((style (if (looking-at "\\*\\*\\*") 'context)) (start (line-beginning-position (if (eq style 'context) 3 2))) (mid (if (eq style 'context) @@ -1764,9 +1697,8 @@ SRC and DST are the two variants of text as returned by `diff-hunk-text'. SWITCHED is non-nil if the patch is already applied. NOPROMPT, if non-nil, means not to prompt the user." (save-excursion - (let* ((hunk-bounds (diff-bounds-of-hunk)) - (other (diff-xor other-file diff-jump-to-old-file)) - (char-offset (- (point) (goto-char (car hunk-bounds)))) + (let* ((other (diff-xor other-file diff-jump-to-old-file)) + (char-offset (- (point) (diff-beginning-of-hunk t))) ;; Check that the hunk is well-formed. Otherwise diff-mode and ;; the user may disagree on what constitutes the hunk ;; (e.g. because an empty line truncates the hunk mid-course), @@ -1775,7 +1707,7 @@ NOPROMPT, if non-nil, means not to prompt the user." ;; Suppress check when NOPROMPT is non-nil (Bug#3033). (_ (unless noprompt (diff-sanity-check-hunk))) (hunk (buffer-substring - (point) (cadr hunk-bounds))) + (point) (save-excursion (diff-end-of-hunk) (point)))) (old (diff-hunk-text hunk reverse char-offset)) (new (diff-hunk-text hunk (not reverse) char-offset)) ;; Find the location specification. @@ -1838,6 +1770,7 @@ the value of this variable when given an appropriate prefix argument). With a prefix argument, REVERSE the hunk." (interactive "P") + (diff-beginning-of-hunk t) (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched) ;; Sometimes we'd like to have the following behavior: if ;; REVERSE go to the new file, otherwise go to the old. @@ -1883,15 +1816,8 @@ With a prefix argument, REVERSE the hunk." ;; Display BUF in a window (set-window-point (display-buffer buf) (+ (car pos) (cdr new))) (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil) - - ;; Advance to the next hunk with skip-hunk-start set to t - ;; because we want the behavior of moving to the next logical - ;; hunk, not the original behavior where were would sometimes - ;; stay on the current hunk. This is the behavior we get when - ;; navigating through hunks interactively, and we want it when - ;; applying hunks too (see http://debbugs.gnu.org/17544). (when diff-advance-after-apply-hunk - (diff-hunk-next nil t)))))) + (diff-hunk-next)))))) (defun diff-test-hunk (&optional reverse) @@ -1972,15 +1898,14 @@ For use in `add-log-current-defun-function'." (defun diff-ignore-whitespace-hunk () "Re-diff the current hunk, ignoring whitespace differences." (interactive) - (let* ((hunk-bounds (diff-bounds-of-hunk)) - (char-offset (- (point) (goto-char (car hunk-bounds)))) + (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number")) (string-to-number (match-string 1)))) (inhibit-read-only t) (hunk (delete-and-extract-region - (point) (cadr hunk-bounds))) + (point) (save-excursion (diff-end-of-hunk) (point)))) (lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1. (file1 (make-temp-file "diff1")) (file2 (make-temp-file "diff2")) @@ -2062,35 +1987,48 @@ For use in `add-log-current-defun-function'." (declare-function smerge-refine-subst "smerge-mode" (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)) +(defun diff--forward-while-leading-char (char bound) + "Move point until reaching a line not starting with CHAR. +Return new point, if it was moved." + (let ((pt nil)) + (while (and (< (point) bound) (eql (following-char) char)) + (forward-line 1) + (setq pt (point))) + pt)) + (defun diff-refine-hunk () "Highlight changes of hunk at point at a finer granularity." (interactive) (require 'smerge-mode) (save-excursion - (let* ((hunk-bounds (diff-bounds-of-hunk)) - (style (progn (goto-char (car hunk-bounds)) - (diff-hunk-style))) ;Skips the hunk header as well. + (diff-beginning-of-hunk t) + (let* ((start (point)) + (style (diff-hunk-style)) ;Skips the hunk header as well. (beg (point)) - (end (cadr hunk-bounds)) (props-c '((diff-mode . fine) (face diff-refine-changed))) (props-r '((diff-mode . fine) (face diff-refine-removed))) - (props-a '((diff-mode . fine) (face diff-refine-added)))) + (props-a '((diff-mode . fine) (face diff-refine-added))) + ;; Be careful to go back to `start' so diff-end-of-hunk gets + ;; to read the hunk header's line info. + (end (progn (goto-char start) (diff-end-of-hunk) (point)))) (remove-overlays beg end 'diff-mode 'fine) (goto-char beg) (pcase style (`unified - (while (re-search-forward - (eval-when-compile - (let ((no-LF-at-eol-re "\\(?:\\\\.*\n\\)?")) - (concat "^\\(?:-.*\n\\)+" no-LF-at-eol-re - "\\(\\)" - "\\(?:\\+.*\n\\)+" no-LF-at-eol-re))) - end t) - (smerge-refine-subst (match-beginning 0) (match-end 1) - (match-end 1) (match-end 0) - nil 'diff-refine-preproc props-r props-a))) + (while (re-search-forward "^-" end t) + (let ((beg-del (progn (beginning-of-line) (point))) + beg-add end-add) + (when (and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) + (smerge-refine-subst beg-del beg-add beg-add end-add + nil 'diff-refine-preproc props-r props-a))))) (`context (let* ((middle (save-excursion (re-search-forward "^---"))) (other middle)) diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 95568b29c7c..0235926fbe4 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -150,6 +150,26 @@ It needs to be killed when we quit the session.") (defsubst ediff-get-symbol-from-alist (buf-type alist) (cdr (assoc buf-type alist))) +;; Vector of differences between the variants. Each difference is +;; represented by a vector of two overlays plus a vector of fine diffs, +;; plus a no-fine-diffs flag. The first overlay spans the +;; difference region in the A buffer and the second overlays the diff in +;; the B buffer. If a difference section is empty, the corresponding +;; overlay's endpoints coincide. +;; +;; The precise form of a Difference Vector for one buffer is: +;; [diff diff diff ...] +;; where each diff has the form: +;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff] +;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...] +;; no-fine-diffs-flag says if there are fine differences. +;; state-of-difference is A, B, C, or nil, indicating which buffer is +;; different from the other two (used only in 3-way jobs. +(ediff-defvar-local ediff-difference-vector-A nil "") +(ediff-defvar-local ediff-difference-vector-B nil "") +(ediff-defvar-local ediff-difference-vector-C nil "") +(ediff-defvar-local ediff-difference-vector-Ancestor nil "") +;; A-list of diff vector types associated with buffer types (defconst ediff-difference-vector-alist '((A . ediff-difference-vector-A) (B . ediff-difference-vector-B) @@ -642,32 +662,6 @@ shown in brighter colors." ;;buffer-read-only mode-line-format)) -;; Vector of differences between the variants. Each difference is -;; represented by a vector of two overlays plus a vector of fine diffs, -;; plus a no-fine-diffs flag. The first overlay spans the -;; difference region in the A buffer and the second overlays the diff in -;; the B buffer. If a difference section is empty, the corresponding -;; overlay's endpoints coincide. -;; -;; The precise form of a Difference Vector for one buffer is: -;; [diff diff diff ...] -;; where each diff has the form: -;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff] -;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...] -;; no-fine-diffs-flag says if there are fine differences. -;; state-of-difference is A, B, C, or nil, indicating which buffer is -;; different from the other two (used only in 3-way jobs. -(ediff-defvar-local ediff-difference-vector-A nil "") -(ediff-defvar-local ediff-difference-vector-B nil "") -(ediff-defvar-local ediff-difference-vector-C nil "") -(ediff-defvar-local ediff-difference-vector-Ancestor nil "") -;; A-list of diff vector types associated with buffer types -(defconst ediff-difference-vector-alist - '((A . ediff-difference-vector-A) - (B . ediff-difference-vector-B) - (C . ediff-difference-vector-C) - (Ancestor . ediff-difference-vector-Ancestor))) - ;; [ status status status ...] ;; Each status: [state-of-merge state-of-ancestor] ;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It diff --git a/lisp/xml.el b/lisp/xml.el index cd801be3083..be2ac96f264 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -646,8 +646,10 @@ surpassed `xml-entity-expansion-limit'")))) (defun xml-parse-attlist (&optional xml-ns) "Return the attribute-list after point. Leave point at the first non-blank character after the tag." - (let ((attlist ()) - end-pos name) + (let* ((attlist ()) + (symbol-qnames (eq (car-safe xml-ns) 'symbol-qnames)) + (xml-ns (if symbol-qnames (cdr xml-ns) xml-ns)) + end-pos name) (skip-syntax-forward " ") (while (looking-at (eval-when-compile (concat "\\(" xml-name-re "\\)\\s-*=\\s-*"))) |