diff options
Diffstat (limited to 'lisp')
71 files changed, 1494 insertions, 910 deletions
diff --git a/lisp/auth-source.el b/lisp/auth-source.el index c26935fcc97..7402ab21d74 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2129,7 +2129,7 @@ MODE can be \"login\" or \"password\"." (if user (auth-source-search :host host - :user "yourusername" + :user user :max 1 :require '(:user :secret) :create nil) 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/buff-menu.el b/lisp/buff-menu.el index 77b325ff25d..9f618bcb7de 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -102,9 +102,6 @@ This is set by the prefix argument to `buffer-menu' and related commands.") (make-variable-buffer-local 'Buffer-menu-files-only) -(defvar Info-current-file) ; from info.el -(defvar Info-current-node) ; from info.el - (defvar Buffer-menu-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap))) @@ -702,21 +699,7 @@ means list those buffers and no others." (defun Buffer-menu--pretty-file-name (file) (cond (file (abbreviate-file-name file)) - ((and (boundp 'list-buffers-directory) - list-buffers-directory) - list-buffers-directory) - ((eq major-mode 'Info-mode) - (Buffer-menu-info-node-description Info-current-file)) + ((bound-and-true-p list-buffers-directory)) (t ""))) -(defun Buffer-menu-info-node-description (file) - (cond - ((equal file "dir") "*Info Directory*") - ((eq file 'apropos) "*Info Apropos*") - ((eq file 'history) "*Info History*") - ((eq file 'toc) "*Info TOC*") - ((not (stringp file)) "") ; Avoid errors - (t - (concat "(" (file-name-nondirectory file) ") " Info-current-node)))) - ;;; buff-menu.el ends here 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/calendar/parse-time.el b/lisp/calendar/parse-time.el index 7651c5da1f4..b781cb0eb48 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -1,4 +1,4 @@ -;;; parse-time.el --- parsing time strings +;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*- ;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc. @@ -203,12 +203,9 @@ any values that are unknown are returned as nil." (time-second 2digit) (time-secfrac "\\(\\.[0-9]+\\)?") (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) - (time-offset (concat "Z" time-numoffset)) (partial-time (concat time-hour colon time-minute colon time-second time-secfrac)) - (full-date (concat date-fullyear dash date-month dash date-mday)) - (full-time (concat partial-time time-offset)) - (date-time (concat full-date "T" full-time))) + (full-date (concat date-fullyear dash date-month dash date-mday))) (list (concat "^" full-date) (concat "T" partial-time) (concat "\\(Z\\|" time-numoffset "\\)"))) @@ -225,7 +222,7 @@ If DATE-STRING cannot be parsed, it falls back to (time-re (nth 1 parse-time-iso8601-regexp)) (tz-re (nth 2 parse-time-iso8601-regexp)) re-start - time seconds minute hour fractional-seconds + time seconds minute hour day month year day-of-week dst tz) ;; We need to populate 'time' with ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) @@ -240,9 +237,6 @@ If DATE-STRING cannot be parsed, it falls back to (setq hour (string-to-number (match-string 1 date-string)) minute (string-to-number (match-string 2 date-string)) seconds (string-to-number (match-string 3 date-string)) - fractional-seconds (string-to-number (or - (match-string 4 date-string) - "0")) re-start (match-end 0)) (when (string-match tz-re date-string re-start) (if (string= "Z" (match-string 1 date-string)) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a790419b86f..51c43c7d21a 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -511,6 +511,7 @@ since it could result in memory overflow and make Emacs crash." (scroll-step windows integer) (scroll-conservatively windows integer) (scroll-margin windows integer) + (maximum-scroll-margin windows float "26.1") (hscroll-margin windows integer "22.1") (hscroll-step windows number "22.1") (truncate-partial-width-windows 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/dired.el b/lisp/dired.el index 350f6a7d2e3..2733372eb7b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -59,6 +59,10 @@ May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch. +Options that include embedded whitespace must be quoted +like this: \\\"--option=value with spaces\\\"; you can use +`combine-and-quote-strings' to produce the correct quoting of +each option. On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp, some of the `ls' switches are not supported; see the doc string of `insert-directory' in `ls-lisp.el' for more details." diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 2c11cd23a7f..172ea163c18 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -442,6 +442,9 @@ Typically \"page-%s.png\".") (defun doc-view-revert-buffer (&optional ignore-auto noconfirm) "Like `revert-buffer', but preserves the buffer's current modes." (interactive (list (not current-prefix-arg))) + (if (< undo-outer-limit (* 2 (buffer-size))) + ;; It's normal for this operation to result in a very large undo entry. + (setq-local undo-outer-limit (* 2 (buffer-size)))) (cl-labels ((revert () (let (revert-buffer-function) (revert-buffer ignore-auto noconfirm 'preserve-modes)))) @@ -1763,6 +1766,8 @@ toggle between displaying the document or editing it as text. (unless doc-view-doc-type (doc-view-set-doc-type)) (doc-view-set-up-single-converter) + (unless (memq doc-view-doc-type '(ps)) + (setq-local require-final-newline nil)) (doc-view-make-safe-dir doc-view-cache-directory) ;; Handle compressed files, remote files, files inside archives 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/edebug.el b/lisp/emacs-lisp/edebug.el index db54d1eeb20..ec0f08de356 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -112,6 +112,18 @@ and some not, use `def-edebug-spec' to specify an `edebug-form-spec'." :type 'boolean :group 'edebug) +(defcustom edebug-max-depth 150 + "Maximum recursion depth when instrumenting code. +This limit is intended to stop recursion if an Edebug specification +contains an infinite loop. When Edebug is instrumenting code +containing very large quoted lists, it may reach this limit and give +the error message \"Too deep - perhaps infinite loop in spec?\". +Make this limit larger to countermand that, but you may also need to +increase `max-lisp-eval-depth' and `max-specpdl-size'." + :type 'integer + :group 'edebug + :version "26.1") + (defcustom edebug-save-windows t "If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to @@ -1452,7 +1464,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-after-dotted-spec nil) (defvar edebug-matching-depth 0) ;; initial value -(defconst edebug-max-depth 150) ;; maximum number of matching recursions. ;;; Failure to match diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 7d99cb30274..4cf9d9609e9 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -97,7 +97,7 @@ To be used in ERT tests. If BODY finishes successfully, the test buffer is killed; if there is an error, the test buffer is kept around on error for further inspection. Its name is derived from the name of the test and the result of NAME-FORM." - (declare (debug ((form) body)) + (declare (debug ((":name" form) body)) (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) @@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (kill-buffer clone))))))) +(defmacro ert-with-message-capture (var &rest body) + "Execute BODY while collecting anything written with `message' in VAR. + +Capture all messages produced by `message' when it is called from +Lisp, and concatenate them separated by newlines into one string. + +This is useful for separating the issuance of messages by the +code under test from the behavior of the *Messages* buffer." + (declare (debug (symbolp body)) + (indent 1)) + (let ((g-advice (cl-gensym))) + `(let* ((,var "") + (,g-advice (lambda (func &rest args) + (if (or (null args) (equal (car args) "")) + (apply func args) + (let ((msg (apply #'format-message args))) + (setq ,var (concat ,var msg "\n")) + (funcall func "%s" msg)))))) + (advice-add 'message :around ,g-advice) + (unwind-protect + (progn ,@body) + (advice-remove 'message ,g-advice))))) + + (provide 'ert-x) ;;; ert-x.el ends here diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index a45fc0a05c3..cf82fe3ec63 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -4,7 +4,7 @@ ;; Author: Artur Malabarba <emacs@endlessparentheses.com> ;; Package-Requires: ((emacs "24.1")) -;; Version: 1.0.4 +;; Version: 1.0.5 ;; Keywords: extensions lisp ;; Prefix: let-alist ;; Separator: - diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 54678c5f324..46a5eedd150 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -89,7 +89,8 @@ (functionp &rest form) sexp)) -(def-edebug-spec pcase-MACRO pcase--edebug-match-macro) +;; See bug#24717 +(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro) ;; Only called from edebug. (declare-function get-edebug-spec "edebug" (symbol)) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7736225b5fa..f7a846927c0 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -115,12 +115,16 @@ threading." binding)) bindings))) -(defmacro if-let (bindings then &rest else) - "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +(defmacro if-let* (bindings then &rest else) + "Bind variables according to VARLIST and eval THEN or ELSE. +Each binding is evaluated in turn with `let*', and evaluation +stops if a binding value is nil. If all are non-nil, the value +of THEN is returned, or the last form in ELSE is returned. +Each element of VARLIST is a symbol (which is bound to nil) +or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). +In the special case you only want to bind a single value, +VARLIST can just be a plain tuple. +\n(fn VARLIST THEN ELSE...)" (declare (indent 2) (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) (when (and (<= (length bindings) 2) @@ -132,15 +136,23 @@ to bind a single value, BINDINGS can just be a plain tuple." ,then ,@else))) -(defmacro when-let (bindings &rest body) - "Process BINDINGS and if all values are non-nil eval BODY. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +(defmacro when-let* (bindings &rest body) + "Bind variables according to VARLIST and conditionally eval BODY. +Each binding is evaluated in turn with `let*', and evaluation +stops if a binding value is nil. If all are non-nil, the value +of the last form in BODY is returned. +Each element of VARLIST is a symbol (which is bound to nil) +or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). +In the special case you only want to bind a single value, +VARLIST can just be a plain tuple. +\n(fn VARLIST BODY...)" (declare (indent 1) (debug if-let)) (list 'if-let bindings (macroexp-progn body))) +(defalias 'if-let 'if-let*) +(defalias 'when-let 'when-let*) +(defalias 'and-let* 'when-let*) + (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." (zerop (hash-table-count hash-table))) @@ -214,6 +226,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses, perform the requested window recentering or scrolling and ask again. +When `use-dialog-box' is t (the default), this function can pop +up a dialog window to collect the user input. That functionality +requires `display-popup-menus-p' to return t. Otherwise, a text +dialog will be used. + The return value is the matching entry from the CHOICES list. Usage example: 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/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 24a8f039fa5..457ad55dd6c 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -57,9 +57,9 @@ ;; Usage: ;; Simply load this file into emacs (version 19 or higher) -;; using the following command. +;; and run the function edt-mapper, using the following command. -;; emacs -q -l edt-mapper.el +;; emacs -q -l edt-mapper -f edt-mapper ;; The "-q" option prevents loading of your init file (commands ;; therein might confuse this program). @@ -96,10 +96,6 @@ ;;; Code: -;; Otherwise it just hangs. This seems preferable. -(if noninteractive - (error "edt-mapper cannot be loaded in batch mode")) - ;;; ;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs). ;;; Determine Window System, and X Server Vendor (if appropriate). @@ -124,6 +120,8 @@ ;;; ;;; Key variables ;;; + +;; FIXME some/all of these should be let-bound, not global. (defvar edt-key nil) (defvar edt-enter nil) (defvar edt-return nil) @@ -137,88 +135,116 @@ (defvar edt-save-function-key-map) ;;; -;;; Determine Terminal Type (if appropriate). -;;; - -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (setq edt-term nil) - (setq edt-term (getenv "TERM"))) - -;;; -;;; Implements a workaround for a feature that was added to simple.el. -;;; -;;; Many function keys have no Emacs functions assigned to them by -;;; default. A subset of these are typically assigned functions in the -;;; EDT emulation. This includes all the keypad keys and a some others -;;; like Delete. -;;; -;;; Logic in simple.el maps some of these unassigned function keys to -;;; ordinary typing keys. Where this is the case, a call to -;;; read-key-sequence, below, does not return the name of the function -;;; key pressed by the user but, instead, it returns the name of the -;;; key to which it has been mapped. It needs to know the name of the -;;; key pressed by the user. As a workaround, we assign a function to -;;; each of the unassigned function keys of interest, here. These -;;; assignments override the mapping to other keys and are only -;;; temporary since, when edt-mapper is finished executing, it causes -;;; Emacs to exit. -;;; - -(mapc - (lambda (function-key) - (if (not (lookup-key (current-global-map) function-key)) - (define-key (current-global-map) function-key 'forward-char))) - '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] - [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] - [kp-space] - [kp-tab] - [kp-enter] - [kp-multiply] - [kp-add] - [kp-separator] - [kp-subtract] - [kp-decimal] - [kp-divide] - [kp-equal] - [backspace] - [delete] - [tab] - [linefeed] - [clear])) - -;;; -;;; Make sure the window is big enough to display the instructions, -;;; except where window cannot be re-sized. -;;; - -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (set-frame-size (selected-frame) 80 36)) - -;;; -;;; Create buffers - Directions and Keys +;;; Key mapping functions ;;; -(if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) -(if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) +(defun edt-map-key (ident descrip) + (interactive) + (if (featurep 'xemacs) + (progn + (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) + (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) + (cond ((not (equal edt-key edt-return)) + (set-buffer "Keys") + (insert (format " (\"%s\" . %s)\n" ident edt-key)) + (set-buffer "Directions")) + ;; bogosity to get next prompt to come up, if the user hits <CR>! + ;; check periodically to see if this is still needed... + (t + (set-buffer "Keys") + (insert (format " (\"%s\" . \"\" )\n" ident)) + (set-buffer "Directions")))) + (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip))) + (cond ((not (equal edt-key edt-return)) + (set-buffer "Keys") + (insert (if (vectorp edt-key) + (format " (\"%s\" . %s)\n" ident edt-key) + (format " (\"%s\" . \"%s\")\n" ident edt-key))) + (set-buffer "Directions")) + ;; bogosity to get next prompt to come up, if the user hits <CR>! + ;; check periodically to see if this is still needed... + (t + (set-buffer "Keys") + (insert (format " (\"%s\" . \"\" )\n" ident)) + (set-buffer "Directions")))) + edt-key) -;;; -;;; Put header in the Keys buffer -;;; -(set-buffer "Keys") -(insert "\ +(defun edt-mapper () + (if noninteractive + (user-error "edt-mapper cannot be loaded in batch mode")) + ;; Determine Terminal Type (if appropriate). + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (setq edt-term nil) + (setq edt-term (getenv "TERM"))) + ;; + ;; Implements a workaround for a feature that was added to simple.el. + ;; + ;; Many function keys have no Emacs functions assigned to them by + ;; default. A subset of these are typically assigned functions in the + ;; EDT emulation. This includes all the keypad keys and a some others + ;; like Delete. + ;; + ;; Logic in simple.el maps some of these unassigned function keys to + ;; ordinary typing keys. Where this is the case, a call to + ;; read-key-sequence, below, does not return the name of the function + ;; key pressed by the user but, instead, it returns the name of the + ;; key to which it has been mapped. It needs to know the name of the + ;; key pressed by the user. As a workaround, we assign a function to + ;; each of the unassigned function keys of interest, here. These + ;; assignments override the mapping to other keys and are only + ;; temporary since, when edt-mapper is finished executing, it causes + ;; Emacs to exit. + ;; + (mapc + (lambda (function-key) + (if (not (lookup-key (current-global-map) function-key)) + (define-key (current-global-map) function-key 'forward-char))) + '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] + [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] + [kp-space] + [kp-tab] + [kp-enter] + [kp-multiply] + [kp-add] + [kp-separator] + [kp-subtract] + [kp-decimal] + [kp-divide] + [kp-equal] + [backspace] + [delete] + [tab] + [linefeed] + [clear])) + ;; + ;; Make sure the window is big enough to display the instructions, + ;; except where window cannot be re-sized. + ;; + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (set-frame-size (selected-frame) 80 36)) + ;; + ;; Create buffers - Directions and Keys + ;; + (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) + (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) + ;; + ;; Put header in the Keys buffer + ;; + (set-buffer "Keys") + (insert "\ ;; ;; Key definitions for the EDT emulation within GNU Emacs ;; -(defconst *EDT-keys* +\(defconst *EDT-keys* '( -") - -;;; -;;; Display directions -;;; -(switch-to-buffer "Directions") -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (insert " + ") + + ;; + ;; Display directions + ;; + (switch-to-buffer "Directions") + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (insert " EDT MAPPER You will be asked to press keys to create a custom mapping (under a @@ -240,7 +266,7 @@ just press RETURN at the prompt. ") - (insert " + (insert " EDT MAPPER You will be asked to press keys to create a custom mapping of your @@ -259,39 +285,39 @@ ")) -(delete-other-windows) - -;;; -;;; Save <CR> for future reference. -;;; -;;; For GNU Emacs, running in a Window System, first hide bindings in -;;; function-key-map. -;;; -(cond - ((featurep 'xemacs) - (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) - (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) - (t - (if edt-window-system - (progn - (setq edt-save-function-key-map function-key-map) - (setq function-key-map (make-sparse-keymap)))) - (setq edt-return (read-key-sequence "Hit carriage-return <CR> to continue ")))) - -;;; -;;; Remove prefix-key bindings to F1 and F2 in global-map so they can be -;;; bound in the EDT Emulation mode. -;;; -(global-unset-key [f1]) -(global-unset-key [f2]) - -;;; -;;; Display Keypad Diagram and Begin Prompting for Keys -;;; -(set-buffer "Directions") -(delete-region (point-min) (point-max)) -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (insert " + (delete-other-windows) + + ;; + ;; Save <CR> for future reference. + ;; + ;; For GNU Emacs, running in a Window System, first hide bindings in + ;; function-key-map. + ;; + (cond + ((featurep 'xemacs) + (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) + (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) + (t + (if edt-window-system + (progn + (setq edt-save-function-key-map function-key-map) + (setq function-key-map (make-sparse-keymap)))) + (setq edt-return (read-key-sequence "Hit carriage-return <CR> to continue ")))) + + ;; + ;; Remove prefix-key bindings to F1 and F2 in global-map so they can be + ;; bound in the EDT Emulation mode. + ;; + (global-unset-key [f1]) + (global-unset-key [f2]) + + ;; + ;; Display Keypad Diagram and Begin Prompting for Keys + ;; + (set-buffer "Directions") + (delete-region (point-min) (point-max)) + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (insert " PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. @@ -321,11 +347,11 @@ REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY. ") - (progn - (insert " + (progn + (insert " GENERATING A CUSTOM CONFIGURATION FILE FOR TERMINAL TYPE: ") - (insert (format "%s." edt-term)) - (insert " + (insert (format "%s." edt-term)) + (insert " PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. @@ -347,142 +373,109 @@ REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY."))) -;;; -;;; Key mapping functions -;;; -(defun edt-map-key (ident descrip) - (interactive) - (if (featurep 'xemacs) - (progn - (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) - (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) - (cond ((not (equal edt-key edt-return)) - (set-buffer "Keys") - (insert (format " (\"%s\" . %s)\n" ident edt-key)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (set-buffer "Keys") - (insert (format " (\"%s\" . \"\" )\n" ident)) - (set-buffer "Directions")))) - (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip))) - (cond ((not (equal edt-key edt-return)) - (set-buffer "Keys") - (insert (if (vectorp edt-key) - (format " (\"%s\" . %s)\n" ident edt-key) - (format " (\"%s\" . \"%s\")\n" ident edt-key))) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (set-buffer "Keys") - (insert (format " (\"%s\" . \"\" )\n" ident)) - (set-buffer "Directions")))) - edt-key) -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; Arrows ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "UP" " - The Up Arrow Key") -(edt-map-key "DOWN" " - The Down Arrow Key") -(edt-map-key "LEFT" " - The Left Arrow Key") -(edt-map-key "RIGHT" " - The Right Arrow Key") + (edt-map-key "UP" " - The Up Arrow Key") + (edt-map-key "DOWN" " - The Down Arrow Key") + (edt-map-key "LEFT" " - The Left Arrow Key") + (edt-map-key "RIGHT" " - The Right Arrow Key") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; PF keys ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "PF1" " - The PF1 (GOLD) Key") -(edt-map-key "PF2" " - The Keypad PF2 Key") -(edt-map-key "PF3" " - The Keypad PF3 Key") -(edt-map-key "PF4" " - The Keypad PF4 Key") + (edt-map-key "PF1" " - The PF1 (GOLD) Key") + (edt-map-key "PF2" " - The Keypad PF2 Key") + (edt-map-key "PF3" " - The Keypad PF3 Key") + (edt-map-key "PF4" " - The Keypad PF4 Key") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; KP0-9 KP- KP, KPP and KPE ;; ") -(set-buffer "Directions") - -(edt-map-key "KP0" " - The Keypad 0 Key") -(edt-map-key "KP1" " - The Keypad 1 Key") -(edt-map-key "KP2" " - The Keypad 2 Key") -(edt-map-key "KP3" " - The Keypad 3 Key") -(edt-map-key "KP4" " - The Keypad 4 Key") -(edt-map-key "KP5" " - The Keypad 5 Key") -(edt-map-key "KP6" " - The Keypad 6 Key") -(edt-map-key "KP7" " - The Keypad 7 Key") -(edt-map-key "KP8" " - The Keypad 8 Key") -(edt-map-key "KP9" " - The Keypad 9 Key") -(edt-map-key "KP-" " - The Keypad - Key") -(edt-map-key "KP," " - The Keypad , Key") -(edt-map-key "KPP" " - The Keypad . Key") -(edt-map-key "KPE" " - The Keypad Enter Key") -;; Save the enter key -(setq edt-enter edt-key) -(setq edt-enter-seq edt-key-seq) - - -(set-buffer "Keys") -(insert " + (set-buffer "Directions") + + (edt-map-key "KP0" " - The Keypad 0 Key") + (edt-map-key "KP1" " - The Keypad 1 Key") + (edt-map-key "KP2" " - The Keypad 2 Key") + (edt-map-key "KP3" " - The Keypad 3 Key") + (edt-map-key "KP4" " - The Keypad 4 Key") + (edt-map-key "KP5" " - The Keypad 5 Key") + (edt-map-key "KP6" " - The Keypad 6 Key") + (edt-map-key "KP7" " - The Keypad 7 Key") + (edt-map-key "KP8" " - The Keypad 8 Key") + (edt-map-key "KP9" " - The Keypad 9 Key") + (edt-map-key "KP-" " - The Keypad - Key") + (edt-map-key "KP," " - The Keypad , Key") + (edt-map-key "KPP" " - The Keypad . Key") + (edt-map-key "KPE" " - The Keypad Enter Key") + ;; Save the enter key + (setq edt-enter edt-key) + (setq edt-enter-seq edt-key-seq) + + + (set-buffer "Keys") + (insert " ;; ;; Editing keypad (FIND, INSERT, REMOVE) ;; (SELECT, PREVIOUS, NEXT) ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "FIND" " - The Find key on the editing keypad") -(edt-map-key "INSERT" " - The Insert key on the editing keypad") -(edt-map-key "REMOVE" " - The Remove key on the editing keypad") -(edt-map-key "SELECT" " - The Select key on the editing keypad") -(edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") -(edt-map-key "NEXT" " - The Next Scr key on the editing keypad") + (edt-map-key "FIND" " - The Find key on the editing keypad") + (edt-map-key "INSERT" " - The Insert key on the editing keypad") + (edt-map-key "REMOVE" " - The Remove key on the editing keypad") + (edt-map-key "SELECT" " - The Select key on the editing keypad") + (edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") + (edt-map-key "NEXT" " - The Next Scr key on the editing keypad") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; F1-14 Help Do F17-F20 ;; ") -(set-buffer "Directions") - -(edt-map-key "F1" " - F1 Function Key") -(edt-map-key "F2" " - F2 Function Key") -(edt-map-key "F3" " - F3 Function Key") -(edt-map-key "F4" " - F4 Function Key") -(edt-map-key "F5" " - F5 Function Key") -(edt-map-key "F6" " - F6 Function Key") -(edt-map-key "F7" " - F7 Function Key") -(edt-map-key "F8" " - F8 Function Key") -(edt-map-key "F9" " - F9 Function Key") -(edt-map-key "F10" " - F10 Function Key") -(edt-map-key "F11" " - F11 Function Key") -(edt-map-key "F12" " - F12 Function Key") -(edt-map-key "F13" " - F13 Function Key") -(edt-map-key "F14" " - F14 Function Key") -(edt-map-key "HELP" " - HELP Function Key") -(edt-map-key "DO" " - DO Function Key") -(edt-map-key "F17" " - F17 Function Key") -(edt-map-key "F18" " - F18 Function Key") -(edt-map-key "F19" " - F19 Function Key") -(edt-map-key "F20" " - F20 Function Key") - -(set-buffer "Directions") -(delete-region (point-min) (point-max)) -(insert " + (set-buffer "Directions") + + (edt-map-key "F1" " - F1 Function Key") + (edt-map-key "F2" " - F2 Function Key") + (edt-map-key "F3" " - F3 Function Key") + (edt-map-key "F4" " - F4 Function Key") + (edt-map-key "F5" " - F5 Function Key") + (edt-map-key "F6" " - F6 Function Key") + (edt-map-key "F7" " - F7 Function Key") + (edt-map-key "F8" " - F8 Function Key") + (edt-map-key "F9" " - F9 Function Key") + (edt-map-key "F10" " - F10 Function Key") + (edt-map-key "F11" " - F11 Function Key") + (edt-map-key "F12" " - F12 Function Key") + (edt-map-key "F13" " - F13 Function Key") + (edt-map-key "F14" " - F14 Function Key") + (edt-map-key "HELP" " - HELP Function Key") + (edt-map-key "DO" " - DO Function Key") + (edt-map-key "F17" " - F17 Function Key") + (edt-map-key "F18" " - F18 Function Key") + (edt-map-key "F19" " - F19 Function Key") + (edt-map-key "F20" " - F20 Function Key") + + (set-buffer "Directions") + (delete-region (point-min) (point-max)) + (insert " ADDITIONAL FUNCTION KEYS Your keyboard may have additional function keys which do not correspond @@ -501,53 +494,53 @@ When you are done, just press RETURN at the \"EDT Key Name:\" prompt. ") -(switch-to-buffer "Directions") -;;; -;;; Add support for extras keys -;;; -(set-buffer "Keys") -(insert "\ + (switch-to-buffer "Directions") + ;; + ;; Add support for extras keys + ;; + (set-buffer "Keys") + (insert "\ ;; ;; Extra Keys ;; ") -;;; -;;; Restore function-key-map. -;;; -(if (and edt-window-system (not (featurep 'xemacs))) - (setq function-key-map edt-save-function-key-map)) -(setq EDT-key-name "") -(while (not - (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) - (edt-map-key EDT-key-name "")) - -; -; No more keys to add, so wrap up. -; -(set-buffer "Keys") -(insert "\ + ;; + ;; Restore function-key-map. + ;; + (if (and edt-window-system (not (featurep 'xemacs))) + (setq function-key-map edt-save-function-key-map)) + (setq EDT-key-name "") + (while (not + (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) + (edt-map-key EDT-key-name "")) + + ;; + ;; No more keys to add, so wrap up. + ;; + (set-buffer "Keys") + (insert "\ ) ) ") -;;; -;;; Save the key mapping program -;;; -;;; -;;; Save the key mapping file -;;; -(let ((file (concat - "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") - (if edt-term (concat "-" edt-term)) - (if edt-xserver (concat "-" edt-xserver)) - (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) - "-keys"))) - (set-visited-file-name - (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) -(save-buffer) - -(message "That's it! Press any key to exit") -(sit-for 600) -(kill-emacs t) + ;; + ;; Save the key mapping program + ;; + ;; + ;; Save the key mapping file + ;; + (let ((file (concat + "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") + (if edt-term (concat "-" edt-term)) + (if edt-xserver (concat "-" edt-xserver)) + (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) + "-keys"))) + (set-visited-file-name + (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) + (save-buffer) + + (message "That's it! Press any key to exit") + (sit-for 600) + (kill-emacs t)) ;;; edt-mapper.el ends here diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 31f555b0326..a6b2d785ac5 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -1928,6 +1928,8 @@ Optional argument NOT-YES changes the default to negative." ;;; INITIALIZATION COMMANDS. ;;; +(declare-function edt-mapper "edt-mapper" ()) + ;;; ;;; Function used to load LK-201 key mapping file generated by edt-mapper.el. ;;; @@ -1968,7 +1970,7 @@ created." You can do this by quitting Emacs and then invoking Emacs again as follows: - emacs -q -l edt-mapper + emacs -q -l edt-mapper -f edt-mapper [NOTE: If you do nothing out of the ordinary in your init file, and the search for edt-mapper is successful, you can try running it now.] @@ -1983,7 +1985,9 @@ created." (insert (format "Ah yes, there it is, in \n\n %s \n\n" path)) (if (edt-y-or-n-p "Do you want to run it now? ") - (load-file path) + (progn + (load-file path) + (edt-mapper)) (error "EDT Emulation not configured"))) (insert (substitute-command-keys "Nope, I can't seem to find it. :-(\n\n")) diff --git a/lisp/files.el b/lisp/files.el index f60282b775a..b7d104853c3 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 @@ -5133,6 +5134,14 @@ Before and after saving the buffer, this function runs "Non-nil means `save-some-buffers' should save this buffer without asking.") (make-variable-buffer-local 'buffer-save-without-query) +(defcustom save-some-buffers-default-predicate nil + "Default predicate for `save-some-buffers'. +This allows you to stop `save-some-buffers' from asking +about certain files that you'd usually rather not save." + :group 'auto-save + :type 'function + :version "26.1") + (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. You can answer `y' to save, `n' not to save, `C-r' to look at the @@ -5148,10 +5157,13 @@ If PRED is nil, all the file-visiting buffers are considered. If PRED is t, then certain non-file buffers will also be considered. If PRED is a zero-argument function, it indicates for each buffer whether to consider it or not when called with that buffer current. +PRED defaults to the value of `save-some-buffers-default-predicate'. See `save-some-buffers-action-alist' if you want to change the additional actions you can take on files." (interactive "P") + (unless pred + (setq pred save-some-buffers-default-predicate)) (save-window-excursion (let* (queried autosaved-buffers files-done abbrevs-done) @@ -6571,7 +6583,7 @@ normally equivalent short `-D' option is just passed on to (unless (equal switches "") ;; Split the switches at any spaces so we can ;; pass separate options as separate args. - (split-string switches))) + (split-string-and-unquote switches))) ;; Avoid lossage if FILE starts with `-'. '("--") (progn @@ -6811,6 +6823,8 @@ asks whether processes should be killed. Runs the members of `kill-emacs-query-functions' in turn and stops if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (interactive "P") + ;; Don't use save-some-buffers-default-predicate, because we want + ;; to ask about all the buffers before killing Emacs. (save-some-buffers arg t) (let ((confirm confirm-kill-emacs)) (and diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index e1af859516c..a4ff840f755 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 @@ -1708,9 +1713,10 @@ regexp." ;; (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?> ")<" table) (modify-syntax-entry ?< "(>" table) - ;; make M-. in article buffers work for `foo' strings - (modify-syntax-entry ?' " " table) - (modify-syntax-entry ?` " " table) + ;; make M-. in article buffers work for `foo' strings, + ;; and still allow C-s C-w to yank ' to the search ring + (modify-syntax-entry ?' "'" table) + (modify-syntax-entry ?` "'" table) table) "Syntax table used in article mode buffers. Initialized from `text-mode-syntax-table'.") @@ -6841,17 +6847,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/ibuffer.el b/lisp/ibuffer.el index c6e5e471a36..71bf1d6dcc2 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1319,13 +1319,14 @@ a new window in the current frame, splitting vertically." (cl-assert (derived-mode-p 'ibuffer-mode))) (defun ibuffer-buffer-file-name () - (or buffer-file-name - (let ((dirname (or (and (boundp 'dired-directory) - (if (stringp dired-directory) - dired-directory - (car dired-directory))) - (bound-and-true-p list-buffers-directory)))) - (and dirname (expand-file-name dirname))))) + (cond + ((buffer-file-name)) + ((bound-and-true-p list-buffers-directory)) + ((let ((dirname (and (boundp 'dired-directory) + (if (stringp dired-directory) + dired-directory + (car dired-directory))))) + (and dirname (expand-file-name dirname)))))) (define-ibuffer-op ibuffer-do-save () "Save marked buffers as with `save-buffer'." diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 901225fa2e9..2a4064560a7 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -94,6 +94,7 @@ ;; * WARNING: The "database" format used might be changed so keep a ;; backup of `image-dired-db-file' when testing new versions. ;; +;; * `image-dired-display-image-mode' does not support animation ;; ;; TODO ;; ==== @@ -228,7 +229,7 @@ Used together with `image-dired-cmd-create-thumbnail-options'." :group 'image-dired) (defcustom image-dired-cmd-create-thumbnail-options - '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") + '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") "Options of command used to create thumbnail image. Used with `image-dired-cmd-create-thumbnail-program'. Available format specifiers are: %w which is replaced by @@ -246,7 +247,7 @@ Used together with `image-dired-cmd-create-temp-image-options'." :group 'image-dired) (defcustom image-dired-cmd-create-temp-image-options - '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") + '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") "Options of command used to create temporary image for display window. Used together with `image-dired-cmd-create-temp-image-program', Available format specifiers are: %w and %h which are replaced by @@ -316,7 +317,7 @@ Available format specifiers are described in :group 'image-dired) (defcustom image-dired-cmd-create-standard-thumbnail-options - (append '("-size" "%wx%h" "%f") + (append '("-size" "%wx%h" "%f[0]") (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program) (list @@ -1626,6 +1627,7 @@ Resized or in full-size." :group 'image-dired (buffer-disable-undo) (image-mode-setup-winprops) + (setq cursor-type nil) (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) (defvar image-dired-minor-mode-map diff --git a/lisp/indent.el b/lisp/indent.el index db31f0454ce..fdd184c7998 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -487,9 +487,9 @@ line, but does not move past any whitespace that was explicitly inserted (if (memq (current-justification) '(center right)) (skip-chars-forward " \t"))) -(defvar indent-region-function nil +(defvar indent-region-function #'indent-region-line-by-line "Short cut function to indent region using `indent-according-to-mode'. -A value of nil means really run `indent-according-to-mode' on each line.") +Default is to really run `indent-according-to-mode' on each line.") (defun indent-region (start end &optional column) "Indent each nonblank line in the region. @@ -541,24 +541,26 @@ column to indent to; if it is nil, use one of the three methods above." (funcall indent-region-function start end)) ;; Else, use a default implementation that calls indent-line-function on ;; each line. - (t - (save-excursion - (setq end (copy-marker end)) - (goto-char start) - (let ((pr (unless (minibufferp) - (make-progress-reporter "Indenting region..." (point) end)))) - (while (< (point) end) - (or (and (bolp) (eolp)) - (indent-according-to-mode)) - (forward-line 1) - (and pr (progress-reporter-update pr (point)))) - (and pr (progress-reporter-done pr)) - (move-marker end nil))))) + (t (indent-region-line-by-line start end))) ;; In most cases, reindenting modifies the buffer, but it may also ;; leave it unmodified, in which case we have to deactivate the mark ;; by hand. (setq deactivate-mark t)) +(defun indent-region-line-by-line (start end) + (save-excursion + (setq end (copy-marker end)) + (goto-char start) + (let ((pr (unless (minibufferp) + (make-progress-reporter "Indenting region..." (point) end)))) + (while (< (point) end) + (or (and (bolp) (eolp)) + (indent-according-to-mode)) + (forward-line 1) + (and pr (progress-reporter-update pr (point)))) + (and pr (progress-reporter-done pr)) + (move-marker end nil)))) + (define-obsolete-function-alias 'indent-relative-maybe 'indent-relative-first-indent-point "26.1") diff --git a/lisp/info.el b/lisp/info.el index e32b6b35632..0cfcec32f82 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1599,6 +1599,16 @@ escaped (\\\",\\\\)." parameter-alist)) parameter-alist)) +(defun Info-node-description (file) + (cond + ((equal file "dir") "*Info Directory*") + ((eq file 'apropos) "*Info Apropos*") + ((eq file 'history) "*Info History*") + ((eq file 'toc) "*Info TOC*") + ((not (stringp file)) "") ; Avoid errors + (t + (concat "(" (file-name-nondirectory file) ") " Info-current-node)))) + (defun Info-display-images-node () "Display images in current node." (save-excursion @@ -1693,6 +1703,7 @@ escaped (\\\",\\\\)." (setq Info-history-forward nil)) (if (not (eq Info-fontify-maximum-menu-size nil)) (Info-fontify-node)) + (setq list-buffers-directory (Info-node-description Info-current-file)) (Info-display-images-node) (Info-hide-cookies-node) (run-hooks 'Info-selection-hook))))) 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/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index aae751e8d2d..3f3990e8695 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -283,16 +283,6 @@ DOCSTRING arguments." See documentation for `make-obsolete-variable' for a description of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and -ACCESS-TYPE arguments." - (if (featurep 'xemacs) - `(make-obsolete-variable ,obsolete-name ,current-name) - `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))) - -(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) - "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. -See documentation for `make-obsolete-variable' for a description -of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN -and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE, introduced in Emacs 24." (if (featurep 'xemacs) 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 fc7fdd30850..48dcd5edd11 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3614,18 +3614,36 @@ connection buffer." ;;; Utility functions: -(defun tramp-accept-process-output (&optional proc timeout timeout-msecs) +(defun tramp-accept-process-output (proc timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set for process communication also." + ;; FIXME: There are problems, when an asynchronous process runs in + ;; parallel, and also timers are active. See + ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>. + (when (and timer-event-last + (string-prefix-p "*tramp/" (process-name proc)) + (let (result) + (maphash + (lambda (key _value) + (and (processp key) + (not (string-prefix-p "*tramp/" (process-name key))) + (tramp-compat-process-live-p key) + (setq result t))) + tramp-cache-data) + result)) + (sit-for 0.01 'nodisp)) (with-current-buffer (process-buffer proc) (let (buffer-read-only last-coding-system-used) ;; Under Windows XP, accept-process-output doesn't return - ;; sometimes. So we add an additional timeout. - (with-timeout ((or timeout 1)) - (accept-process-output proc timeout timeout-msecs (and proc t))) - (tramp-message proc 10 "%s %s\n%s" - proc (process-status proc) (buffer-string))))) + ;; sometimes. So we add an additional timeout. JUST-THIS-ONE + ;; is set due to Bug#12145. + (tramp-message + proc 10 "%s %s %s\n%s" + proc (process-status proc) + (with-timeout (timeout) + (accept-process-output proc timeout nil t)) + (buffer-string))))) (defun tramp-check-for-regexp (proc regexp) "Check, whether REGEXP is contained in process buffer of PROC. 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 981b8464aaa..ed5b4c65068 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -267,7 +267,7 @@ on your head.") (dun-mprincl "You can't drop anything while on the bus.") (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) diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 7cb36c4396b..0f7e4b598dc 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1221,6 +1221,18 @@ Works with: arglist-cont, arglist-cont-nonempty." (vector (progn (goto-char alignto) (current-column))))))) +(defun c-lineup-under-anchor (langelem) + "Line up the current line directly under the anchor position in LANGELEM. + +This is like 0, except it supersedes any indentation already calculated for +previous syntactic elements in the syntactic context. + +Works with: Any syntactic symbol which has an anchor position." + (save-excursion + (goto-char (c-langelem-pos langelem)) + (vector (current-column)))) + + (defun c-lineup-dont-change (langelem) "Do not change the indentation of the current line. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f214242bdd9..7f49557c7a6 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10260,13 +10260,22 @@ comment at the start of cc-engine.el for more info." (t nil))))) (setq pos (point)) - (if (and after-type-id-pos - (goto-char after-type-id-pos) - (setq res (c-back-over-member-initializers)) - (goto-char res) - (eq (car (c-beginning-of-decl-1 lim)) 'same)) - (cons (point) nil) ; Return value. + (cond + ((and after-type-id-pos + (goto-char after-type-id-pos) + (setq res (c-back-over-member-initializers)) + (goto-char res) + (eq (car (c-beginning-of-decl-1 lim)) 'same)) + (cons (point) nil)) ; Return value. + + ((and after-type-id-pos + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?\())) + ;; Single identifier between '(' and '{'. We have a bracelist. + (cons after-type-id-pos nil)) + (t (goto-char pos) ;; Checks to do on all sexps before the brace, up to the ;; beginning of the statement. @@ -10368,7 +10377,7 @@ comment at the start of cc-engine.el for more info." ; languages where ; `c-opt-inexpr-brace-list-key' is ; non-nil and we have macros. - (t t))) ;; The caller can go up one level. + (t t)))) ;; The caller can go up one level. ))) (defun c-inside-bracelist-p (containing-sexp paren-state) @@ -10493,6 +10502,30 @@ comment at the start of cc-engine.el for more info." (c-at-statement-start-p)) (make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") +(defun c-looking-at-statement-block () + ;; Point is at an opening brace. If this is a statement block (i.e. the + ;; elements in it are terminated by semicolons) return t. Otherwise, return + ;; nil. + (let ((here (point))) + (prog1 + (if (c-go-list-forward) + (let ((there (point))) + (backward-char) + (c-syntactic-skip-backward + "^;," here t) + (cond + ((eq (char-before) ?\;) t) + ((eq (char-before) ?,) nil) + (t (goto-char here) + (forward-char) + (and (c-syntactic-re-search-forward "{" there t t) + (progn (backward-char) + (c-looking-at-statement-block)))))) + (forward-char) + (and (c-syntactic-re-search-forward "[;,]" nil t t) + (eq (char-before) ?\;))) + (goto-char here)))) + (defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) ;; Return non-nil if we're looking at the beginning of a block ;; inside an expression. The value returned is actually a cons of @@ -10648,15 +10681,7 @@ comment at the start of cc-engine.el for more info." (and (c-major-mode-is 'c++-mode) (save-excursion (goto-char block-follows) - (if (c-go-list-forward) - (progn - (backward-char) - (c-syntactic-skip-backward - "^;," block-follows t) - (not (eq (char-before) ?\;))) - (or (not (c-syntactic-re-search-forward - "[;,]" nil t t)) - (not (eq (char-before) ?\;))))))) + (not (c-looking-at-statement-block))))) nil (cons 'inexpr-statement (point))))) @@ -10792,17 +10817,20 @@ comment at the start of cc-engine.el for more info." syntax-extra-args stop-at-boi-only containing-sexp - paren-state) + paren-state + &optional fixed-anchor) ;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as ;; needed with further syntax elements of the types `substatement', - ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', and - ;; `defun-block-intro'. + ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', + ;; `defun-block-intro', and `brace-list-intro'. ;; - ;; Do the generic processing to anchor the given syntax symbol on - ;; the preceding statement: Skip over any labels and containing - ;; statements on the same line, and then search backward until we - ;; find a statement or block start that begins at boi without a - ;; label or comment. + ;; Do the generic processing to anchor the given syntax symbol on the + ;; preceding statement: First skip over any labels and containing statements + ;; on the same line. If FIXED-ANCHOR is non-nil, use this as the + ;; anchor-point for the given syntactic symbol, and don't make syntactic + ;; entries for constructs beginning on lines before that containing + ;; ANCHOR-POINT. Otherwise search backward until we find a statement or + ;; block start that begins at boi without a label or comment. ;; ;; Point is assumed to be at the prospective anchor point for the ;; given SYNTAX-SYMBOL. More syntax entries are added if we need to @@ -10831,6 +10859,7 @@ comment at the start of cc-engine.el for more info." (let ((syntax-last c-syntactic-context) (boi (c-point 'boi)) + (anchor-boi (c-point 'boi)) ;; Set when we're on a label, so that we don't stop there. ;; FIXME: To be complete we should check if we're on a label ;; now at the start. @@ -10908,7 +10937,9 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'substatement nil)))) ))) - containing-sexp) + containing-sexp + (or (null fixed-anchor) + (> containing-sexp anchor-boi))) ;; Now we have to go out of this block. (goto-char containing-sexp) @@ -10982,6 +11013,14 @@ comment at the start of cc-engine.el for more info." (cdr (assoc (match-string 1) c-other-decl-block-key-in-symbols-alist)) (max (c-point 'boi paren-pos) (point)))) + ((save-excursion + (goto-char paren-pos) + (c-looking-at-or-maybe-in-bracelist containing-sexp)) + (if (save-excursion + (goto-char paren-pos) + (c-looking-at-statement-block)) + (c-add-syntax 'defun-block-intro nil) + (c-add-syntax 'brace-list-intro nil))) (t (c-add-syntax 'defun-block-intro nil)))) (c-add-syntax 'statement-block-intro nil))) @@ -11001,7 +11040,10 @@ comment at the start of cc-engine.el for more info." (setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty nil 28)] (while q (unless (car q) - (setcar q (point))) + (setcar q (if (or (cdr p) + (null fixed-anchor)) + (point) + fixed-anchor))) (setq q (cdr q))) (setq p (cdr p)))) ))) @@ -12354,7 +12396,8 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws (c-point 'eol)) (c-looking-at-special-brace-list (point))))) (c-add-syntax 'brace-entry-open (point)) - (c-add-syntax 'brace-list-entry (point)) + (c-add-stmt-syntax 'brace-list-entry nil t containing-sexp + paren-state (point)) )) )))) @@ -12848,7 +12891,7 @@ Cannot combine absolute offsets %S and %S in `add' method" ;; ;; Note that topmost-intro always has an anchor position at bol, for ;; historical reasons. It's often used together with other symbols - ;; that has more sane positions. Since we always use the first + ;; that have more sane positions. Since we always use the first ;; found anchor position, we rely on that these other symbols always ;; precede topmost-intro in the LANGELEMS list. ;; diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index d3505490505..b3848a74f97 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -67,6 +67,7 @@ (arglist-close . c-lineup-arglist) (inline-open . 0) (brace-list-open . +) + (brace-list-intro . c-lineup-arglist-intro-after-paren) (topmost-intro-cont . (first c-lineup-topmost-intro-cont c-lineup-gnu-DEFUN-intro-cont)))) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index a6a96d15188..1114b21381d 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1115,7 +1115,7 @@ can always override the use of `c-default-style' by making calls to ;; Anchor pos: At the brace list decl start(*). (brace-list-intro . +) ;; Anchor pos: At the brace list decl start(*). - (brace-list-entry . 0) + (brace-list-entry . c-lineup-under-anchor) ;; Anchor pos: At the first non-ws char after the open paren if ;; the first token is on the same line, otherwise boi at that ;; token. 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 2e5c6ae119b..e42e01481b6 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 @@ -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) @@ -3852,6 +3849,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." comment-start-skip "\\(//+\\|/\\*+\\)\\s *") (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local c-block-comment-start-regexp "/\\*") + (setq-local comment-multi-line t) (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". 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..a8933b0103e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -918,7 +918,7 @@ IGNORES is a list of glob patterns." (grep-compute-defaults) (defvar grep-find-template) (defvar grep-highlight-matches) - (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " + (let* ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E" grep-find-template t t)) (grep-highlight-matches nil) (command (xref--rgrep-command (xref--regexp-to-extended regexp) 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/replace.el b/lisp/replace.el index ff917344453..a825040a979 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1304,6 +1304,19 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(defcustom list-matching-lines-current-line-face 'lazy-highlight + "Face used by \\[list-matching-lines] to highlight the current line." + :type 'face + :group 'matching + :version "26.1") + +(defcustom list-matching-lines-jump-to-current-line nil + "If non-nil, \\[list-matching-lines] shows the current line highlighted. +Set the point right after such line when there are matches after it." +:type 'boolean +:group 'matching +:version "26.1") + (defcustom list-matching-lines-prefix-face 'shadow "Face used by \\[list-matching-lines] to show the prefix column. If the face doesn't differ from the default face, @@ -1360,7 +1373,15 @@ invoke `occur'." "*") (or unique-p (not interactive-p))))) -(defun occur (regexp &optional nlines) +;; Region limits when `occur' applies on a region. +(defvar occur--region-start nil) +(defvar occur--region-end nil) +(defvar occur--matches-threshold nil) +(defvar occur--orig-line nil) +(defvar occur--orig-line-str nil) +(defvar occur--final-pos nil) + +(defun occur (regexp &optional nlines region) "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. @@ -1369,9 +1390,17 @@ before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. Interactively it is the prefix arg. +Optional arg REGION, if non-nil, mean restrict search to the +specified region. Otherwise search the entire buffer. +REGION must be a list of (START . END) positions as returned by +`region-bounds'. + The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. +If `list-matching-lines-jump-to-current-line' is non-nil, then show +the current line highlighted with `list-matching-lines-current-line-face' +and set point at the first match after such line. If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. @@ -1386,8 +1415,30 @@ For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and program. When there is no parenthesized subexpressions in REGEXP the entire match is collected. In any case the searched buffer is not modified." - (interactive (occur-read-primary-args)) - (occur-1 regexp nlines (list (current-buffer)))) + (interactive + (nconc (occur-read-primary-args) + (and (use-region-p) (list (region-bounds))))) + (let* ((start (and (caar region) (max (caar region) (point-min)))) + (end (and (cdar region) (min (cdar region) (point-max)))) + (in-region-p (or start end))) + (when in-region-p + (or start (setq start (point-min))) + (or end (setq end (point-max)))) + (let ((occur--region-start start) + (occur--region-end end) + (occur--matches-threshold + (and in-region-p + (line-number-at-pos (min start end)))) + (occur--orig-line + (line-number-at-pos (point))) + (occur--orig-line-str + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (save-excursion ; If no matches `occur-1' doesn't restore the point. + (and in-region-p (narrow-to-region start end)) + (occur-1 regexp nlines (list (current-buffer))) + (and in-region-p (widen)))))) (defvar ido-ignore-item-temp-list) @@ -1482,7 +1533,8 @@ See also `multi-occur'." (occur-mode)) (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. - (buffer-undo-list t)) + (buffer-undo-list t) + (occur--final-pos nil)) (erase-buffer) (let ((count (if (stringp nlines) @@ -1534,6 +1586,10 @@ See also `multi-occur'." (if (= count 0) (kill-buffer occur-buf) (display-buffer occur-buf) + (when occur--final-pos + (set-window-point + (get-buffer-window occur-buf 'all-frames) + occur--final-pos)) (setq next-error-last-buffer occur-buf) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -1545,19 +1601,26 @@ See also `multi-occur'." (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) - (case-fold-search case-fold)) + (case-fold-search case-fold) + (in-region-p (and occur--region-start occur--region-end)) + (multi-occur-p (cdr buffers))) ;; Map over all the buffers (dolist (buf buffers) (when (buffer-live-p buf) (let ((lines 0) ;; count of matching lines (matches 0) ;; count of matches - (curr-line 1) ;; line count + (curr-line ;; line count + (or occur--matches-threshold 1)) + (orig-line occur--orig-line) + (orig-line-str occur--orig-line-str) + (orig-line-shown-p) (prev-line nil) ;; line number of prev match endpt (prev-after-lines nil) ;; context lines of prev match (matchbeg 0) (origpt nil) (begpt nil) (endpt nil) + (finalpt nil) (marker nil) (curstring "") (ret nil) @@ -1658,6 +1721,18 @@ See also `multi-occur'." (nth 0 ret)))) ;; Actually insert the match display data (with-current-buffer out-buf + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p) + (not orig-line-shown-p) + (>= curr-line orig-line)) + (insert + (concat + (propertize + (format "%7d:%s" orig-line orig-line-str) + 'face list-matching-lines-current-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "Current line") "\n")) + (setq orig-line-shown-p t finalpt (point))) (insert data))) (goto-char endpt)) (if endpt @@ -1671,6 +1746,18 @@ See also `multi-occur'." (forward-line 1)) (goto-char (point-max))) (setq prev-line (1- curr-line))) + ;; Insert original line if haven't done yet. + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p) + (not orig-line-shown-p)) + (with-current-buffer out-buf + (insert + (concat + (propertize + (format "%7d:%s" orig-line orig-line-str) + 'face list-matching-lines-current-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "Current line") "\n")))) ;; Flush remaining context after-lines. (when prev-after-lines (with-current-buffer out-buf @@ -1684,7 +1771,7 @@ See also `multi-occur'." (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s%s in buffer: %s\n" + (format "%d match%s%s%s in buffer: %s%s\n" matches (if (= matches 1) "" "es") ;; Don't display the same number of lines ;; and matches in case of 1 match per line. @@ -1694,13 +1781,21 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf)) + (buffer-name buf) + (if in-region-p + (format " within region: %d-%d" + occur--region-start + occur--region-end) + "")) 'read-only t)) (setq end (point)) (add-text-properties beg end `(occur-title ,buf)) (when title-face - (add-face-text-property beg end title-face))) - (goto-char (point-min))))))) + (add-face-text-property beg end title-face)) + (goto-char (if finalpt + (setq occur--final-pos + (cl-incf finalpt (- end beg))) + (point-min))))))))) ;; Display total match count and regexp for multi-buffer. (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) 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..a204577ddf9 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. @@ -1297,8 +1417,10 @@ be a list of the form returned by `event-start' and `event-end'." ;; bug#23850 (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") (make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1") +(make-obsolete 'string-make-unibyte "use `encode-coding-string'." "26.1") (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") +(make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") (defun log10 (x) "Return (log X 10), the log base 10 of X." 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 c81c3f62e16..0c7d76f7924 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -32,9 +32,11 @@ ;;; Code: +(require 'eww) (require 'seq) (require 'sgml-mode) (require 'smie) +(require 'subr-x) (defgroup css nil "Cascading Style Sheets (CSS) editing mode." @@ -621,6 +623,12 @@ cannot be completed sensibly: `custom-ident', (modify-syntax-entry ?- "_" st) st)) +(defvar css-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap info-lookup-symbol] 'css-lookup-symbol) + map) + "Keymap used in `css-mode'.") + (eval-and-compile (defconst css--uri-re (concat @@ -734,7 +742,30 @@ cannot be completed sensibly: `custom-ident', (defconst css-smie-grammar (smie-prec2->grammar - (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) + (smie-precs->prec2 + '((assoc ";") + ;; Colons that belong to a CSS property. These get a higher + ;; precedence than other colons, such as colons in selectors, + ;; which are represented by a plain ":" token. + (left ":-property") + (assoc ",") + (assoc ":"))))) + +(defun css--colon-inside-selector-p () + "Return t if point looks to be inside a CSS selector. +This function is intended to be good enough to help SMIE during +tokenization, but should not be regarded as a reliable function +for determining whether point is within a selector." + (save-excursion + (re-search-forward "[{};)]" nil t) + (eq (char-before) ?\{))) + +(defun css--colon-inside-funcall () + "Return t if point is inside a function call." + (when-let (opening-paren-pos (nth 1 (syntax-ppss))) + (save-excursion + (goto-char opening-paren-pos) + (eq (char-after) ?\()))) (defun css-smie--forward-token () (cond @@ -748,7 +779,13 @@ cannot be completed sensibly: `custom-ident', ";") ((progn (forward-comment (point-max)) (looking-at "[;,:]")) - (forward-char 1) (match-string 0)) + (forward-char 1) + (if (equal (match-string 0) ":") + (if (or (css--colon-inside-selector-p) + (css--colon-inside-funcall)) + ":" + ":-property") + (match-string 0))) (t (smie-default-forward-token)))) (defun css-smie--backward-token () @@ -759,7 +796,13 @@ cannot be completed sensibly: `custom-ident', ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p) (> pos (point))) ";") ((memq (char-before) '(?\; ?\, ?\:)) - (forward-char -1) (string (char-after))) + (forward-char -1) + (if (eq (char-after) ?\:) + (if (or (css--colon-inside-selector-p) + (css--colon-inside-funcall)) + ":" + ":-property") + (string (char-after)))) (t (smie-default-backward-token))))) (defun css-smie-rules (kind token) @@ -1087,5 +1130,112 @@ pseudo-elements, pseudo-classes, at-rules, and bang-rules." (setq-local font-lock-defaults (list (scss-font-lock-keywords) nil t))) + + +(defvar css--mdn-lookup-history nil) + +(defcustom css-lookup-url-format + "https://developer.mozilla.org/en-US/docs/Web/CSS/%s?raw¯os" + "Format for a URL where CSS documentation can be found. +The format should include a single \"%s\" substitution. +The name of the CSS property, @-id, pseudo-class, or pseudo-element +to look up will be substituted there." + :version "26.1" + :type 'string + :group 'css) + +(defun css--mdn-after-render () + (setf header-line-format nil) + (goto-char (point-min)) + (let ((window (get-buffer-window (current-buffer) 'visible))) + (when window + (when (re-search-forward "^Summary" nil 'move) + (beginning-of-line) + (set-window-start window (point)))))) + +(defconst css--mdn-symbol-regexp + (concat "\\(" + ;; @-ids. + "\\(@" (regexp-opt css-at-ids) "\\)" + "\\|" + ;; ;; Known properties. + (regexp-opt css-property-ids t) + "\\|" + ;; Pseudo-classes. + "\\(:" (regexp-opt css-pseudo-class-ids) "\\)" + "\\|" + ;; Pseudo-elements with either one or two ":"s. + "\\(::?" (regexp-opt css-pseudo-element-ids) "\\)" + "\\)") + "Regular expression to match the CSS symbol at point.") + +(defconst css--mdn-property-regexp + (concat "\\_<" (regexp-opt css-property-ids t) "\\s-*\\(?:\\=\\|:\\)") + "Regular expression to match a CSS property.") + +(defconst css--mdn-completion-list + (nconc + ;; @-ids. + (mapcar (lambda (atrule) (concat "@" atrule)) css-at-ids) + ;; Pseudo-classes. + (mapcar (lambda (class) (concat ":" class)) css-pseudo-class-ids) + ;; Pseudo-elements with either one or two ":"s. + (mapcar (lambda (elt) (concat ":" elt)) css-pseudo-element-ids) + (mapcar (lambda (elt) (concat "::" elt)) css-pseudo-element-ids) + ;; Properties. + css-property-ids) + "List of all symbols available for lookup via MDN.") + +(defun css--mdn-find-symbol () + "A helper for `css-lookup-symbol' that finds the symbol at point. +Returns the symbol, a string, or nil if none found." + (save-excursion + ;; Skip backward over a word first. + (skip-chars-backward "-[:alnum:] \t") + ;; Now skip ":" or "@" to see if it's a pseudo-element or at-id. + (skip-chars-backward "@:") + (if (looking-at css--mdn-symbol-regexp) + (match-string-no-properties 0) + (let ((bound (save-excursion + (beginning-of-line) + (point)))) + (when (re-search-backward css--mdn-property-regexp bound t) + (match-string-no-properties 1)))))) + +;;;###autoload +(defun css-lookup-symbol (symbol) + "Display the CSS documentation for SYMBOL, as found on MDN. +When this command is used interactively, it picks a default +symbol based on the CSS text before point -- either an @-keyword, +a property name, a pseudo-class, or a pseudo-element, depending +on what is seen near point." + (interactive + (list + (let* ((sym (css--mdn-find-symbol)) + (enable-recursive-minibuffers t) + (value (completing-read + (if sym + (format "Describe CSS symbol (default %s): " sym) + "Describe CSS symbol: ") + css--mdn-completion-list nil nil nil + 'css--mdn-lookup-history sym))) + (if (equal value "") sym value)))) + (when symbol + ;; If we see a single-colon pseudo-element like ":after", turn it + ;; into "::after". + (when (and (eq (aref symbol 0) ?:) + (member (substring symbol 1) css-pseudo-element-ids)) + (setq symbol (concat ":" symbol))) + (let ((url (format css-lookup-url-format symbol)) + (buffer (get-buffer-create "*MDN CSS*"))) + (save-selected-window + ;; Make sure to display the buffer before calling `eww', as + ;; that calls `pop-to-buffer-same-window'. + (switch-to-buffer-other-window buffer) + (with-current-buffer buffer + (eww-mode) + (add-hook 'eww-after-render-hook #'css--mdn-after-render nil t) + (eww url)))))) + (provide 'css-mode) ;;; css-mode.el ends here 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/vc/diff-mode.el b/lisp/vc/diff-mode.el index b7ad8e8ebd8..31c33e6a720 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -437,6 +437,9 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") (defconst diff-hunk-header-re (concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")) (defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* \n]\\).+\n" (substring diff-hunk-header-re 1))) + +(defconst diff-separator-re "^--+ ?$") + (defvar diff-narrowed-to nil) (defun diff-hunk-style (&optional style) @@ -501,7 +504,8 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") ;; "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") + (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. @@ -545,7 +549,8 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." (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)) + (forward-line 0) + (point)) (t (error "Can't find the beginning of the hunk")))))) (defun diff-unified-hunk-p () @@ -645,28 +650,36 @@ If the prefix ARG is given, restrict the view to the current file instead." (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) +(defun diff--some-hunks-p () + (save-excursion + (goto-char (point-min)) + (re-search-forward diff-hunk-header-re nil t))) + (defun diff-hunk-kill () "Kill the hunk at point." (interactive) - (let* ((hunk-bounds (diff-bounds-of-hunk)) - (file-bounds (ignore-errors (diff-bounds-of-file))) - ;; If the current hunk is the only one for its file, kill the - ;; file header too. - (bounds (if (and file-bounds - (progn (goto-char (car file-bounds)) - (= (progn (diff-hunk-next) (point)) - (car hunk-bounds))) - (progn (goto-char (cadr hunk-bounds)) - ;; bzr puts a newline after the last hunk. - (while (looking-at "^\n") - (forward-char 1)) - (= (point) (cadr file-bounds)))) - file-bounds - hunk-bounds)) - (inhibit-read-only t)) - (apply 'kill-region bounds) - (goto-char (car bounds)) - (diff-beginning-of-hunk t))) + (if (not (diff--some-hunks-p)) + (error "No hunks") + (diff-beginning-of-hunk t) + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (file-bounds (ignore-errors (diff-bounds-of-file))) + ;; If the current hunk is the only one for its file, kill the + ;; file header too. + (bounds (if (and file-bounds + (progn (goto-char (car file-bounds)) + (= (progn (diff-hunk-next) (point)) + (car hunk-bounds))) + (progn (goto-char (cadr hunk-bounds)) + ;; bzr puts a newline after the last hunk. + (while (looking-at "^\n") + (forward-char 1)) + (= (point) (cadr file-bounds)))) + file-bounds + hunk-bounds)) + (inhibit-read-only t)) + (apply 'kill-region bounds) + (goto-char (car bounds)) + (ignore-errors (diff-beginning-of-hunk t))))) (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -718,9 +731,12 @@ data such as \"Index: ...\" and such." (defun diff-file-kill () "Kill current file's hunks." (interactive) - (let ((inhibit-read-only t)) - (apply 'kill-region (diff-bounds-of-file))) - (diff-beginning-of-hunk t)) + (if (not (diff--some-hunks-p)) + (error "No hunks") + (diff-beginning-of-hunk t) + (let ((inhibit-read-only t)) + (apply 'kill-region (diff-bounds-of-file))) + (ignore-errors (diff-beginning-of-hunk t)))) (defun diff-kill-junk () "Kill spurious empty diffs." @@ -1535,15 +1551,20 @@ Only works for unified diffs." (pcase (char-after) (?\s (cl-decf before) (cl-decf after) t) (?- - (if (and (looking-at diff-file-header-re) - (zerop before) (zerop after)) - ;; No need to query: this is a case where two patches - ;; are concatenated and only counting the lines will - ;; give the right result. Let's just add an empty - ;; line so that our code which doesn't count lines - ;; will not get confused. - (progn (save-excursion (insert "\n")) nil) - (cl-decf before) t)) + (cond + ((and (looking-at diff-separator-re) + (zerop before) (zerop after)) + nil) + ((and (looking-at diff-file-header-re) + (zerop before) (zerop after)) + ;; No need to query: this is a case where two patches + ;; are concatenated and only counting the lines will + ;; give the right result. Let's just add an empty + ;; line so that our code which doesn't count lines + ;; will not get confused. + (save-excursion (insert "\n")) nil) + (t + (cl-decf before) t))) (?+ (cl-decf after) t) (_ (cond @@ -1998,57 +2019,58 @@ Return new point, if it was moved." "Highlight changes of hunk at point at a finer granularity." (interactive) (require 'smerge-mode) - (save-excursion - (diff-beginning-of-hunk t) - (let* ((start (point)) - (style (diff-hunk-style)) ;Skips the hunk header as well. - (beg (point)) - (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))) - ;; 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 "^-" 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)) - (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) - (smerge-refine-subst (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - 'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) - (_ ;; Normal diffs. - (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) - ;; It's a combined add&remove, so there's something to do. - (smerge-refine-subst beg1 (match-beginning 0) - (match-end 0) end - nil 'diff-refine-preproc props-r props-a)))))))) + (when (diff--some-hunks-p) + (save-excursion + (diff-beginning-of-hunk t) + (let* ((start (point)) + (style (diff-hunk-style)) ;Skips the hunk header as well. + (beg (point)) + (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))) + ;; 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 "^-" 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)) + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-subst (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + 'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))))) + (_ ;; Normal diffs. + (let ((beg1 (1+ (point)))) + (when (re-search-forward "^---.*\n" end t) + ;; It's a combined add&remove, so there's something to do. + (smerge-refine-subst beg1 (match-beginning 0) + (match-end 0) end + nil 'diff-refine-preproc props-r props-a))))))))) (defun diff-undo (&optional arg) "Perform `undo', ignoring the buffer's read-only status." 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-*"))) |