diff options
59 files changed, 818 insertions, 915 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 5db74799ade..ffd65c88027 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,6 +1,6 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 79) + (fill-column . 70) (bug-reference-url-format . "https://debbugs.gnu.org/%s"))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) diff --git a/.gitignore b/.gitignore index 389fb450d86..e75df8b8b61 100644 --- a/.gitignore +++ b/.gitignore @@ -251,6 +251,7 @@ gnustmp* # Version control and locks. *.orig +*.rej *.swp *~ .#* diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 68c8c1259d4..ee2c2091770 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -63,8 +63,7 @@ EMACS = ../src/emacs${EXEEXT} EMACSOPT = -batch --no-site-file --no-site-lisp # Extra flags to pass to the byte compiler -BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-force-lexical-warnings t)' - +BYTE_COMPILE_EXTRA_FLAGS = # For example to not display the undefined function warnings you can use this: # BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))' # The example above is just for developers, it should not be used by default. @@ -86,7 +85,7 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \ # Set load-prefer-newer for the benefit of the non-bootstrappers. BYTE_COMPILE_FLAGS = \ - --eval '(setq load-prefer-newer t byte-compile-force-lexical-warnings t)' $(BYTE_COMPILE_EXTRA_FLAGS) + --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. They're ordered by size, so we use @@ -317,7 +316,7 @@ compile-targets: $(TARGETS) # Compile all the Elisp files that need it. Beware: it approximates # 'no-byte-compile', so watch out for false-positives! compile-main: gen-lisp compile-clean - @(cd $(lisp) && \ + @(cd $(lisp) && \ els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ for el in ${MAIN_FIRST} $$els; do \ test -f $$el || continue; \ diff --git a/lisp/abbrev.el b/lisp/abbrev.el index f8c82238a31..3d0a843e375 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -648,8 +648,7 @@ either a single abbrev table or a list of abbrev tables." ;; to treat the distinction between a single table and a list of tables. (cond ((consp tables) tables) - ((abbrev-table-p tables) (list tables)) - (tables (signal 'wrong-type-argument (list 'abbrev-table-p tables))) + ((vectorp tables) (list tables)) (t (let ((tables (if (listp local-abbrev-table) (append local-abbrev-table diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index f9a420090ee..4ca8515989b 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -31,8 +31,9 @@ (require 'calc-macs) -;; Find out how many 9s in 9.9999... will give distinct Emacs floats, -;; then back off by one. +;;; Find out how many 9s in 9.9999... will give distinct Emacs floats, +;;; then back off by one. + (defvar math-emacs-precision (let* ((n 1) (x 9) @@ -45,9 +46,9 @@ (1- n)) "The number of digits in an Emacs float.") -;; Find the largest power of 10 which is an Emacs float, -;; then back off by one so that any float d.dddd...eN -;; is an Emacs float, for acceptable d.dddd.... +;;; Find the largest power of 10 which is an Emacs float, +;;; then back off by one so that any float d.dddd...eN +;;; is an Emacs float, for acceptable d.dddd.... (defvar math-largest-emacs-expt (let ((x 1) @@ -366,9 +367,9 @@ If this can't be done, return NIL." (message "Angles measured in radians"))) -;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] -;; This method takes advantage of the fact that Newton's method starting -;; with an overestimate always works, even using truncating integer division! +;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] +;;; This method takes advantage of the fact that Newton's method starting +;;; with an overestimate always works, even using truncating integer division! (defun math-isqrt (a) (cond ((Math-zerop a) a) ((not (natnump a)) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index dad87dc8c97..2c0280ccf3b 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -156,9 +156,9 @@ If DATE lacks timezone information, GMT is assumed." (let ((overflow-error '(error "Specified time is not representable"))) (if (equal err overflow-error) (signal (car err) (cdr err)) - (condition-case-unless-debug err + (condition-case err (encode-time (parse-time-string - (timezone-make-date-arpa-standard date))) + (timezone-make-date-arpa-standard date))) (error (if (equal err overflow-error) (signal (car err) (cdr err)) diff --git a/lisp/completion.el b/lisp/completion.el index d5450998204..b9c3a21f5ea 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -2221,7 +2221,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (defun completion-before-command () (funcall (or (and (symbolp this-command) (get this-command 'completion-function)) - #'use-completion-under-or-before-point))) + 'use-completion-under-or-before-point))) ;; Lisp mode diffs. diff --git a/lisp/composite.el b/lisp/composite.el index 926fa44c88e..e0d0721f16d 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -1,4 +1,4 @@ -;;; composite.el --- support character composition -*- lexical-binding:t -*- +;;; composite.el --- support character composition ;; Copyright (C) 2001-2019 Free Software Foundation, Inc. @@ -588,6 +588,7 @@ All non-spacing characters have this function in (as (lglyph-ascent glyph)) (de (lglyph-descent glyph)) (ce (/ (+ lb rb) 2)) + (w (lglyph-width glyph)) xoff yoff) (cond ((and class (>= class 200) (<= class 240)) @@ -688,7 +689,9 @@ All non-spacing characters have this function in (defun compose-gstring-for-dotted-circle (gstring direction) (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle + (dc-id (lglyph-code dc)) (fc (lgstring-glyph gstring 1)) ; glyph of the following char + (fc-id (lglyph-code fc)) (gstr (and nil (font-shape-gstring gstring direction)))) (if (and gstr (or (= (lgstring-glyph-len gstr) 1) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 6728525a547..5fb9d751e25 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -551,8 +551,7 @@ happened." (goto-char pos) (funcall electric-pair-inhibit-predicate last-command-event))))) - (let ((electric-indent--destination (point-marker))) - (save-excursion (electric-pair--insert pair)))))) + (save-excursion (electric-pair--insert pair))))) (_ (when (and (if (functionp electric-pair-open-newline-between-pairs) (funcall electric-pair-open-newline-between-pairs) diff --git a/lisp/electric.el b/lisp/electric.el index c70e60b720a..53e53bd975c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -220,14 +220,6 @@ If `indent-line-function' is one of those, then `electric-indent-mode' will not try to reindent lines. It is normally better to make the major mode set `electric-indent-inhibit', but this can be used as a workaround.") -(defun electric-indent--inhibited-p () - (or electric-indent-inhibit - (memq indent-line-function - electric-indent-functions-without-reindent))) - -(defvar electric-indent--destination nil - "If non-nil, position to which point will be later restored.") - (defun electric-indent-post-self-insert-function () "Function that `electric-indent-mode' adds to `post-self-insert-hook'. This indents if the hook `electric-indent-functions' returns non-nil, @@ -269,26 +261,26 @@ or comment." (when at-newline (let ((before (copy-marker (1- pos) t))) (save-excursion - (unless (electric-indent--inhibited-p) + (unless + (or (memq indent-line-function + electric-indent-functions-without-reindent) + electric-indent-inhibit) ;; Don't reindent the previous line if the ;; indentation function is not a real one. (goto-char before) (condition-case-unless-debug () (indent-according-to-mode) - (error (throw 'indent-error nil)))) - ;; The goal here will be to remove the trailing - ;; whitespace after reindentation of the previous line - ;; because that may have (re)introduced it. - (goto-char before) - ;; We were at EOL in marker `before' before the call - ;; to `indent-according-to-mode' but after we may - ;; not be (Bug#15767). - (when (and (eolp) - ;; Don't delete "trailing space" before point! - (not (and electric-indent--destination - (= (point) electric-indent--destination)))) - (delete-horizontal-space t))))) - (unless (and (electric-indent--inhibited-p) + (error (throw 'indent-error nil))) + ;; The goal here will be to remove the trailing + ;; whitespace after reindentation of the previous line + ;; because that may have (re)introduced it. + (goto-char before) + ;; We were at EOL in marker `before' before the call + ;; to `indent-according-to-mode' but after we may + ;; not be (Bug#15767). + (when (and (eolp)) + (delete-horizontal-space t)))))) + (unless (and electric-indent-inhibit (not at-newline)) (condition-case-unless-debug () (indent-according-to-mode) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d8ea33a160d..431525431a4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2981,7 +2981,7 @@ for symbols generated by the byte compiler itself." lexenv reserved-csts) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, - ;; t -> a list of forms, + ;; 'progn or t -> a list of forms, ;; 'lambda -> body of a lambda, ;; 'file -> used at file-level. (let ((byte-compile--for-effect for-effect) @@ -3044,19 +3044,21 @@ for symbols generated by the byte compiler itself." ;; a single atom, but that causes confusion if the docstring ;; uses the (file . pos) syntax. Besides, now that we have ;; the Lisp_Compiled type, the compiled form is faster. - ;; eval/nil-> atom, quote or (function atom atom atom) - ;; t -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) + ;; eval -> atom, quote or (function atom atom atom) + ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. - (let (body tmp) + (let (rest + (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. + tmp body) (cond ;; #### This should be split out into byte-compile-nontrivial-function-p. ((or (eq output-type 'lambda) (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output) (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit. (not (setq tmp (assq 'byte-return byte-compile-output))) - (let ((maycall t) ; t if we may make a funcall. - (rest (nreverse - (cdr (memq tmp (reverse byte-compile-output)))))) + (progn + (setq rest (nreverse + (cdr (memq tmp (reverse byte-compile-output))))) (while (cond ((memq (car (car rest)) '(byte-varref byte-constant)) @@ -3065,7 +3067,7 @@ for symbols generated by the byte compiler itself." (or (consp tmp) (and (symbolp tmp) (not (macroexp--const-symbol-p tmp))))) - (if maycall ;;Why? --Stef + (if maycall (setq body (cons (list 'quote tmp) body))) (setq body (cons tmp body)))) ((and maycall @@ -3073,7 +3075,7 @@ for symbols generated by the byte compiler itself." (null (nthcdr 3 rest)) (setq tmp (get (car (car rest)) 'byte-opcode-invert)) (or (null (cdr rest)) - (and (memq output-type '(file t)) + (and (memq output-type '(file progn t)) (cdr (cdr rest)) (eq (car (nth 1 rest)) 'byte-discard) (progn (setq rest (cdr rest)) t)))) diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 3b6ea12ecff..e4ed745b25d 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -234,13 +234,73 @@ Some generic modes are defined in `generic-x.el'." (cond ((characterp end) (setq end (char-to-string end))) ((zerop (length end)) (setq end "\n"))) - (push (list start end) normalized))) + (push (cons start end) normalized))) (nreverse normalized))) +(defun generic-set-comment-syntax (st comment-list) + "Set up comment functionality for generic mode." + (let ((chars nil) + (comstyles) + (comstyle "") + (comment-start nil)) + + ;; Go through all the comments. + (pcase-dolist (`(,start . ,end) comment-list) + (let ((comstyle + ;; Reuse comstyles if necessary. + (or (cdr (assoc start comstyles)) + (cdr (assoc end comstyles)) + ;; Otherwise, use a style not yet in use. + (if (not (rassoc "" comstyles)) "") + (if (not (rassoc "b" comstyles)) "b") + "c"))) + (push (cons start comstyle) comstyles) + (push (cons end comstyle) comstyles) + + ;; Setup the syntax table. + (if (= (length start) 1) + (modify-syntax-entry (aref start 0) + (concat "< " comstyle) st) + (let ((c0 (aref start 0)) (c1 (aref start 1))) + ;; Store the relevant info but don't update yet. + (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) + (push (cons c1 (concat (cdr (assoc c1 chars)) + (concat "2" comstyle))) chars))) + (if (= (length end) 1) + (modify-syntax-entry (aref end 0) + (concat ">" comstyle) st) + (let ((c0 (aref end 0)) (c1 (aref end 1))) + ;; Store the relevant info but don't update yet. + (push (cons c0 (concat (cdr (assoc c0 chars)) + (concat "3" comstyle))) chars) + (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) + + ;; Process the chars that were part of a 2-char comment marker + (with-syntax-table st ;For `char-syntax'. + (dolist (cs (nreverse chars)) + (modify-syntax-entry (car cs) + (concat (char-to-string (char-syntax (car cs))) + " " (cdr cs)) + st))))) + +(defun generic-set-comment-vars (comment-list) + (when comment-list + (setq-local comment-start (caar comment-list)) + (setq-local comment-end + (let ((end (cdar comment-list))) + (if (string-equal end "\n") "" end))) + (setq-local comment-start-skip + (concat (regexp-opt (mapcar #'car comment-list)) + "+[ \t]*")) + (setq-local comment-end-skip + (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list)))))) + (defun generic-mode-set-comments (comment-list) "Set up comment functionality for generic mode." - (let ((st (make-syntax-table))) - (comment-set-syntax st comment-list) + (let ((st (make-syntax-table)) + (comment-list (generic--normalize-comments comment-list))) + (generic-set-comment-syntax st comment-list) + (generic-set-comment-vars comment-list) (set-syntax-table st))) (defun generic-bracket-support () diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ac47d98359b..fa6dc98d04c 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -237,7 +237,6 @@ (eval-when-compile (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>")) limit t) - ;; FIXME: If it's indented like `defun' then highlight the first arg! (let ((sym (intern-soft (match-string 1)))) (when (or (special-form-p sym) (and (macrop sym) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5b136bdf489..b60a8a136a1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1163,6 +1163,26 @@ The return result is a `package-desc'." (insert (format "Error while verifying signature %s:\n" sig-file))) (insert "\nCommand output:\n" (epg-context-error-output context)))))) +(defmacro package--with-work-buffer (location file &rest body) + "Run BODY in a buffer containing the contents of FILE at LOCATION. +LOCATION is the base location of a package archive, and should be +one of the URLs (or file names) specified in `package-archives'. +FILE is the name of a file relative to that base location. + +This macro retrieves FILE from LOCATION into a temporary buffer, +and evaluates BODY while that buffer is current. This work +buffer is killed afterwards. Return the last value in BODY." + (declare (indent 2) (debug t) + (obsolete package--with-response-buffer "25.1")) + `(with-temp-buffer + (if (string-match-p "\\`https?:" ,location) + (url-insert-file-contents (concat ,location ,file)) + (unless (file-name-absolute-p ,location) + (error "Archive location %s is not an absolute file name" + ,location)) + (insert-file-contents (expand-file-name ,file ,location))) + ,@body)) + (cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) "Access URL and run BODY in a buffer containing the response. Point is after the headers when BODY runs. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 07beb722fc3..ae2cf8eb02f 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -97,34 +97,11 @@ (declare-function get-edebug-spec "edebug" (symbol)) (declare-function edebug-match "edebug" (cursor specs)) -(defun pcase--get-macroexpander (s) - "Return the macroexpander for pcase pattern head S, or nil" - (let ((em (assoc s (assq :pcase-macroexpander macroexpand-all-environment)))) - (if em (cdr em) - (get s 'pcase-macroexpander)))) - -(defmacro pcase-macrolet (bindings &rest body) - (let ((new-macros (if (consp (car-safe bindings)) - (mapcar (lambda (binding) - (cons (car binding) - (eval (if (cddr binding) - `(lambda ,(cadr binding) - ,@(cddr binding)) - (cadr binding)) - lexical-binding))) - bindings) - (eval bindings lexical-binding))) - (old-pme (assq :pcase-macroexpander macroexpand-all-environment))) - (macroexpand-all (macroexp-progn body) - (cons (cons :pcase-macroexpander - (append new-macros old-pme)) - macroexpand-all-environment)))) - (defun pcase--edebug-match-macro (cursor) (let (specs) (mapatoms (lambda (s) - (let ((m (pcase--get-macroexpander s))) + (let ((m (get s 'pcase-macroexpander))) (when (and m (get-edebug-spec m)) (push (cons (symbol-name s) (get-edebug-spec m)) specs))))) @@ -216,7 +193,7 @@ Emacs Lisp manual for more information and examples." (let (more) ;; Collect all the extensions. (mapatoms (lambda (symbol) - (let ((me (pcase--get-macroexpander symbol))) + (let ((me (get symbol 'pcase-macroexpander))) (when me (push (cons symbol me) more))))) @@ -442,7 +419,7 @@ of the elements of LIST is performed as if by `pcase-let'. ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) (t - (let* ((expander (pcase--get-macroexpander head)) + (let* ((expander (get head 'pcase-macroexpander)) (npat (if expander (apply expander (cdr pat))))) (if (null npat) (error (if expander diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index a9b5df53c84..00f72e284ad 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -141,7 +141,7 @@ usually more efficient than that of a simplified version: (completion-regexp-list nil) (open (cond ((stringp paren) paren) (paren "\\("))) (sorted-strings (delete-dups - (sort (copy-sequence strings) #'string-lessp))) + (sort (copy-sequence strings) 'string-lessp))) (re (cond ;; No strings: return an unmatchable regexp. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 47265962591..f2163b243ee 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -239,7 +239,7 @@ be either: ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in ;; the repetition, maybe). - (let* ((nts (mapcar #'car bnf)) ;Non-terminals. + (let* ((nts (mapcar 'car bnf)) ;Non-terminals. (first-ops-table ()) (last-ops-table ()) (first-nts-table ()) @@ -258,7 +258,7 @@ be either: (push resolver precs)) (t (error "Unknown resolver %S" resolver)))) (apply #'smie-merge-prec2s over - (mapcar #'smie-precs->prec2 precs)))) + (mapcar 'smie-precs->prec2 precs)))) again) (dolist (rules bnf) (let ((nt (car rules)) @@ -489,7 +489,7 @@ CSTS is a list of pairs representing arcs in a graph." res)) cycle))) (mapconcat - (lambda (elems) (mapconcat #'identity elems "=")) + (lambda (elems) (mapconcat 'identity elems "=")) (append names (list (car names))) " < "))) @@ -559,7 +559,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or ;; Then eliminate trivial constraints iteratively. (let ((i 0)) (while csts - (let ((rhvs (mapcar #'cdr csts)) + (let ((rhvs (mapcar 'cdr csts)) (progress nil)) (dolist (cst csts) (unless (memq (car cst) rhvs) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index e7c737d85ab..bdb205ce7c8 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -293,15 +293,15 @@ ;; desirable that viper-pre-command-sentinel is the last hook and ;; viper-post-command-sentinel is the first hook. - (remove-hook 'post-command-hook #'viper-post-command-sentinel) - (add-hook 'post-command-hook #'viper-post-command-sentinel) - (remove-hook 'pre-command-hook #'viper-pre-command-sentinel) - (add-hook 'pre-command-hook #'viper-pre-command-sentinel t) + (remove-hook 'post-command-hook 'viper-post-command-sentinel) + (add-hook 'post-command-hook 'viper-post-command-sentinel) + (remove-hook 'pre-command-hook 'viper-pre-command-sentinel) + (add-hook 'pre-command-hook 'viper-pre-command-sentinel t) ;; These hooks will be added back if switching to insert/replace mode (remove-hook 'viper-post-command-hooks - #'viper-insert-state-post-command-sentinel 'local) + 'viper-insert-state-post-command-sentinel 'local) (remove-hook 'viper-pre-command-hooks - #'viper-insert-state-pre-command-sentinel 'local) + 'viper-insert-state-pre-command-sentinel 'local) (setq viper-intermediate-command nil) (cond ((eq new-state 'vi-state) (cond ((member viper-current-state '(insert-state replace-state)) @@ -344,9 +344,9 @@ (viper-move-marker-locally 'viper-last-posn-while-in-insert-state (point)) (add-hook 'viper-post-command-hooks - #'viper-insert-state-post-command-sentinel t 'local) + 'viper-insert-state-post-command-sentinel t 'local) (add-hook 'viper-pre-command-hooks - #'viper-insert-state-pre-command-sentinel t 'local)) + 'viper-insert-state-pre-command-sentinel t 'local)) ) ; outermost cond ;; Nothing needs to be done to switch to emacs mode! Just set some @@ -1074,7 +1074,7 @@ as a Meta key and any number of multiple escapes are allowed." ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) - (if (viper-memq-char char '(?# ?\")) (viper--user-error)) + (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell)) (setq com (cons char com)) (setq cont nil)) ;; If com is nil we set com as char, and read more. Again, if char is @@ -1093,7 +1093,7 @@ as a Meta key and any number of multiple escapes are allowed." (let ((reg (read-char))) (if (viper-valid-register reg) (setq viper-use-register reg) - (viper--user-error)) + (user-error viper-ViperBell)) (setq char (read-char)))) (t (setq com char) @@ -1115,7 +1115,7 @@ as a Meta key and any number of multiple escapes are allowed." (viper-regsuffix-command-p char) (viper= char ?!) ; bang command (viper= char ?g) ; the gg command (like G0) - (viper--user-error)) + (user-error viper-ViperBell)) (setq cmd-to-exec-at-end (viper-exec-form-in-vi `(key-binding (char-to-string ,char))))) @@ -1149,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed." ((equal com '(?= . ?=)) (viper-line (cons value ?=))) ;; gg acts as G0 ((equal (car com) ?g) (viper-goto-line 0)) - (t (viper--user-error))))) + (t (user-error viper-ViperBell))))) (if cmd-to-exec-at-end (progn @@ -1432,25 +1432,23 @@ as a Meta key and any number of multiple escapes are allowed." (setq viper-intermediate-command 'viper-exec-buffer-search) (viper-search viper-s-string viper-s-forward 1)) -(defvar viper-exec-array - (let ((a (make-vector 128 nil))) +(defvar viper-exec-array (make-vector 128 nil)) - ;; Using a dispatch array allows adding functions like buffer search - ;; without affecting other functions. Buffer search can now be bound - ;; to any character. +;; Using a dispatch array allows adding functions like buffer search +;; without affecting other functions. Buffer search can now be bound +;; to any character. - (aset a ?c 'viper-exec-change) - (aset a ?C 'viper-exec-Change) - (aset a ?d 'viper-exec-delete) - (aset a ?D 'viper-exec-Delete) - (aset a ?y 'viper-exec-yank) - (aset a ?Y 'viper-exec-Yank) - (aset a ?r 'viper-exec-dummy) - (aset a ?! 'viper-exec-bang) - (aset a ?< 'viper-exec-shift) - (aset a ?> 'viper-exec-shift) - (aset a ?= 'viper-exec-equals) - a)) +(aset viper-exec-array ?c 'viper-exec-change) +(aset viper-exec-array ?C 'viper-exec-Change) +(aset viper-exec-array ?d 'viper-exec-delete) +(aset viper-exec-array ?D 'viper-exec-Delete) +(aset viper-exec-array ?y 'viper-exec-yank) +(aset viper-exec-array ?Y 'viper-exec-Yank) +(aset viper-exec-array ?r 'viper-exec-dummy) +(aset viper-exec-array ?! 'viper-exec-bang) +(aset viper-exec-array ?< 'viper-exec-shift) +(aset viper-exec-array ?> 'viper-exec-shift) +(aset viper-exec-array ?= 'viper-exec-equals) @@ -1589,7 +1587,7 @@ invokes the command before that, etc." (defun viper-undo-sentinel (beg end length) (run-hook-with-args 'viper-undo-functions beg end length)) -(add-hook 'after-change-functions #'viper-undo-sentinel) +(add-hook 'after-change-functions 'viper-undo-sentinel) ;; Hook used in viper-undo (defun viper-after-change-undo-hook (beg end _len) @@ -1599,7 +1597,7 @@ invokes the command before that, etc." ;; some other hooks may be changing various text properties in ;; the buffer in response to 'undo'; so remove this hook to avoid ;; its repeated invocation - (remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local) + (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local) )) (defun viper-undo () @@ -1610,7 +1608,7 @@ invokes the command before that, etc." undo-beg-posn undo-end-posn) ;; the viper-after-change-undo-hook removes itself after the 1st invocation - (add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local) + (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local) (undo-start) (undo-more 2) @@ -1882,8 +1880,8 @@ Undo previous insertion and inserts new." ;;; Minibuffer business (defsubst viper-set-minibuffer-style () - (add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel) - (add-hook 'post-command-hook #'viper-minibuffer-post-command-hook)) + (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) + (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook)) (defun viper-minibuffer-setup-sentinel () @@ -2229,22 +2227,22 @@ problems." viper-sitting-in-replace t viper-replace-chars-to-delete 0) (add-hook - 'viper-after-change-functions #'viper-replace-mode-spy-after t 'local) + 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local) (add-hook - 'viper-before-change-functions #'viper-replace-mode-spy-before t 'local) + 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local) ;; this will get added repeatedly, but no harm - (add-hook 'after-change-functions #'viper-after-change-sentinel t) - (add-hook 'before-change-functions #'viper-before-change-sentinel t) + (add-hook 'after-change-functions 'viper-after-change-sentinel t) + (add-hook 'before-change-functions 'viper-before-change-sentinel t) (viper-move-marker-locally 'viper-last-posn-in-replace-region (viper-replace-start)) (add-hook - 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel + 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel t 'local) (add-hook - 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local) + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) ;; guard against a smarty who switched from R-replace to normal replace (remove-hook - 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local) + 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) (if overwrite-mode (overwrite-mode -1)) ) @@ -2318,13 +2316,13 @@ problems." ;; Don't delete anything if current point is past the end of the overlay. (defun viper-finish-change () (remove-hook - 'viper-after-change-functions #'viper-replace-mode-spy-after 'local) + 'viper-after-change-functions 'viper-replace-mode-spy-after 'local) (remove-hook - 'viper-before-change-functions #'viper-replace-mode-spy-before 'local) + 'viper-before-change-functions 'viper-replace-mode-spy-before 'local) (remove-hook - 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local) + 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) (remove-hook - 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local) + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) (viper-restore-cursor-color 'after-replace-mode) (setq viper-sitting-in-replace nil) ; just in case we'll need to know it (save-excursion @@ -2354,21 +2352,21 @@ problems." (defun viper-finish-R-mode () (remove-hook - 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local) + 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) (remove-hook - 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local) + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) (viper-downgrade-to-insert)) (defun viper-start-R-mode () ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number (overwrite-mode 1) (add-hook - 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local) + 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local) (add-hook - 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local) + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) ;; guard against a smarty who switched from R-replace to normal replace (remove-hook - 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local) + 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) ) @@ -2543,9 +2541,9 @@ On reaching end of line, stop and signal error." ;; the forward motion before the 'viper-execute-com', but, of ;; course, 'dl' doesn't work on an empty line, so we have to ;; catch that condition before 'viper-execute-com' - (if (and (eolp) (bolp)) (viper--user-error) (forward-char val)) + (if (and (eolp) (bolp)) (user-error viper-ViperBell) (forward-char val)) (if com (viper-execute-com 'viper-forward-char val com)) - (if (eolp) (progn (backward-char 1) (viper--user-error)))) + (if (eolp) (progn (backward-char 1) (user-error viper-ViperBell)))) (forward-char val) (if com (viper-execute-com 'viper-forward-char val com))))) @@ -2559,7 +2557,7 @@ On reaching beginning of line, stop and signal error." (if com (viper-move-marker-locally 'viper-com-point (point))) (if viper-ex-style-motion (progn - (if (bolp) (viper--user-error) (backward-char val)) + (if (bolp) (user-error viper-ViperBell) (backward-char val)) (if com (viper-execute-com 'viper-backward-char val com))) (backward-char val) (if com (viper-execute-com 'viper-backward-char val com))))) @@ -2876,7 +2874,7 @@ On reaching beginning of line, stop and signal error." (if com (viper-execute-com 'viper-goto-col val com)) (save-excursion (end-of-line) - (if (> val (current-column)) (viper--user-error))) + (if (> val (current-column)) (user-error viper-ViperBell))) )) @@ -3003,7 +3001,7 @@ If point is on a widget or a button, simulate clicking on that widget/button." ;; If FORWARD then search is forward, otherwise backward. OFFSET is used to ;; adjust point after search. (defun viper-find-char (arg char forward offset) - (or (char-or-string-p char) (viper--user-error)) + (or (char-or-string-p char) (user-error viper-ViperBell)) (let ((arg (if forward arg (- arg))) (cmd (if (eq viper-intermediate-command 'viper-repeat) (nth 5 viper-d-com) @@ -3337,7 +3335,7 @@ controlled by the sign of prefix numeric value." (if com (viper-move-marker-locally 'viper-com-point (point))) (backward-sexp 1) (if com (viper-execute-com 'viper-paren-match nil com))) - (t (viper--user-error)))))) + (t (user-error viper-ViperBell)))))) (defun viper-toggle-parse-sexp-ignore-comments () (interactive) @@ -3908,7 +3906,7 @@ Null string will repeat previous search." (let ((reg viper-use-register)) (setq viper-use-register nil) (error viper-EmptyRegister reg)) - (viper--user-error))) + (user-error viper-ViperBell))) (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (progn @@ -3958,7 +3956,7 @@ Null string will repeat previous search." (let ((reg viper-use-register)) (setq viper-use-register nil) (error viper-EmptyRegister reg)) - (viper--user-error))) + (user-error viper-ViperBell))) (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (beginning-of-line)) (viper-set-destructive-command @@ -4003,7 +4001,7 @@ Null string will repeat previous search." (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) (if (and viper-ex-style-motion (eolp)) - (if (bolp) (viper--user-error) (setq val 0))) ; not bol---simply back 1 ch + (if (bolp) (user-error viper-ViperBell) (setq val 0))) ; not bol---simply back 1 ch (save-excursion (viper-forward-char-carefully val) (setq end-del-pos (point))) @@ -4273,7 +4271,7 @@ and regexp replace." ((viper= char ?,) (viper-cycle-through-mark-ring)) ((viper= char ?^) (push-mark viper-saved-mark t t)) ((viper= char ?D) (mark-defun)) - (t (viper--user-error)) + (t (user-error viper-ViperBell)) ))) ;; Algorithm: If first invocation of this command save mark on ring, goto @@ -4372,7 +4370,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." (switch-to-buffer buff) (goto-char viper-com-point) (viper-change-state-to-vi) - (viper--user-error))))) + (user-error viper-ViperBell))))) ((and (not skip-white) (viper= char ?`)) (if com (viper-move-marker-locally 'viper-com-point (point))) (if (and (viper-same-line (point) viper-last-jump) diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 7aa3333f25c..26bca686cb3 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -1239,7 +1239,7 @@ reversed." (read-string "[Hit return to confirm] ") (quit (save-excursion (kill-buffer " *delete text*")) - (viper--user-error))) + (user-error viper-ViperBell))) (save-excursion (kill-buffer " *delete text*"))) (if ex-buffer (cond ((viper-valid-register ex-buffer '(Letter)) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 2af94979278..1d7bb1580ce 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -64,8 +64,6 @@ (define-obsolete-function-alias 'viper-iconify 'iconify-or-deiconify-frame "27.1") -(defun viper--user-error () (user-error "Viper bell")) -(defun viper--user-error () (user-error "Viper bell")) ;; CHAR is supposed to be a char or an integer (positive or negative) ;; LIST is a list of chars, nil, and negative numbers diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index bdce91f221f..53a59207839 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -536,17 +536,17 @@ keybindings will not do anything useful." ((when (boundp 'erc-track-when-inactive) (if erc-track-when-inactive (progn - (add-hook 'window-configuration-change-hook #'erc-user-is-active) - (add-hook 'erc-send-completed-hook #'erc-user-is-active) - (add-hook 'erc-server-001-functions #'erc-user-is-active)) + (add-hook 'window-configuration-change-hook 'erc-user-is-active) + (add-hook 'erc-send-completed-hook 'erc-user-is-active) + (add-hook 'erc-server-001-functions 'erc-user-is-active)) (erc-track-add-to-mode-line erc-track-position-in-mode-line) (erc-update-mode-line) (add-hook 'window-configuration-change-hook - #'erc-window-configuration-change) - (add-hook 'erc-insert-post-hook #'erc-track-modified-channels) - (add-hook 'erc-disconnected-hook #'erc-modified-channels-update)) + 'erc-window-configuration-change) + (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) + (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) ;; enable the tracking keybindings - (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) + (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) (erc-track-minor-mode-maybe))) ;; Disable: ((when (boundp 'erc-track-when-inactive) @@ -554,15 +554,14 @@ keybindings will not do anything useful." (if erc-track-when-inactive (progn (remove-hook 'window-configuration-change-hook - #'erc-user-is-active) - (remove-hook 'erc-send-completed-hook #'erc-user-is-active) - (remove-hook 'erc-server-001-functions #'erc-user-is-active) - ;; FIXME: Never added!? - (remove-hook 'erc-timer-hook #'erc-user-is-active)) + 'erc-user-is-active) + (remove-hook 'erc-send-completed-hook 'erc-user-is-active) + (remove-hook 'erc-server-001-functions 'erc-user-is-active) + (remove-hook 'erc-timer-hook 'erc-user-is-active)) (remove-hook 'window-configuration-change-hook - #'erc-window-configuration-change) - (remove-hook 'erc-disconnected-hook #'erc-modified-channels-update) - (remove-hook 'erc-insert-post-hook #'erc-track-modified-channels)) + 'erc-window-configuration-change) + (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) + (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) ;; disable the tracking keybindings (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) (when erc-track-minor-mode diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0b0cc044e91..f5c9decc3a2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5453,7 +5453,7 @@ This returns non-nil only if we actually send anything." ;; obsolete, and when it's finally removed, this binding should ;; also be removed. (with-suppressed-warnings ((lexical str)) - (defvar str)) ;FIXME: Obey the "erc-" prefix convention. + (defvar str)) (let ((str input) (erc-insert-this t) (erc-send-this t) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 96e95365f5f..fe8eb35d366 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -306,7 +306,8 @@ Prepend remote identification of `default-directory', if any." (setq m (cdr m)))) l) (define-obsolete-function-alias - 'eshell-uniqify-list #'eshell-uniquify-list "27.1") + 'eshell-uniqify-list + 'eshell-uniquify-list "27.1") (defun eshell-stringify (object) "Convert OBJECT into a string value." @@ -325,11 +326,11 @@ Prepend remote identification of `default-directory', if any." (defsubst eshell-stringify-list (args) "Convert each element of ARGS into a string value." - (mapcar #'eshell-stringify args)) + (mapcar 'eshell-stringify args)) (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat #'eshell-stringify (flatten-tree args) " ")) + (mapconcat 'eshell-stringify (flatten-tree args) " ")) (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." @@ -525,7 +526,7 @@ Unless optional argument INPLACE is non-nil, return a new string." (defsubst eshell-copy-environment () "Return an unrelated copy of `process-environment'." - (mapcar #'concat process-environment)) + (mapcar 'concat process-environment)) (defun eshell-subgroups (groupsym) "Return all of the subgroups of GROUPSYM." diff --git a/lisp/follow.el b/lisp/follow.el index e570fffdf58..acc2b26c550 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -117,7 +117,7 @@ ;; `follow-mode'. ;; ;; Example: -;; (add-hook 'follow-mode-hook #'my-follow-mode-hook) +;; (add-hook 'follow-mode-hook 'my-follow-mode-hook) ;; ;; (defun my-follow-mode-hook () ;; (define-key follow-mode-map "\C-ca" 'your-favorite-function) @@ -307,8 +307,8 @@ are \" Fw\", or simply \"\"." :group 'follow :set (lambda (symbol value) (if value - (add-hook 'find-file-hook #'follow-find-file-hook t) - (remove-hook 'find-file-hook #'follow-find-file-hook)) + (add-hook 'find-file-hook 'follow-find-file-hook t) + (remove-hook 'find-file-hook 'follow-find-file-hook)) (set-default symbol value))) (defcustom follow-hide-ghost-cursors t ; Maybe this should be nil. @@ -370,7 +370,7 @@ This is typically set by explicit scrolling commands.") (defsubst follow-debug-message (&rest args) "Like `message', but only active when `follow-debug' is non-nil." (if (and (boundp 'follow-debug) follow-debug) - (apply #'message args))) + (apply 'message args))) ;;; Cache @@ -428,28 +428,27 @@ Keys specific to Follow mode: :keymap follow-mode-map (if follow-mode (progn - (add-hook 'compilation-filter-hook - #'follow-align-compilation-windows t t) - (add-function :before pre-redisplay-function #'follow-pre-redisplay-function) - (add-hook 'window-size-change-functions #'follow-window-size-change t) - (add-hook 'after-change-functions #'follow-after-change nil t) - (add-hook 'isearch-update-post-hook #'follow-post-command-hook nil t) - (add-hook 'replace-update-post-hook #'follow-post-command-hook nil t) - (add-hook 'ispell-update-post-hook #'follow-post-command-hook nil t) + (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t) + (add-function :before pre-redisplay-function 'follow-pre-redisplay-function) + (add-hook 'window-size-change-functions 'follow-window-size-change t) + (add-hook 'after-change-functions 'follow-after-change nil t) + (add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t) + (add-hook 'replace-update-post-hook 'follow-post-command-hook nil t) + (add-hook 'ispell-update-post-hook 'follow-post-command-hook nil t) (when isearch-lazy-highlight (setq-local isearch-lazy-highlight 'all-windows)) (when follow-hide-ghost-cursors (setq-local cursor-in-non-selected-windows nil)) - (setq window-group-start-function #'follow-window-start) - (setq window-group-end-function #'follow-window-end) - (setq set-window-group-start-function #'follow-set-window-start) - (setq recenter-window-group-function #'follow-recenter) + (setq window-group-start-function 'follow-window-start) + (setq window-group-end-function 'follow-window-end) + (setq set-window-group-start-function 'follow-set-window-start) + (setq recenter-window-group-function 'follow-recenter) (setq pos-visible-in-window-group-p-function - #'follow-pos-visible-in-window-p) - (setq selected-window-group-function #'follow-all-followers) - (setq move-to-window-group-line-function #'follow-move-to-window-line)) + 'follow-pos-visible-in-window-p) + (setq selected-window-group-function 'follow-all-followers) + (setq move-to-window-group-line-function 'follow-move-to-window-line)) ;; Remove globally-installed hook functions only if there is no ;; other Follow mode buffer. @@ -459,8 +458,8 @@ Keys specific to Follow mode: (setq following (buffer-local-value 'follow-mode (car buffers)) buffers (cdr buffers))) (unless following - (remove-function pre-redisplay-function #'follow-pre-redisplay-function) - (remove-hook 'window-size-change-functions #'follow-window-size-change))) + (remove-function pre-redisplay-function 'follow-pre-redisplay-function) + (remove-hook 'window-size-change-functions 'follow-window-size-change))) (kill-local-variable 'move-to-window-group-line-function) (kill-local-variable 'selected-window-group-function) @@ -472,11 +471,11 @@ Keys specific to Follow mode: (kill-local-variable 'cursor-in-non-selected-windows) - (remove-hook 'ispell-update-post-hook #'follow-post-command-hook t) - (remove-hook 'replace-update-post-hook #'follow-post-command-hook t) - (remove-hook 'isearch-update-post-hook #'follow-post-command-hook t) - (remove-hook 'after-change-functions #'follow-after-change t) - (remove-hook 'compilation-filter-hook #'follow-align-compilation-windows t))) + (remove-hook 'ispell-update-post-hook 'follow-post-command-hook t) + (remove-hook 'replace-update-post-hook 'follow-post-command-hook t) + (remove-hook 'isearch-update-post-hook 'follow-post-command-hook t) + (remove-hook 'after-change-functions 'follow-after-change t) + (remove-hook 'compilation-filter-hook 'follow-align-compilation-windows t))) (defun follow-find-file-hook () "Find-file hook for Follow mode. See the variable `follow-auto'." @@ -1052,16 +1051,16 @@ returned by `follow-windows-start-end'." (defun follow-select-if-visible (dest win-start-end) "Select and return a window, if DEST is visible in it. Return the selected window." - (let (win) + (let (win wse) (while (and (not win) win-start-end) ;; Don't select a window that was just moved. This makes it ;; possible to later select the last window after a ;; `end-of-buffer' command. - (let ((wse (car win-start-end))) - (when (follow-pos-visible dest (car wse) win-start-end) - (setq win (car wse)) - (select-window win)) - (setq win-start-end (cdr win-start-end)))) + (setq wse (car win-start-end)) + (when (follow-pos-visible dest (car wse) win-start-end) + (setq win (car wse)) + (select-window win)) + (setq win-start-end (cdr win-start-end))) win)) ;; Lets select a window showing the end. Make sure we only select it if @@ -1218,29 +1217,29 @@ should be a member of WINDOWS, starts at position START." (setq win (or win (selected-window))) (setq start (or start (window-start win))) (save-excursion - ;; Always calculate what happens when no line is displayed in the first - ;; window. (The `previous' res is needed below!) - (goto-char guess) - (vertical-motion 0 (car windows)) - (let ((res (point)) - done) + (let (done win-start res opoint) + ;; Always calculate what happens when no line is displayed in the first + ;; window. (The `previous' res is needed below!) + (goto-char guess) + (vertical-motion 0 (car windows)) + (setq res (point)) (while (not done) - (let ((opoint (point))) - (if (not (= (vertical-motion -1 (car windows)) -1)) - ;; Hit roof! - (setq done t res (point-min)) - (let ((win-start (follow-calc-win-start windows (point) win))) - (cond ((>= (point) opoint) - ;; In some pathological cases, vertical-motion may - ;; return -1 even though point has not decreased. In - ;; that case, avoid looping forever. - (setq done t res (point))) - ((= win-start start) ; Perfect match, use this value - (setq done t res (point))) - ((< win-start start) ; Walked to far, use previous result - (setq done t)) - (t ; Store result for next iteration - (setq res (point)))))))) + (setq opoint (point)) + (if (not (= (vertical-motion -1 (car windows)) -1)) + ;; Hit roof! + (setq done t res (point-min)) + (setq win-start (follow-calc-win-start windows (point) win)) + (cond ((>= (point) opoint) + ;; In some pathological cases, vertical-motion may + ;; return -1 even though point has not decreased. In + ;; that case, avoid looping forever. + (setq done t res (point))) + ((= win-start start) ; Perfect match, use this value + (setq done t res (point))) + ((< win-start start) ; Walked to far, use previous result + (setq done t)) + (t ; Store result for next iteration + (setq res (point)))))) res))) ;;; Avoid tail recenter @@ -1317,8 +1316,6 @@ follow-mode is not necessarily enabled in this buffer.") ;; Work in the selected window, not in the current buffer. (with-current-buffer (window-buffer win) (unless (and (symbolp this-command) - ;; FIXME: Why not compare buffer-modified-tick and - ;; selected-window to their old value, instead? (get this-command 'follow-mode-use-cache)) (setq follow-windows-start-end-cache nil)) (follow-adjust-window win))))) @@ -1326,7 +1323,7 @@ follow-mode is not necessarily enabled in this buffer.") ;; NOTE: to debug follow-mode with edebug, it is helpful to add ;; `follow-post-command-hook' to `post-command-hook' temporarily. Do ;; this locally to the target buffer with, say,: -;; M-: (add-hook 'post-command-hook #'follow-post-command-hook t t) +;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t) ;; . (defun follow-adjust-window (win) @@ -1514,12 +1511,15 @@ follow-mode is not necessarily enabled in this buffer.") "Make a highlighted region stretching multiple windows look good." (let* ((all (follow-split-followers windows win)) (pred (car all)) - (succ (cdr all))) - (dolist (w pred) - (let ((data (assq w win-start-end))) - (set-window-point w (max (nth 1 data) (- (nth 2 data) 1))))) - (dolist (w succ) - (set-window-point w (nth 1 (assq w win-start-end)))))) + (succ (cdr all)) + data) + (while pred + (setq data (assq (car pred) win-start-end)) + (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1))) + (setq pred (cdr pred))) + (while succ + (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end))) + (setq succ (cdr succ))))) ;;; Scroll bar @@ -1616,7 +1616,7 @@ follow-mode is not necessarily enabled in this buffer.") (select-window picked-window 'norecord))) (select-frame orig-frame))))) -(add-hook 'window-scroll-functions #'follow-avoid-tail-recenter t) +(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t) ;;; Low level window start and end. @@ -1690,8 +1690,9 @@ of the actual window containing it. The remaining elements are omitted if the character after POS is fully visible; otherwise, RTOP and RBOT are the number of pixels off-window at the top and bottom of the screen line (\"row\") containing POS, ROWH is the visible height -of that row, and VPOS is the row number (zero-based)." - (let* ((windows (follow-all-followers window))) +of that row, and VPOS is the row number \(zero-based)." + (let* ((windows (follow-all-followers window)) + (last (car (last windows)))) (when follow-start-end-invalid (follow-redisplay windows (car windows))) (let* ((cache (follow-windows-start-end windows)) @@ -1702,9 +1703,10 @@ of that row, and VPOS is the row number (zero-based)." last-elt (setq our-pos (or pos (point))) (catch 'element - (dolist (ce cache) - (when (< our-pos (nth 2 ce)) - (throw 'element ce))) + (while cache + (when (< our-pos (nth 2 (car cache))) + (throw 'element (car cache))) + (setq cache (cdr cache))) last-elt))) (pos-visible-in-window-p our-pos (car pertinent-elt) partially)))) @@ -1718,7 +1720,7 @@ zero means top of the first window in the group, negative means (start-end (follow-windows-start-end windows)) (rev-start-end (reverse start-end)) (lines 0) - elt count) + middle-window elt count) (select-window (cond ((null arg) diff --git a/lisp/format-spec.el b/lisp/format-spec.el index e290a2727d5..4455c594286 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -1,4 +1,4 @@ -;;; format-spec.el --- functions for formatting arbitrary formatting strings -*- lexical-binding:t -*- +;;; format-spec.el --- functions for formatting arbitrary formatting strings ;; Copyright (C) 1999-2019 Free Software Foundation, Inc. diff --git a/lisp/frame.el b/lisp/frame.el index 87bf058f7fb..9402c15a56b 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -26,7 +26,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(eval-when-compile (require 'subr-x)) ;For string-trim-right (cl-defgeneric frame-creation-function (params) "Method for window-system dependent functions to create a new frame. @@ -2502,34 +2501,14 @@ command starts, by installing a pre-command hook." (when (and (> blink-cursor-blinks 0) (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) (blink-cursor-suspend) - (add-hook 'post-command-hook #'blink-cursor-check)) - ;; FIXME: Under TTYs, apparently redisplay only obeys internal-show-cursor - ;; when there is something else to update on the screen. This is arguably - ;; a bug, but in the meantime we can circumvent it here by causing an - ;; artificial update which thus "forces" a cursor update. - (when (null window-system) - (let* ((message-log-max nil) - (msg (current-message)) - ;; Construct a dummy temp message different from the current one. - ;; This message usually flashes by too quickly to be visible, but - ;; occasionally it can be noticed, so make it "inconspicuous". - ;; Not too "inconspicuous", tho: just adding or removing a SPC at the - ;; end doesn't cause an update, for example. - (dummymsg (concat (if (> (length msg) 40) - (let ((msg (string-trim-right msg))) - (if (> (length msg) 2) - (substring msg 0 -2) - msg)) - msg) "-"))) - (message "%s" dummymsg) - (if msg (message "%s" msg) (message nil))))) + (add-hook 'post-command-hook 'blink-cursor-check))) (defun blink-cursor-end () "Stop cursor blinking. This is installed as a pre-command hook by `blink-cursor-start'. When run, it cancels the timer `blink-cursor-timer' and removes itself as a pre-command hook." - (remove-hook 'pre-command-hook #'blink-cursor-end) + (remove-hook 'pre-command-hook 'blink-cursor-end) (internal-show-cursor nil t) (when blink-cursor-timer (cancel-timer blink-cursor-timer) @@ -2548,7 +2527,15 @@ frame receives focus." (defun blink-cursor--should-blink () "Determine whether we should be blinking. Returns whether we have any focused non-TTY frame." - blink-cursor-mode) + (and blink-cursor-mode + (let ((frame-list (frame-list)) + (any-graphical-focused nil)) + (while frame-list + (let ((frame (pop frame-list))) + (when (and (display-graphic-p frame) (frame-focus-state frame)) + (setf any-graphical-focused t) + (setf frame-list nil)))) + any-graphical-focused))) (defun blink-cursor-check () "Check if cursor blinking shall be restarted. @@ -2557,7 +2544,7 @@ stopped by `blink-cursor-suspend'. Internally calls `blink-cursor--should-blink' and returns its result." (let ((should-blink (blink-cursor--should-blink))) (when (and should-blink (not blink-cursor-idle-timer)) - (remove-hook 'post-command-hook #'blink-cursor-check) + (remove-hook 'post-command-hook 'blink-cursor-check) (blink-cursor--start-idle-timer)) should-blink)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 6b5a21eaf55..d826faca5bd 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1615,7 +1615,7 @@ It is a string, such as \"PGP\". If nil, ask user." :group 'gnus-article :type 'boolean) -(defcustom gnus-blocked-images #'gnus-block-private-groups +(defcustom gnus-blocked-images 'gnus-block-private-groups "Images that have URLs matching this regexp will be blocked. Note that the main reason external images are included in HTML emails (these days) is to allow tracking whether you've read the @@ -2693,7 +2693,7 @@ If READ-CHARSET, ask for a coding system." "Format an HTML article." (interactive) (let ((handles nil) - (inhibit-read-only t)) + (buffer-read-only nil)) (when (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (setq handles (mm-dissect-buffer t t)))) @@ -4302,67 +4302,71 @@ If variable `gnus-use-long-file-name' is non-nil, it is (canlock-verify gnus-original-article-buffer))) (eval-and-compile - (defmacro gnus-art-defun (gnus-fun &optional article-fun) - "Define GNUS-FUN as a function that runs ARTICLE-FUN in the article buffer." - (unless article-fun - (if (not (string-match "\\`gnus-" (symbol-name gnus-fun))) - (error "Can't guess article-fun argument") - (setq article-fun (intern (substring (symbol-name gnus-fun) - (match-end 0)))))) - `(defun ,gnus-fun (&optional interactive &rest args) - ,(format "Run `%s' in the article buffer." article-fun) - (interactive (list t)) - (with-current-buffer gnus-article-buffer - (if interactive - (call-interactively ',article-fun) - (apply #',article-fun args)))))) -(gnus-art-defun gnus-article-hide-headers) -(gnus-art-defun gnus-article-verify-x-pgp-sig) -(gnus-art-defun gnus-article-verify-cancel-lock) -(gnus-art-defun gnus-article-hide-boring-headers) -(gnus-art-defun gnus-article-treat-overstrike) -(gnus-art-defun gnus-article-treat-ansi-sequences) -(gnus-art-defun gnus-article-fill-long-lines) -(gnus-art-defun gnus-article-capitalize-sentences) -(gnus-art-defun gnus-article-remove-cr) -(gnus-art-defun gnus-article-remove-leading-whitespace) -(gnus-art-defun gnus-article-display-x-face) -(gnus-art-defun gnus-article-display-face) -(gnus-art-defun gnus-article-de-quoted-unreadable) -(gnus-art-defun gnus-article-de-base64-unreadable) -(gnus-art-defun gnus-article-decode-HZ) -(gnus-art-defun gnus-article-wash-html) -(gnus-art-defun gnus-article-unsplit-urls) -(gnus-art-defun gnus-article-hide-list-identifiers) -(gnus-art-defun gnus-article-strip-banner) -(gnus-art-defun gnus-article-babel) -(gnus-art-defun gnus-article-hide-pem) -(gnus-art-defun gnus-article-hide-signature) -(gnus-art-defun gnus-article-strip-headers-in-body) -(gnus-art-defun gnus-article-remove-trailing-blank-lines) -(gnus-art-defun gnus-article-strip-leading-blank-lines) -(gnus-art-defun gnus-article-strip-multiple-blank-lines) -(gnus-art-defun gnus-article-strip-leading-space) -(gnus-art-defun gnus-article-strip-trailing-space) -(gnus-art-defun gnus-article-strip-blank-lines) -(gnus-art-defun gnus-article-strip-all-blank-lines) -(gnus-art-defun gnus-article-date-local) -(gnus-art-defun gnus-article-date-english) -(gnus-art-defun gnus-article-date-iso8601) -(gnus-art-defun gnus-article-date-original) -(gnus-art-defun gnus-article-treat-date) -(gnus-art-defun gnus-article-date-ut) -(gnus-art-defun gnus-article-decode-mime-words) -(gnus-art-defun gnus-article-decode-charset) -(gnus-art-defun gnus-article-decode-encoded-words) -(gnus-art-defun gnus-article-date-user) -(gnus-art-defun gnus-article-date-lapsed) -(gnus-art-defun gnus-article-date-combined-lapsed) -(gnus-art-defun gnus-article-emphasize) -(gnus-art-defun gnus-article-treat-dumbquotes) -(gnus-art-defun gnus-article-treat-non-ascii) -(gnus-art-defun gnus-article-normalize-headers) -;;(gnus-art-defun gnus-article-show-all-headers article-show-all) + (mapc + (lambda (func) + (let (afunc gfunc) + (if (consp func) + (setq afunc (car func) + gfunc (cdr func)) + (setq afunc func + gfunc (intern (format "gnus-%s" func)))) + (defalias gfunc + (when (fboundp afunc) + `(lambda (&optional interactive &rest args) + ,(documentation afunc t) + (interactive (list t)) + (with-current-buffer gnus-article-buffer + (if interactive + (call-interactively ',afunc) + (apply #',afunc args)))))))) + '(article-hide-headers + article-verify-x-pgp-sig + article-verify-cancel-lock + article-hide-boring-headers + article-treat-overstrike + article-treat-ansi-sequences + article-fill-long-lines + article-capitalize-sentences + article-remove-cr + article-remove-leading-whitespace + article-display-x-face + article-display-face + article-de-quoted-unreadable + article-de-base64-unreadable + article-decode-HZ + article-wash-html + article-unsplit-urls + article-hide-list-identifiers + article-strip-banner + article-babel + article-hide-pem + article-hide-signature + article-strip-headers-in-body + article-remove-trailing-blank-lines + article-strip-leading-blank-lines + article-strip-multiple-blank-lines + article-strip-leading-space + article-strip-trailing-space + article-strip-blank-lines + article-strip-all-blank-lines + article-date-local + article-date-english + article-date-iso8601 + article-date-original + article-treat-date + article-date-ut + article-decode-mime-words + article-decode-charset + article-decode-encoded-words + article-date-user + article-date-lapsed + article-date-combined-lapsed + article-emphasize + article-treat-dumbquotes + article-treat-non-ascii + article-normalize-headers + ;;(article-show-all . gnus-article-show-all-headers) + ))) ;;; ;;; Gnus article mode @@ -4865,19 +4869,18 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'gnus-article-push-button) + (define-key map [down-mouse-3] 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) (define-key map (cadr c) (car c))) - - (easy-menu-define gnus-mime-button-menu map "MIME button menu." - `("MIME Part" - ,@(mapcar (lambda (c) - (vector (caddr c) (car c) :active t)) - gnus-mime-button-commands))) - - (define-key map [down-mouse-3] - (easy-menu-binding gnus-mime-button-menu)) map)) +(easy-menu-define + gnus-mime-button-menu gnus-mime-button-map "MIME button menu." + `("MIME Part" + ,@(mapcar (lambda (c) + (vector (caddr c) (car c) :active t)) + gnus-mime-button-commands))) + (defvar gnus-url-button-commands '((gnus-article-copy-string "u" "Copy URL to kill ring"))) @@ -4920,6 +4923,16 @@ General format specifiers can also be used. See Info node (setq mm-w3m-safe-url-regexp nil))) ,@body)) +(defun gnus-mime-button-menu (event prefix) + "Construct a context-sensitive menu of MIME commands." + (interactive "e\nP") + (save-window-excursion + (let ((pos (event-start event))) + (select-window (posn-window pos)) + (goto-char (posn-point pos)) + (gnus-article-check-buffer) + (popup-menu gnus-mime-button-menu nil prefix)))) + (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." (interactive) @@ -5042,12 +5055,10 @@ and `gnus-mime-delete-part', and not provided at run-time normally." nil nil))) (gnus-mime-save-part-and-strip file)) -(defun gnus-mime-save-part-and-strip (&optional file event) +(defun gnus-mime-save-part-and-strip (&optional file) "Save the MIME part under point then replace it with an external body. If FILE is given, use it for the external part." - (interactive (list nil last-nonmenu-event)) - (save-excursion - (mouse-set-point event) + (interactive) (gnus-article-check-buffer) (when (gnus-group-read-only-p) (error "The current group does not support deleting of parts")) @@ -5079,16 +5090,15 @@ The current article has a complicated MIME structure, giving up...")) (access-type . "LOCAL-FILE") (name . ,file))))) ;; (set-buffer gnus-summary-buffer) - (gnus-article-edit-part handles id))))) + (gnus-article-edit-part handles id)))) ;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all ;; parts...>') but with stripping would be nice. -(defun gnus-mime-delete-part (&optional event) +(defun gnus-mime-delete-part () "Delete the MIME part under point. Replace it with some information about the removed part." - (interactive (list last-nonmenu-event)) - (mouse-set-point event) + (interactive) (gnus-article-check-buffer) (when (gnus-group-read-only-p) (error "The current group does not support deleting of parts")) @@ -5134,36 +5144,33 @@ Deleting parts may malfunction or destroy the article; continue? ")) ;; (set-buffer gnus-summary-buffer) (gnus-article-edit-part handles id)))) -(defun gnus-mime-save-part (&optional event) +(defun gnus-mime-save-part () "Save the MIME part under point." - (interactive (list last-nonmenu-event)) - (mouse-set-point event) + (interactive) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data (mm-save-part data)))) -(defun gnus-mime-pipe-part (&optional cmd event) - "Pipe the MIME part under point to a process." - (interactive (list nil last-nonmenu-event)) - (mouse-set-point event) +(defun gnus-mime-pipe-part (&optional cmd) + "Pipe the MIME part under point to a process. +Use CMD as the process." + (interactive) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data (mm-pipe-part data cmd)))) -(defun gnus-mime-view-part (&optional event) +(defun gnus-mime-view-part () "Interactively choose a viewing method for the MIME part under point." - (interactive (list last-nonmenu-event)) - (save-excursion - (mouse-set-point event) - (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data))) - (when data - (setq gnus-article-mime-handles - (mm-merge-handles - gnus-article-mime-handles (setq data (copy-sequence data)))) - (mm-interactively-view-part data))))) + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (when data + (setq gnus-article-mime-handles + (mm-merge-handles + gnus-article-mime-handles (setq data (copy-sequence data)))) + (mm-interactively-view-part data)))) (defun gnus-mime-view-part-as-type-internal () (gnus-article-check-buffer) @@ -5180,13 +5187,11 @@ Deleting parts may malfunction or destroy the article; continue? ")) '("text/plain" . 0)) '("application/octet-stream" . 0)))) -(defun gnus-mime-view-part-as-type (&optional mime-type pred event) +(defun gnus-mime-view-part-as-type (&optional mime-type pred) "Choose a MIME media type, and view the part as such. If non-nil, PRED is a predicate to use during completion to limit the available media-types." - (interactive (list nil nil last-nonmenu-event)) - (save-excursion - (if event (mouse-set-point event)) + (interactive) (unless mime-type (setq mime-type (let ((default (gnus-mime-view-part-as-type-internal))) @@ -5217,14 +5222,13 @@ available media-types." (mm-merge-handles gnus-article-mime-handles handle)) (when (mm-handle-displayed-p handle) (mm-remove-part handle)) - (gnus-mm-display-part handle))))) + (gnus-mm-display-part handle)))) -(defun gnus-mime-copy-part (&optional handle arg event) +(defun gnus-mime-copy-part (&optional handle arg) "Put the MIME part under point into a new buffer. If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg last-nonmenu-event)) - (mouse-set-point event) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (unless handle (setq handle (get-text-property (point) 'gnus-data))) @@ -5276,12 +5280,9 @@ are decompressed." (setq buffer-file-name nil)) (goto-char (point-min))))) -(defun gnus-mime-print-part (&optional handle filename event) +(defun gnus-mime-print-part (&optional handle filename) "Print the MIME part under point." - (interactive - (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)) - (save-excursion - (mouse-set-point event) + (interactive (list nil (ps-print-preprint current-prefix-arg))) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) @@ -5302,13 +5303,12 @@ are decompressed." (with-temp-buffer (insert contents) (gnus-print-buffer)) - (ps-despool filename)))))) + (ps-despool filename))))) -(defun gnus-mime-inline-part (&optional handle arg event) +(defun gnus-mime-inline-part (&optional handle arg) "Insert the MIME part under point into the current buffer. Compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg last-nonmenu-event)) - (if event (mouse-set-point event)) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (let* ((inhibit-read-only t) (b (point)) @@ -5402,12 +5402,10 @@ CHARSET may either be a string or a symbol." (setcdr param charset) (setcdr type (cons (cons 'charset charset) (cdr type))))))) -(defun gnus-mime-view-part-as-charset (&optional handle arg event) +(defun gnus-mime-view-part-as-charset (&optional handle arg) "Insert the MIME part under point into the current buffer using the specified charset." - (interactive (list nil current-prefix-arg last-nonmenu-event)) - (save-excursion - (mouse-set-point event) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (let ((handle (or handle (get-text-property (point) 'gnus-data))) (fun (get-text-property (point) 'gnus-callback)) @@ -5441,13 +5439,11 @@ specified charset." (setcar (cddr form) (list 'quote (or (cadr (member preferred parts)) (car parts))))) - (funcall fun handle)))))) + (funcall fun handle))))) -(defun gnus-mime-view-part-externally (&optional handle event) +(defun gnus-mime-view-part-externally (&optional handle) "View the MIME part under point with an external viewer." - (interactive (list nil last-nonmenu-event)) - (save-excursion - (mouse-set-point event) + (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-inlined-types nil) @@ -5462,14 +5458,12 @@ specified charset." (gnus-mime-view-part-as-type nil (lambda (type) (stringp (mailcap-mime-info type)))) (when handle - (mm-display-part handle nil t)))))) + (mm-display-part handle nil t))))) -(defun gnus-mime-view-part-internally (&optional handle event) +(defun gnus-mime-view-part-internally (&optional handle) "View the MIME part under point with an internal viewer. If no internal viewer is available, use an external viewer." - (interactive (list nil last-nonmenu-event)) - (save-excursion - (mouse-set-point event) + (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (mm-inlined-types '(".*")) @@ -5483,7 +5477,7 @@ If no internal viewer is available, use an external viewer." (gnus-mime-view-part-as-type nil (lambda (type) (mm-inlinable-p handle type))) (when handle - (gnus-bind-mm-vars (mm-display-part handle nil t))))))) + (gnus-bind-mm-vars (mm-display-part handle nil t)))))) (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at (point)." @@ -5855,7 +5849,7 @@ all parts." (widget-convert-button 'link b e :mime-handle handle - :action #'gnus-widget-press-button + :action 'gnus-widget-press-button :button-keymap gnus-mime-button-map :help-echo (lambda (widget) @@ -6154,7 +6148,7 @@ If nil, don't show those extra buttons." article-type multipart rear-nonsticky t)) (widget-convert-button 'link from (point) - :action #'gnus-widget-press-button) + :action 'gnus-widget-press-button) ;; Do the handles (while (setq handle (pop handles)) (add-text-properties @@ -6178,7 +6172,7 @@ If nil, don't show those extra buttons." gnus-data ,handle rear-nonsticky t)) (widget-convert-button 'link from (point) - :action #'gnus-widget-press-button) + :action 'gnus-widget-press-button) (insert " ")) (insert "\n\n")) (when preferred @@ -7121,11 +7115,13 @@ If given a prefix, show the hidden text instead." (when (and do-update-line (or (numberp article) (stringp article))) - (with-current-buffer gnus-summary-buffer + (let ((buf (current-buffer))) + (set-buffer gnus-summary-buffer) (gnus-summary-update-article do-update-line sparse-header) (gnus-summary-goto-subject do-update-line nil t) (set-window-point (gnus-get-buffer-window (current-buffer) t) - (point))))))) + (point)) + (set-buffer buf)))))) (defun gnus-block-private-groups (group) "Allows images in newsgroups to be shown, blocks images in all @@ -7320,7 +7316,8 @@ groups." (gnus-article-mode) (set-window-configuration winconf) ;; Tippy-toe some to make sure that point remains where it was. - (with-current-buffer curbuf + (save-current-buffer + (set-buffer curbuf) (set-window-start (get-buffer-window (current-buffer)) window-start) (goto-char p)))) (gnus-summary-show-article))) @@ -7872,16 +7869,15 @@ call it with the value of the `gnus-data' text property." (when fun (funcall fun data)))) -(defun gnus-article-press-button (&optional event) +(defun gnus-article-press-button () "Check text at point for a callback function. If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." - (interactive (list last-nonmenu-event)) - (save-excursion - (mouse-set-point event) - (let ((fun (get-text-property (point) 'gnus-callback))) - (when fun - (funcall fun (get-text-property (point) 'gnus-data)))))) + (interactive) + (let ((data (get-text-property (point) 'gnus-data)) + (fun (get-text-property (point) 'gnus-callback))) + (when fun + (funcall fun data)))) (defun gnus-article-highlight (&optional force) "Highlight current article. @@ -8099,7 +8095,7 @@ url is put as the `gnus-button-url' overlay property on the button." (list 'mouse-face gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data)))) - (widget-convert-button 'link from to :action #'gnus-widget-press-button + (widget-convert-button 'link from to :action 'gnus-widget-press-button :help-echo (or text "Follow the link") :keymap gnus-url-button-map)) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 9ae28b1290e..485f815d9b9 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -1,4 +1,4 @@ -;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding:t -*- +;;; gnus-cloud.el --- storing and retrieving data via IMAP ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. @@ -52,12 +52,14 @@ Each element may be either a string or a property list. The latter should have a :directory element whose value is a string, and a :match element whose value is a regular expression to match against the basename of files in said directory." + :group 'gnus-cloud :type '(repeat (choice (string :tag "File") (plist :tag "Property list")))) (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) "Storage method for cloud data, defaults to EPG if that's available." :version "26.1" + :group 'gnus-cloud :type '(radio (const :tag "No encoding" nil) (const :tag "Base64" base64) (const :tag "Base64+gzip" base64-gzip) @@ -66,6 +68,7 @@ against the basename of files in said directory." (defcustom gnus-cloud-interactive t "Whether Gnus Cloud changes should be confirmed." :version "26.1" + :group 'gnus-cloud :type 'boolean) (defvar gnus-cloud-group-name "Emacs-Cloud") @@ -78,6 +81,7 @@ against the basename of files in said directory." "The IMAP select method used to store the cloud data. See also `gnus-server-set-cloud-method-server' for an easy interactive way to set this from the Server buffer." + :group 'gnus-cloud :type '(radio (const :tag "Not set" nil) (string :tag "A Gnus server name as a string"))) @@ -127,7 +131,8 @@ easy interactive way to set this from the Server buffer." (base64-encode-region (point-min) (point-max))) ((eq gnus-cloud-storage-method 'epg) - (let ((context (epg-make-context 'OpenPGP))) + (let ((context (epg-make-context 'OpenPGP)) + cipher) (setf (epg-context-armor context) t) (setf (epg-context-textmode context) t) (let ((data (epg-encrypt-string context @@ -348,7 +353,6 @@ Use old data if FORCE-OLDER is not nil." (group &optional previous method)) (defun gnus-cloud-ensure-cloud-group () - ;; FIXME: `method' is not used!? (let ((method (if (stringp gnus-cloud-method) (gnus-server-to-method gnus-cloud-method) gnus-cloud-method))) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 4d10e1170da..e2c728df8f4 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -644,14 +644,7 @@ articles in the topic and its subtopics." (add-text-properties (point) (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec - `((indentation . ,indentation) - (visible . ,visible) - (name . ,name) - (level . ,level) - (number-of-groups . ,number-of-groups) - (total-number-of-articles . ,total-number-of-articles) - (entries . ,entries)))) + (eval gnus-topic-line-format-spec)) (list 'gnus-topic name 'gnus-topic-level level 'gnus-topic-unread unread diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index fcd5ec621cc..31421cc7555 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -38,7 +38,7 @@ (require 'time-date) (require 'text-property-search) -(defcustom gnus-completing-read-function #'gnus-emacs-completing-read +(defcustom gnus-completing-read-function 'gnus-emacs-completing-read "Function use to do completing read." :version "24.1" :group 'gnus-meta @@ -87,7 +87,6 @@ This is a compatibility function for different Emacsen." (defmacro gnus-eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then return to the original window." - (declare (indent 1) (debug (form body))) (let ((tempvar (make-symbol "GnusStartBufferWindow")) (w (make-symbol "w")) (buf (make-symbol "buf"))) @@ -104,6 +103,9 @@ This is a compatibility function for different Emacsen." ,@forms) (select-window ,tempvar))))) +(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) +(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) + (defsubst gnus-goto-char (point) (and point (goto-char point))) @@ -300,24 +302,26 @@ Symbols are also allowed; their print names are used instead." (defmacro gnus-local-set-keys (&rest plist) "Set the keys in PLIST in the current keymap." - (declare (indent 1)) `(gnus-define-keys-1 (current-local-map) ',plist)) (defmacro gnus-define-keys (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) (defmacro gnus-define-keys-safe (keymap &rest plist) "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - (declare (indent 1)) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) +(put 'gnus-define-keys 'lisp-indent-function 1) +(put 'gnus-define-keys-safe 'lisp-indent-function 1) +(put 'gnus-local-set-keys 'lisp-indent-function 1) + (defmacro gnus-define-keymap (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - (declare (indent 1)) `(gnus-define-keys-1 ,keymap (quote ,plist))) +(put 'gnus-define-keymap 'lisp-indent-function 1) + (defun gnus-define-keys-1 (keymap plist &optional safe) (when (null keymap) (error "Can't set keys in a null keymap")) @@ -440,7 +444,7 @@ displayed in the echo area." `(let (str time) (cond ((eq gnus-add-timestamp-to-message 'log) (setq str (let (message-log-max) - (apply #'message ,format-string ,args))) + (apply 'message ,format-string ,args))) (when (and message-log-max (> message-log-max 0) (/= (length str) 0)) @@ -458,7 +462,7 @@ displayed in the echo area." (gnus-add-timestamp-to-message (if (or (and (null ,format-string) (null ,args)) (progn - (setq str (apply #'format ,format-string ,args)) + (setq str (apply 'format ,format-string ,args)) (zerop (length str)))) (prog1 (and ,format-string str) @@ -467,7 +471,7 @@ displayed in the echo area." (message "%s" (concat ,timestamp str)) str)) (t - (apply #'message ,format-string ,args))))))) + (apply 'message ,format-string ,args))))))) (defvar gnus-action-message-log nil) @@ -486,10 +490,9 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages inside loops." (if (<= level gnus-verbose) (let ((message - (apply (if gnus-add-timestamp-to-message - #'gnus-message-with-timestamp - #'message) - args))) + (if gnus-add-timestamp-to-message + (apply 'gnus-message-with-timestamp args) + (apply 'message args)))) (when (and (consp gnus-action-message-log) (<= level 3)) (push message gnus-action-message-log)) @@ -497,7 +500,7 @@ inside loops." ;; We have to do this format thingy here even if the result isn't ;; shown - the return value has to be the same as the return value ;; from `message'. - (apply #'format args))) + (apply 'format args))) (defun gnus-final-warning () (when (and (consp gnus-action-message-log) @@ -510,7 +513,7 @@ inside loops." "Beep an error if LEVEL is equal to or less than `gnus-verbose'. ARGS are passed to `message'." (when (<= (floor level) gnus-verbose) - (apply #'message args) + (apply 'message args) (ding) (let (duration) (when (and (floatp level) @@ -685,20 +688,18 @@ Lisp objects are loadable. Bind `print-quoted' and `print-readably' to t, and `print-escape-multibyte', `print-escape-newlines', `print-escape-nonascii', `print-length', `print-level' and `print-string-length' to nil." - `(progn - (defvar print-string-length) (defvar print-readably) - (let ((print-quoted t) - (print-readably t) - ;;print-circle - ;;print-continuous-numbering - print-escape-multibyte - print-escape-newlines - print-escape-nonascii - ;;print-gensym - print-length - print-level - print-string-length) - ,@forms))) + `(let ((print-quoted t) + (print-readably t) + ;;print-circle + ;;print-continuous-numbering + print-escape-multibyte + print-escape-newlines + print-escape-nonascii + ;;print-gensym + print-length + print-level + print-string-length) + ,@forms)) (defun gnus-prin1 (form) "Use `prin1' on FORM in the current buffer. @@ -851,10 +852,11 @@ the user are disabled, it is recommended that only the most minimal operations are performed by FORMS. If you wish to assign many complicated values atomically, compute the results into temporary variables and then do only the assignment atomically." - (declare (indent 0)) `(let ((inhibit-quit gnus-atomic-be-safe)) ,@forms)) +(put 'gnus-atomic-progn 'lisp-indent-function 0) + (defmacro gnus-atomic-progn-assign (protect &rest forms) "Evaluate FORMS, but ensure that the variables listed in PROTECT are not changed if anything in FORMS signals an error or otherwise @@ -864,7 +866,6 @@ It is safe to use gnus-atomic-progn-assign with long computations. Note that if any of the symbols in PROTECT were unbound, they will be set to nil on a successful assignment. In case of an error or other non-local exit, it will still be unbound." - (declare (indent 1)) ;;(debug (sexp body)) (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol (concat (symbol-name x) "-tmp")) @@ -877,8 +878,8 @@ non-local exit, it will still be unbound." ,(cadr x)))) temp-sym-map)) (sym-temp-let sym-temp-map) - (temp-sym-assign (apply #'append temp-sym-map)) - (sym-temp-assign (apply #'append sym-temp-map)) + (temp-sym-assign (apply 'append temp-sym-map)) + (sym-temp-assign (apply 'append sym-temp-map)) (result (make-symbol "result-tmp"))) `(let (,@temp-sym-let ,result) @@ -889,6 +890,9 @@ non-local exit, it will still be unbound." (setq ,@sym-temp-assign)) ,result))) +(put 'gnus-atomic-progn-assign 'lisp-indent-function 1) +;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) + (defmacro gnus-atomic-setq (&rest pairs) "Similar to setq, except that the real symbols are only assigned when there are no errors. And when the real symbols are assigned, they are @@ -1098,16 +1102,16 @@ ARG is passed to the first function." (defun gnus-run-hooks (&rest funcs) "Does the same as `run-hooks', but saves the current buffer." (save-current-buffer - (apply #'run-hooks funcs))) + (apply 'run-hooks funcs))) (defun gnus-run-hook-with-args (hook &rest args) "Does the same as `run-hook-with-args', but saves the current buffer." (save-current-buffer - (apply #'run-hook-with-args hook args))) + (apply 'run-hook-with-args hook args))) (defun gnus-run-mode-hooks (&rest funcs) "Run `run-mode-hooks', saving the current buffer." - (save-current-buffer (apply #'run-mode-hooks funcs))) + (save-current-buffer (apply 'run-mode-hooks funcs))) ;;; Various @@ -1190,7 +1194,6 @@ ARG is passed to the first function." ;; Fixme: Why not use `with-output-to-temp-buffer'? (defmacro gnus-with-output-to-file (file &rest body) - (declare (indent 1) (debug (form body))) (let ((buffer (make-symbol "output-buffer")) (size (make-symbol "output-buffer-size")) (leng (make-symbol "output-buffer-length")) @@ -1213,6 +1216,9 @@ ARG is passed to the first function." (write-region (substring ,buffer 0 ,leng) nil ,file ,append 'no-msg)))))) +(put 'gnus-with-output-to-file 'lisp-indent-function 1) +(put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) + (defun gnus-add-text-properties-when (property value start end properties &optional object) "Like `add-text-properties', only applied on where PROPERTY is VALUE." @@ -1300,7 +1306,7 @@ sure of changing the value of `foo'." (setq gnus-info-buffer (current-buffer)) (gnus-configure-windows 'info))) -(defun gnus-not-ignore (&rest _) +(defun gnus-not-ignore (&rest args) t) (defvar gnus-directory-sep-char-regexp "/" @@ -1352,7 +1358,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', `(,spec elem)) ((listp spec) (if (memq (car spec) '(or and not)) - `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec))) + `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) (defun gnus-completing-read (prompt collection &optional require-match @@ -1391,8 +1397,6 @@ SPEC is a predicate specifier that contains stuff like `or', `and', ;; Make sure iswitchb is loaded before we let-bind its variables. ;; If it is loaded inside the let, variables can become unbound afterwards. (require 'iswitchb) - (declare-function iswitchb-minibuffer-setup "iswitchb" ()) - (defvar iswitchb-make-buflist-hook) (let ((iswitchb-make-buflist-hook (lambda () (setq iswitchb-temp-buflist @@ -1406,14 +1410,16 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (unwind-protect (progn (or iswitchb-mode - (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)) + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) (iswitchb-read-buffer prompt def require-match)) (or iswitchb-mode - (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))))) + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + +(put 'gnus-parse-without-error 'lisp-indent-function 0) +(put 'gnus-parse-without-error 'edebug-form-spec '(body)) (defmacro gnus-parse-without-error (&rest body) "Allow continuing onto the next line even if an error occurs." - (declare (indent 0) (debug (body))) `(while (not (eobp)) (condition-case () (progn @@ -1504,17 +1510,18 @@ Return nil otherwise." (defvar tool-bar-mode) -(defun gnus-tool-bar-update (&rest _) +(defun gnus-tool-bar-update (&rest ignore) "Update the tool bar." - (when (bound-and-true-p tool-bar-mode) + (when (and (boundp 'tool-bar-mode) + tool-bar-mode) (let* ((args nil) (func (cond ((fboundp 'tool-bar-update) - #'tool-bar-update) + 'tool-bar-update) ((fboundp 'force-window-update) - #'force-window-update) + 'force-window-update) ((fboundp 'redraw-frame) (setq args (list (selected-frame))) - #'redraw-frame) + 'redraw-frame) (t 'ignore)))) (apply func args)))) @@ -1529,7 +1536,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp (if seqs2_n (let* ((seqs (cons seq1 seqs2_n)) (cnt 0) - (heads (mapcar (lambda (_seq) + (heads (mapcar (lambda (seq) (make-symbol (concat "head" (int-to-string (setq cnt (1+ cnt)))))) @@ -1562,7 +1569,8 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp system-configuration) ((memq 'type lst) (symbol-name system-type)) - (t nil)))) + (t nil))) + codename) (cond ((not (memq 'emacs lst)) nil) @@ -1578,7 +1586,9 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp empty directories from OLD-PATH." (when (file-exists-p old-path) (let* ((old-dir (file-name-directory old-path)) + (old-name (file-name-nondirectory old-path)) (new-dir (file-name-directory new-path)) + (new-name (file-name-nondirectory new-path)) temp) (gnus-make-directory new-dir) (rename-file old-path new-path t) @@ -1683,7 +1693,7 @@ lists of strings." (setq props (plist-put props :foreground (face-foreground face))) (setq props (plist-put props :background (face-background face)))) (ignore-errors - (apply #'create-image file type data-p props)))) + (apply 'create-image file type data-p props)))) (defun gnus-put-image (glyph &optional string category) (let ((point (point))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 760bcc2293d..9e52abc1ca7 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1,4 +1,4 @@ -;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*- +;;; nnimap.el --- IMAP interface for Gnus ;; Copyright (C) 2010-2019 Free Software Foundation, Inc. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index baef5a789ae..39f701ae2a8 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -597,7 +597,7 @@ FILE is the file where FUNCTION was probably defined." ;; of the *packages* in which the function is defined. (let* ((name (symbol-name symbol)) (re (concat "\\_<" (regexp-quote name) "\\_>")) - (news (directory-files data-directory t "\\`NEWS")) + (news (directory-files data-directory t "\\`NEWS.[1-9]")) (place nil) (first nil)) (with-temp-buffer @@ -612,7 +612,7 @@ FILE is the file where FUNCTION was probably defined." ;; Almost all entries are of the form "* ... in Emacs NN.MM." ;; but there are also a few in the form "* Emacs NN.MM is a bug ;; fix release ...". - (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)" + (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)" nil t)) (message "Ref found in non-versioned section in %S" (file-name-nondirectory f)) @@ -621,7 +621,8 @@ FILE is the file where FUNCTION was probably defined." (setq place (list f pos)) (setq first version))))))))) (when first - (make-text-button first nil 'type 'help-news 'help-args place)))) + (make-text-button first nil 'type 'help-news 'help-args place)) + first)) (add-hook 'help-fns-describe-function-functions #'help-fns--mention-first-release) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 201efb7f2a7..f42b594dc46 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1537,7 +1537,7 @@ Return the input string." (quail-terminate-translation)) (defun quail-update-translation (control-flag) - "Update the current translation status according to CONTROL-FLAG. +"Update the current translation status according to CONTROL-FLAG. If CONTROL-FLAG is integer value, it is the number of keys in the head `quail-current-key' which can be translated. The remaining keys are put back to `unread-command-events' to be handled again. If diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 3f28144ed6a..9f603c0c710 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -109,7 +109,7 @@ folder. This is useful for folders that are easily regenerated." (let ((folder mh-current-folder) (window-config mh-previous-window-config)) (mh-set-folder-modified-p t) ; lock folder to kill it - (mh-exec-cmd-daemon "rmf" #'mh-rmf-daemon folder) + (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) (when (boundp 'mh-speed-folder-map) (mh-speed-invalidate-map folder)) (mh-remove-from-sub-folders-cache folder) @@ -123,7 +123,7 @@ folder. This is useful for folders that are easily regenerated." (message "Folder %s removed" folder)) (message "Folder not removed"))) -(defun mh-rmf-daemon (_process output) +(defun mh-rmf-daemon (process output) "The rmf PROCESS puts OUTPUT in temporary buffer. Display the results only if something went wrong." (set-buffer (get-buffer-create mh-temp-buffer)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0ec2b685d83..57702760fbc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1225,45 +1225,6 @@ scroll the window of possible completions." (if (eq (car bounds) base) md-at-point (completion-metadata (substring string 0 base) table pred)))) -(defun completion-score-sort (completions) - (sort completions - (lambda (x y) - (> (or (get-text-property 0 'completion-score x) 0) - (or (get-text-property 0 'completion-score y) 0))))) - -(defun completion-sort (all &optional prefer-regular table-sort-fun) - "Sort ALL, which is the list of all the completion strings we found. -If PREFER-REGULAR, then give a bit more importance to returning -an ordering that is easy to scan quickly (e.g. lexicographic) rather -then trying to minimize the expected position of the completion -actually desired. -TABLE-SORT-FUN is the sorting function specified by the completion table, -if applicable. -The sort is performed in a destructive way." - (cond - (table-sort-fun - ;; I feel like we should slowly deprecate table-sort-fun (probably - ;; replacing it with a way for the completion table to provide scores), - ;; so let's not try to be clever here. - (funcall table-sort-fun all)) - (t - ;; Prefer shorter completions, by default. - (if prefer-regular - (setq all (sort all #'string-lessp)) - (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2))))) - (if (minibufferp) - ;; Prefer recently used completions and put the default, if - ;; it exists, on top. - (let ((hist (symbol-value minibuffer-history-variable))) - (setq all (sort all - (lambda (c1 c2) - (cond ((equal c1 minibuffer-default) t) - ((equal c2 minibuffer-default) nil) - (t (> (length (member c1 hist)) - (length (member c2 hist))))))))))) - (setq all (completion-score-sort all)) - all))) - (defun completion-all-sorted-completions (&optional start end) (or completion-all-sorted-completions (let* ((start (or start (minibuffer-prompt-end))) @@ -1293,7 +1254,23 @@ The sort is performed in a destructive way." (setq all (delete-dups all)) (setq last (last all)) - (setq all (completion-sort all nil sort-fun)) + (cond + (sort-fun + (setq all (funcall sort-fun all))) + (t + ;; Prefer shorter completions, by default. + (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2))))) + (if (minibufferp) + ;; Prefer recently used completions and put the default, if + ;; it exists, on top. + (let ((hist (symbol-value minibuffer-history-variable))) + (setq all + (sort all + (lambda (c1 c2) + (cond ((equal c1 minibuffer-default) t) + ((equal c2 minibuffer-default) nil) + (t (> (length (member c1 hist)) + (length (member c2 hist)))))))))))) ;; Cache the result. This is not just for speed, but also so that ;; repeated calls to minibuffer-force-complete can cycle through ;; all possibilities. @@ -1910,7 +1887,9 @@ variables.") ;; not always. (let ((sort-fun (completion-metadata-get all-md 'display-sort-function))) - (completion-sort completions 'prefer-regular sort-fun))) + (if sort-fun + (funcall sort-fun completions) + (sort completions 'string-lessp)))) (when afun (setq completions (mapcar (lambda (s) @@ -2891,9 +2870,7 @@ Return the new suffix." 'point (substring afterpoint 0 (cdr bounds))))) (all (completion-pcm--all-completions prefix pattern table pred))) - (when all - (nconc (completion-pcm--hilit-commonality pattern all) - (car bounds))))) + (completion-hilit-commonality all point (car bounds)))) ;;; Partial-completion-mode style completion. @@ -3056,8 +3033,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'." (when (string-match-p regex c) (push c poss))) (nreverse poss)))))) -(defvar completion-score-match-tightness 100 - "Controls how the completion style scores its matches. +(defvar flex-score-match-tightness 100 + "Controls how the `flex' completion style scores its matches. Value is a positive number. Values smaller than one make the scoring formula value matches scattered along the string, while @@ -3102,7 +3079,7 @@ latter (which has two).") ;; For the numerator, we use the number of +, i.e. the ;; length of the pattern. For the denominator, it ;; sums (1+ (/ (grouplen - 1) - ;; completion-score-match-tightness)) across all groups of + ;; flex-score-match-tightness)) across all groups of ;; -, sums one to that total, and then multiples by ;; the length of the string. (score-numerator 0) @@ -3118,7 +3095,7 @@ latter (which has two).") score-denominator (+ score-denominator 1 (/ (- a last-b 1) - completion-score-match-tightness + flex-score-match-tightness 1.0)))) (setq last-b b)))) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 7beb61bb643..75fc7d62211 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -1,4 +1,4 @@ -;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding:t -*- +;;; ldap.el --- client interface to LDAP for Emacs ;; Copyright (C) 1998-2019 Free Software Foundation, Inc. @@ -419,12 +419,12 @@ RFC2798 Section 9.1.1") (encode-coding-string str ldap-coding-system)) (defun ldap-decode-address (str) - (mapconcat #'ldap-decode-string + (mapconcat 'ldap-decode-string (split-string str "\\$") "\n")) (defun ldap-encode-address (str) - (mapconcat #'ldap-encode-string + (mapconcat 'ldap-encode-string (split-string str "\n") "$")) @@ -566,9 +566,9 @@ its distinguished name DN. The function returns a list of matching entries. Each entry is itself an alist of attribute/value pairs." (let* ((buf (get-buffer-create " *ldap-search*")) - (bufval (get-buffer-create " *ldap-value*")) - (host (or (plist-get search-plist 'host) - ldap-default-host)) + (bufval (get-buffer-create " *ldap-value*")) + (host (or (plist-get search-plist 'host) + ldap-default-host)) ;; find entries with port "ldap" that match the requested host if any (asfound (when (plist-get search-plist 'auth-source) (nth 0 (auth-source-search :host (or host t) @@ -592,60 +592,59 @@ an alist of attribute/value pairs." (base (or (plist-get search-plist 'base) (plist-get asfound :base) ldap-default-base)) - (filter (plist-get search-plist 'filter)) - (attributes (plist-get search-plist 'attributes)) - (attrsonly (plist-get search-plist 'attrsonly)) - (scope (plist-get search-plist 'scope)) - (auth (plist-get search-plist 'auth)) - (deref (plist-get search-plist 'deref)) - (timelimit (plist-get search-plist 'timelimit)) - (sizelimit (plist-get search-plist 'sizelimit)) - (withdn (plist-get search-plist 'withdn)) - (numres 0) - (arglist - (append - (if (and host - (not (equal "" host))) - (list (format - ;; Use -H if host is a new-style LDAP URI. - (if (string-match "\\`[a-zA-Z]+://" host) - "-H%s" - "-h%s") - host))) - (if (and attrsonly - (not (equal "" attrsonly))) - (list "-A")) - (if (and base - (not (equal "" base))) - (list (format "-b%s" base))) - (if (and scope - (not (equal "" scope))) - (list (format "-s%s" scope))) - (if (and binddn - (not (equal "" binddn))) - (list (format "-D%s" binddn))) - (if (and auth - (equal 'simple auth)) - (list "-x")) - ;; Allow passwd to be set to "", representing a blank password. - (if passwd - (list "-W")) - (if (and deref - (not (equal "" deref))) - (list (format "-a%s" deref))) - (if (and timelimit - (not (equal "" timelimit))) - (list (format "-l%s" timelimit))) - (if (and sizelimit - (not (equal "" sizelimit))) - (list (format "-z%s" sizelimit))))) - dn name value record result) + (filter (plist-get search-plist 'filter)) + (attributes (plist-get search-plist 'attributes)) + (attrsonly (plist-get search-plist 'attrsonly)) + (scope (plist-get search-plist 'scope)) + (auth (plist-get search-plist 'auth)) + (deref (plist-get search-plist 'deref)) + (timelimit (plist-get search-plist 'timelimit)) + (sizelimit (plist-get search-plist 'sizelimit)) + (withdn (plist-get search-plist 'withdn)) + (numres 0) + arglist dn name value record result proc) (if (or (null filter) (equal "" filter)) (error "No search filter")) (setq filter (cons filter attributes)) (with-current-buffer buf (erase-buffer) + (if (and host + (not (equal "" host))) + (setq arglist (nconc arglist + (list (format + ;; Use -H if host is a new-style LDAP URI. + (if (string-match "^[a-zA-Z]+://" host) + "-H%s" + "-h%s") + host))))) + (if (and attrsonly + (not (equal "" attrsonly))) + (setq arglist (nconc arglist (list "-A")))) + (if (and base + (not (equal "" base))) + (setq arglist (nconc arglist (list (format "-b%s" base))))) + (if (and scope + (not (equal "" scope))) + (setq arglist (nconc arglist (list (format "-s%s" scope))))) + (if (and binddn + (not (equal "" binddn))) + (setq arglist (nconc arglist (list (format "-D%s" binddn))))) + (if (and auth + (equal 'simple auth)) + (setq arglist (nconc arglist (list "-x")))) + ;; Allow passwd to be set to "", representing a blank password. + (if passwd + (setq arglist (nconc arglist (list "-W")))) + (if (and deref + (not (equal "" deref))) + (setq arglist (nconc arglist (list (format "-a%s" deref))))) + (if (and timelimit + (not (equal "" timelimit))) + (setq arglist (nconc arglist (list (format "-l%s" timelimit))))) + (if (and sizelimit + (not (equal "" sizelimit))) + (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) (if passwd ;; Leave process-connection-type at its default value. See ;; discussion in Bug#33050. @@ -673,7 +672,7 @@ an alist of attribute/value pairs." " bind distinguished name (binddn)")) (error "Failed ldapsearch invocation: %s \"%s\"" ldap-ldapsearch-prog - (mapconcat #'identity proc-args "\" \"")))))) + (mapconcat 'identity proc-args "\" \"")))))) (apply #'call-process ldap-ldapsearch-prog ;; Ignore stderr, which can corrupt results nil (list buf nil) nil diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 96a7b12c06e..24084c828e1 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1871,11 +1871,11 @@ This function does not alter the INPUT string." (setq global-mode-string (append global-mode-string '(rcirc-activity-string)))) (add-hook 'window-configuration-change-hook - #'rcirc-window-configuration-change)) + 'rcirc-window-configuration-change)) (setq global-mode-string (delete 'rcirc-activity-string global-mode-string)) (remove-hook 'window-configuration-change-hook - #'rcirc-window-configuration-change))) + 'rcirc-window-configuration-change))) (or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist) (setq minor-mode-alist diff --git a/lisp/newcomment.el b/lisp/newcomment.el index f4ca6e77b46..ac706b949ba 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -334,92 +334,6 @@ terminated by the end of line (i.e., `comment-end' is empty)." (const :tag "EOL-terminated" eol)) :group 'comment) -;;;; Setup syntax from "high-level" description of comment syntax - -;; This defines `comment-set-syntax' so a major mode can just call -;; this one function to setup the comment syntax both in the syntax-table -;; and in the various comment-* variables. - -(defvar comment--set-table - ;; We want to associate extra properties with syntax-table, but syntax-tables - ;; don't have "properties", so we use an eq-hash-table indexed by - ;; syntax-tables instead. - (make-hash-table :test #'eq)) - -(defun comment--set-comment-syntax (st comment-list) - "Set up comment functionality for generic mode." - (let ((chars nil) - (comstyles) - (comment-start nil)) - - ;; Go through all the comments. - (pcase-dolist (`(,start ,end . ,props) comment-list) - (let ((nested (if (plist-get props :nested) "n")) - (comstyle - ;; Reuse comstyles if necessary. - (or (cdr (assoc start comstyles)) - (cdr (assoc end comstyles)) - ;; Otherwise, use a style not yet in use. - (if (not (rassoc "" comstyles)) "") - (if (not (rassoc "b" comstyles)) "b") - "c"))) - (push (cons start comstyle) comstyles) - (push (cons end comstyle) comstyles) - - ;; Setup the syntax table. - (if (= (length start) 1) - (modify-syntax-entry (aref start 0) - (concat "< " comstyle nested) st) - (let ((c0 (aref start 0)) (c1 (aref start 1))) - ;; Store the relevant info but don't update yet. - (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) - (push (cons c1 (concat (cdr (assoc c1 chars)) - (concat "2" comstyle))) - chars))) - (if (= (length end) 1) - (modify-syntax-entry (aref end 0) - (concat "> " comstyle nested) st) - (let ((c0 (aref end 0)) (c1 (aref end 1))) - ;; Store the relevant info but don't update yet. - (push (cons c0 (concat (cdr (assoc c0 chars)) - (concat "3" comstyle))) - chars) - (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) - - ;; Process the chars that were part of a 2-char comment marker - (with-syntax-table st ;For `char-syntax'. - (dolist (cs (nreverse chars)) - (modify-syntax-entry (car cs) - (concat (char-to-string (char-syntax (car cs))) - " " (cdr cs)) - st))))) - -(defun comment--set-comment-vars (comment-list) - (when comment-list - (let ((first (car comment-list))) - (setq-local comment-start (car first)) - (setq-local comment-end - (let ((end (cadr first))) - (if (string-equal end "\n") "" end)))) - (unless comment-start-skip ;Don't override manual setup. - (setq-local comment-start-skip - (concat (regexp-opt (mapcar #'car comment-list)) - "+[ \t]*"))) - (unless comment-end-skip ;Don't override manual setup. - (setq-local comment-end-skip - (concat "[ \t]*" - (regexp-opt (mapcar #'cadr comment-list))))))) - -(defun comment-set-syntax (st comment-list) - (comment--set-comment-syntax st comment-list) - (setf (gethash st comment--set-table) comment-list)) - -(defun comment-get-syntax (&optional st) - (unless st (setq st (syntax-table))) - (or (gethash st comment--set-table) - (let ((parent (char-table-parent st))) - (when parent (comment-get-syntax parent))))) - ;;;; ;;;; Helpers ;;;; @@ -444,14 +358,11 @@ functions work correctly. Lisp callers of any other `comment-*' function should first call this function explicitly." (unless (and (not comment-start) noerror) (unless comment-start - (let ((comment-list (comment-get-syntax))) - (if comment-list - (comment--set-comment-vars comment-list) - (let ((cs (read-string "No comment syntax is defined. Use: "))) - (if (zerop (length cs)) - (error "No comment syntax defined") - (set (make-local-variable 'comment-start) cs) - (set (make-local-variable 'comment-start-skip) cs)))))) + (let ((cs (read-string "No comment syntax is defined. Use: "))) + (if (zerop (length cs)) + (error "No comment syntax defined") + (set (make-local-variable 'comment-start) cs) + (set (make-local-variable 'comment-start-skip) cs)))) ;; comment-use-syntax (when (eq comment-use-syntax 'undecided) (set (make-local-variable 'comment-use-syntax) diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el index e2bb8adfef5..798475bbc3d 100644 --- a/lisp/nxml/rng-uri.el +++ b/lisp/nxml/rng-uri.el @@ -83,11 +83,10 @@ Signal an error if URI is not a valid file URL." (cond ((not scheme) (unless pattern (rng-uri-error "URI `%s' does not have a scheme" uri))) - ((not (member (downcase scheme) '("file" "http"))) - (rng-uri-error "URI `%s' does not use the `file:' or `http:' scheme" uri))) - (when (and (equal (downcase scheme) "file") - (not (member authority - (cons (system-name) '(nil "" "localhost"))))) + ((not (string= (downcase scheme) "file")) + (rng-uri-error "URI `%s' does not use the `file:' scheme" uri))) + (when (not (member authority + (cons (system-name) '(nil "" "localhost")))) (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'" uri)) (when query diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index c0bf29a3988..afa33e064f3 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -439,8 +439,7 @@ and VALUE-END, otherwise a STRING giving the value." (comment (xmltok+ (xmltok-g markup-declaration "!") (xmltok-g comment-first-dash "-" - (xmltok-g comment-open "-") opt) - opt)) + (xmltok-g comment-open "-") opt) opt)) (cdata-section (xmltok+ "!" (xmltok-g marked-section-open "\\[") @@ -541,9 +540,7 @@ and VALUE-END, otherwise a STRING giving the value." "%" (xmltok-g param-entity-ref ncname (xmltok-g param-entity-ref-close - ";") - opt) - opt)) + ";") opt) opt)) (starts-with-nmtoken-not-name (xmltok-g nmtoken (xmltok-p name-continue-not-start-char or ":") @@ -574,8 +571,7 @@ and VALUE-END, otherwise a STRING giving the value." "!" (xmltok-p (xmltok-g comment-first-dash "-" (xmltok-g comment-open "-") opt) or (xmltok-g named-markup-declaration - ncname)) - opt)) + ncname)) opt)) (after-lt (xmltok+ markup-declaration or (xmltok-g processing-instruction-question diff --git a/lisp/org/org.el b/lisp/org/org.el index 6f83d5a579d..5aa49b29d6f 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -7430,6 +7430,7 @@ a block. Return a non-nil value when toggling is successful." (org-defkey map [(right)] 'org-goto-right) (org-defkey map [(control ?g)] 'org-goto-quit) (org-defkey map "\C-i" 'org-cycle) + (org-defkey map [(tab)] 'org-cycle) (org-defkey map [(down)] 'outline-next-visible-heading) (org-defkey map [(up)] 'outline-previous-visible-heading) (if org-goto-auto-isearch @@ -12998,7 +12999,8 @@ Returns the new TODO keyword, or nil if no state change should occur." (and (= c ?q) (not (rassoc c fulltable)))) (setq quit-flag t)) ((= c ?\ ) nil) - ((car (rassoc c fulltable))) + ((setq e (rassoc c fulltable) tg (car e)) + tg) (t (setq quit-flag t))))))) (defun org-entry-is-todo-p () @@ -15211,11 +15213,11 @@ Returns the new tags string, or nil to not change the current settings." (setq current (delete tg current)) (push tg current))) (when exit-after-next (setq exit-after-next 'now))) - ((setq tg (car (rassoc c todo-table))) + ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion (org-todo tg))) (when exit-after-next (setq exit-after-next 'now))) - ((setq tg (car (rassoc c ntable))) + ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) (cl-loop for g in groups do @@ -17614,28 +17616,27 @@ D may be an absolute day number, or a calendar-type list (month day year)." (defun org-diary-sexp-entry (sexp entry d) "Process a SEXP diary ENTRY for date D." - ;; FIXME: Consolidate with diary-sexp-entry! (require 'diary-lib) ;; `org-anniversary' and alike expect ENTRY and DATE to be bound ;; dynamically. - (let* ((user-sexp (car (read-from-string sexp))) - (sexp `(let ((entry ,entry) (date ',d)) ,user-sexp)) + (let* ((sexp `(let ((entry ,entry) + (date ',d)) + ,(car (read-from-string sexp)))) (result (if calendar-debug-sexp (eval sexp) - (condition-case err + (condition-case nil (eval sexp) (error (beep) - (message "Bad sexp at line %d in %s: %S\nError: %S" + (message "Bad sexp at line %d in %s: %s" (org-current-line) - (buffer-file-name) user-sexp err) + (buffer-file-name) sexp) (sleep-for 2)))))) (cond ((stringp result) (split-string result "; ")) ((and (consp result) (not (consp (cdr result))) - (stringp (cdr result))) - (cdr result)) - ((and (consp result) (stringp (car result))) - result) + (stringp (cdr result))) (cdr result)) + ((and (consp result) + (stringp (car result))) result) (result entry)))) (defun org-diary-to-ical-string (frombuf) @@ -23286,7 +23287,7 @@ major mode." (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) (open-line 1)) (org-indent-line) - (insert comment-start))) + (insert "# "))) (defvar comment-empty-lines) ; From newcomment.el. (defun org-comment-or-uncomment-region (beg end &rest _) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 73fd9709211..401e5aa1da5 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -30,7 +30,7 @@ ;; To use pcomplete with shell-mode, for example, you will need the ;; following in your init file: ;; -;; (add-hook 'shell-mode-hook #'pcomplete-shell-setup) +;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup) ;; ;; Most of the code below simply provides support mechanisms for ;; writing completion functions. Completion functions themselves are @@ -129,26 +129,31 @@ (defcustom pcomplete-file-ignore nil "A regexp of filenames to be disregarded during file completion." - :type '(choice regexp (const :tag "None" nil))) + :type '(choice regexp (const :tag "None" nil)) + :group 'pcomplete) (defcustom pcomplete-dir-ignore nil "A regexp of names to be disregarded during directory completion." - :type '(choice regexp (const :tag "None" nil))) + :type '(choice regexp (const :tag "None" nil)) + :group 'pcomplete) (defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) ;; FIXME: the doc mentions file-name completion, but the code ;; seems to apply it to all completions. "If non-nil, ignore case when doing filename completion." - :type 'boolean) + :type 'boolean + :group 'pcomplete) (defcustom pcomplete-autolist nil "If non-nil, automatically list possibilities on partial completion. This mirrors the optional behavior of tcsh." - :type 'boolean) + :type 'boolean + :group 'pcomplete) (defcustom pcomplete-suffix-list (list ?/ ?:) "A list of characters which constitute a proper suffix." - :type '(repeat character)) + :type '(repeat character) + :group 'pcomplete) (make-obsolete-variable 'pcomplete-suffix-list nil "24.1") (defcustom pcomplete-recexact nil @@ -156,22 +161,25 @@ This mirrors the optional behavior of tcsh." This mirrors the optional behavior of tcsh. A non-nil value is useful if `pcomplete-autolist' is non-nil too." - :type 'boolean) + :type 'boolean + :group 'pcomplete) (define-obsolete-variable-alias 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") -(defcustom pcomplete-man-function #'man +(defcustom pcomplete-man-function 'man "A function to that will be called to display a manual page. It will be passed the name of the command to document." - :type 'function) + :type 'function + :group 'pcomplete) -(defcustom pcomplete-compare-entry-function #'string-lessp +(defcustom pcomplete-compare-entry-function 'string-lessp "This function is used to order file entries for completion. The behavior of most all shells is to sort alphabetically." :type '(radio (function-item string-lessp) (function-item file-newer-than-file-p) - (function :tag "Other"))) + (function :tag "Other")) + :group 'pcomplete) (defcustom pcomplete-help nil "A string or function (or nil) used for context-sensitive help. @@ -180,7 +188,8 @@ If non-nil, it must a sexp that will be evaluated, and whose result will be shown in the minibuffer. If nil, the function `pcomplete-man-function' will be called with the current command argument." - :type '(choice string sexp (const :tag "Use man page" nil))) + :type '(choice string sexp (const :tag "Use man page" nil)) + :group 'pcomplete) (defcustom pcomplete-expand-before-complete nil "If non-nil, expand the current argument before completing it. @@ -190,10 +199,11 @@ resolved first, and the resultant value that will be completed against to be inserted in the buffer. Note that exactly what gets expanded and how is entirely up to the behavior of the `pcomplete-parse-arguments-function'." - :type 'boolean) + :type 'boolean + :group 'pcomplete) (defcustom pcomplete-parse-arguments-function - #'pcomplete-parse-buffer-arguments + 'pcomplete-parse-buffer-arguments "A function to call to parse the current line's arguments. It should be called with no parameters, and with point at the position of the argument that is to be completed. @@ -208,7 +218,8 @@ representation of that argument), and BEG-POS gives the beginning position of each argument, as it is seen by the user. The establishes a relationship between the fully resolved value of the argument, and the textual representation of the argument." - :type 'function) + :type 'function + :group 'pcomplete) (defcustom pcomplete-cycle-completions t "If non-nil, hitting the TAB key cycles through the completion list. @@ -219,7 +230,8 @@ it acts more like zsh or 4nt, showing the first maximal match first, followed by any further matches on each subsequent pressing of the TAB key. \\[pcomplete-list] is the key to press if the user wants to see the list of possible completions." - :type 'boolean) + :type 'boolean + :group 'pcomplete) (defcustom pcomplete-cycle-cutoff-length 5 "If the number of completions is greater than this, don't cycle. @@ -234,7 +246,8 @@ has already entered enough input to disambiguate most of the possibilities, and therefore they are probably most interested in cycling through the candidates. Set this value to nil if you want cycling to always be enabled." - :type '(choice integer (const :tag "Always cycle" nil))) + :type '(choice integer (const :tag "Always cycle" nil)) + :group 'pcomplete) (defcustom pcomplete-restore-window-delay 1 "The number of seconds to wait before restoring completion windows. @@ -245,13 +258,15 @@ displayed will be restored), after this many seconds of idle time. If set to nil, completion windows will be left on second until the user removes them manually. If set to 0, they will disappear immediately after the user enters a key other than TAB." - :type '(choice integer (const :tag "Never restore" nil))) + :type '(choice integer (const :tag "Never restore" nil)) + :group 'pcomplete) (defcustom pcomplete-try-first-hook nil "A list of functions which are called before completing an argument. This can be used, for example, for completing things which might apply to all arguments, such as variable names after a $." - :type 'hook) + :type 'hook + :group 'pcomplete) (defsubst pcomplete-executables (&optional regexp) "Complete amongst a list of directories and executables." @@ -295,11 +310,13 @@ generate the completions list. This means that the hook (lambda () (pcomplete-here (pcomplete-executables)))) "Function called for completing the initial command argument." - :type 'function) + :type 'function + :group 'pcomplete) -(defcustom pcomplete-command-name-function #'pcomplete-command-name +(defcustom pcomplete-command-name-function 'pcomplete-command-name "Function called for determining the current command name." - :type 'function) + :type 'function + :group 'pcomplete) (defcustom pcomplete-default-completion-function (function @@ -307,14 +324,16 @@ generate the completions list. This means that the hook (while (pcomplete-here (pcomplete-entries))))) "Function called when no completion rule can be found. This function is used to generate completions for every argument." - :type 'function) + :type 'function + :group 'pcomplete) (defcustom pcomplete-use-paring t "If t, pare alternatives that have already been used. If nil, you will always see the completion set of possible options, no matter which of those options have already been used in previous command arguments." - :type 'boolean) + :type 'boolean + :group 'pcomplete) (defcustom pcomplete-termination-string " " "A string that is inserted after any completion or expansion. @@ -323,7 +342,8 @@ words separated by spaces. However, if your list uses a different separator character, or if the completion occurs in a word that is already terminated by a character, this variable should be locally modified to be an empty string, or the desired separation string." - :type 'string) + :type 'string + :group 'pcomplete) ;;; Internal Variables: @@ -439,7 +459,7 @@ Same as `pcomplete' but using the standard completion UI." ;; between pcomplete-stub and the buffer's text is simply due to ;; some chars removed by unquoting. Again, this is not ;; indispensable but reduces the reliance on c-t-subvert and - ;; improves corner case behaviors. See e.g. bug#34888. + ;; improves corner case behaviors. (while (progn (setq buftext (pcomplete-unquote-argument (buffer-substring beg (point)))) (and (> beg argbeg) @@ -481,10 +501,6 @@ Same as `pcomplete' but using the standard completion UI." (setq table (completion-table-case-fold table))) (list beg (point) table :predicate pred - ;; FIXME: This might be useful even if `completions' is nil! - :context-help-function - (let ((ph pcomplete-help)) ;;Preserve the current value. - (lambda () (let ((pcomplete-help ph)) (pcomplete--help)))) :exit-function ;; If completion is finished, add a terminating space. ;; We used to also do this if STATUS is `sole', but @@ -512,7 +528,6 @@ Same as `pcomplete' but using the standard completion UI." "Support extensible programmable completion. To use this function, just bind the TAB key to it, or add it to your completion functions list (it should occur fairly early in the list)." - (declare (obsolete "use `completion-at-point' with `pcomplete-completions-at-point' instead" "27.1")) (interactive "p") (if (and interactively pcomplete-cycle-completions @@ -555,7 +570,6 @@ completion functions list (it should occur fairly early in the list)." ;;;###autoload (defun pcomplete-reverse () "If cycling completion is in use, cycle backwards." - (declare (obsolete ?? "27.1")) (interactive) (call-interactively 'pcomplete)) @@ -563,7 +577,6 @@ completion functions list (it should occur fairly early in the list)." (defun pcomplete-expand-and-complete () "Expand the textual value of the current argument. This will modify the current buffer." - (declare (obsolete "use pcomplete-expand and completion-at-point" "27.1")) (interactive) (let ((pcomplete-expand-before-complete t)) (pcomplete))) @@ -571,8 +584,6 @@ This will modify the current buffer." ;;;###autoload (defun pcomplete-continue () "Complete without reference to any cycling completions." - ;; It doesn't seem to be used, so it's OK if we don't have a substitute. - (declare (obsolete nil "27.1")) (interactive) (setq pcomplete-current-completions nil pcomplete-last-completion-raw nil) @@ -583,41 +594,30 @@ This will modify the current buffer." "Expand the textual value of the current argument. This will modify the current buffer." (interactive) - (setq pcomplete-current-completions nil - pcomplete-last-completion-raw nil) - (catch 'pcompleted - (let* ((pcomplete-stub) - pcomplete-seen pcomplete-norm-func - pcomplete-args pcomplete-last pcomplete-index - (pcomplete-autolist pcomplete-autolist) - (pcomplete-suffix-list pcomplete-suffix-list) - (pcomplete-expand-only-p t)) - (pcomplete-parse-arguments 'expand-before-complete))) - ;; FIXME: What is this doing? - (when (and pcomplete-current-completions - (> (length pcomplete-current-completions) 0)) ;?? - (delete-char (- pcomplete-last-completion-length)) - (dolist (c (prog1 pcomplete-current-completions - (setq pcomplete-current-completions nil))) - (unless (pcomplete-insert-entry "" c t - pcomplete-last-completion-raw) - (insert-and-inherit pcomplete-termination-string))))) + (let ((pcomplete-expand-before-complete t) + (pcomplete-expand-only-p t)) + (pcomplete) + (when (and pcomplete-current-completions + (> (length pcomplete-current-completions) 0)) ;?? + (delete-char (- pcomplete-last-completion-length)) + (while pcomplete-current-completions + (unless (pcomplete-insert-entry + "" (car pcomplete-current-completions) t + pcomplete-last-completion-raw) + (insert-and-inherit pcomplete-termination-string)) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions)))))) ;;;###autoload (defun pcomplete-help () "Display any help information relative to the current argument." - (interactive) ;FIXME! - ;; (declare (obsolete ?? "27.1")) - (let* ((data (pcomplete-completions-at-point)) - (helpfun (plist-get (nthcdr 3 data) :context-help-function))) - (if helpfun - (funcall helpfun) - (message "No context-sensitive help available")))) + (interactive) + (let ((pcomplete-show-help t)) + (pcomplete))) ;;;###autoload (defun pcomplete-list () "Show the list of possible completions for the current argument." - (declare (obsolete completion-help-at-point "27.1")) (interactive) (when (and pcomplete-cycle-completions pcomplete-current-completions @@ -751,9 +751,9 @@ COMPLETEF-SYM should be the symbol where the dynamic-complete-functions are kept. For comint mode itself, this is `comint-dynamic-complete-functions'." (set (make-local-variable 'pcomplete-parse-arguments-function) - #'pcomplete-parse-comint-arguments) + 'pcomplete-parse-comint-arguments) (add-hook 'completion-at-point-functions - #'pcomplete-completions-at-point nil 'local) + 'pcomplete-completions-at-point nil 'local) (set (make-local-variable completef-sym) (copy-sequence (symbol-value completef-sym))) (let* ((funs (symbol-value completef-sym)) @@ -915,12 +915,12 @@ component, `default-directory' is used as the basis for completion." (or (eq action t) (eq (car-safe action) 'boundaries)))) (let ((newstring - (mapconcat #'identity (nreverse (cons string strings)) ""))) + (mapconcat 'identity (nreverse (cons string strings)) ""))) ;; FIXME: We could also try to return unexpanded envvars. (complete-with-action action table newstring pred)) (let* ((envpos (apply #'+ (mapcar #' length strings))) (newstring - (mapconcat #'identity (nreverse (cons string strings)) "")) + (mapconcat 'identity (nreverse (cons string strings)) "")) (bounds (completion-boundaries newstring table pred (or (cdr-safe action) "")))) (if (>= (car bounds) envpos) @@ -1181,12 +1181,12 @@ extra checking, and munging of the COMPLETIONS list." ;; pare it down, if applicable (when (and pcomplete-use-paring pcomplete-seen) (setq pcomplete-seen - (mapcar #'directory-file-name pcomplete-seen)) + (mapcar 'directory-file-name pcomplete-seen)) (dolist (p pcomplete-seen) (add-to-list 'pcomplete-seen (funcall pcomplete-norm-func p))) (setq completions - (apply-partially #'completion-table-with-predicate + (apply-partially 'completion-table-with-predicate completions (when pcomplete-seen (lambda (f) @@ -1262,21 +1262,20 @@ See also `pcomplete-filename'." (defun pcomplete--help () "Produce context-sensitive help for the current argument. If specific documentation can't be given, be generic." - (cond - ((functionp pcomplete-help) (funcall pcomplete-help)) - ((consp pcomplete-help) - (message "%s" (eval pcomplete-help t))) - ((and (stringp pcomplete-help) - (fboundp 'Info-goto-node)) - (save-window-excursion (info)) - (switch-to-buffer-other-window "*info*") - (Info-goto-node pcomplete-help)) - (t + (if (and pcomplete-help + (or (and (stringp pcomplete-help) + (fboundp 'Info-goto-node)) + (listp pcomplete-help))) + (if (listp pcomplete-help) + (message "%s" (eval pcomplete-help)) + (save-window-excursion (info)) + (switch-to-buffer-other-window "*info*") + (funcall (symbol-function 'Info-goto-node) pcomplete-help)) (if pcomplete-man-function (let ((cmd (funcall pcomplete-command-name-function))) (if (and cmd (> (length cmd) 0)) (funcall pcomplete-man-function cmd))) - (message "No context-sensitive help available"))))) + (message "No context-sensitive help available")))) ;; general utilities @@ -1293,12 +1292,12 @@ If specific documentation can't be given, be generic." l) (define-obsolete-function-alias 'pcomplete-uniqify-list - #'pcomplete-uniquify-list "27.1") + 'pcomplete-uniquify-list "27.1") (defun pcomplete-process-result (cmd &rest args) "Call CMD using `call-process' and return the simplest result." (with-temp-buffer - (apply #'call-process cmd nil t nil args) + (apply 'call-process cmd nil t nil args) (skip-chars-backward "\n") (buffer-substring (point-min) (point)))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 8d6cce690d1..5c18879712c 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -525,8 +525,6 @@ preferably use the `c-mode-menu' language constant directly." ;; and `after-change-functions'. Note that this variable is not set when ;; `c-before-change' is invoked by a change to text properties. -(defvar c--use-syntax-propertize t) - (defun c-basic-common-init (mode default-style) "Do the necessary initialization for the syntax handling routines and the line breaking/filling code. Intended to be used by other @@ -671,20 +669,15 @@ that requires a literal mode spec at compile time." ;; Install the functions that ensure that various internal caches ;; don't become invalid due to buffer changes. - (if c--use-syntax-propertize - (setq-local syntax-propertize-function - (lambda (start end) - (c-before-change start (point-max)) - (c-after-change start end (- end start)))) - (when (featurep 'xemacs) - (make-local-hook 'before-change-functions) - (make-local-hook 'after-change-functions)) - (add-hook 'before-change-functions 'c-before-change nil t) - (setq c-just-done-before-change nil) - ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10 - ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need - ;; c-after-font-lock-init. - (add-hook 'after-change-functions 'c-after-change nil t)) + (when (featurep 'xemacs) + (make-local-hook 'before-change-functions) + (make-local-hook 'after-change-functions)) + (add-hook 'before-change-functions 'c-before-change nil t) + (setq c-just-done-before-change nil) + ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10 + ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need + ;; c-after-font-lock-init. + (add-hook 'after-change-functions 'c-after-change nil t) (when (boundp 'font-lock-extend-after-change-region-function) (set (make-local-variable 'font-lock-extend-after-change-region-function) 'c-extend-after-change-region))) ; Currently (2009-05) used by all @@ -742,17 +735,15 @@ compatible with old code; callers should always specify it." (widen) (setq c-new-BEG (point-min)) (setq c-new-END (point-max)) - (unless c--use-syntax-propertize - (save-excursion - (let (before-change-functions after-change-functions) - (mapc (lambda (fn) - (funcall fn (point-min) (point-max))) - c-get-state-before-change-functions) - (mapc (lambda (fn) - (funcall fn (point-min) (point-max) - (- (point-max) (point-min)))) - c-before-font-lock-functions) - )))) + (save-excursion + (let (before-change-functions after-change-functions) + (mapc (lambda (fn) + (funcall fn (point-min) (point-max))) + c-get-state-before-change-functions) + (mapc (lambda (fn) + (funcall fn (point-min) (point-max) + (- (point-max) (point-min)))) + c-before-font-lock-functions)))) (set (make-local-variable 'outline-regexp) "[^#\n\^M]") (set (make-local-variable 'outline-level) 'c-outline-level) @@ -2059,12 +2050,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; ;; Type a space in the first blank line, and the fontification of the next ;; line was fouled up by context fontification. - (when c--use-syntax-propertize - ;; This should also update c-new-END and c-new-BEG. - (syntax-propertize end) - ;; FIXME: Apparently `c-new-END' may be left unchanged to a stale value, - ;; presumably when the buffer gets truncated. - (if (> c-new-END (point-max)) (setq c-new-END (point-max)))) (let (new-beg new-end new-region case-fold-search) (if (and c-in-after-change-fontification (< beg c-new-END) (> end c-new-BEG)) @@ -2103,8 +2088,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (defun c-after-font-lock-init () ;; Put on `font-lock-mode-hook'. This function ensures our after-change ;; function will get executed before the font-lock one. - (when (and c--use-syntax-propertize - (memq #'c-after-change after-change-functions)) + (when (memq #'c-after-change after-change-functions) (remove-hook 'after-change-functions #'c-after-change t) (add-hook 'after-change-functions #'c-after-change nil t))) @@ -2158,14 +2142,11 @@ This function is called from `c-common-init', once per mode initialization." (when (eq font-lock-support-mode 'jit-lock-mode) (save-restriction (widen) - ;; FIXME: This presumes that c-new-BEG and c-new-END have been set - ;; I guess from the before-change-function. (c-save-buffer-state () ; Protect the undo-list from put-text-property. (if (< c-new-BEG beg) (put-text-property c-new-BEG beg 'fontified nil)) (if (> c-new-END end) - (put-text-property end (min c-new-END (point-max)) - 'fontified nil))))) + (put-text-property end c-new-END 'fontified nil))))) (cons c-new-BEG c-new-END)) ;; Emacs < 22 and XEmacs diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d5ef37a4c02..254269ddf1a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -480,7 +480,8 @@ Older version of this page was called `perl5', newer `perl'." :type 'string :group 'cperl-help-system) -(defcustom cperl-use-syntax-table-text-property t +(defcustom cperl-use-syntax-table-text-property + (boundp 'parse-sexp-lookup-properties) "Non-nil means CPerl sets up and uses `syntax-table' text property." :type 'boolean :group 'cperl-speed) @@ -699,7 +700,55 @@ install choose-color.el, available from `fill-paragraph' on a comment may leave the point behind the paragraph. It also triggers a bug in some versions of Emacs (CPerl tries -to detect it and bulk out).") +to detect it and bulk out). + +See documentation of a variable `cperl-problems-old-emaxen' for the +problems which disappear if you upgrade Emacs to a reasonably new +version (20.3 for Emacs, and those of 2004 for XEmacs).") + +(defvar cperl-problems-old-emaxen 'please-ignore-this-line + "Description of problems in CPerl mode specific for older Emacs versions. + +Emacs had a _very_ restricted syntax parsing engine until version +20.1. Most problems below are corrected starting from this version of +Emacs, and all of them should be fixed in version 20.3. (Or apply +patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in +this respect (until 2003). + +Note that even with newer Emacsen in some very rare cases the details +of interaction of `font-lock' and syntaxification may be not cleaned +up yet. You may get slightly different colors basing on the order of +fontification and syntaxification. Say, the initial faces is correct, +but editing the buffer breaks this. + +Even with older Emacsen CPerl mode tries to corrects some Emacs +misunderstandings, however, for efficiency reasons the degree of +correction is different for different operations. The partially +corrected problems are: POD sections, here-documents, regexps. The +operations are: highlighting, indentation, electric keywords, electric +braces. + +This may be confusing, since the regexp s#//#/#; may be highlighted +as a comment, but it will be recognized as a regexp by the indentation +code. Or the opposite case, when a POD section is highlighted, but +may break the indentation of the following code (though indentation +should work if the balance of delimiters is not broken by POD). + +The main trick (to make $ a \"backslash\") makes constructions like +${aaa} look like unbalanced braces. The only trick I can think of is +to insert it as $ {aaa} (valid in perl5, not in perl4). + +Similar problems arise in regexps, when /(\\s|$)/ should be rewritten +as /($|\\s)/. Note that such a transposition is not always possible. + +The solution is to upgrade your Emacs or patch an older one. Note +that Emacs 20.2 has some bugs related to `syntax-table' text +properties. Patches are available on the main CPerl download site, +and on CPAN. + +If these bugs cannot be fixed on your machine (say, you have an inferior +environment and cannot recompile), you may still disable all the fancy stuff +via `cperl-use-syntax-table-text-property'.") (defvar cperl-praise 'please-ignore-this-line "Advantages of CPerl mode. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 30c9b813407..4306f5daa02 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -152,8 +152,7 @@ Used to gray out relevant toolbar icons.") (bound-and-true-p gdb-active-process))))) ([go] menu-item (if (bound-and-true-p gdb-active-process) - "Continue" "Run") - gud-go + "Continue" "Run") gud-go :visible (and (eq gud-minor-mode 'gdbmi) (gdb-show-run-p))) ([stop] menu-item "Stop" gud-stop-subjob @@ -191,8 +190,7 @@ Used to gray out relevant toolbar icons.") (eq gud-minor-mode 'gdbmi))) ([print*] menu-item (if (eq gud-minor-mode 'jdb) "Dump object" - "Print Dereference") - gud-pstar + "Print Dereference") gud-pstar :enable (not gud-running) :visible (memq gud-minor-mode '(gdbmi gdb jdb))) ([print] menu-item "Print Expression" gud-print diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 33c69e168f4..aa412304c59 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -33,11 +33,12 @@ ;;; Added by Tom Perrine (TEP) (defvar m2-mode-syntax-table (let ((table (make-syntax-table))) - ;; FIXME: nesting! - ;; FIXME: `comment-indent' just inserts "(**)" whereas the old code - ;; resulted in a nicer "(* *)"! - (comment-set-syntax table '(("(*" . "*)") ("//" . "\n"))) (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?/ ". 12" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\( "()1" table) + (modify-syntax-entry ?\) ")(4" table) + (modify-syntax-entry ?* ". 23nb" table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) @@ -203,11 +204,10 @@ (let ((tok (smie-default-backward-token))) (cond ((zerop (length tok)) - (if (bobp) (setq res ":") - (let ((forward-sexp-function nil)) - (condition-case nil - (forward-sexp -1) - (scan-error (setq res ":")))))) + (let ((forward-sexp-function nil)) + (condition-case nil + (forward-sexp -1) + (scan-error (setq res ":"))))) ((member tok '("|" "OF" "..")) (setq res ":-case")) ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE")) (setq res ":"))))) @@ -311,6 +311,9 @@ followed by the first character of the construct. (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + (set (make-local-variable 'comment-start) "(* ") + (set (make-local-variable 'comment-end) " *)") + (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *") (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'font-lock-defaults) '((m3-font-lock-keywords diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 28d8746ffaf..e1f9a33a691 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -628,8 +628,7 @@ builtins.") ;; OS specific "VMSError" "WindowsError" ) - symbol-end) - . font-lock-type-face) + symbol-end) . font-lock-type-face) ;; assignments ;; support for a = b = c = 5 (,(lambda (limit) @@ -679,7 +678,6 @@ Which one will be chosen depends on the value of ((rx (or "\"\"\"" "'''")) (0 (ignore (python-syntax-stringify)))))) -;; Always define the alias(es) *before* the variable. (define-obsolete-variable-alias 'python--prettify-symbols-alist 'python-prettify-symbols-alist "26.1") diff --git a/lisp/startup.el b/lisp/startup.el index 2b4f4c7520c..7759ed5aed3 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -980,13 +980,6 @@ XDG convention for dotfiles." (found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path))) found-path)) -(defcustom gc-cons-opportunistic-idle-time 5 - "Number of seconds before trying an opportunistic GC. -After this number of seconds of idle time, Emacs tries to collect -garbage more eagerly (i.e. with thresholds halved) in the hope -to avoid running the GC later during non-idle time." - :type 'integer) - (defun command-line () "A subroutine of `normal-top-level'. Amongst another things, it parses the command-line arguments." @@ -1384,16 +1377,6 @@ please check its value") (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) - ;; Start opportunistic GC (after loading the init file, so we obey - ;; its settings). This is desirable for two reason: - ;; - It reduces the number of times we have to GC in the middle of - ;; an operation. - ;; - It means we GC when the C stack is short, reducing the risk of false - ;; positives from the conservative stack scanning. - (when gc-cons-opportunistic-idle-time - (run-with-idle-timer gc-cons-opportunistic-idle-time t - #'garbage-collect-maybe 2)) - (setq after-init-time (current-time)) ;; Display any accumulated warnings after all functions in ;; `after-init-hook' like `desktop-read' have finalized possible diff --git a/lisp/subr.el b/lisp/subr.el index 3f5e1d7a3a4..baff1e909a1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -825,11 +825,11 @@ Example: "Return a copy of SEQ with all occurrences of ELT removed. SEQ must be a list, vector, or string. The comparison is done with `equal'." (declare (side-effect-free t)) - (delete elt (if (nlistp seq) - ;; If SEQ isn't a list, there's no need to copy SEQ because - ;; `delete' will return a new object. - seq - (copy-sequence seq)))) + (if (nlistp seq) + ;; If SEQ isn't a list, there's no need to copy SEQ because + ;; `delete' will return a new object. + (delete elt seq) + (delete elt (copy-sequence seq)))) (defun remq (elt list) "Return LIST with all occurrences of ELT removed. @@ -851,10 +851,10 @@ This is the same format used for saving keyboard macros (see `edmacro-mode'). For an approximate inverse of this, see `key-description'." - (declare (pure t)) ;; Don't use a defalias, since the `pure' property is only true for ;; the calling convention of `kbd'. (read-kbd-macro keys)) +(put 'kbd 'pure t) (defun undefined () "Beep to tell the user this binding is undefined." @@ -5586,17 +5586,6 @@ returned list are in the same order as in TREE. (defalias 'flatten-list 'flatten-tree) ;; The initial anchoring is for better performance in searching matches. -(defun internal--opportunistic-gc () - "Run the GC during idle time." - (let ((gc-cons-threshold (/ gc-cons-threshold 2)) - ;; FIXME: This doesn't work because it's only consulted at the end - ;; of a GC in order to set the next `gc_relative_threshold'! - (gc-cons-percentage (/ gc-cons-percentage 2))) - ;; HACK ATTACK: the purpose of this dummy call to `eval' is to call - ;; `maybe_gc', so we will trigger a GC if we allocated half of the maximum - ;; allowed before the GC is forced upon us. - (eval 1 t))) - (defconst regexp-unmatchable "\\`a\\`" "Standard regexp guaranteed not to match any string at all.") diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index d612217bdb9..c4b0a8fb6e6 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -1107,7 +1107,6 @@ versions of xterm." (t (error "Unsupported number of xterm colors (%d)" (+ 16 ncolors))))) ;; Modifying color mappings means realized faces don't use the ;; right colors, so clear them. - ;; FIXME: Only for the selected frame! (clear-face-cache))) (defun xterm-maybe-set-dark-background-mode (redc greenc bluec) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 19e0039ea53..5d5d787945d 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1115,7 +1115,7 @@ to exclude some SCSS constructs." (goto-char start-point) (forward-comment (- (point))) (skip-chars-backward "@[:alpha:]") - (unless (looking-at-p "@\\(?:mixin\\|include\\)") + (unless (looking-at-p "@\\(mixin\\|include\\)") (cdr color))))) (defun css--compute-color (start-point match) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 7d951ff16e8..c285491a305 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -900,12 +900,6 @@ region, instead of just filling the current paragraph." (equal hash (buffer-hash))) (set-buffer-modified-p nil))))) -(defun unfill-paragraph () - "That thing." - (interactive) - (let ((fill-column (/ most-positive-fixnum 2))) - (fill-paragraph))) - (declare-function comment-search-forward "newcomment" (limit &optional noerror)) (declare-function comment-string-strip "newcomment" (str beforep afterp)) diff --git a/lisp/window.el b/lisp/window.el index 00523d57cd8..726d022dfe9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6485,7 +6485,7 @@ pass the elements of (cdr ARGS) as the remaining arguments." (set-window-dedicated-p window t) window))))) -(defcustom special-display-function #'special-display-popup-frame +(defcustom special-display-function 'special-display-popup-frame "Function to call for displaying special buffers. This function is called with two arguments - the buffer and, optionally, a list - and should return a window displaying that diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index a330604e9bd..5ff718292d3 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -84,7 +84,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) (cond ((null down) - ;; This is an "up-only" event. Pretend there was a down-event + ;; This is an "up-only" event. Pretend there was an up-event ;; right before and keep the up-event for later. (push event unread-command-events) (vector (cons (intern (replace-regexp-in-string diff --git a/src/alloc.c b/src/alloc.c index 86ecf5291c6..64aaa8acdfa 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5989,28 +5989,6 @@ garbage_collect (void) garbage_collect_1 (&gcst); } -DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe, Sgarbage_collect_maybe, 1, 1, "", - doc: /* Call `garbage-collect' if enough allocation happened. -FACTOR determines what "enough" means here: -a FACTOR of N means to run the GC if more than 1/Nth of the allocations -needed to triger automatic allocation took place. */) - (Lisp_Object factor) -{ - CHECK_FIXNAT (factor); - EMACS_INT fact = XFIXNAT (factor); - byte_ct new_csgc = consing_since_gc * fact; - if (new_csgc / fact != consing_since_gc) - /* Overflow! */ - garbage_collect (); - else - { - consing_since_gc = new_csgc; - maybe_gc (); - consing_since_gc /= fact; - } - return Qnil; -} - DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than @@ -7411,7 +7389,6 @@ N should be nonnegative. */); defsubr (&Smake_finalizer); defsubr (&Spurecopy); defsubr (&Sgarbage_collect); - defsubr (&Sgarbage_collect_maybe); defsubr (&Smemory_info); defsubr (&Smemory_use_counts); defsubr (&Ssuspicious_object); diff --git a/src/keyboard.c b/src/keyboard.c index 9e1567f8cfe..56916e0cb4e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2728,7 +2728,7 @@ read_char (int commandflag, Lisp_Object map, /* If there is still no input available, ask for GC. */ if (!detect_input_pending_run_timers (0)) - maybe_gc (); /* FIXME: Why? */ + maybe_gc (); } /* Notify the caller if an autosave hook, or a timer, sentinel or diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 0b67fb3f1f1..4f1e5729be1 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -876,6 +876,15 @@ baz\"\"" (call-interactively (key-binding `[,last-command-event]))) (should (equal (buffer-string) "int main () {\n \n}")))) +(define-derived-mode plainer-c-mode c-mode "pC" + "A plainer/saner C-mode with no internal electric machinery." + (c-toggle-electric-state -1) + (setq-local electric-indent-local-mode-hook nil) + (setq-local electric-indent-mode-hook nil) + (electric-indent-local-mode 1) + (dolist (key '(?\" ?\' ?\{ ?\} ?\( ?\) ?\[ ?\])) + (local-set-key (vector key) 'self-insert-command))) + (ert-deftest electric-modes-int-main-allman-style () (ert-with-test-buffer () (plainer-c-mode) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 428b19226b4..35df7cc17f1 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -74,7 +74,7 @@ 'completion-table-with-predicate full-collection no-A nil)))))) -(ert-deftest completion-table-subvert-test () ;bug#34888 +(ert-deftest completion-table-subvert-test () (let* ((origtable '("A-hello" "A-there")) (subvtable (completion-table-subvert origtable "B" "A"))) (should (equal (try-completion "B-hel" subvtable) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c8fe00dd393..525f62a3c0b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3885,7 +3885,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - (defvar tramp-display-escape-sequence-regexp) ;Defined in tramp-sh.el + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) (fnnd (file-name-nondirectory tmp-name)) |