diff options
author | Andrea Corallo <akrl@sdf.org> | 2020-12-27 17:54:57 +0100 |
---|---|---|
committer | Andrea Corallo <akrl@sdf.org> | 2020-12-27 17:54:57 +0100 |
commit | 8fb94630136700aa4e74c7fc212b019d2db380ae (patch) | |
tree | 69b3938a89f450509a7001f45ba3acca057fb40d /lisp | |
parent | 271fb8a269aff924070b188f23355d0c368356dd (diff) | |
parent | df882c9701755e2ae063f05d3381de14ae09951e (diff) | |
download | emacs-8fb94630136700aa4e74c7fc212b019d2db380ae.tar.gz emacs-8fb94630136700aa4e74c7fc212b019d2db380ae.tar.bz2 emacs-8fb94630136700aa4e74c7fc212b019d2db380ae.zip |
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'lisp')
28 files changed, 818 insertions, 263 deletions
diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 50795ce7946..27cf94d3786 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2408,23 +2408,51 @@ MODE can be \"login\" or \"password\"." (list user password auth-info))) ;;; Tiny mode for editing .netrc/.authinfo modes (that basically just -;;; hides passwords). +;;; hides passwords and adds basic syntax highlighting). (defcustom authinfo-hidden "password" "Regexp matching elements in .authinfo/.netrc files that should be hidden." :type 'regexp :version "27.1") +(defcustom authinfo-hide-elements t + "Whether to use `authinfo-hidden' to hide elements in authinfo files." + :type 'boolean + :version "28.1") + +(defvar authinfo--keywords + '(("^#.*" . font-lock-comment-face) + ("^\\(machine\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-variable-name-face) + (2 font-lock-builtin-face)) + ("\\(login\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-keyword-face)) + ("\\(password\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-doc-face)) + ("\\(port\\)[ \t]+\\([^ \t\n]+\\)" + (1 font-lock-comment-delimiter-face) + (2 font-lock-type-face)) + ("\\([^ \t\n]+\\)[, \t]+\\([^ \t\n]+\\)" + (1 font-lock-constant-face) + (2 nil)))) + ;;;###autoload (define-derived-mode authinfo-mode fundamental-mode "Authinfo" "Mode for editing .authinfo/.netrc files. -This is just like `fundamental-mode', but hides passwords. The -passwords are revealed when point moved into the password. +This is just like `fundamental-mode', but has basic syntax +highlighting and hides passwords. Passwords are revealed when +point is moved into the passwords (see `authinfo-hide-elements'). \\{authinfo-mode-map}" - (authinfo--hide-passwords (point-min) (point-max)) - (reveal-mode)) + (font-lock-add-keywords nil authinfo--keywords) + (setq-local comment-start "#") + (setq-local comment-end "") + (when authinfo-hide-elements + (authinfo--hide-passwords (point-min) (point-max)) + (reveal-mode))) (defun authinfo--hide-passwords (start end) (save-excursion @@ -2436,14 +2464,15 @@ passwords are revealed when point moved into the password. nil t) (when (auth-source-netrc-looking-at-token) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) - (overlay-put overlay 'display (propertize "****" - 'face 'warning)) + (overlay-put overlay 'display + (propertize "****" 'face 'font-lock-doc-face)) (overlay-put overlay 'reveal-toggle-invisible #'authinfo--toggle-display))))))) (defun authinfo--toggle-display (overlay hide) (if hide - (overlay-put overlay 'display (propertize "****" 'face 'warning)) + (overlay-put overlay 'display + (propertize "****" 'face 'font-lock-doc-face)) (overlay-put overlay 'display nil))) (provide 'auth-source) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 3975a9ba6a9..637df85f5dc 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -2745,9 +2745,10 @@ section in the category moved to." (setq ov (make-overlay (save-excursion (todo-item-start)) (save-excursion (todo-item-end)))) (overlay-put ov 'face 'todo-search)) - (let* ((pl (if (and marked (> (cdr marked) 1)) "s" "")) - (cat+file (todo-read-category (concat "Move item" pl - " to category: ") + (let* ((num (if (not marked) 1 (cdr marked))) + (cat+file (todo-read-category + (ngettext "Move item to category: " + "Move items to category: " num) nil file))) (while (and (equal (car cat+file) cat1) (equal (cdr cat+file) file1)) @@ -2974,7 +2975,7 @@ comments without asking." (interactive) (let* ((cat (todo-current-category)) (marked (assoc cat todo-categories-with-marks)) - (pl (if (and marked (> (cdr marked) 1)) "s" ""))) + (num (if (not marked) 1 (cdr marked)))) (when (or marked (todo-done-item-p)) (let ((buffer-read-only) (opoint (point)) @@ -2982,6 +2983,9 @@ comments without asking." (first 'first) (item-count 0) (diary-count 0) + (omit-prompt (ngettext "Omit comment from restored item? " + "Omit comments from restored items? " + num)) start end item ov npoint undone) (and marked (goto-char (point-min))) (catch 'done @@ -3013,10 +3017,7 @@ comments without asking." (if (eq first 'first) (setq first (if (eq todo-undo-item-omit-comment 'ask) - (when (todo-y-or-n-p - (concat "Omit comment" pl - " from restored item" - pl "? ")) + (when (todo-y-or-n-p omit-prompt) 'omit) (when todo-undo-item-omit-comment 'omit))) t) @@ -5782,11 +5783,13 @@ have been removed." (delete f todo-category-completions-files)) (push f deleted))) (when deleted - (let ((pl (> (length deleted) 1)) + (let ((ndeleted (length deleted)) (names (mapconcat (lambda (f) (concat "\"" f "\"")) deleted ", "))) - (message (concat "File" (if pl "s" "") " %s ha" (if pl "ve" "s") - " been deleted and removed from\n" - "the list of category completion files") + (message (concat + (ngettext "File %s has been deleted and removed from\n" + "Files %s have been deleted and removed from\n" + ndeleted) + "the list of category completion files") names)) (put 'todo-category-completions-files 'custom-type `(set ,@(todo--files-type-list))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 469bbe6c7c0..0eee6e9d015 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1169,7 +1169,9 @@ hash-table-count int-to-string intern-soft isnan keymap-parent - lax-plist-get ldexp length line-beginning-position line-end-position + lax-plist-get ldexp + length length< length> length= + line-beginning-position line-end-position local-variable-if-set-p local-variable-p locale-info log log10 logand logb logcount logior lognot logxor lsh make-byte-code make-list make-string make-symbol marker-buffer max diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f242e922bde..8e5ece3605d 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -592,7 +592,7 @@ already is one.)" "A list of entries associating symbols with buffer regions. Each entry is an `edebug--form-data' struct with fields: SYMBOL, BEGIN-MARKER, and END-MARKER. The markers -are at the beginning and end of an entry level form and SYMBOL is +are at the beginning and end of an instrumented form and SYMBOL is a symbol that holds all edebug related information for the form on its property list. diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index cf927729b6c..aafefe02603 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -394,7 +394,70 @@ The search is done in the source for library LIBRARY." (progn (beginning-of-line) (cons (current-buffer) (point))) - (cons (current-buffer) nil))))))))) + ;; If the regexp search didn't find the location of + ;; the symbol (for example, because it is generated by + ;; a macro), try a slightly more expensive search that + ;; expands macros until it finds the symbol. + (cons (current-buffer) + (find-function--search-by-expanding-macros + (current-buffer) symbol type)))))))))) + +(defun find-function--try-macroexpand (form) + "Try to macroexpand FORM in full or partially. +This is a best-effort operation in which if macroexpansion fails, +this function returns FORM as is." + (ignore-errors + (or + (macroexpand-all form) + (macroexpand-1 form) + form))) + +(defun find-function--any-subform-p (form pred) + "Walk FORM and apply PRED to its subexpressions. +Return t if any PRED returns t." + (cond + ((not (consp form)) nil) + ((funcall pred form) t) + (t + (cl-destructuring-bind (left-child . right-child) form + (or + (find-function--any-subform-p left-child pred) + (find-function--any-subform-p right-child pred)))))) + +(defun find-function--search-by-expanding-macros (buf symbol type) + "Expand macros in BUF to search for the definition of SYMBOL of TYPE." + (catch 'found + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (condition-case nil + (while t + (let ((form (read (current-buffer))) + (expected-symbol-p + (lambda (form) + (cond + ((null type) + ;; Check if a given form is a `defalias' to + ;; SYM, the function name we are searching + ;; for. All functions in Emacs Lisp + ;; ultimately expand to a `defalias' form + ;; after several steps of macroexpansion. + (and (eq (car-safe form) 'defalias) + (equal (car-safe (cdr form)) + `(quote ,symbol)))) + ((eq type 'defvar) + ;; Variables generated by macros ultimately + ;; expand to `defvar'. + (and (eq (car-safe form) 'defvar) + (eq (car-safe (cdr form)) symbol))) + (t nil))))) + (when (find-function--any-subform-p + (find-function--try-macroexpand form) + expected-symbol-p) + ;; We want to return the location at the beginning + ;; of the macro, so move back one sexp. + (throw 'found (progn (backward-sexp) (point)))))) + (end-of-file nil)))))) (defun find-function-library (function &optional lisp-only verbose) "Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 0d57bc16a3a..f1901563429 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -208,6 +208,7 @@ a section." (when start (save-excursion (goto-char start) + (looking-at outline-regexp) (let ((level (lisp-outline-level)) (case-fold-search t) next-section-found) @@ -218,6 +219,7 @@ a section." nil t)) (> (save-excursion (beginning-of-line) + (looking-at outline-regexp) (lisp-outline-level)) level))) (min (if next-section-found diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index b532ddc56c5..332749987c4 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -204,7 +204,9 @@ by counted more than once." (cl-incf total (memory-report--object-size counted (car value)))) (if (cdr value) (if (consp (cdr value)) - (setq value (cdr value)) + (if (gethash (cdr value) counted) + (setq value nil) + (setq value (cdr value))) (cl-incf total (memory-report--object-size counted (cdr value))) (setq value nil)) (setq value nil))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7e5e6fc4a32..656e5ce36bf 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -831,40 +831,45 @@ correspond to previously loaded files (those returned by (declare-function find-library-name "find-func" (library)) +(defun package--files-load-history () + (delq nil + (mapcar (lambda (x) + (let ((f (car x))) + (and (stringp f) + (file-name-sans-extension (file-truename f))))) + load-history))) + +(defun package--list-of-conflicts (dir history) + (delq + nil + (mapcar + (lambda (x) (let* ((file (file-relative-name x dir)) + ;; Previously loaded file, if any. + (previous + (ignore-errors + (file-name-sans-extension + (file-truename (find-library-name file))))) + (pos (when previous (member previous history)))) + ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) + (when pos + (cons (file-name-sans-extension file) (length pos))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))) + (defun package--list-loaded-files (dir) "Recursively list all files in DIR which correspond to loaded features. Returns the `file-name-sans-extension' of each file, relative to DIR, sorted by most recently loaded last." - (let* ((history (delq nil - (mapcar (lambda (x) - (let ((f (car x))) - (and (stringp f) - (file-name-sans-extension f)))) - load-history))) + (let* ((history (package--files-load-history)) (dir (file-truename dir)) ;; List all files that have already been loaded. - (list-of-conflicts - (delq - nil - (mapcar - (lambda (x) (let* ((file (file-relative-name x dir)) - ;; Previously loaded file, if any. - (previous - (ignore-errors - (file-name-sans-extension - (file-truename (find-library-name file))))) - (pos (when previous (member previous history)))) - ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) - (when pos - (cons (file-name-sans-extension file) (length pos))))) - (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))) + (list-of-conflicts (package--list-of-conflicts dir history))) ;; Turn the list of (FILENAME . POS) back into a list of features. Files in ;; subdirectories are returned relative to DIR (so not actually features). (let ((default-directory (file-name-as-directory dir))) (mapcar (lambda (x) (file-truename (car x))) - (sort list-of-conflicts - ;; Sort the files by ascending HISTORY-POSITION. - (lambda (x y) (< (cdr x) (cdr y)))))))) + (sort list-of-conflicts + ;; Sort the files by ascending HISTORY-POSITION. + (lambda (x y) (< (cdr x) (cdr y)))))))) ;;;; `package-activate' ;; This function activates a newer version of a package if an older diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 0067495fea0..7fb1a88b861 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -146,7 +146,8 @@ There can be any number of :example/:result elements." (string-limit :eval (string-limit "foobar" 3) :eval (string-limit "foobar" 3 t) - :eval (string-limit "foobar" 10)) + :eval (string-limit "foobar" 10) + :eval (string-limit "fo好" 3 nil 'utf-8)) (truncate-string-to-width :eval (truncate-string-to-width "foobar" 3) :eval (truncate-string-to-width "你好bar" 5)) @@ -154,9 +155,6 @@ There can be any number of :example/:result elements." :eval (split-string "foo bar") :eval (split-string "|foo|bar|" "|") :eval (split-string "|foo|bar|" "|" t)) - (string-slice - :eval (string-slice "foo-bar" "-") - :eval (string-slice "foo-bar--zot-" "-+")) (string-lines :eval (string-lines "foo\n\nbar") :eval (string-lines "foo\n\nbar" t)) @@ -620,6 +618,12 @@ There can be any number of :example/:result elements." "Data About Lists" (length :eval (length '(a b c))) + (length< + :eval (length< '(a b c) 1)) + (length> + :eval (length> '(a b c) 1)) + (length= + :eval (length> '(a b c) 3)) (safe-length :eval (safe-length '(a b c)))) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7e17a3464e6..9fbb0351af4 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -286,7 +286,7 @@ result will have lines that are longer than LENGTH." (fill-region (point-min) (point-max))) (buffer-string))) -(defun string-limit (string length &optional end) +(defun string-limit (string length &optional end coding-system) "Return (up to) a LENGTH substring of STRING. If STRING is shorter than or equal to LENGTH, the entire string is returned unchanged. @@ -295,34 +295,45 @@ If STRING is longer than LENGTH, return a substring consisting of the first LENGTH characters of STRING. If END is non-nil, return the last LENGTH characters instead. +If CODING-SYSTEM is non-nil, STRING will be encoded before +limiting, and LENGTH is interpreted as the number of bytes to +limit the string to. The result will be a unibyte string that is +shorter than LENGTH, but will not contain \"partial\" characters, +even if CODING-SYSTEM encodes characters with several bytes per +character. + When shortening strings for display purposes, `truncate-string-to-width' is almost always a better alternative than this function." (unless (natnump length) (signal 'wrong-type-argument (list 'natnump length))) - (cond - ((<= (length string) length) string) - (end (substring string (- (length string) length))) - (t (substring string 0 length)))) + (if coding-system + (let ((result nil) + (result-length 0) + (index (if end (1- (length string)) 0))) + (while (let ((encoded (encode-coding-char + (aref string index) coding-system))) + (and (<= (+ (length encoded) result-length) length) + (progn + (push encoded result) + (cl-incf result-length (length encoded)) + (setq index (if end (1- index) + (1+ index)))) + (if end (> index -1) + (< index (length string))))) + ;; No body. + ) + (apply #'concat (if end result (nreverse result)))) + (cond + ((<= (length string) length) string) + (end (substring string (- (length string) length))) + (t (substring string 0 length))))) (defun string-lines (string &optional omit-nulls) "Split STRING into a list of lines. If OMIT-NULLS, empty lines will be removed from the results." (split-string string "\n" omit-nulls)) -(defun string-slice (string regexp) - "Split STRING at REGEXP boundaries and return a list of slices. -The boundaries that match REGEXP are included in the result. - -Also see `split-string'." - (if (zerop (length string)) - (list "") - (let ((i (string-match-p regexp string 1))) - (if i - (cons (substring string 0 i) - (string-slice (substring string i) regexp)) - (list string))))) - (defun string-pad (string length &optional padding start) "Pad STRING to LENGTH using PADDING. If PADDING is nil, the space character is used. If not nil, it diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 13bbb5284a3..e92b89fc4e9 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -33,7 +33,7 @@ ;; ;; (face RELATIVE_SPECS_1 RELATIVE_SPECS_2 ... BASE_SPECS) ;; -;; The "specs" values are a lists of face names or face attribute-value +;; The "specs" values are lists of face names or face attribute-value ;; pairs, and are merged together, with earlier values taking precedence. ;; ;; The RELATIVE_SPECS_* values are added by `face-remap-add-relative' @@ -183,13 +183,13 @@ to apply on top of the normal definition of FACE." This causes the remappings specified by `face-remap-add-relative' to apply on top of the face specification given by SPECS. -The remaining arguments, SPECS, should form a list of faces. -Each list element should be either a face name or a property list +The remaining arguments, SPECS, specify the base of the remapping. +Each one of SPECS should be either a face name or a property list of face attribute/value pairs, like in a `face' text property. -If SPECS is empty, call `face-remap-reset-base' to use the normal -definition of FACE as the base remapping; note that this is -different from SPECS containing a single value nil, which means +If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base' +to use the normal definition of FACE as the base remapping; note that +this is different from SPECS containing a single value nil, which means not to inherit from the global definition of FACE at all." (while (and (consp specs) (not (null (car specs))) (null (cdr specs))) (setq specs (car specs))) diff --git a/lisp/forms.el b/lisp/forms.el index 8974f99ef57..b8638bc6e20 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -436,6 +436,14 @@ Also, initial position is at last record." (defvar read-file-filter) ; bound in forms--intuit-from-file +;; The code used to use `run-hooks' but in a way that's actually +;; incompatible with hooks (and with lexical scoping), so this function +;; approximates the actual behavior that `run-hooks' provided. +(defun forms--run-functions (functions) + (if (functionp functions) + (funcall functions) + (mapc #'funcall functions))) + ;;;###autoload (defun forms-mode (&optional primary) ;; FIXME: use define-derived-mode @@ -547,8 +555,6 @@ Commands: Equivalent keys in read-only mode: "`forms-multi-line' is equal to `forms-field-sep'"))) (error (concat "Forms control file error: " "`forms-multi-line' must be nil or a one-character string")))) - (or (fboundp 'set-text-properties) - (setq forms-use-text-properties nil)) ;; Validate and process forms-format-list. ;;(message "forms: pre-processing format list...") @@ -568,12 +574,12 @@ Commands: Equivalent keys in read-only mode: ;; Check if record filters are defined. (if (and forms-new-record-filter - (not (fboundp forms-new-record-filter))) + (not (functionp forms-new-record-filter))) (error (concat "Forms control file error: " "`forms-new-record-filter' is not a function"))) (if (and forms-modified-record-filter - (not (fboundp forms-modified-record-filter))) + (not (functionp forms-modified-record-filter))) (error (concat "Forms control file error: " "`forms-modified-record-filter' is not a function"))) @@ -647,7 +653,7 @@ Commands: Equivalent keys in read-only mode: (with-current-buffer forms--file-buffer (let ((inhibit-read-only t) (file-modified (buffer-modified-p))) - (mapc #'funcall read-file-filter) + (forms--run-functions read-file-filter) (if (not file-modified) (set-buffer-modified-p nil))) (if write-file-filter (add-hook 'write-file-functions write-file-filter nil t))) @@ -875,8 +881,7 @@ Commands: Equivalent keys in read-only mode: (list 'face forms--rw-face 'front-sticky '(face)))) ;; Enable `post-command-hook' to restore the properties. - (setq post-command-hook - (append (list 'forms--iif-post-command-hook) post-command-hook))) + (add-hook 'post-command-hook #'forms--iif-post-command-hook)) ;; No action needed. Clear marker. (setq forms--iif-start nil))) @@ -885,8 +890,7 @@ Commands: Equivalent keys in read-only mode: "`post-command-hook' function for read-only segments." ;; Disable `post-command-hook'. - (setq post-command-hook - (delq 'forms--iif-hook-post-command-hook post-command-hook)) + (remove-hook 'post-command-hook #'forms--iif-post-command-hook) ;; Restore properties. (if forms--iif-start @@ -916,7 +920,7 @@ Commands: Equivalent keys in read-only mode: (if forms-use-text-properties `(lambda (arg) (let ((inhibit-read-only t)) - ,@(apply 'append + ,@(apply #'append (mapcar #'forms--make-format-elt-using-text-properties forms-format-list)) ;; Prevent insertion before the first text. @@ -929,7 +933,7 @@ Commands: Equivalent keys in read-only mode: '(rear-nonsticky nil))) (setq forms--iif-start nil)) `(lambda (arg) - ,@(apply 'append + ,@(apply #'append (mapcar #'forms--make-format-elt forms-format-list))))) ;; We have tallied the number of markers and dynamic texts, @@ -1100,7 +1104,7 @@ Commands: Equivalent keys in read-only mode: `(lambda nil (let (here) (goto-char (point-min)) - ,@(apply 'append + ,@(apply #'append (mapcar #'forms--make-parser-elt (append forms-format-list (list nil))))))))) @@ -1219,7 +1223,7 @@ Commands: Equivalent keys in read-only mode: (setq the-record (with-current-buffer forms--file-buffer (let ((inhibit-read-only t)) - (run-hooks 'read-file-filter)) + (forms--run-functions read-file-filter)) (goto-char (point-min)) (forms--get-record))) @@ -1427,7 +1431,7 @@ Commands: Equivalent keys in read-only mode: ;; ;; We have our own revert function - use it. (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'forms--revert-buffer) + (setq revert-buffer-function #'forms--revert-buffer) t) @@ -1900,7 +1904,7 @@ after writing out the data." ;; Write file hooks are run via write-file-functions. ;; (if write-file-filter ;; (save-excursion - ;; (run-hooks 'write-file-filter))) + ;; (forms--run-functions write-file-filter))) ;; If they have a write-file-filter, force the buffer to be ;; saved even if it doesn't seem to be changed. First, they @@ -1912,7 +1916,7 @@ after writing out the data." (save-buffer args) (if read-file-filter (save-excursion - (run-hooks 'read-file-filter))) + (forms--run-functions read-file-filter))) (set-buffer-modified-p nil))) ;; Make sure we end up with the same record number as we started. ;; Since read-file-filter may perform arbitrary transformations on @@ -2037,20 +2041,19 @@ Usage: (setq forms-number-of-fields (defun forms--debug (&rest args) "Internal debugging routine." (if forms--debug - (let ((ret nil)) - (while args - (let ((el (car-safe args))) - (setq args (cdr-safe args)) - (if (stringp el) - (setq ret (concat ret el)) - (setq ret (concat ret (prin1-to-string el) " = ")) - (if (boundp el) - (let ((vel (eval el))) - (setq ret (concat ret (prin1-to-string vel) "\n"))) - (setq ret (concat ret "<unbound>" "\n"))) - (if (fboundp el) - (setq ret (concat ret (prin1-to-string (symbol-function el)) - "\n")))))) + (let ((ret + (mapconcat + (lambda (el) + (if (stringp el) el + (concat (prin1-to-string el) " = " + (if (boundp el) + (prin1-to-string (eval el)) + "<unbound>") + "\n" + (if (fboundp el) + (concat (prin1-to-string (symbol-function el)) + "\n"))))) + args ""))) (with-current-buffer (get-buffer-create "*forms-mode debug*") (if (zerop (buffer-size)) (emacs-lisp-mode)) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 99449ad359f..3b436864f8d 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1075,6 +1075,90 @@ (define-charset-alias 'ebcdic-int 'ibm038) (define-charset-alias 'cp038 'ibm038) +(define-charset 'ibm256 + "Netherlands version of EBCDIC" + :short-name "IBM256" + :code-space [0 255] + :mime-charset 'ibm256 + :map "IBM256") + +(define-charset 'ibm273 + "Austrian / German version of EBCDIC" + :short-name "IBM273" + :code-space [0 255] + :mime-charset 'ibm273 + :map "IBM273") + +(define-charset 'ibm274 + "Belgian version of EBCDIC" + :short-name "IBM274" + :code-space [0 255] + :mime-charset 'ibm274 + :map "IBM274") + +(define-charset 'ibm275 + "Brazilian version of EBCDIC" + :short-name "IBM275" + :code-space [0 255] + :mime-charset 'ibm275 + :map "IBM275") + +(define-charset 'ibm277 + "Danish / Norwegian version of EBCDIC" + :short-name "IBM277" + :code-space [0 255] + :mime-charset 'ibm277 + :map "IBM277") + +(define-charset 'ibm278 + "Finnish / Swedish version of EBCDIC" + :short-name "IBM278" + :code-space [0 255] + :mime-charset 'ibm278 + :map "IBM278") + +(define-charset 'ibm280 + "Italian version of EBCDIC" + :short-name "IBM280" + :code-space [0 255] + :mime-charset 'ibm270 + :map "IBM280") + +(define-charset 'ibm281 + "Japanese-E version of EBCDIC" + :short-name "IBM281" + :code-space [0 255] + :mime-charset 'ibm281 + :map "IBM281") + +(define-charset 'ibm284 + "Spanish version of EBCDIC" + :short-name "IBM284" + :code-space [0 255] + :mime-charset 'ibm284 + :map "IBM284") + +(define-charset 'ibm285 + "UK english version of EBCDIC" + :short-name "IBM285" + :code-space [0 255] + :mime-charset 'ibm285 + :map "IBM285") + +(define-charset 'ibm290 + "Japanese katakana version of EBCDIC" + :short-name "IBM290" + :code-space [0 255] + :mime-charset 'ibm290 + :map "IBM290") + +(define-charset 'ibm297 + "French version of EBCDIC" + :short-name "IBM297" + :code-space [0 255] + :mime-charset 'ibm297 + :map "IBM297") + (define-charset 'ibm1047 ;; Says groff: "IBM1047, `EBCDIC Latin 1/Open Systems' used by OS/390 Unix." diff --git a/lisp/language/european.el b/lisp/language/european.el index 713a0fdb344..1f9a15333ba 100644 --- a/lisp/language/european.el +++ b/lisp/language/european.el @@ -324,6 +324,87 @@ Latin-9 is sometimes nicknamed `Latin-0'.")) :mime-charset 'windows-1257) (define-coding-system-alias 'cp1257 'windows-1257) +(define-coding-system 'ibm256 + "Netherlands version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm256) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-int1 'ibm256) +(define-coding-system-alias 'cp256 'ibm256) + +(define-coding-system 'ibm273 + "Austrian / German version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm273) + :mnemonic ?*) +(define-coding-system-alias 'cp273 'ibm273) + +(define-coding-system 'ibm274 + "Belgian version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm274) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-be 'ibm274) +(define-coding-system-alias 'cp274 'ibm274) + +(define-coding-system 'ibm275 + "Brazilian version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm275) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-br 'ibm275) +(define-coding-system-alias 'cp275 'ibm275) + +(define-coding-system 'ibm277 + "Danish / Norwegian version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm277) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-cp-dk 'ibm277) +(define-coding-system-alias 'ebcdic-cp-no 'ibm277) +(define-coding-system-alias 'cp277 'ibm277) + +(define-coding-system 'ibm278 + "Finnish / Swedish version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm278) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-cp-fi 'ibm278) +(define-coding-system-alias 'ebcdic-cp-se 'ibm278) +(define-coding-system-alias 'cp278 'ibm278) + +(define-coding-system 'ibm280 + "Italian version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm280) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-cp-it 'ibm280) +(define-coding-system-alias 'cp280 'ibm280) + +(define-coding-system 'ibm284 + "Spanish version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm284) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-cp-es 'ibm284) +(define-coding-system-alias 'cp284 'ibm284) + +(define-coding-system 'ibm285 + "UK english version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm285) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-cp-gb 'ibm285) +(define-coding-system-alias 'cp285 'ibm285) + +(define-coding-system 'ibm297 + "French version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm297) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-cp-fr 'ibm297) +(define-coding-system-alias 'cp297 'ibm297) + (define-coding-system 'cp775 "DOS codepage 775 (PC Baltic, MS-DOS Baltic Rim)" :coding-type 'charset diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el index 9a99245dfde..a517b4ea8eb 100644 --- a/lisp/language/japanese.el +++ b/lisp/language/japanese.el @@ -188,6 +188,22 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>." (define-coding-system-alias 'shift_jis-2004 'japanese-shift-jis-2004) +(define-coding-system 'ibm281 + "Japanese-E version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm281) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-jp-e 'ibm281) +(define-coding-system-alias 'cp281 'ibm281) + +(define-coding-system 'ibm290 + "Japanese katakana version of EBCDIC" + :coding-type 'charset + :charset-list '(ibm290) + :mnemonic ?*) +(define-coding-system-alias 'ebcdic-jp-kana 'ibm290) +(define-coding-system-alias 'cp290 'ibm290) + (set-language-info-alist "Japanese" '((setup-function . setup-japanese-environment-internal) (exit-function . use-default-char-width-table) diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index db518482591..4d8c9267f31 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -214,6 +214,16 @@ the cdr is set to t. Else, the car is set to nil." ;; rule means this cannot be spam. (setcar result nil))))) +;; Don't spuriously advance to the next unseen message while +;; prompting, because that causes it to then be missed while actually +;; reading mail afterwards! Call this instead of +;; rmail-first-unseen-message. +(defun rsf--rmail-last-seen-message () + (max 1 + ;; 'rmail-first-unseen-message' can return nil in a completely + ;; empty buffer. + (1- (or (rmail-first-unseen-message) 1)))) + (defun rmail-spam-filter (msg) "Return nil if message number MSG is spam based on `rsf-definitions-alist'. If spam, optionally output message to a file `rsf-file' and delete @@ -327,8 +337,7 @@ it from rmail file. Called for each new message retrieved by (if (and (car maybe-spam) (cdr maybe-spam)) ;; Temporarily set rmail-current-message in order to output ;; and delete the spam msg if needed: - (let ((rmail-current-message msg) ; FIXME does this do anything? - (action (cdr (assq 'action + (let ((action (cdr (assq 'action (nth num-element rsf-definitions-alist)))) (newfile (not (file-exists-p rsf-file)))) ;; Check action item in rsf-definitions-alist and do it. @@ -337,7 +346,7 @@ it from rmail file. Called for each new message retrieved by ;; Else the prompt to write a new file leaves the raw ;; mbox buffer visible. (and newfile - (rmail-show-message (rmail-first-unseen-message) t)) + (rmail-show-message (rsf--rmail-last-seen-message) t)) (rmail-output rsf-file) ;; Swap back, else rmail-get-new-mail-1 gets confused. (when newfile @@ -377,7 +386,7 @@ This is called at the end of `rmail-get-new-mail-1' if there is new mail." (sleep-for rsf-sleep-after-message)) (when (> nspam 0) ;; Otherwise sleep or expunge prompt leaves raw mbox buffer showing. - (rmail-show-message (or (rmail-first-unseen-message) 1) t) + (rmail-show-message (or (rsf--rmail-last-seen-message) 1) t) (unwind-protect (progn (if rsf-beep (ding t)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 1722c53be05..fa1a90bc844 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,12 +49,12 @@ ;; The user option `tramp-gvfs-methods' contains the list of supported ;; connection methods. Per default, these are "afp", "dav", "davs", -;; "gdrive", "media", "nextcloud" and "sftp". +;; "gdrive", "mtp", "nextcloud" and "sftp". ;; "gdrive" and "nextcloud" connection methods require a respective ;; account in GNOME Online Accounts, with enabled "Files" service. -;; The "media" connection method is responsible for media devices, +;; The "mtp" connection method is responsible for media devices, ;; like cell phones, tablets, cameras etc. The device must already be ;; connected via USB, before accessing it. @@ -131,7 +131,7 @@ ;;;###tramp-autoload (defcustom tramp-gvfs-methods - '("afp" "dav" "davs" "gdrive" "media" "nextcloud" "sftp") + '("afp" "dav" "davs" "gdrive" "mtp" "nextcloud" "sftp") "List of methods for remote files, accessed with GVFS." :group 'tramp :version "28.1" @@ -142,7 +142,7 @@ (const "gdrive") (const "http") (const "https") - (const "media") + (const "mtp") (const "nextcloud") (const "sftp") (const "smb")))) @@ -159,7 +159,7 @@ ;;;###tramp-autoload (defvar tramp-media-methods '("afc" "gphoto2" "mtp") - "List of GVFS methods which are covered by the \"media\" method. + "List of GVFS methods which are covered by the \"mtp\" method. They are checked during start up via `tramp-gvfs-interface-remotevolumemonitor'.") @@ -1639,7 +1639,7 @@ ID-FORMAT valid values are `string' and `integer'." (if (tramp-tramp-file-p filename) (with-parsed-tramp-file-name filename nil ;; Ensure that media devices are cached. - (when (string-equal method "media") + (when (string-equal method "mtp") (tramp-get-media-device v)) (with-tramp-connection-property v "activation-uri" (setq localname "/") @@ -1649,7 +1649,7 @@ ID-FORMAT valid values are `string' and `integer'." (setq method "davs" localname (concat (tramp-gvfs-get-remote-prefix v) localname))) - (when (string-equal "media" method) + (when (string-equal "mtp" method) (when-let ((media (tramp-get-connection-property v "media-device" nil))) (setq method (tramp-media-device-method media) @@ -2058,7 +2058,7 @@ and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals." (uri (url-generic-parse-url (nth 5 volume))) (method (url-type uri)) (vec (make-tramp-file-name - :method "media" + :method "mtp" ;; A host name cannot contain spaces. :host (tramp-compat-string-replace " " "_" (nth 1 volume)))) (media (make-tramp-media-device @@ -2363,7 +2363,7 @@ VEC is used only for traces." tramp-gvfs-interface-remotevolumemonitor "List"))) (let* ((uri (url-generic-parse-url (nth 5 volume))) (vec (make-tramp-file-name - :method "media" + :method "mtp" ;; A host name cannot contain spaces. :host (tramp-compat-string-replace " " "_" (nth 1 volume)))) (media (make-tramp-media-device @@ -2376,12 +2376,12 @@ VEC is used only for traces." (tramp-set-connection-property vec "media-device" media) (tramp-set-connection-property media "vector" vec)))) - ;; Adapt default host name, supporting /media:: when possible. + ;; Adapt default host name, supporting /mtp:: when possible. (setq tramp-default-host-alist (append - `(("media" nil ,(if (= (length devices) 1) (car devices) ""))) + `(("mtp" nil ,(if (= (length devices) 1) (car devices) ""))) (delete - (assoc "media" tramp-default-host-alist) + (assoc "mtp" tramp-default-host-alist) tramp-default-host-alist))))) (defun tramp-parse-media-names (service) @@ -2498,7 +2498,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." ;; Add completion functions for media devices. (tramp-get-media-devices nil) (tramp-set-completion-function - "media" + "mtp" (mapcar (lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method))) tramp-media-methods)))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index cd63b0ebefa..1c65ca1a0cf 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -10752,8 +10752,4 @@ when defining today." (provide 'org-agenda) -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - ;;; org-agenda.el ends here diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index a9a1181935c..d3dc0ab3e75 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1947,8 +1947,4 @@ Assume sexps have been marked with (provide 'org-capture) -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - ;;; org-capture.el ends here diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 506fba8aaf5..d397e3ed05b 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -377,18 +377,25 @@ error when the user input is empty." 'org-time-stamp-inactive) (apply #'completing-read args))) -(defun org--mks-read-key (allowed-keys prompt) +(defun org--mks-read-key (allowed-keys prompt navigation-keys) "Read a key and ensure it is a member of ALLOWED-KEYS. +Enable keys to scroll the window if NAVIGATION-KEYS is set. TAB, SPC and RET are treated equivalently." - (let* ((key (char-to-string - (pcase (read-char-exclusive prompt) - ((or ?\s ?\t ?\r) ?\t) - (char char))))) - (if (member key allowed-keys) - key - (message "Invalid key: `%s'" key) - (sit-for 1) - (org--mks-read-key allowed-keys prompt)))) + (setq header-line-format (when navigation-keys "Use C-n, C-p, C-v, M-v to navigate.")) + (let ((char-key (read-char-exclusive prompt))) + (if (and navigation-keys (memq char-key '(14 16 22 134217846))) + (progn + (org-scroll char-key) + (org--mks-read-key allowed-keys prompt navigation-keys)) + (let ((key (char-to-string + (pcase char-key + ((or ?\s ?\t ?\r) ?\t) + (char char))))) + (if (member key allowed-keys) + key + (message "Invalid key: `%s'" key) + (sit-for 1) + (org--mks-read-key allowed-keys prompt navigation-keys)))))) (defun org-mks (table title &optional prompt specials) "Select a member of an alist with multiple keys. @@ -461,15 +468,13 @@ is selected, only the bare key is returned." ;; Display UI and let user select an entry or ;; a sub-level prefix. (goto-char (point-min)) - (setq header-line-format nil) (org-fit-window-to-buffer) - (unless (pos-visible-in-window-p (1- (point-max))) - (setq header-line-format "Use C-n, C-p or C-v to navigate.") - (setq allowed-keys (append allowed-keys '("\C-n" "\C-p" "\C-v")))) - (let ((pressed (org--mks-read-key allowed-keys prompt))) - (while (and (member pressed '("\C-n" "\C-p" "\C-v"))) - (org-scroll (string-to-char pressed)) - (setq pressed (org--mks-read-key allowed-keys prompt))) + (message "") ; With this line the prompt appears in + ; the minibuffer. Else keystrokes may + ; appear, which is spurious. + (let ((pressed (org--mks-read-key + allowed-keys prompt + (not (pos-visible-in-window-p (1- (point-max))))))) (setq current (concat current pressed)) (cond ((equal pressed "\C-g") (user-error "Abort")) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 479ca460852..25b3354bdd7 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.4.3")) + (let ((org-release "9.4.4")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.4.3")) + (let ((org-git-version "release_9.4.4")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 0d7c6c87fdc..0473caef9bc 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -8,7 +8,7 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: https://orgmode.org -;; Version: 9.4.3 +;; Version: 9.4.4 ;; This file is part of GNU Emacs. ;; diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 218bbb47cd5..51f620ea1f0 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1414,12 +1414,14 @@ comment at the start of cc-engine.el for more info." (setq ret 'label))) ;; Skip over the unary operators that can start the statement. - (while (progn - (c-backward-syntactic-ws lim) - ;; protect AWK post-inc/decrement operators, etc. - (and (not (c-at-vsemi-p (point))) - (/= (skip-chars-backward "-.+!*&~@`#") 0))) + (while (and (> (point) lim) + (progn + (c-backward-syntactic-ws lim) + ;; protect AWK post-inc/decrement operators, etc. + (and (not (c-at-vsemi-p (point))) + (/= (skip-chars-backward "-.+!*&~@`#") 0)))) (setq pos (point))) + (goto-char pos) ret))) @@ -3567,8 +3569,9 @@ mhtml-mode." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Defuns which analyze the buffer, yet don't change `c-state-cache'. (defun c-get-fallback-scan-pos (here) - ;; Return a start position for building `c-state-cache' from - ;; scratch. This will be at the top level, 2 defuns back. + ;; Return a start position for building `c-state-cache' from scratch. This + ;; will be at the top level, 2 defuns back. Return nil if we don't find + ;; these defun starts a reasonable way back. (save-excursion (save-restriction (when (> here (* 10 c-state-cache-too-far)) @@ -11177,6 +11180,7 @@ comment at the start of cc-engine.el for more info." (c-backward-syntactic-ws lim) (not (or (memq (char-before) '(?\; ?} ?: nil)) (c-at-vsemi-p)))) + (not (and lim (<= (point) lim))) (save-excursion (backward-char) (not (looking-at "\\s("))) @@ -11615,6 +11619,195 @@ comment at the start of cc-engine.el for more info." (or (looking-at c-brace-list-key) (progn (goto-char here) nil)))) +(defun c-laomib-loop (lim) + ;; The "expensive" loop from `c-looking-at-or-maybe-in-bracelist'. Move + ;; backwards over comma separated sexps as far as possible, but no further + ;; than LIM, which may be nil, meaning no limit. Return the final value of + ;; `braceassignp', which is t if we encountered "= {", usually nil + ;; otherwise. + (let ((braceassignp 'dontknow) + (class-key + ;; Pike can have class definitions anywhere, so we must + ;; check for the class key here. + (and (c-major-mode-is 'pike-mode) + c-decl-block-key))) + (while (eq braceassignp 'dontknow) + (cond ((eq (char-after) ?\;) + (setq braceassignp nil)) + ((and class-key + (looking-at class-key)) + (setq braceassignp nil)) + ((and c-has-compound-literals + (looking-at c-return-key)) + (setq braceassignp t) + nil) + ((eq (char-after) ?=) + ;; We've seen a =, but must check earlier tokens so + ;; that it isn't something that should be ignored. + (setq braceassignp 'maybe) + (while (and (eq braceassignp 'maybe) + (zerop (c-backward-token-2 1 t lim))) + (setq braceassignp + (cond + ;; Check for operator = + ((and c-opt-op-identifier-prefix + (looking-at c-opt-op-identifier-prefix)) + nil) + ;; Check for `<opchar>= in Pike. + ((and (c-major-mode-is 'pike-mode) + (or (eq (char-after) ?`) + ;; Special case for Pikes + ;; `[]=, since '[' is not in + ;; the punctuation class. + (and (eq (char-after) ?\[) + (eq (char-before) ?`)))) + nil) + ((looking-at "\\s.") 'maybe) + ;; make sure we're not in a C++ template + ;; argument assignment + ((and + (c-major-mode-is 'c++-mode) + (save-excursion + (let ((here (point)) + (pos< (progn + (skip-chars-backward "^<>") + (point)))) + (and (eq (char-before) ?<) + (not (c-crosses-statement-barrier-p + pos< here)) + (not (c-in-literal)) + )))) + nil) + (t t))))) + ((and + (c-major-mode-is 'c++-mode) + (eq (char-after) ?\[) + ;; Be careful of "operator []" + (not (save-excursion + (c-backward-token-2 1 nil lim) + (looking-at c-opt-op-identifier-prefix)))) + (setq braceassignp t) + nil)) + (when (eq braceassignp 'dontknow) + (cond ((and + (not (eq (char-after) ?,)) + (save-excursion + (c-backward-syntactic-ws) + (eq (char-before) ?}))) + (setq braceassignp nil)) + ((/= (c-backward-token-2 1 t lim) 0) + (if (save-excursion + (and c-has-compound-literals + (eq (c-backward-token-2 1 nil lim) 0) + (eq (char-after) ?\())) + (setq braceassignp t) + (setq braceassignp nil)))))) + braceassignp)) + +;; The following variable is a cache of up to four entries, each entry of +;; which is a list representing a call to c-laomib-loop. It contains the +;; following elements: +;; 0: `lim' argument - used as an alist key, never nil. +;; 1: Position in buffer where the scan started. +;; 2: Position in buffer where the scan ended. +;; 3: Result of the call to `c-laomib-loop'. +(defvar c-laomib-cache nil) +(make-variable-buffer-local 'c-laomib-cache) + +(defun c-laomib-get-cache (containing-sexp) + ;; Get an element from `c-laomib-cache' matching CONTAINING-SEXP. + ;; Return that element or nil if one wasn't found. + (let ((elt (assq containing-sexp c-laomib-cache))) + (when elt + ;; Move the fetched `elt' to the front of the cache. + (setq c-laomib-cache (delq elt c-laomib-cache)) + (push elt c-laomib-cache) + elt))) + +(defun c-laomib-put-cache (lim start end result) + ;; Insert a new element into `c-laomib-cache', removing another element to + ;; make room, if necessary. The four parameters LIM, START, END, RESULT are + ;; the components of the new element (see comment for `c-laomib-cache'). + ;; The return value is of no significance. + (when lim + (let ((old-elt (assq lim c-laomib-cache)) + ;; (elt (cons containing-sexp (cons start nil))) + (new-elt (list lim start end result)) + big-ptr + (cur-ptr c-laomib-cache) + togo togo-ptr (size 0) cur-size + ) + (if old-elt (setq c-laomib-cache (delq old-elt c-laomib-cache))) + + (while (>= (length c-laomib-cache) 4) + ;; We delete the least recently used elt which doesn't enclose START, + ;; or.. + (dolist (elt c-laomib-cache) + (if (or (<= start (cadr elt)) + (> start (car (cddr elt)))) + (setq togo elt))) + + ;; ... delete the least recently used elt which isn't the biggest. + (when (not togo) + (while (cdr cur-ptr) + (setq cur-size (- (nth 2 (cadr cur-ptr)) (car (cadr cur-ptr)))) + (when (> cur-size size) + (setq size cur-size + big-ptr cur-ptr)) + (setq cur-ptr (cdr cur-ptr))) + (setq togo (if (cddr big-ptr) + (car (last big-ptr)) + (car big-ptr)))) + + (setq c-laomib-cache (delq togo c-laomib-cache))) + + (push new-elt c-laomib-cache)))) + +(defun c-laomib-fix-elt (lwm elt paren-state) + ;; Correct a c-laomib-cache entry ELT with respect to buffer changes, either + ;; doing nothing, signalling it is to be deleted, or replacing its start + ;; point with one lower in the buffer than LWM. PAREN-STATE is the paren + ;; state at LWM. Return the corrected entry, or nil (if it needs deleting). + ;; Note that corrections are made by `setcar'ing the original structure, + ;; which thus remains intact. + (cond + ((or (not lwm) (> lwm (cadr elt))) + elt) + ((<= lwm (nth 2 elt)) + nil) + (t + (let (cur-brace) + ;; Search for the last brace in `paren-state' before (car `lim'). This + ;; brace will become our new 2nd element of `elt'. + (while + ;; Search one brace level per iteration. + (and paren-state + (progn + ;; (setq cur-brace (c-laomib-next-BRACE paren-state)) + (while + ;; Go past non-brace levels, one per iteration. + (and paren-state + (not (eq (char-after + (c-state-cache-top-lparen paren-state)) + ?{))) + (setq paren-state (cdr paren-state))) + (cadr paren-state)) + (> (c-state-cache-top-lparen (cdr paren-state)) (car elt))) + (setq paren-state (cdr paren-state))) + (when (cadr paren-state) + (setcar (cdr elt) (c-state-cache-top-lparen paren-state)) + elt))))) + +(defun c-laomib-invalidate-cache (beg _end) + ;; Called from late in c-before-change. Amend `c-laomib-cache' to remove + ;; details pertaining to the buffer after position BEG. + (save-excursion + (goto-char beg) + (let ((paren-state (c-parse-state))) + (dolist (elt c-laomib-cache) + (when (not (c-laomib-fix-elt beg elt paren-state)) + (setq c-laomib-cache (delq elt c-laomib-cache))))))) + (defun c-looking-at-or-maybe-in-bracelist (&optional containing-sexp lim) ;; Point is at an open brace. If this starts a brace list, return a list ;; whose car is the buffer position of the start of the construct which @@ -11635,14 +11828,10 @@ comment at the start of cc-engine.el for more info." ;; Here, "brace list" does not include the body of an enum. (save-excursion (let ((start (point)) - (class-key - ;; Pike can have class definitions anywhere, so we must - ;; check for the class key here. - (and (c-major-mode-is 'pike-mode) - c-decl-block-key)) (braceassignp 'dontknow) inexpr-brace-list bufpos macro-start res pos after-type-id-pos - in-paren parens-before-brace) + in-paren parens-before-brace + paren-state paren-pos) (setq res (c-backward-token-2 1 t lim)) ;; Checks to do only on the first sexp before the brace. @@ -11651,8 +11840,10 @@ comment at the start of cc-engine.el for more info." (cond ((and (or (not (eq res 0)) (eq (char-after) ?,)) - (c-go-up-list-backward nil lim) ; FIXME!!! Check ; `lim' 2016-07-12. - (eq (char-after) ?\()) + (setq paren-state (c-parse-state)) + (setq paren-pos (c-pull-open-brace paren-state)) + (eq (char-after paren-pos) ?\()) + (goto-char paren-pos) (setq braceassignp 'c++-noassign in-paren 'in-paren)) ((looking-at c-pre-id-bracelist-key) @@ -11669,9 +11860,11 @@ comment at the start of cc-engine.el for more info." (cond ((or (not (eq res 0)) (eq (char-after) ?,)) - (and (c-go-up-list-backward nil lim) ; FIXME!!! Check `lim' 2016-07-12. - (eq (char-after) ?\() - (setq in-paren 'in-paren))) + (and (setq paren-state (c-parse-state)) + (setq paren-pos (c-pull-open-brace paren-state)) + (eq (char-after paren-pos) ?\() + (setq in-paren 'in-paren) + (goto-char paren-pos))) ((looking-at c-pre-id-bracelist-key)) ((looking-at c-return-key)) (t (setq after-type-id-pos (point)) @@ -11724,79 +11917,36 @@ comment at the start of cc-engine.el for more info." (t (goto-char pos) - ;; Checks to do on all sexps before the brace, up to the - ;; beginning of the statement. - (while (eq braceassignp 'dontknow) - (cond ((eq (char-after) ?\;) - (setq braceassignp nil)) - ((and class-key - (looking-at class-key)) - (setq braceassignp nil)) - ((and c-has-compound-literals - (looking-at c-return-key)) - (setq braceassignp t) - nil) - ((eq (char-after) ?=) - ;; We've seen a =, but must check earlier tokens so - ;; that it isn't something that should be ignored. - (setq braceassignp 'maybe) - (while (and (eq braceassignp 'maybe) - (zerop (c-backward-token-2 1 t lim))) - (setq braceassignp - (cond - ;; Check for operator = - ((and c-opt-op-identifier-prefix - (looking-at c-opt-op-identifier-prefix)) - nil) - ;; Check for `<opchar>= in Pike. - ((and (c-major-mode-is 'pike-mode) - (or (eq (char-after) ?`) - ;; Special case for Pikes - ;; `[]=, since '[' is not in - ;; the punctuation class. - (and (eq (char-after) ?\[) - (eq (char-before) ?`)))) - nil) - ((looking-at "\\s.") 'maybe) - ;; make sure we're not in a C++ template - ;; argument assignment - ((and - (c-major-mode-is 'c++-mode) - (save-excursion - (let ((here (point)) - (pos< (progn - (skip-chars-backward "^<>") - (point)))) - (and (eq (char-before) ?<) - (not (c-crosses-statement-barrier-p - pos< here)) - (not (c-in-literal)) - )))) - nil) - (t t))))) - ((and - (c-major-mode-is 'c++-mode) - (eq (char-after) ?\[) - ;; Be careful of "operator []" - (not (save-excursion - (c-backward-token-2 1 nil lim) - (looking-at c-opt-op-identifier-prefix)))) - (setq braceassignp t) - nil)) - (when (eq braceassignp 'dontknow) - (cond ((and - (not (eq (char-after) ?,)) - (save-excursion - (c-backward-syntactic-ws) - (eq (char-before) ?}))) - (setq braceassignp nil)) - ((/= (c-backward-token-2 1 t lim) 0) - (if (save-excursion - (and c-has-compound-literals - (eq (c-backward-token-2 1 nil lim) 0) - (eq (char-after) ?\())) - (setq braceassignp t) - (setq braceassignp nil)))))) + (when (eq braceassignp 'dontknow) + (let* ((cache-entry (and containing-sexp + (c-laomib-get-cache containing-sexp))) + (lim2 (or (cadr cache-entry) lim)) + sub-bassign-p) + (if cache-entry + (cond + ((<= (point) (cadr cache-entry)) + ;; We're inside the region we've already scanned over, so + ;; just go to that scan's end position. + (goto-char (nth 2 cache-entry)) + (setq braceassignp (nth 3 cache-entry))) + ((> (point) (cadr cache-entry)) + ;; We're beyond the previous scan region, so just scan as + ;; far as the end of that region. + (setq sub-bassign-p (c-laomib-loop lim2)) + (if (<= (point) (cadr cache-entry)) + (progn + (c-laomib-put-cache containing-sexp + start (nth 2 cache-entry) + (nth 3 cache-entry) ;; sub-bassign-p + ) + (setq braceassignp (nth 3 cache-entry)) + (goto-char (nth 2 cache-entry))) + (setq braceassignp sub-bassign-p))) + (t)) + + (setq braceassignp (c-laomib-loop lim)) + (when lim + (c-laomib-put-cache lim start (point) braceassignp))))) (cond (braceassignp diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 7a111017074..f6d36f5670c 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -639,6 +639,8 @@ that requires a literal mode spec at compile time." ;; doesn't work with filladapt but it's better than nothing. (set (make-local-variable 'fill-paragraph-function) 'c-fill-paragraph) + ;; Initialize the cache for `c-looking-at-or-maybe-in-bracelist'. + (setq c-laomib-cache nil) ;; Initialize the three literal sub-caches. (c-truncate-lit-pos-cache 1) ;; Initialize the cache of brace pairs, and opening braces/brackets/parens. @@ -2054,7 +2056,9 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (if c-get-state-before-change-functions (mapc (lambda (fn) (funcall fn beg end)) - c-get-state-before-change-functions)))) + c-get-state-before-change-functions)) + + (c-laomib-invalidate-cache beg end))) (c-clear-string-fences)))) (c-truncate-lit-pos-cache beg) ;; The following must be done here rather than in `c-after-change' @@ -2205,7 +2209,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") old-pos (new-pos pos) capture-opener - bod-lim bo-decl) + bod-lim bo-decl + paren-state containing-brace) (goto-char (c-point 'bol new-pos)) (unless lit-start (setq bod-lim (c-determine-limit 500)) @@ -2224,12 +2229,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (setq old-pos (point)) (let (pseudo) (while - (progn - (c-syntactic-skip-backward "^;{}" bod-lim t) - (and (eq (char-before) ?}) - (save-excursion - (backward-char) - (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state)))))) + (and + ;; N.B. `c-syntactic-skip-backward' doesn't check (> (point) + ;; lim) and can loop if that's not the case. + (> (point) bod-lim) + (progn + (c-syntactic-skip-backward "^;{}" bod-lim t) + (and (eq (char-before) ?}) + (save-excursion + (backward-char) + (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state))))))) (goto-char pseudo)) t) (> (point) bod-lim) @@ -2262,7 +2271,14 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (and (eq (char-before) ?{) (save-excursion (backward-char) - (consp (c-looking-at-or-maybe-in-bracelist)))) + (setq paren-state (c-parse-state)) + (while + (and + (setq containing-brace + (c-pull-open-brace paren-state)) + (not (eq (char-after containing-brace) ?{)))) + (consp (c-looking-at-or-maybe-in-bracelist + containing-brace containing-brace)))) ))) (not (bobp))) (backward-char)) ; back over (, [, <. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 87542ea133c..2fc2d14ee6a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5666,7 +5666,7 @@ indentation and initial hashes. Behaves usually outside of comment." 'cperl-hash-face 'cperl-array-face) nil) ; arrays and hashes - ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" + ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) (if (eq (char-after (match-beginning 3)) ?{) diff --git a/lisp/so-long.el b/lisp/so-long.el index 431073a2a18..417409bc327 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -41,9 +41,9 @@ ;; simply aren't optimised (remotely) for this scenario, so performance can ;; suffer significantly. ;; -;; When such files are detected, the command `so-long' is automatically called, -;; overriding certain minor modes and variables with performance implications -;; (all configurable), in order to enhance performance in the buffer. +;; When so-long detects such a file, it calls the command `so-long', which +;; overrides certain minor modes and variables (you can configure the details) +;; to improve performance in the buffer. ;; ;; The default action enables the major mode `so-long-mode' in place of the mode ;; that Emacs selected. This ensures that the original major mode cannot affect diff --git a/lisp/subr.el b/lisp/subr.el index 357c97a1393..eaebdf663d8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1747,7 +1747,32 @@ FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the list of hooks to run in HOOK, then nothing is done. See `add-hook'. The optional third argument, LOCAL, if non-nil, says to modify -the hook's buffer-local value rather than its default value." +the hook's buffer-local value rather than its default value. + +Interactively, prompt for the various arguments (skipping local +unless HOOK has both local and global functions). If multiple +functions have the same representation under `princ', the first +one will be removed." + (interactive + (let* ((hook (intern (completing-read "Hook variable: " obarray #'boundp t))) + (local + (and + (local-variable-p hook) + (symbol-value hook) + ;; No need to prompt if there's nothing global + (or (not (default-value hook)) + (y-or-n-p (format "%s has a buffer-local binding, use that? " + hook))))) + (fn-alist (mapcar + (lambda (x) (cons (with-output-to-string (prin1 x)) x)) + (if local (symbol-value hook) (default-value hook)))) + (function (alist-get (completing-read + (format "%s hook to remove: " + (if local "Buffer-local" "Global")) + fn-alist + nil t) + fn-alist nil nil 'string=))) + (list hook function local))) (or (boundp hook) (set hook nil)) (or (default-boundp hook) (set-default hook nil)) ;; Do nothing if LOCAL is t but this hook has no local binding. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 46bf89f14eb..c9444718536 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -27,6 +27,7 @@ ;;; Code: +(require 'cl-lib) (require 'seq) ; tab-line.el is not pre-loaded so it's safe to use it here @@ -35,6 +36,18 @@ :group 'convenience :version "27.1") +(defcustom tab-line-tab-face-functions '(tab-line-tab-face-special) + "Functions called to modify tab faces. +Each function is called with five arguments: the tab, a list of +all tabs, the face returned by the previously called modifier, +whether the tab is a buffer, and whether the tab is selected." + :type '(repeat + (choice (function-item tab-line-tab-face-special) + (function-item tab-line-tab-face-inactive-alternating) + (function :tag "Custom function"))) + :group 'tab-line + :version "28.1") + (defgroup tab-line-faces '((tab-line custom-face)) ; tab-line is defined in faces.el "Faces used in the tab line." :group 'tab-line @@ -63,6 +76,25 @@ :version "27.1" :group 'tab-line-faces) +(defface tab-line-tab-inactive-alternate + `((t (:inherit tab-line-tab-inactive :background "grey65"))) + "Alternate face for inactive tab-line tabs. +Applied to alternating tabs when option +`tab-line-tab-face-functions' includes function +`tab-line-tab-face-inactive-alternating'." + :version "28.1" + :group 'tab-line-faces) + +(defface tab-line-tab-special + '((default (:weight bold)) + (((supports :slant italic)) + (:slant italic :weight normal))) + "Face for special (i.e. non-file-backed) tabs. +Applied when option `tab-line-tab-face-functions' includes +function `tab-line-tab-face-special'." + :version "28.1" + :group 'tab-line-faces) + (defface tab-line-tab-current '((default :inherit tab-line-tab) @@ -412,7 +444,14 @@ variable `tab-line-tabs-function'." (cdr (assq 'selected tab)))) (name (if buffer-p (funcall tab-line-tab-name-function tab tabs) - (cdr (assq 'name tab))))) + (cdr (assq 'name tab)))) + (face (if selected-p + (if (eq (selected-window) (old-selected-window)) + 'tab-line-tab-current + 'tab-line-tab) + 'tab-line-tab-inactive))) + (dolist (fn tab-line-tab-face-functions) + (setf face (funcall fn tab tabs face buffer-p selected-p))) (concat separator (apply 'propertize @@ -425,11 +464,7 @@ variable `tab-line-tabs-function'." `( tab ,tab ,@(if selected-p '(selected t)) - face ,(if selected-p - (if (eq (selected-window) (old-selected-window)) - 'tab-line-tab-current - 'tab-line-tab) - 'tab-line-tab-inactive) + face ,face mouse-face tab-line-highlight))))) tabs)) (hscroll-data (tab-line-auto-hscroll strings hscroll))) @@ -453,6 +488,24 @@ variable `tab-line-tabs-function'." tab-line-new-button) (list tab-line-new-button))))) +(defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p) + "Return FACE for TAB in TABS with alternation. +When TAB is an inactive buffer and is even-numbered, make FACE +inherit from `tab-line-tab-inactive-alternate'. For use in +`tab-line-tab-face-functions'." + (when (and (not selected-p) (cl-evenp (cl-position tab tabs))) + (setf face `(:inherit (tab-line-tab-inactive-alternate ,face)))) + face) + +(defun tab-line-tab-face-special (tab _tabs face buffer-p _selected-p) + "Return FACE for TAB according to whether it's special. +When TAB is a non-file-backed buffer, make FACE inherit from +`tab-line-tab-special'. For use in +`tab-line-tab-face-functions'." + (when (and buffer-p (not (buffer-file-name tab))) + (setf face `(:inherit (tab-line-tab-special ,face)))) + face) + (defvar tab-line-auto-hscroll) (defun tab-line-format () |