commit 6bcf7912aad6312d4bd521a3b8b5d9638d83dfa1 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Mon May 11 00:30:10 2020 -0400 * lisp/textmodes/bibtex.el: Avoid `eval` In the top-level construction of the entry-type commands, use `defalias` instead of (eval `(defun ...)). (bibtex-insert-kill): Strength reduce `eval` => `symbol-value`. (bibtex-autokey-before-presentation-function): Avoid nil value. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 670e763814..229c06f7c4 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -440,7 +440,7 @@ If parsing fails, try to set this variable to nil." "Alist of BibTeX entry types and their associated fields. Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL). ENTRY-TYPE is the type of a BibTeX entry. -DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used. +DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used. REQUIRED is a list of required fields. CROSSREF is a list of fields that are optional if a crossref field is present; but these fields are required otherwise. @@ -1051,7 +1051,7 @@ See `bibtex-generate-autokey' for details." (defvaralias 'bibtex-autokey-name-case-convert 'bibtex-autokey-name-case-convert-function) -(defcustom bibtex-autokey-name-case-convert-function 'downcase +(defcustom bibtex-autokey-name-case-convert-function #'downcase "Function called for each name to perform case conversion. See `bibtex-generate-autokey' for details." :group 'bibtex-autokey @@ -1127,7 +1127,7 @@ Case is significant. See `bibtex-generate-autokey' for details." (defvaralias 'bibtex-autokey-titleword-case-convert 'bibtex-autokey-titleword-case-convert-function) -(defcustom bibtex-autokey-titleword-case-convert-function 'downcase +(defcustom bibtex-autokey-titleword-case-convert-function #'downcase "Function called for each titleword to perform case conversion. See `bibtex-generate-autokey' for details." :group 'bibtex-autokey @@ -1188,12 +1188,12 @@ See `bibtex-generate-autokey' for details." :group 'bibtex-autokey :type 'boolean) -(defcustom bibtex-autokey-before-presentation-function nil - "If non-nil, function to call before generated key is presented. +(defcustom bibtex-autokey-before-presentation-function #'identity + "Function to call before generated key is presented. The function must take one argument (the automatically generated key), and must return a string (the key to use)." :group 'bibtex-autokey - :type '(choice (const nil) function)) + :type 'function) (defcustom bibtex-entry-offset 0 "Offset for BibTeX entries. @@ -1242,7 +1242,7 @@ If non-nil, the column for the equal sign is the value of :group 'bibtex :type '(repeat string)) -(defcustom bibtex-summary-function 'bibtex-summary +(defcustom bibtex-summary-function #'bibtex-summary "Function to call for generating a summary of current BibTeX entry. It takes no arguments. Point must be at beginning of entry. Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'." @@ -1660,7 +1660,7 @@ Initialized by `bibtex-set-dialect'.") (defvar bibtex-font-lock-url-regexp ;; Assume that field names begin at the beginning of a line. (concat "^[ \t]*" - (regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t) + (regexp-opt (delete-dups (mapcar #'caar bibtex-generate-url-list)) t) "[ \t]*=[ \t]*") "Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.") @@ -1892,14 +1892,16 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." (let ((mtch (match-string-no-properties 0))) (push (or (if bibtex-expand-strings (cdr (assoc-string mtch (bibtex-strings) t))) - mtch) content) + mtch) + content) (goto-char (match-end 0))) (let ((bounds (bibtex-parse-field-string))) (push (buffer-substring-no-properties - (1+ (car bounds)) (1- (cdr bounds))) content) + (1+ (car bounds)) (1- (cdr bounds))) + content) (goto-char (cdr bounds)))) (re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t)) - (apply 'concat (nreverse content)))) + (apply #'concat (nreverse content)))) (buffer-substring-no-properties (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)))) @@ -2239,8 +2241,9 @@ Optional arg BEG is beginning of entry." Optional arg COMMA is as in `bibtex-enclosing-field'." (unless bibtex-last-kill-command (error "BibTeX kill ring is empty")) (let ((fun (lambda (kryp kr) ; adapted from `current-kill' - (car (set kryp (nthcdr (mod (- n (length (eval kryp))) - (length kr)) kr)))))) + (car (set kryp (nthcdr (mod (- n (length (symbol-value kryp))) + (length kr)) + kr)))))) ;; We put the mark at the beginning of the inserted field or entry ;; and point at its end - a behavior similar to what `yank' does. ;; The mark is then used by `bibtex-yank-pop', which needs to know @@ -2251,7 +2254,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." (goto-char (bibtex-end-of-field (bibtex-enclosing-field comma))) (push-mark) (bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer - bibtex-field-kill-ring) t nil t)) + bibtex-field-kill-ring) + t nil t)) ;; insert past the current entry (bibtex-skip-to-valid-entry) (push-mark) @@ -2615,7 +2619,7 @@ Return optimized value to be used by `bibtex-format-entry'." regexp-alist)) (let (opt-list) ;; Loop over field names - (dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist)))) + (dolist (field (delete-dups (apply #'append (mapcar #'car regexp-alist)))) (let (rules) ;; Collect all matches we have for this field name (dolist (e regexp-alist) @@ -2623,7 +2627,7 @@ Return optimized value to be used by `bibtex-format-entry'." (push (cons (nth 1 e) (nth 2 e)) rules))) (if (eq type 'braces) ;; concatenate all regexps to a single regexp - (setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)"))) + (setq rules (concat "\\(?:" (mapconcat #'car rules "\\|") "\\)"))) ;; create list of replacement rules. (push (cons field rules) opt-list))) opt-list)) @@ -2674,7 +2678,7 @@ and `bibtex-autokey-names-stretch'." (if (string= "" names) names (let* ((case-fold-search t) - (name-list (mapcar 'bibtex-autokey-demangle-name + (name-list (mapcar #'bibtex-autokey-demangle-name (split-string names "[ \t\n]+and[ \t\n]+"))) additional-names) (unless (or (not (numberp bibtex-autokey-names)) @@ -2686,7 +2690,7 @@ and `bibtex-autokey-names-stretch'." bibtex-autokey-names) (nreverse name-list))) additional-names bibtex-autokey-additional-names)) - (concat (mapconcat 'identity name-list + (concat (mapconcat #'identity name-list bibtex-autokey-name-separator) additional-names))))) @@ -2736,7 +2740,7 @@ Return the result as a string." ;; specific words and use only a specific amount of words. (let ((counter 0) (ignore-re (concat "\\`\\(?:" - (mapconcat 'identity + (mapconcat #'identity bibtex-autokey-titleword-ignore "\\|") "\\)\\'")) titlewords titlewords-extra word) @@ -2760,7 +2764,7 @@ Return the result as a string." ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra. (unless (string-match "\\b\\w+" titlestring) (setq titlewords (append titlewords-extra titlewords))) - (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords) + (mapconcat #'bibtex-autokey-demangle-title (nreverse titlewords) bibtex-autokey-titleword-separator)))) (defun bibtex-autokey-demangle-title (titleword) @@ -2837,7 +2841,7 @@ Concatenate the key: non-empty insert `bibtex-autokey-name-year-separator' between the two. If the title part and the year (or name) part are non-empty, insert `bibtex-autokey-year-title-separator' between the two. - 2. If `bibtex-autokey-before-presentation-function' is non-nil, it must be + 2. `bibtex-autokey-before-presentation-function' must be a function taking one argument. Call this function with the generated key as the argument. Use the return value of this function (a string) as the key. @@ -2865,7 +2869,7 @@ Concatenate the key: (defun bibtex-global-key-alist () "Return global key alist based on `bibtex-files'." (if bibtex-files - (apply 'append + (apply #'append (mapcar (lambda (buf) (with-current-buffer buf bibtex-reference-keys)) ;; include current buffer only if it uses `bibtex-mode' @@ -3129,7 +3133,7 @@ does not use `bibtex-mode'." (if buffer-list (switch-to-buffer (completing-read "Switch to BibTeX buffer: " - (mapcar 'buffer-name buffer-list) + (mapcar #'buffer-name buffer-list) nil t (if current (buffer-name (current-buffer))))) (message "No BibTeX buffers defined"))) @@ -3178,7 +3182,7 @@ that is generated by calling `bibtex-url'." Used as default value of `bibtex-summary-function'." ;; It would be neat to make this function customizable. How? (if (looking-at bibtex-entry-maybe-empty-head) - (let* ((bibtex-autokey-name-case-convert-function 'identity) + (let* ((bibtex-autokey-name-case-convert-function #'identity) (bibtex-autokey-name-length 'infty) (bibtex-autokey-names 1) (bibtex-autokey-names-stretch 0) @@ -3189,7 +3193,7 @@ Used as default value of `bibtex-summary-function'." (year (bibtex-autokey-get-year)) (bibtex-autokey-titlewords 5) (bibtex-autokey-titlewords-stretch 2) - (bibtex-autokey-titleword-case-convert-function 'identity) + (bibtex-autokey-titleword-case-convert-function #'identity) (bibtex-autokey-titleword-length 5) (bibtex-autokey-titleword-separator " ") (title (bibtex-autokey-get-title)) @@ -3336,12 +3340,12 @@ BOUND limits the search." (define-button-type 'bibtex-url 'action 'bibtex-button-action - 'bibtex-function 'bibtex-url + 'bibtex-function #'bibtex-url 'help-echo (purecopy "mouse-2, RET: follow URL")) (define-button-type 'bibtex-search-crossref 'action 'bibtex-button-action - 'bibtex-function 'bibtex-search-crossref + 'bibtex-function #'bibtex-search-crossref 'help-echo (purecopy "mouse-2, RET: follow crossref")) (defun bibtex-button (beg end type &rest args) @@ -3405,7 +3409,7 @@ if that value is non-nil. \\{bibtex-mode-map}" (add-hook 'completion-at-point-functions - 'bibtex-completion-at-point-function nil 'local) + #'bibtex-completion-at-point-function nil 'local) (make-local-variable 'bibtex-buffer-last-parsed-tick) ;; Install stealthy parse function if not already installed (unless bibtex-parse-idle-timer @@ -3419,7 +3423,7 @@ if that value is non-nil. (set (make-local-variable 'comment-column) 0) (set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*") (set (make-local-variable 'outline-regexp) "[ \t]*@") - (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field) + (set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field) (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s)) (set (make-local-variable 'font-lock-defaults) @@ -3441,7 +3445,7 @@ if that value is non-nil. (syntax-propertize-via-font-lock bibtex-font-lock-syntactic-keywords)) ;; Allow `bibtex-dialect' as a file-local variable. - (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t)) + (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t)) (defun bibtex-entry-alist (dialect) "Return entry-alist for DIALECT." @@ -3488,8 +3492,9 @@ are also bound buffer-locally if `bibtex-dialect' is already buffer-local in the current buffer (for example, as a file-local variable). LOCAL is t for interactive calls." (interactive (list (intern (completing-read "Dialect: " - (mapcar 'list bibtex-dialect-list) - nil t)) t)) + (mapcar #'list bibtex-dialect-list) + nil t)) + t)) (let ((setfun (if (or local (local-variable-p 'bibtex-dialect)) (lambda (var val) (set (make-local-variable var) val)) 'set))) @@ -3506,7 +3511,7 @@ LOCAL is t for interactive calls." bibtex-dialect)))) (funcall setfun 'bibtex-entry-type (concat "@[ \t]*\\(?:" - (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)")) + (regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)")) (funcall setfun 'bibtex-entry-head (concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\(" bibtex-reference-key "\\)")) @@ -3516,7 +3521,7 @@ LOCAL is t for interactive calls." (concat "^[ \t]*@[ \t]*\\(?:" (regexp-opt (append '("String" "Preamble") - (mapcar 'car bibtex-entry-alist))) "\\)")) + (mapcar #'car bibtex-entry-alist))) "\\)")) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t))) @@ -3549,11 +3554,13 @@ LOCAL is t for interactive calls." (let* ((entry (car elt)) (fname (intern (format "bibtex-%s" entry)))) (unless (fboundp fname) - (eval (list 'defun fname nil - (format "Insert a template for a @%s entry; see also `bibtex-entry'." - entry) - '(interactive "*") - `(bibtex-entry ,entry)))) + (defalias fname + (lambda () + (:documentation + (format "Insert a template for a @%s entry; see also `bibtex-entry'." + entry) + (interactive "*") + (bibtex-entry entry))))) ;; Menu entries (define-key menu-map (vector fname) `(menu-item ,(or (nth 1 elt) (car elt)) ,fname)))) @@ -3608,8 +3615,8 @@ is non-nil." (insert "@" entry-type (bibtex-entry-left-delimiter)) (if key (insert key)) (save-excursion - (mapc 'bibtex-make-field (car field-list)) - (mapc 'bibtex-make-optional-field (cdr field-list)) + (mapc #'bibtex-make-field (car field-list)) + (mapc #'bibtex-make-optional-field (cdr field-list)) (if bibtex-comma-after-last-field (insert ",")) (insert "\n") @@ -3657,8 +3664,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE." (insert (bibtex-field-left-delimiter))) (goto-char end))) (skip-chars-backward " \t\n") - (mapc 'bibtex-make-field required) - (mapc 'bibtex-make-optional-field optional))))) + (mapc #'bibtex-make-field required) + (mapc #'bibtex-make-optional-field optional))))) (defun bibtex-parse-entry (&optional content keep-opt-alt) "Parse entry at point, return an alist. @@ -4980,7 +4987,8 @@ If mark is active reformat entries in region, if not in whole buffer." ("Remove empty optional and alternative fields? " . opts-or-alts) ("Remove delimiters around pure numerical fields? " . numerical-fields) (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ") . last-comma) + " comma at end of entry? ") + . last-comma) ("Replace double page dashes by single ones? " . page-dashes) ("Delete whitespace at the beginning and end of fields? " . whitespace) ("Inherit booktitle? " . inherit-booktitle) @@ -5047,7 +5055,7 @@ entries from minibuffer." (goto-char (point-max)) (message "Buffer is now parsable. Please save it."))) -(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1") +(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1") (defun bibtex-completion-at-point-function () (let ((pnt (point)) (case-fold-search t) @@ -5258,8 +5266,8 @@ Return the URL or nil if none can be generated." ;; If SCHEME is set up correctly, ;; we should never reach this point (error "Match failed: %s" text))) - (if fmt (apply 'format fmt (nreverse obj)) - (apply 'concat (nreverse obj))))) + (if fmt (apply #'format fmt (nreverse obj)) + (apply #'concat (nreverse obj))))) (if (called-interactively-p 'interactive) (message "%s" url)) (unless no-browse (browse-url url))) (if (and (not url) (called-interactively-p 'interactive)) @@ -5289,10 +5297,11 @@ where FILE is the BibTeX file of ENTRY." (list (completing-read "Field: " (delete-dups - (apply 'append + (apply #'append bibtex-user-optional-fields - (mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2 x)))) - bibtex-entry-alist))) nil t) + (mapcar (lambda (x) (mapcar #'car (apply #'append (nthcdr 2 x)))) + bibtex-entry-alist))) + nil t) (read-string "Regexp: ") (if bibtex-search-entry-globally (not current-prefix-arg) commit 68b34c66319bbc314d505f1352ee8b28b00d69f2 Author: Stefan Monnier Date: Mon May 11 00:18:14 2020 -0400 * lisp/subr.el (dolist, dotimes, combine-change-calls): Cosmetic tweaks (dolist, dotimes): Adjust comment since testing `lexical-binding` is supposed to be reliable. (combine-change-calls): Add debug and indent specs. diff --git a/lisp/subr.el b/lisp/subr.el index c8913145a1..324c59f13f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -257,10 +257,9 @@ Then evaluate RESULT to get return value, default nil. ;; use dolist. ;; FIXME: This cost disappears in byte-compiled lexical-binding files. (let ((temp '--dolist-tail--)) - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other is slightly faster (and has cleaner semantics) - ;; with lexical scoping. + ;; This test does not matter much because both semantics are acceptable, + ;; but one is slightly faster with dynamic scoping and the other is + ;; slightly faster (and has cleaner semantics) with lexical scoping. (if lexical-binding `(let ((,temp ,(nth 1 spec))) (while ,temp @@ -292,9 +291,9 @@ the return value (nil if RESULT is omitted). Its use is deprecated. (let ((temp '--dotimes-limit--) (start 0) (end (nth 1 spec))) - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other has cleaner semantics. + ;; This test does not matter much because both semantics are acceptable, + ;; but one is slightly faster with dynamic scoping and the other has + ;; cleaner semantics. (if lexical-binding (let ((counter '--dotimes-counter--)) `(let ((,temp ,end) @@ -4033,7 +4032,7 @@ the function `undo--wrap-and-run-primitive-undo'." (defmacro combine-change-calls (beg end &rest body) "Evaluate BODY, running the change hooks just once. -BODY is a sequence of lisp forms to evaluate. BEG and END bound +BODY is a sequence of Lisp forms to evaluate. BEG and END bound the region the change hooks will be run for. Firstly, `before-change-functions' is invoked for the region @@ -4051,7 +4050,8 @@ change `before-change-functions' or `after-change-functions'. Additionally, the buffer modifications of BODY are recorded on the buffer's undo list as a single \(apply ...) entry containing -the function `undo--wrap-and-run-primitive-undo'. " +the function `undo--wrap-and-run-primitive-undo'." + (declare (debug t) (indent 2)) `(combine-change-calls-1 ,beg ,end (lambda () ,@body))) (defun undo--wrap-and-run-primitive-undo (beg end list) commit 5601eb231fe1467b2949d7cdc57d8fefb81540e2 Author: Stefan Monnier Date: Mon May 11 00:15:15 2020 -0400 * lisp/emacs-lisp/syntax.el (syntax-propertize): Use run-hook-wrapped This way we avoid making assumptions about the content of syntax-propertize-extend-region-functions diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 11cc1988b1..3294378754 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -345,23 +345,27 @@ END) suitable for `syntax-propertize-function'." (end (max pos (min (point-max) (+ start syntax-propertize-chunk-size)))) - (funs syntax-propertize-extend-region-functions)) - (while funs - (let ((new (funcall (pop funs) start end)) - ;; Avoid recursion! - (syntax-propertize--done most-positive-fixnum)) - (if (or (null new) - (and (>= (car new) start) (<= (cdr new) end))) - nil - (setq start (car new)) - (setq end (cdr new)) - ;; If there's been a change, we should go through the - ;; list again since this new position may - ;; warrant a different answer from one of the funs we've - ;; already seen. - (unless (eq funs - (cdr syntax-propertize-extend-region-functions)) - (setq funs syntax-propertize-extend-region-functions))))) + (first t) + (repeat t)) + (while repeat + (setq repeat nil) + (run-hook-wrapped + 'syntax-propertize-extend-region-functions + (lambda (f) + (let ((new (funcall f start end)) + ;; Avoid recursion! + (syntax-propertize--done most-positive-fixnum)) + (if (or (null new) + (and (>= (car new) start) (<= (cdr new) end))) + nil + (setq start (car new)) + (setq end (cdr new)) + ;; If there's been a change, we should go through the + ;; list again since this new position may + ;; warrant a different answer from one of the funs we've + ;; already seen. + (unless first (setq repeat t)))) + (setq first nil)))) ;; Flush ppss cache between the original value of `start' and that ;; set above by syntax-propertize-extend-region-functions. (syntax-ppss-flush-cache start) commit 67bcde188f777e1f884eb46ab3123afa74d8d303 Author: Stefan Monnier Date: Mon May 11 00:12:29 2020 -0400 * lisp/ielm.el: Handle corner case where */**/*** are not yet bound Remote redundant :group args. (ielm-eval-input): Use bound-and-true-p for */**/*** diff --git a/lisp/ielm.el b/lisp/ielm.el index fc06ebfa2d..47c5158ce4 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -44,8 +44,7 @@ (defcustom ielm-noisy t "If non-nil, IELM will beep on error." - :type 'boolean - :group 'ielm) + :type 'boolean) (defcustom ielm-prompt-read-only t "If non-nil, the IELM prompt is read only. @@ -74,7 +73,6 @@ buffers, including IELM buffers. If you sometimes use IELM on text-only terminals or with `emacs -nw', you might wish to use another binding for `comint-kill-whole-line'." :type 'boolean - :group 'ielm :version "22.1") (defcustom ielm-prompt "ELISP> " @@ -90,8 +88,7 @@ does not update the prompt of an *ielm* buffer with a running process. For IELM buffers that are not called `*ielm*', you can execute \\[inferior-emacs-lisp-mode] in that IELM buffer to update the value, for new prompts. This works even if the buffer has a running process." - :type 'string - :group 'ielm) + :type 'string) (defvar ielm-prompt-internal "ELISP> " "Stored value of `ielm-prompt' in the current IELM buffer. @@ -103,8 +100,7 @@ customizes `ielm-prompt'.") "Controls whether \\\\[ielm-return] has intelligent behavior in IELM. If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline and indents for incomplete sexps. If nil, always inserts newlines." - :type 'boolean - :group 'ielm) + :type 'boolean) (defcustom ielm-dynamic-multiline-inputs t "Force multiline inputs to start from column zero? @@ -112,15 +108,13 @@ If non-nil, after entering the first line of an incomplete sexp, a newline will be inserted after the prompt, moving the input to the next line. This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs." - :type 'boolean - :group 'ielm) + :type 'boolean) (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) (defcustom ielm-mode-hook nil "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." :options '(eldoc-mode) - :type 'hook - :group 'ielm) + :type 'hook) ;; We define these symbols (that are only used buffer-locally in ielm ;; buffers) this way to avoid having them be defined in the global @@ -366,9 +360,9 @@ nonempty, then flushes the buffer." ;; that same let. To avoid problems, neither of ;; these buffers should be alive during the ;; evaluation of form. - (let* ((*1 *) - (*2 **) - (*3 ***) + (let* ((*1 (bound-and-true-p *)) + (*2 (bound-and-true-p **)) + (*3 (bound-and-true-p ***)) (active-process (ielm-process)) (old-standard-output standard-output) new-standard-output @@ -453,11 +447,12 @@ nonempty, then flushes the buffer." (if error-type (progn (when ielm-noisy (ding)) - (setq output (concat output "*** " error-type " *** ")) - (setq output (concat output result))) + (setq output (concat output + "*** " error-type " *** " + result))) ;; There was no error, so shift the *** values - (setq *** **) - (setq ** *) + (setq *** (bound-and-true-p **)) + (setq ** (bound-and-true-p *)) (setq * result)) (when (or (not for-effect) (not (equal output ""))) (setq output (concat output "\n")))) commit c9d7253dd1bd33c1b857203bc9a050013fcb4b34 Author: Dmitry Gutov Date: Mon May 11 05:13:25 2020 +0300 Map "mail/compose" icon to "mail-message-new" in GTK * lisp/term/x-win.el (x-gtk-stock-map): One more icon mapping. diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index d7bc64fa52..42a6f4030e 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1434,7 +1434,7 @@ This returns an error if any Emacs frames are X frames." ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending") ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check")) ("images/gnus/toggle-subscription" . "gtk-task-recurring") - ("images/mail/compose" . "gtk-mail-compose") + ("images/mail/compose" . ("mail-message-new" "gtk-mail-compose")) ("images/mail/copy" . "gtk-mail-copy") ("images/mail/forward" . "gtk-mail-forward") ("images/mail/inbox" . "gtk-inbox") commit f8da04d6fa5a55367c8ed58a79a8ad3a501bc697 Author: Dmitry Gutov Date: Mon May 11 04:34:55 2020 +0300 Use the "modern" toolbars in Gnus again * lisp/gnus/gmm-utils.el (gmm-tool-bar-style): Undo the breakage from commit d88118db37dd (https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg02094.html). diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 2df098bc0b..6d24b409ed 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -168,9 +168,9 @@ ARGS are passed to `message'." (defcustom gmm-tool-bar-style (if (and (boundp 'tool-bar-mode) tool-bar-mode - (memq (display-visual-class) - (list 'static-gray 'gray-scale - 'static-color 'pseudo-color))) + (not (memq (display-visual-class) + (list 'static-gray 'gray-scale + 'static-color 'pseudo-color)))) 'gnome 'retro) "Preferred tool bar style." commit b97877470dcf98d02e4bd31ece7bfb862969663f Author: Dmitry Gutov Date: Mon May 11 04:25:53 2020 +0300 Use better icons on GTK in message-mode and isearch * lisp/gnus/message.el (message-tool-bar-retro): Use non-Gnus-specific icon. * lisp/term/x-win.el (x-gtk-stock-map): Use more themed icons (bug#40990). diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8f402bfc62..5a6827af76 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7984,7 +7984,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list." (defcustom message-tool-bar-retro '(;; Old Emacs 21 icon for consistency. - (message-send-and-exit "gnus/mail-send") + (message-send-and-exit "mail/send") (message-kill-buffer "close") (message-dont-send "cancel") (mml-attach-file "attach" mml-mode-map) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 5b8feb14a5..d7bc64fa52 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1407,13 +1407,13 @@ This returns an error if any Emacs frames are X frames." ("etc/images/right-arrow" . ("go-next" "gtk-go-forward")) ("etc/images/home" . ("go-home" "gtk-home")) ("etc/images/jump-to" . ("go-jump" "gtk-jump-to")) - ("etc/images/index" . "gtk-index") + ("etc/images/index" . ("gtk-search" "gtk-index")) ("etc/images/exit" . ("application-exit" "gtk-quit")) ("etc/images/cancel" . "gtk-cancel") ("etc/images/info" . ("dialog-information" "gtk-info")) ("etc/images/bookmark_add" . "n:bookmark_add") ;; Used in Gnus and/or MH-E: - ("etc/images/attach" . "gtk-attach") + ("etc/images/attach" . ("mail-attachment" "gtk-attach")) ("etc/images/connect" . "gtk-connect") ("etc/images/contact" . "gtk-contact") ("etc/images/delete" . ("edit-delete" "gtk-delete")) @@ -1425,12 +1425,14 @@ This returns an error if any Emacs frames are X frames." ("etc/images/lock" . "gtk-lock") ("etc/images/next-page" . "gtk-next-page") ("etc/images/refresh" . ("view-refresh" "gtk-refresh")) + ("etc/images/search-replace" . "edit-find-replace") ("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending")) ("etc/images/sort-column-ascending" . "gtk-sort-column-ascending") ("etc/images/sort-criteria" . "gtk-sort-criteria") ("etc/images/sort-descending" . ("view-sort-descending" "gtk-sort-descending")) ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending") + ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check")) ("images/gnus/toggle-subscription" . "gtk-task-recurring") ("images/mail/compose" . "gtk-mail-compose") ("images/mail/copy" . "gtk-mail-copy") @@ -1442,7 +1444,7 @@ This returns an error if any Emacs frames are X frames." ("images/mail/reply-all" . "gtk-mail-reply-to-all") ("images/mail/reply" . "gtk-mail-reply") ("images/mail/save-draft" . "gtk-mail-handling") - ("images/mail/send" . "gtk-mail-send") + ("images/mail/send" . ("mail-send" "gtk-mail-send")) ("images/mail/spam" . "gtk-spam") ;; Used for GDB Graphical Interface ("images/gud/break" . "gtk-no") commit a218c9861573b5ec4979ff2662f5c0343397e3ff Author: Stefan Monnier Date: Sun May 10 19:07:45 2020 -0400 * lisp/emacs-lisp/pcase.el: Don't bind unused vars in branches (pcase--fgrep): Change calling convention to take bindings rather than just variables. (pcase--funcall, pcase--eval): Adjust to this new calling convention. (pcase--expand): Use `pcase--fgrep` to bind only the vars that are used. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 36b93fa7ac..4b7689ad42 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'. (seen '()) (codegen (lambda (code vars) - (let ((prev (assq code seen))) + (let ((vars (pcase--fgrep vars code)) + (prev (assq code seen))) (if (not prev) (let ((res (pcase-codegen code vars))) (push (list code vars res) seen) @@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'. (if (pcase--small-branch-p (cdr case)) ;; Don't bother sharing multiple ;; occurrences of this leaf since it's small. - #'pcase-codegen codegen) + (lambda (code vars) + (pcase-codegen code + (pcase--fgrep vars code))) + codegen) (cdr case) vars)))) cases)))) @@ -687,14 +691,17 @@ MATCH is the pattern that needs to be matched, of the form: '(nil . :pcase--fail) '(:pcase--fail . nil)))))) -(defun pcase--fgrep (vars sexp) - "Check which of the symbols VARS appear in SEXP." +(defun pcase--fgrep (bindings sexp) + "Return those of the BINDINGS which might be used in SEXP." (let ((res '())) - (while (consp sexp) - (dolist (var (pcase--fgrep vars (pop sexp))) - (unless (memq var res) (push var res)))) - (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) - res)) + (while (and (consp sexp) bindings) + (dolist (binding (pcase--fgrep bindings (pop sexp))) + (push binding res) + (setq bindings (remove binding bindings)))) + (let ((tmp (assq sexp bindings))) + (if tmp + (cons tmp res) + res)))) (defun pcase--self-quoting-p (upat) (or (keywordp upat) (integerp upat) (stringp upat))) @@ -734,13 +741,11 @@ MATCH is the pattern that needs to be matched, of the form: "Build a function call to FUN with arg ARG." (if (symbolp fun) `(,fun ,arg) - (let* (;; `vs' is an upper bound on the vars we need. - (vs (pcase--fgrep (mapcar #'car vars) fun)) - (env (mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs)) + (let* (;; `env' is an upper bound on the bindings we need. + (env (mapcar (lambda (x) (list (car x) (cdr x))) + (pcase--fgrep vars fun))) (call (progn - (when (memq arg vs) + (when (assq arg env) ;; `arg' is shadowed by `env'. (let ((newsym (gensym "x"))) (push (list newsym arg) env) @@ -748,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form: (if (functionp fun) `(funcall #',fun ,arg) `(,@fun ,arg))))) - (if (null vs) + (if (null env) call ;; Let's not replace `vars' in `fun' since it's ;; too difficult to do it right, instead just @@ -759,10 +764,12 @@ MATCH is the pattern that needs to be matched, of the form: "Build an expression that will evaluate EXP." (let* ((found (assq exp vars))) (if found (cdr found) - (let* ((vs (pcase--fgrep (mapcar #'car vars) exp)) - (env (mapcar (lambda (v) (list v (cdr (assq v vars)))) - vs))) - (if env (macroexp-let* env exp) exp))))) + (let* ((env (pcase--fgrep vars exp))) + (if env + (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) + env) + exp) + exp))))) ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. commit 7f7a8fbfd707ee51858a9bee53cff560a0e5b3c0 Author: Stefan Monnier Date: Sun May 10 16:17:01 2020 -0400 * lisp/emacs-lisp/eieio.el (eieio pcase macro): Fix last-minute typo diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 6482c4d052..ee5dd2cccd 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -364,7 +364,7 @@ contents of field NAME is matched against PAT, or they can be of `(app (pcase--flip eieio-oref ',name) ,pat)) ((pred symbolp) `(app (pcase--flip eieio-oref ',field) ,field)))) - field-s))) + fields))) ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. commit 5a31b1afca41e71f15a56ad834449bf49ca6aad2 Author: Tassilo Horn Date: Sun May 10 20:41:42 2020 +0200 Prefer function-put over put for setting browse-url-browser-kind. * lisp/net/browse-url.el: Prefer `function-put' over `put' for setting `browse-url-browser-kind' symbol property. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index f88de98fca..8132f8d993 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -127,8 +127,10 @@ ;; is not sensible to invoke an external browser with it, so here only ;; internal browsers are considered. Therefore, it is advised to put ;; that property also on custom browser functions. -;; (put 'my-browse-url-in-emacs 'browse-url-browser-kind 'internal) -;; (put 'my-browse-url-externally 'browse-url-browser-kind 'external) +;; (function-put 'my-browse-url-in-emacs 'browse-url-browser-kind +;; 'internal) +;; (function-put 'my-browse-url-externally 'browse-url-browser-kind +;; 'external) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: @@ -621,8 +623,8 @@ process), or nil (we don't know)." (defun browse-url--browser-kind-mailto (url) (browse-url--browser-kind browse-url-mailto-function url)) -(put 'browse-url--mailto 'browse-url-browser-kind - #'browse-url--browser-kind-mailto) +(function-put 'browse-url--mailto 'browse-url-browser-kind + #'browse-url--browser-kind-mailto) (defun browse-url--man (url &rest args) "Calls `browse-url-man-function' with URL and ARGS." @@ -630,8 +632,8 @@ process), or nil (we don't know)." (defun browse-url--browser-kind-man (url) (browse-url--browser-kind browse-url-man-function url)) -(put 'browse-url--man 'browse-url-browser-kind - #'browse-url--browser-kind-man) +(function-put 'browse-url--man 'browse-url-browser-kind + #'browse-url--browser-kind-man) (defun browse-url--browser (url &rest args) "Calls `browse-url-browser-function' with URL and ARGS." @@ -639,8 +641,8 @@ process), or nil (we don't know)." (defun browse-url--browser-kind-browser (url) (browse-url--browser-kind browse-url-browser-function url)) -(put 'browse-url--browser 'browse-url-browser-kind - #'browse-url--browser-kind-browser) +(function-put 'browse-url--browser 'browse-url-browser-kind + #'browse-url--browser-kind-browser) (defun browse-url--non-html-file-url-p (url) "Return non-nil if URL is a file:// URL of a non-HTML file." @@ -1010,8 +1012,8 @@ The optional NEW-WINDOW argument is not used." (url-unhex-string url) url))))) -(put 'browse-url-default-windows-browser 'browse-url-browser-kind - 'external) +(function-put 'browse-url-default-windows-browser 'browse-url-browser-kind + 'external) (defun browse-url-default-macosx-browser (url &optional _new-window) "Invoke the macOS system's default Web browser. @@ -1019,8 +1021,8 @@ The optional NEW-WINDOW argument is not used." (interactive (browse-url-interactive-arg "URL: ")) (start-process (concat "open " url) nil "open" url)) -(put 'browse-url-default-macosx-browser 'browse-url-browser-kind - 'external) +(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind + 'external) ;; --- Netscape --- @@ -1078,9 +1080,9 @@ instead of `browse-url-new-window-flag'." (lambda (&rest _ignore) (error "No usable browser found")))) url args)) -(put 'browse-url-default-browser 'browse-url-browser-kind - ;; Well, most probably external if we ignore w3. - 'external) +(function-put 'browse-url-default-browser 'browse-url-browser-kind + ;; Well, most probably external if we ignore w3. + 'external) (defun browse-url-can-use-xdg-open () "Return non-nil if the \"xdg-open\" program can be used. @@ -1101,7 +1103,7 @@ The optional argument IGNORED is not used." (interactive (browse-url-interactive-arg "URL: ")) (call-process "xdg-open" nil 0 nil url)) -(put 'browse-url-xdg-open 'browse-url-browser-kind 'external) +(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-netscape (url &optional new-window) @@ -1146,7 +1148,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-netscape-sentinel process ,url))))) -(put 'browse-url-netscape 'browse-url-browser-kind 'external) +(function-put 'browse-url-netscape 'browse-url-browser-kind 'external) (defun browse-url-netscape-sentinel (process url) "Handle a change to the process communicating with Netscape." @@ -1218,7 +1220,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-mozilla-sentinel process ,url))))) -(put 'browse-url-mozilla 'browse-url-browser-kind 'external) +(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external) (defun browse-url-mozilla-sentinel (process url) "Handle a change to the process communicating with Mozilla." @@ -1260,7 +1262,7 @@ instead of `browse-url-new-window-flag'." '("-new-window"))) (list url))))) -(put 'browse-url-firefox 'browse-url-browser-kind 'external) +(function-put 'browse-url-firefox 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-chromium (url &optional _new-window) @@ -1279,7 +1281,7 @@ The optional argument NEW-WINDOW is not used." browse-url-chromium-arguments (list url))))) -(put 'browse-url-chromium 'browse-url-browser-kind 'external) +(function-put 'browse-url-chromium 'browse-url-browser-kind 'external) (defun browse-url-chrome (url &optional _new-window) "Ask the Google Chrome WWW browser to load URL. @@ -1297,7 +1299,7 @@ The optional argument NEW-WINDOW is not used." browse-url-chrome-arguments (list url))))) -(put 'browse-url-chrome 'browse-url-browser-kind 'external) +(function-put 'browse-url-chrome 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-galeon (url &optional new-window) @@ -1336,7 +1338,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-galeon-sentinel process ,url))))) -(put 'browse-url-galeon 'browse-url-browser-kind 'external) +(function-put 'browse-url-galeon 'browse-url-browser-kind 'external) (defun browse-url-galeon-sentinel (process url) "Handle a change to the process communicating with Galeon." @@ -1384,7 +1386,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-epiphany-sentinel process ,url))))) -(put 'browse-url-epiphany 'browse-url-browser-kind 'external) +(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external) (defun browse-url-epiphany-sentinel (process url) "Handle a change to the process communicating with Epiphany." @@ -1410,7 +1412,7 @@ currently selected window instead." file-name-handler-alist))) (if same-window (find-file url) (find-file-other-window url)))) -(put 'browse-url-emacs 'browse-url-browser-kind 'internal) +(function-put 'browse-url-emacs 'browse-url-browser-kind 'internal) ;;;###autoload (defun browse-url-gnome-moz (url &optional new-window) @@ -1436,7 +1438,7 @@ used instead of `browse-url-new-window-flag'." '("--newwin")) (list "--raise" url)))) -(put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) +(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) ;; --- Mosaic --- @@ -1489,7 +1491,7 @@ used instead of `browse-url-new-window-flag'." (append browse-url-mosaic-arguments (list url))) (message "Starting %s...done" browse-url-mosaic-program)))) -(put 'browse-url-mosaic 'browse-url-browser-kind 'external) +(function-put 'browse-url-mosaic 'browse-url-browser-kind 'external) ;; --- Mosaic using CCI --- @@ -1523,7 +1525,7 @@ used instead of `browse-url-new-window-flag'." (process-send-string "browse-url" "disconnect\r\n") (delete-process "browse-url")) -(put 'browse-url-cci 'browse-url-browser-kind 'external) +(function-put 'browse-url-cci 'browse-url-browser-kind 'external) ;; --- Conkeror --- ;;;###autoload @@ -1562,7 +1564,7 @@ NEW-WINDOW instead of `browse-url-new-window-flag'." "buffer") url)))))) -(put 'browse-url-conkeror 'browse-url-browser-kind 'external) +(function-put 'browse-url-conkeror 'browse-url-browser-kind 'external) ;; --- W3 --- @@ -1587,7 +1589,7 @@ used instead of `browse-url-new-window-flag'." (w3-fetch-other-window url) (w3-fetch url))) -(put 'browse-url-w3 'browse-url-browser-kind 'internal) +(function-put 'browse-url-w3 'browse-url-browser-kind 'internal) ;;;###autoload (defun browse-url-w3-gnudoit (url &optional _new-window) @@ -1603,7 +1605,7 @@ The `browse-url-gnudoit-program' program is used with options given by (list (concat "(w3-fetch \"" url "\")") "(raise-frame)")))) -(put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal) +(function-put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal) ;; --- Lynx in an xterm --- @@ -1622,7 +1624,7 @@ The optional argument NEW-WINDOW is not used." ,@browse-url-xterm-args "-e" ,browse-url-text-browser ,url))) -(put 'browse-url-text-xterm 'browse-url-browser-kind 'external) +(function-put 'browse-url-text-xterm 'browse-url-browser-kind 'external) ;; --- Lynx in an Emacs "term" window --- @@ -1698,7 +1700,7 @@ used instead of `browse-url-new-window-flag'." url "\r"))))) -(put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) +(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) ;; --- mailto --- @@ -1747,7 +1749,7 @@ used instead of `browse-url-new-window-flag'." (unless (bolp) (insert "\n")))))))) -(put 'browse-url-mail 'browse-url-browser-kind 'internal) +(function-put 'browse-url-mail 'browse-url-browser-kind 'internal) ;; --- man --- @@ -1762,7 +1764,7 @@ used instead of `browse-url-new-window-flag'." ((executable-find manual-program) (man url)) (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url))))) -(put 'browse-url-man 'browse-url-browser-kind 'internal) +(function-put 'browse-url-man 'browse-url-browser-kind 'internal) ;; --- Random browser --- @@ -1781,7 +1783,7 @@ don't offer a form of remote control." 0 nil (append browse-url-generic-args (list url)))) -(put 'browse-url-generic 'browse-url-browser-kind 'external) +(function-put 'browse-url-generic 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-kde (url &optional _new-window) @@ -1793,7 +1795,7 @@ The optional argument NEW-WINDOW is not used." (apply #'start-process (concat "KDE " url) nil browse-url-kde-program (append browse-url-kde-args (list url)))) -(put 'browse-url-kde 'browse-url-browser-kind 'external) +(function-put 'browse-url-kde 'browse-url-browser-kind 'external) (defun browse-url-elinks-new-window (url) "Ask the Elinks WWW browser to load URL in a new window." @@ -1804,7 +1806,8 @@ The optional argument NEW-WINDOW is not used." browse-url-elinks-wrapper (list "elinks" url))))) -(put 'browse-url-elinks-new-window 'browse-url-browser-kind 'external) +(function-put 'browse-url-elinks-new-window 'browse-url-browser-kind + 'external) ;;;###autoload (defun browse-url-elinks (url &optional new-window) @@ -1827,7 +1830,7 @@ from `browse-url-elinks-wrapper'." `(lambda (process change) (browse-url-elinks-sentinel process ,url)))))) -(put 'browse-url-elinks 'browse-url-browser-kind 'external) +(function-put 'browse-url-elinks 'browse-url-browser-kind 'external) (defun browse-url-elinks-sentinel (process url) "Determines if Elinks is running or a new one has to be started." commit 0bb9aeddd6ac713c751b3b6586d62d2dcc8465c0 Author: Stefan Monnier Date: Sun May 10 13:51:51 2020 -0400 * lisp/emacs-lisp/eieio.el (eieio pcase macro): Remove unused var `is` diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 999d75f79e..6482c4d052 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -351,21 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the contents of field NAME is matched against PAT, or they can be of the form NAME which is a shorthand for (NAME NAME)." (declare (debug (&rest [&or (sexp pcase-PAT) sexp]))) - (let ((is (make-symbol "table"))) - ;; FIXME: This generates a horrendous mess of redundant let bindings. - ;; `pcase' needs to be improved somehow to introduce let-bindings more - ;; sparingly, or the byte-compiler needs to be taught to optimize - ;; them away. - ;; FIXME: `pcase' does not do a good job here of sharing tests&code among - ;; various branches. - `(and (pred eieio-object-p) + ;; FIXME: This generates a horrendous mess of redundant let bindings. + ;; `pcase' needs to be improved somehow to introduce let-bindings more + ;; sparingly, or the byte-compiler needs to be taught to optimize + ;; them away. + ;; FIXME: `pcase' does not do a good job here of sharing tests&code among + ;; various branches. + `(and (pred eieio-object-p) ,@(mapcar (lambda (field) (pcase-exhaustive field (`(,name ,pat) - `(app (pcase--flip eieio-oref ',name) ,pat)) + `(app (pcase--flip eieio-oref ',name) ,pat)) ((pred symbolp) `(app (pcase--flip eieio-oref ',field) ,field)))) - fields)))) + field-s))) ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. commit 8f808be68bfab51fe282e7ee2f6bc8c28bf7a442 Author: Simen Heggestøyl Date: Sun May 10 16:17:27 2020 +0200 Use lexical-binding in glasses.el and add tests * lisp/progmodes/glasses.el: Use lexical-binding. (glasses-separator, glasses-original-separator, glasses-face) (glasses-separate-parentheses-p) (glasses-separate-parentheses-exceptions) (glasses-separate-capital-groups, glasses-uncapitalize-p) (glasses-uncapitalize-regexp, glasses-convert-on-write-p): Remove redundant :group args. * test/lisp/progmodes/glasses-tests.el: New file with tests for glasses.el. diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index cad74f9f63..ab65a1590c 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -1,4 +1,4 @@ -;;; glasses.el --- make cantReadThis readable +;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want to add missing separators, set `glasses-separator' to an empty string. If you don't want to replace existent separators, set `glasses-original-separator' to an empty string." - :group 'glasses :type 'string :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set `glasses-separator' to \"-\", underscore separators are displayed as hyphens. If `glasses-original-separator' is an empty string, no such display change is performed." - :group 'glasses :type 'string :set 'glasses-custom-set :initialize 'custom-initialize-default @@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter. For example, you can set `glasses-separator' to an empty string and `glasses-face' to `bold'. Then unreadable identifiers will have no separators, but will have their capitals in bold." - :group 'glasses :type '(choice (const :tag "None" nil) face) :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -100,7 +97,6 @@ but will have their capitals in bold." (defcustom glasses-separate-parentheses-p t "If non-nil, ensure space between an identifier and an opening parenthesis." - :group 'glasses :type 'boolean) (defcustom glasses-separate-parentheses-exceptions @@ -108,7 +104,6 @@ but will have their capitals in bold." "List of regexp that are exceptions for `glasses-separate-parentheses-p'. They are matched to the current line truncated to the point where the parenthesis expression starts." - :group 'glasses :type '(repeat regexp)) (defcustom glasses-separate-capital-groups t @@ -116,7 +111,6 @@ parenthesis expression starts." When the value is non-nil, HTMLSomething and IPv6 are displayed as HTML_Something and I_Pv6 respectively. Set the value to nil if you prefer to display them unchanged." - :group 'glasses :type 'boolean :version "24.1") @@ -124,7 +118,6 @@ if you prefer to display them unchanged." "If non-nil, downcase embedded capital letters in identifiers. Only identifiers starting with lower case letters are affected, letters inside other identifiers are unchanged." - :group 'glasses :type 'boolean :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -135,7 +128,6 @@ other identifiers are unchanged." Only words starting with this regexp are uncapitalized. The regexp is case sensitive. It has any effect only when `glasses-uncapitalize-p' is non-nil." - :group 'glasses :type 'regexp :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -149,7 +141,6 @@ file write then. Note the removal action does not try to be much clever, so it can remove real separators too." - :group 'glasses :type 'boolean) diff --git a/test/lisp/progmodes/glasses-tests.el b/test/lisp/progmodes/glasses-tests.el new file mode 100644 index 0000000000..277a9cc192 --- /dev/null +++ b/test/lisp/progmodes/glasses-tests.el @@ -0,0 +1,101 @@ +;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'glasses) +(require 'seq) + +(ert-deftest glasses-tests-parenthesis-exception-p () + (with-temp-buffer + (insert "public OnClickListener menuListener() {}") + (let ((glasses-separate-parentheses-exceptions '("^Listen"))) + (should-not (glasses-parenthesis-exception-p 1 (point-max))) + (should (glasses-parenthesis-exception-p 15 (point-max))) + (should-not (glasses-parenthesis-exception-p 24 (point-max))) + (should (glasses-parenthesis-exception-p 28 (point-max)))))) + +(ert-deftest glasses-tests-overlay-p () + (should + (glasses-overlay-p (glasses-make-overlay (point-min) (point-max)))) + (should-not + (glasses-overlay-p (make-overlay (point-min) (point-max))))) + +(ert-deftest glasses-tests-make-overlay-p () + (let ((o (glasses-make-overlay (point-min) (point-max)))) + (should (eq (overlay-get o 'category) 'glasses))) + (let ((o (glasses-make-overlay (point-min) (point-max) 'foo))) + (should (eq (overlay-get o 'category) 'foo)))) + +(ert-deftest glasses-tests-make-readable () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (glasses-make-readable (point-min) (point-max)) + (pcase-let ((`(,o1 ,o2 ,o3) + (sort (overlays-in (point-min) (point-max)) + (lambda (o1 o2) + (< (overlay-start o1) (overlay-start o2)))))) + (should (= (overlay-start o1) 7)) + (should (equal (overlay-get o1 'before-string) + glasses-separator)) + (should (= (overlay-start o2) 17)) + (should (equal (overlay-get o2 'before-string) + glasses-separator)) + (should (= (overlay-start o3) 25)) + (should (equal (overlay-get o3 'before-string) " "))))) + +(ert-deftest glasses-tests-make-readable-dont-separate-parentheses () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (let ((glasses-separate-parentheses-p nil)) + (glasses-make-readable (point-min) (point-max)) + (should-not (overlays-at 25))))) + +(ert-deftest glasses-tests-make-unreadable () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (glasses-make-readable (point-min) (point-max)) + (should (seq-some #'glasses-overlay-p + (overlays-in (point-min) (point-max)))) + (glasses-make-unreadable (point-min) (point-max)) + (should-not (seq-some #'glasses-overlay-p + (overlays-in (point-min) (point-max)))))) + +(ert-deftest glasses-tests-convert-to-unreadable () + (with-temp-buffer + (insert "set_Background_Resource(R.button_right);") + (let ((glasses-convert-on-write-p nil)) + (should-not (glasses-convert-to-unreadable)) + (should (equal (buffer-string) + "set_Background_Resource(R.button_right);"))) + (let ((glasses-convert-on-write-p t)) + (should-not (glasses-convert-to-unreadable)) + (should (equal (buffer-string) + "setBackgroundResource(R.button_right);"))))) + +(provide 'glasses-tests) +;;; glasses-tests.el ends here commit 1efaa1d66b9bc51284c7cac4477f45c9bde4fcfb Author: Simen Heggestøyl Date: Sun May 10 14:44:26 2020 +0200 Allow underscores in CSS variable names * lisp/textmodes/css-mode.el (css-nmchar-re): Allow underscores in variable names (and in identifiers in general). * test/manual/indent/css-mode.css: Add some examples of variable names with underscores in them. * test/manual/indent/less-css-mode.less: Add some examples of variable names with underscores in them. * test/manual/indent/scss-mode.scss: Add some examples of variable names with underscores in them. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index ab9e2dc35e..0035c5e7b0 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -886,7 +886,7 @@ cannot be completed sensibly: `custom-ident', (defconst css-escapes-re "\\\\\\(?:[^\000-\037\177]\\|[[:xdigit:]]+[ \n\t\r\f]?\\)") -(defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)")) +(defconst css-nmchar-re (concat "\\(?:[-_[:alnum:]]\\|" css-escapes-re "\\)")) (defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)")) (defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*") ;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes. diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css index ecf6c3c0ca..041aeec1b1 100644 --- a/test/manual/indent/css-mode.css +++ b/test/manual/indent/css-mode.css @@ -92,5 +92,9 @@ div::before { .foo-bar--baz { --foo-variable: 5px; + --_variable_with_underscores: #fff; + --_variable-starting-with-underscore: none; margin: var(--foo-variable); + color: var(--_variable_with_underscores); + display: var(--_variable-starting-with-underscore); } diff --git a/test/manual/indent/less-css-mode.less b/test/manual/indent/less-css-mode.less index 36c037450c..b40a2362e2 100644 --- a/test/manual/indent/less-css-mode.less +++ b/test/manual/indent/less-css-mode.less @@ -1,3 +1,13 @@ +@var-with-dashes: #428bca; +@var_with_underscores: 10px; +@_var-starting-with-underscore: none; + +body { + background: @var-with-dashes; + padding: @var_with_underscores; + display: @_var-starting-with-underscore; +} + .desktop-and-old-ie(@rules) { @media screen and (min-width: 1200) { @rules(); } html.lt-ie9 & { @rules(); } diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss index a3dd41eeb4..189ec4e22a 100644 --- a/test/manual/indent/scss-mode.scss +++ b/test/manual/indent/scss-mode.scss @@ -41,9 +41,13 @@ p.#{$name} var article[role="main"] { $toto: 500 !global; $var-with-default: 300 !default; + $var_with_underscores: #fff; + $_var-starting-with-underscore: none; float: left !important; width: 600px / 888px * 100%; height: 100px / 888px * 100%; + color: $var_with_underscores; + display: $_var-starting-with-underscore; } %placeholder { commit 2df2f787116a9b0f3907ffbf1027c2eab0804e7d Author: Simen Heggestøyl Date: Sun May 10 12:14:21 2020 +0200 Add containment module to CSS property list * lisp/textmodes/css-mode.el (css-property-alist): Add new properties from CSS Containment Module Level 1. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 3f581c539c..ab9e2dc35e 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -276,6 +276,10 @@ ("color" color) ("opacity" alphavalue) + ;; CSS Containment Module Level 1 + ;; (https://www.w3.org/TR/css-contain-1/#property-index) + ("contain" "none" "strict" "content" "size" "layout" "paint") + ;; CSS Grid Layout Module Level 1 ;; (https://www.w3.org/TR/css-grid-1/#property-index) ("grid" grid-template grid-template-rows "auto-flow" "dense" commit b7682d2a2617a595b64a7e2839344086a5b0318c Author: Simen Heggestøyl Date: Sun May 10 10:00:56 2020 +0200 Add writing modes module to CSS property list * lisp/textmodes/css-mode.el (css-property-alist): Add new properties from the CSS Writing Modes Level 3 module. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 0d4a910a1d..3f581c539c 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -119,7 +119,6 @@ ("cue" cue-before cue-after) ("cue-after" uri "none") ("cue-before" uri "none") - ("direction" "ltr" "rtl") ("display" "inline" "block" "list-item" "inline-block" "table" "inline-table" "table-row-group" "table-header-group" "table-footer-group" "table-row" "table-column-group" @@ -180,7 +179,6 @@ ("stress" number) ("table-layout" "auto" "fixed") ("top" length percentage "auto") - ("unicode-bidi" "normal" "embed" "bidi-override") ("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle" "bottom" "text-bottom" percentage length) ("visibility" "visible" "hidden" "collapse") @@ -490,6 +488,16 @@ ;; (https://www.w3.org/TR/css-will-change-1/#property-index) ("will-change" "auto" animateable-feature) + ;; CSS Writing Modes Level 3 + ;; (https://www.w3.org/TR/css-writing-modes-3/#property-index) + ;; "glyph-orientation-vertical" is obsolete and left out. + ("direction" "ltr" "rtl") + ("text-combine-upright" "none" "all") + ("text-orientation" "mixed" "upright" "sideways") + ("unicode-bidi" "normal" "embed" "isolate" "bidi-override" + "isolate-override" "plaintext") + ("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr") + ;; Filter Effects Module Level 1 ;; (http://www.w3.org/TR/filter-effects/#property-index) ("color-interpolation-filters" "auto" "sRGB" "linearRGB")