commit 5a9eba603d193324c7ff8c654fa28c6b4f3928f7 (HEAD, refs/remotes/origin/master) Author: Nicolas Petton Date: Tue Dec 18 09:42:50 2018 +0100 New convenience functions in seq.el Functions to access the first or all but the first elements of sequences have been repeatedly asked for (the last occurrence being https://github.com/NicolasPetton/seq.el/issues/9). * lisp/emacs-lisp/seq.el (seq-first, seq-rest): New functions. * test/lisp/emacs-lisp/seq-tests.el (test-seq-first, test-seq-rest): New tests for seq-first and seq-rest. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index b40c424e30..3da33dac4a 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.20 +;; Version: 2.21 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -110,6 +110,14 @@ name to be bound to the rest of SEQUENCE." "Return the number of elements of SEQUENCE." (length sequence)) +(defun seq-first (sequence) + "Return the first element of SEQUENCE." + (seq-elt sequence 0)) + +(defun seq-rest (sequence) + "Return a sequence of the elements of SEQUENCE except the first one." + (seq-drop sequence 1)) + (cl-defgeneric seq-do (function sequence) "Apply FUNCTION to each element of SEQUENCE, presumably for side effects. Return SEQUENCE." diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 989ec3cf9e..0f11bd9714 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -424,5 +424,17 @@ Evaluate BODY for each created sequence. (should (eq (seq-into vec 'vector) vec)) (should (eq (seq-into str 'string) str)))) +(ert-deftest test-seq-first () + (let ((lst '(1 2 3)) + (vec [1 2 3])) + (should (eq (seq-first lst) 1)) + (should (eq (seq-first vec) 1)))) + +(ert-deftest test-seq-rest () + (let ((lst '(1 2 3)) + (vec [1 2 3])) + (should (equal (seq-rest lst) '(2 3))) + (should (equal (seq-rest vec) [2 3])))) + (provide 'seq-tests) ;;; seq-tests.el ends here commit 73b2f7ac698601d3dfbedd7949d95bc506497c50 Author: Glenn Morris Date: Mon Dec 17 22:52:34 2018 -0800 Tiny ert-summarize-tests-batch-and-exit improvement * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): Report the details of unexpected passes as well as failures. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 9702a11998..6d4d90e498 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1563,7 +1563,8 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (message "-------") (with-temp-buffer (dolist (x (list (list skipped "skipped" "SKIPPED") - (list unexpected "unexpected" "FAILED"))) + (list unexpected "unexpected" + "\\(?:FAILED\\|PASSED\\)"))) (mapc (lambda (l) (erase-buffer) (insert-file-contents l) commit 6973b1489b24ca4190d24be9e5f887aef2cc9eff Author: Juri Linkov Date: Tue Dec 18 01:11:15 2018 +0200 Syntactic fontification of diff hunks (bug#33567) * lisp/vc/diff-mode.el (diff-font-lock-syntax): New defcustom. (diff-default-directory): New buffer-local variable. (diff-indicator-removed, diff-indicator-added) (diff-indicator-changed): Set foreground to distinctive colors. (diff-context): Remove colors to make room for syntax highlighting. (diff-font-lock-keywords): Add diff--font-lock-syntax. (diff--font-lock-cleanup): Remove diff-mode syntax overlays. (diff--font-lock-syntax, diff--font-lock-syntax--refresh) (diff-syntax-fontify-revisions, diff-syntax-fontify-hunk) (diff-syntax-fontify-props): New functions. * lisp/vc/diff.el (diff-no-select): Set diff-default-directory to default-directory. * doc/emacs/files.texi (Diff Mode): Document diff-font-lock-syntax. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index b47be51e24..6e1faf84dc 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1617,6 +1617,10 @@ displayed in the echo area). With a prefix argument, it tries to modify the original (``old'') source files rather than the patched (``new'') source files. +@vindex diff-font-lock-syntax + If non-@code{nil}, fragments of source in hunks are highlighted +according to the appropriate major mode. + @node Copying and Naming @section Copying, Naming and Renaming Files diff --git a/etc/NEWS b/etc/NEWS index 95647bbda4..bc76bec2d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -413,6 +413,12 @@ and compares their entire trees. *** Hunks are now automatically refined by default. To disable it, set the new defcustom 'diff-font-lock-refine' to nil. ++++ +*** Better syntax highlighting of Diff hunks. +Fragments of source in Diff hunks are now by default highlighted +according to the appropriate major mode. Customize the new option +'diff-font-lock-syntax' to nil to disable this. + *** File headers can be shortened, mimicking Magit's diff format. To enable it, set the new defcustom 'diff-font-lock-prettify' to t. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 4adef02984..ed953deb21 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -56,6 +56,7 @@ (eval-when-compile (require 'cl-lib)) (autoload 'vc-find-revision "vc") +(autoload 'vc-find-revision-no-save "vc") (defvar vc-find-revision-no-save) (defvar add-log-buffer-file-name-function) @@ -103,12 +104,42 @@ when editing big diffs)." :version "27.1" :type 'boolean) +(defcustom diff-font-lock-syntax t + "If non-nil, diff hunk font-lock includes source language syntax highlighting. +This highlighting is the same as added by `font-lock-mode' +when corresponding source files are visited normally. +Syntax highlighting is added over diff own highlighted changes. + +If t, the default, highlight syntax only in Diff buffers created by Diff +commands that compare files or by VC commands that compare revisions. +These provide all necessary context for reliable highlighting. This value +requires support from a VC backend to find the files being compared. +For diffs against the working-tree version of a file, the highlighting is +based on the current file contents. File-based fontification tries to +infer fontification from the compared files. + +If revision-based or file-based method fails, use hunk-based method to get +fontification from hunk alone if the value is `hunk-also'. + +If `hunk-only', fontification is based on hunk alone, without full source. +It tries to highlight hunks without enough context that sometimes might result +in wrong fontification. This is the fastest option, but less reliable." + :version "27.1" + :type '(choice (const :tag "Don't highlight syntax" nil) + (const :tag "Hunk-based also" hunk-also) + (const :tag "Hunk-based only" hunk-only) + (const :tag "Highlight syntax" t))) + (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") (defvar diff-vc-revisions nil "The VC revisions compared in the current Diff buffer, if any.") +(defvar diff-default-directory nil + "The default directory where the current Diff buffer was created.") +(make-variable-buffer-local 'diff-default-directory) + (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -295,19 +326,25 @@ well." :version "25.1") (defface diff-indicator-removed - '((t :inherit diff-removed)) + '((default :inherit diff-removed) + (((class color) (min-colors 88)) + :foreground "#aa2222")) "`diff-mode' face used to highlight indicator of removed lines (-, <)." :version "22.1") (defvar diff-indicator-removed-face 'diff-indicator-removed) (defface diff-indicator-added - '((t :inherit diff-added)) + '((default :inherit diff-added) + (((class color) (min-colors 88)) + :foreground "#22aa22")) "`diff-mode' face used to highlight indicator of added lines (+, >)." :version "22.1") (defvar diff-indicator-added-face 'diff-indicator-added) (defface diff-indicator-changed - '((t :inherit diff-changed)) + '((default :inherit diff-changed) + (((class color) (min-colors 88)) + :foreground "#aaaa22")) "`diff-mode' face used to highlight indicator of changed lines." :version "22.1") (defvar diff-indicator-changed-face 'diff-indicator-changed) @@ -317,10 +354,7 @@ well." "`diff-mode' face used to highlight function names produced by \"diff -p\".") (defface diff-context - '((((class color grayscale) (min-colors 88) (background light)) - :foreground "#333333") - (((class color grayscale) (min-colors 88) (background dark)) - :foreground "#dddddd")) + '((t nil)) "`diff-mode' face used to highlight context and other side-information." :version "25.1") @@ -406,6 +440,7 @@ and the face `diff-added' for added lines.") (1 font-lock-comment-delimiter-face) (2 font-lock-comment-face)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) + (,#'diff--font-lock-syntax) (,#'diff--font-lock-prettify) (,#'diff--font-lock-refined))) @@ -1348,6 +1383,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN." (defun diff--font-lock-cleanup () (remove-overlays nil nil 'diff-mode 'fine) + (remove-overlays nil nil 'diff-mode 'syntax) (when font-lock-mode (make-local-variable 'font-lock-extra-managed-props) ;; Added when diff--font-lock-prettify is non-nil! @@ -2316,6 +2352,199 @@ fixed, visit it in a buffer." 'display ""))))) nil) +;;; Syntax highlighting from font-lock + +(defun diff--font-lock-syntax (max) + "Apply source language syntax highlighting from font-lock. +Calls `diff-syntax-fontify' on every hunk found between point +and the position in MAX." + (when diff-font-lock-syntax + (when (get-char-property (point) 'diff--font-lock-syntax) + (goto-char (next-single-char-property-change + (point) 'diff--font-lock-syntax nil max))) + (let* ((min (point)) + (beg (or (ignore-errors (diff-beginning-of-hunk)) + (ignore-errors (diff-hunk-next) (point)) + max))) + (while (< beg max) + (let ((end + (save-excursion (goto-char beg) (diff-end-of-hunk) (point)))) + (if (< end min) (setq beg min)) + (unless (or (< end beg) + (get-char-property beg 'diff--font-lock-syntax)) + (diff-syntax-fontify beg end) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff--font-lock-syntax t) + (overlay-put ol 'diff-mode 'syntax) + (overlay-put ol 'evaporate t) + (overlay-put ol 'modification-hooks + '(diff--font-lock-syntax--refresh)))) + (goto-char (max beg end)) + (setq beg (or (ignore-errors (diff-hunk-next) (point)) max)))))) + nil) + +(defun diff--font-lock-syntax--refresh (ol _after _beg _end &optional _len) + (delete-overlay ol)) + +(defun diff-syntax-fontify (beg end) + "Highlight source language syntax in diff hunk between BEG and END." + (save-excursion + (diff-syntax-fontify-hunk beg end t) + (diff-syntax-fontify-hunk beg end nil))) + +(defvar diff-syntax-fontify-revisions (make-hash-table :test 'equal)) + +(defun diff-syntax-fontify-hunk (beg end old) + "Highlight source language syntax in diff hunk between BEG and END. +When OLD is non-nil, highlight the hunk from the old source." + (remove-overlays beg end 'diff-mode 'syntax) + (goto-char beg) + (let* ((hunk (buffer-substring-no-properties beg end)) + (text (or (ignore-errors (diff-hunk-text hunk (not old) nil)) "")) + (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?") + (if old (match-string 1) + (if (match-end 3) (match-string 3) (match-string 1))))) + (line-nb (and line (string-match "\\([0-9]+\\),\\([0-9]+\\)" line) + (list (string-to-number (match-string 1 line)) + (string-to-number (match-string 2 line))))) + props) + (cond + ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) + (let* ((file (diff-find-file-name old t)) + (revision (and file (if (not old) (nth 1 diff-vc-revisions) + (or (nth 0 diff-vc-revisions) + (vc-working-revision file)))))) + (if file + (if (not revision) + ;; Get properties from the current working revision + (when (and (not old) (file-exists-p file) (file-regular-p file)) + ;; Try to reuse an existing buffer + (if (get-file-buffer (expand-file-name file)) + (with-current-buffer (get-file-buffer (expand-file-name file)) + (setq props (diff-syntax-fontify-props nil text line-nb t))) + ;; Get properties from the file + (with-temp-buffer + (insert-file-contents file t) + (setq props (diff-syntax-fontify-props file text line-nb))))) + ;; Get properties from a cached revision + (let* ((buffer-name (format " diff-syntax:%s.~%s~" + (expand-file-name file) revision)) + (buffer (gethash buffer-name diff-syntax-fontify-revisions))) + (unless (and buffer (buffer-live-p buffer)) + (let* ((vc-buffer (ignore-errors + (vc-find-revision-no-save + (expand-file-name file) revision + diff-vc-backend + (get-buffer-create buffer-name))))) + (when vc-buffer + (setq buffer vc-buffer) + (puthash buffer-name buffer diff-syntax-fontify-revisions)))) + (when buffer + (with-current-buffer buffer + (setq props (diff-syntax-fontify-props file text line-nb t)))))) + ;; If file is unavailable, get properties from the hunk alone + (setq file (car (diff-hunk-file-names old))) + (with-temp-buffer + (insert text) + (setq props (diff-syntax-fontify-props file text line-nb nil t)))))) + ((and diff-default-directory (not (eq diff-font-lock-syntax 'hunk-only))) + (let ((file (car (diff-hunk-file-names old)))) + (if (and file (file-exists-p file) (file-regular-p file)) + ;; Try to get full text from the file + (with-temp-buffer + (insert-file-contents file t) + (setq props (diff-syntax-fontify-props file text line-nb))) + ;; Otherwise, get properties from the hunk alone + (with-temp-buffer + (insert text) + (setq props (diff-syntax-fontify-props file text line-nb nil t)))))) + ((memq diff-font-lock-syntax '(hunk-also hunk-only)) + (let ((file (car (diff-hunk-file-names old)))) + (with-temp-buffer + (insert text) + (setq props (diff-syntax-fontify-props file text line-nb nil t)))))) + + ;; Put properties over the hunk text + (goto-char beg) + (when (and props (eq (diff-hunk-style) 'unified)) + (while (< (progn (forward-line 1) (point)) end) + (when (or (and (not old) (not (looking-at-p "[-<]"))) + (and old (not (looking-at-p "[+>]")))) + (if (and old (not (looking-at-p "[-<]"))) + ;; Fontify context lines only from new source, + ;; don't refontify context lines from old source. + (pop props) + (let ((line-props (pop props)) + (bol (1+ (point)))) + (dolist (prop line-props) + (let ((ol (make-overlay (+ bol (nth 0 prop)) + (+ bol (nth 1 prop)) + nil 'front-advance nil))) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face (nth 2 prop))))))))))) + +(defun diff-syntax-fontify-props (file text line-nb &optional no-init hunk-only) + "Get font-lock properties from the source code. +FILE is the name of the source file. TEXT is the literal source text from +hunk. LINE-NB is a pair of numbers: start line number and the number of +lines in the hunk. NO-INIT means no initialization is needed to set major +mode. When HUNK-ONLY is non-nil, then don't verify the existence of the +hunk text in the source file. Otherwise, don't highlight the hunk if the +hunk text is not found in the source file." + (unless no-init + (buffer-disable-undo) + (font-lock-mode -1) + (let ((enable-local-variables :safe) ;; to find `mode:' + (buffer-file-name file)) + (set-auto-mode) + (when (and (memq 'generic-mode-find-file-hook find-file-hook) + (fboundp 'generic-mode-find-file-hook)) + (generic-mode-find-file-hook)))) + + (let ((font-lock-defaults (or font-lock-defaults '(nil t))) + (inhibit-read-only t) + props beg end) + (goto-char (point-min)) + (if hunk-only + (setq beg (point-min) end (point-max)) + (forward-line (1- (nth 0 line-nb))) + ;; non-regexp looking-at to compare hunk text for verification + (if (search-forward text (+ (point) (length text)) t) + (setq beg (- (point) (length text)) end (point)) + (goto-char (point-min)) + (if (search-forward text nil t) + (setq beg (- (point) (length text)) end (point))))) + + (when (and beg end) + (goto-char beg) + (when (text-property-not-all beg end 'fontified t) + (if file + ;; In a temporary or cached buffer + (save-excursion + (font-lock-fontify-region beg end) + (put-text-property beg end 'fontified t)) + ;; In an existing buffer + (font-lock-ensure beg end))) + + (while (< (point) end) + (let* ((bol (point)) + (eol (line-end-position)) + line-props + (searching t) + (from (point)) to + (val (get-text-property from 'face))) + (while searching + (setq to (next-single-property-change from 'face nil eol)) + (when val (push (list (- from bol) (- to bol) val) line-props)) + (setq val (get-text-property to 'face) from to) + (unless (< to eol) (setq searching nil))) + (when val (push (list from eol val) line-props)) + (push (nreverse line-props) props)) + (forward-line 1))) + (set-buffer-modified-p nil) + (nreverse props))) + + (defun diff--filter-substring (str) (when diff-font-lock-prettify ;; Strip the `display' properties added by diff-font-lock-prettify, diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index ac94586cac..ed5b49d3bf 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -121,6 +121,8 @@ Possible values are: nil -- no, it does not check -- try to probe whether it does") +(defvar diff-default-directory) + (defun diff-no-select (old new &optional switches no-async buf) ;; Noninteractive helper for creating and reverting diff buffers (unless (bufferp new) (setq new (expand-file-name new))) @@ -165,6 +167,7 @@ Possible values are: (lambda (_ignore-auto _noconfirm) (diff-no-select old new switches no-async (current-buffer)))) (setq default-directory thisdir) + (setq diff-default-directory default-directory) (let ((inhibit-read-only t)) (insert command "\n")) (if (and (not no-async) (fboundp 'make-process)) commit c5e02f2bce28f3b1f2006ce1f208f4a92ca05ed9 Author: Paul Eggert Date: Mon Dec 17 13:26:42 2018 -0800 Make org-protocol-flatten always an alias * lisp/org/org-protocol.el (org-protocol-flatten): Rewrite as top-level alias, as per Stefan’s suggestion, to avoid compiler warnings. diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index bb88c2fe1f..2a4d51242c 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -349,20 +349,20 @@ returned list." ret) l))) -(if (fboundp 'flatten-tree) - (defalias 'org-protocol-flatten 'flatten-tree) - (defun org-protocol-flatten (list) - "Transform LIST into a flat list. +(defalias 'org-protocol-flatten + (if (fboundp 'flatten-tree) 'flatten-tree + (lambda (list) + "Transform LIST into a flat list. Greedy handlers might receive a list like this from emacsclient: \((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) where \"/dir/\" is the absolute path to emacsclients working directory. This function transforms it into a flat list." - (if (null list) () - (if (listp list) - (append (org-protocol-flatten (car list)) - (org-protocol-flatten (cdr list))) - (list list))))) + (if list + (if (consp list) + (append (org-protocol-flatten (car list)) + (org-protocol-flatten (cdr list))) + (list list)))))) (defun org-protocol-parse-parameters (info &optional new-style default-order) "Return a property list of parameters from INFO. commit 55838e4e6a176317367c6759e0520395e80c856f Author: Stefan Monnier Date: Mon Dec 17 14:51:01 2018 -0500 * lisp/emacs-lisp/map.el: Avoid special casing lists. (map-not-inplace, map-inplace): New errors. (map-insert): New generic function. (map-put!): Signal map-not-inplace rather than a generic 'error'. (map-elt): Use map-not-inplace and map-insert to avoid hardcoding a special case for lists. * test/lisp/emacs-lisp/map-tests.el (test-map-put!): Rename from test-map-put. Also test the errors signaled. diff --git a/etc/NEWS b/etc/NEWS index 327276eef9..95647bbda4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,8 +307,9 @@ the node "(emacs) Directory Variables" of the user manual. ** map.el *** Now defined via generic functions that can be extended via cl-defmethod. *** Deprecate the 'map-put' macro in favor of a new 'map-put!' function. -*** map-contains-key now returns a boolean rather than the key. +*** 'map-contains-key' now returns a boolean rather than the key. *** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'. +*** New generic function 'map-insert'. --- ** Follow mode diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 78cedd3ab1..d5051fcd98 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -95,12 +95,13 @@ Returns the result of evaluating the form associated with MAP-VAR's type." (t (error "Unsupported map type `%S': %S" (type-of ,map-var) ,map-var))))) +(define-error 'map-not-inplace "Cannot modify map in-place: %S") + (cl-defgeneric map-elt (map key &optional default testfn) "Lookup KEY in MAP and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. TESTFN is deprecated. Its default depends on the MAP argument. -If MAP is a list, the default is `eql' to lookup KEY. In the base definition, MAP can be an alist, hash-table, or array." (declare @@ -110,15 +111,16 @@ In the base definition, MAP can be an alist, hash-table, or array." (macroexp-let2* nil ;; Eval them once and for all in the right order. ((key key) (default default) (testfn testfn)) - `(if (listp ,mgetter) - ;; Special case the alist case, since it can't be handled by the - ;; map--put function. - ,(gv-get `(alist-get ,key (gv-synthetic-place - ,mgetter ,msetter) - ,default nil ,testfn) - do) - ,(funcall do `(map-elt ,mgetter ,key ,default) - (lambda (v) `(map-put! ,mgetter ,key ,v))))))))) + (funcall do `(map-elt ,mgetter ,key ,default) + (lambda (v) + `(condition-case nil + ;; Silence warnings about the hidden 4th arg. + (with-no-warnings (map-put! ,mgetter ,key ,v ,testfn)) + (map-not-inplace + ,(funcall msetter + `(map-insert ,mgetter ,key ,v)))))))))) + ;; `testfn' is deprecated. + (advertised-calling-convention (map key &optional default) "27.1")) (map--dispatch map :list (alist-get key map default nil testfn) :hash-table (gethash key map default) @@ -336,17 +338,36 @@ MAP can be a list, hash-table or array." ;; FIXME: I wish there was a way to avoid this η-redex! (cl-defmethod map-into (map (_type (eql list))) (map-pairs map)) -(cl-defgeneric map-put! (map key value) +(cl-defgeneric map-put! (map key value &optional testfn) "Associate KEY with VALUE in MAP and return VALUE. If KEY is already present in MAP, replace the associated value -with VALUE." +with VALUE. +This operates by modifying MAP in place. +If it cannot do that, it signals the `map-not-inplace' error. +If you want to insert an element without modifying MAP, use `map-insert'." + ;; `testfn' only exists for backward compatibility with `map-put'! + (declare (advertised-calling-convention (map key value) "27.1")) (map--dispatch map - :list (let ((p (assoc key map))) - (if p (setcdr p value) - (error "No place to change the mapping for %S" key))) + :list (let ((oldmap map)) + (setf (alist-get key map key nil (or testfn #'equal)) value) + (unless (eq oldmap map) + (signal 'map-not-inplace (list map)))) :hash-table (puthash key value map) + ;; FIXME: If `key' is too large, should we signal `map-not-inplace' + ;; and let `map-insert' grow the array? :array (aset map key value))) +(define-error 'map-inplace "Can only modify map in place: %S") + +(cl-defgeneric map-insert (map key value) + "Return a new map like MAP except that it associates KEY with VALUE. +This does not modify MAP. +If you want to insert an element in place, use `map-put!'." + (if (listp map) + (cons (cons key value) map) + ;; FIXME: Should we signal an error or use copy+put! ? + (signal 'map-inplace (list map)))) + ;; There shouldn't be old source code referring to `map--put', yet we do ;; need to keep it for backward compatibility with .elc files where the ;; expansion of `setf' may call this function. diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 885b09be98..4dd67d48d4 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -76,13 +76,25 @@ Evaluate BODY for each created map. 'b '2)))) -(ert-deftest test-map-put () +(ert-deftest test-map-put! () (with-maps-do map (setf (map-elt map 2) 'hello) (should (eq (map-elt map 2) 'hello))) (with-maps-do map (map-put map 2 'hello) (should (eq (map-elt map 2) 'hello))) + (with-maps-do map + (map-put! map 2 'hello) + (should (eq (map-elt map 2) 'hello)) + (if (not (hash-table-p map)) + (should-error (map-put! map 5 'value) + ;; For vectors, it could arguably signal + ;; map-not-inplace as well, but it currently doesn't. + :type (if (listp map) + 'map-not-inplace + 'error)) + (map-put! map 5 'value) + (should (eq (map-elt map 5) 'value)))) (let ((ht (make-hash-table))) (setf (map-elt ht 2) 'a) (should (eq (map-elt ht 2) @@ -92,7 +104,7 @@ Evaluate BODY for each created map. (should (eq (map-elt alist 2) 'a))) (let ((vec [3 4 5])) - (should-error (setf (map-elt vec 3) 6)))) + (should-error (setf (map-elt vec 3) 6)))) (ert-deftest test-map-put-alist-new-key () "Regression test for Bug#23105." @@ -105,9 +117,9 @@ Evaluate BODY for each created map. (let ((alist (list (cons "a" 1) (cons "b" 2))) ;; Make sure to use a non-eq "a", even when compiled. (noneq-key (string ?a))) - (map-put alist noneq-key 3 'equal) + (map-put alist noneq-key 3 #'equal) (should-not (cddr alist)) - (map-put alist noneq-key 9) + (map-put alist noneq-key 9 #'eql) (should (cddr alist)))) (ert-deftest test-map-put-return-value () commit 2c3f7f9c45985c36fd9e86c334b49b10e8c8c270 Author: Glenn Morris Date: Mon Dec 17 13:52:46 2018 -0500 Avoid tests failures on hydra due to Tramp autoload changes * test/lisp/filenotify-tests.el, test/lisp/shadowfile-tests.el: * test/lisp/net/tramp-tests.el: Require tramp-sh before changing tramp-remote-path. diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 26b8276b8e..376b20988a 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -180,6 +180,7 @@ Return nil when any other file notification watch is still active." ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") + (require 'tramp-sh) (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) ;; We do not want to try and fail `file-notify-add-watch'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 57b67a0bfe..c566f81610 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -107,6 +107,7 @@ ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") + (require 'tramp-sh) (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) (defvar tramp--test-enabled-checked nil diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 3bab22f8d6..1527d2b2ab 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -69,6 +69,7 @@ ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") + (require 'tramp-sh) (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) (defconst shadow-test-info-file commit 3621593616c1c4ae880c72e8d3de8fac8fc9c581 Author: Paul Eggert Date: Mon Dec 17 10:19:48 2018 -0800 One more flatten-tree test * test/lisp/subr-tests.el (subr-tests-flatten-tree): Add a test for lots of nothing. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 08f9a697a3..b7df718683 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -383,9 +383,11 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (should (equal (flatten-tree 42) '(42))) (should (equal (flatten-tree t) - '(t))) + '(t))) (should (equal (flatten-tree nil) - nil)) + nil)) + (should (equal (flatten-tree '((nil) ((((nil)))) nil)) + nil)) (should (equal (flatten-tree '(1 ("foo" "bar") 2)) '(1 "foo" "bar" 2)))) commit ef144113f3473f39d3df3e96e780c832e0d5420e Author: Paul Eggert Date: Mon Dec 17 10:19:23 2018 -0800 Some more flatten-tree aliases * lisp/allout.el (allout-flatten): * lisp/progmodes/hideif.el (hif-flatten): Now an obsolete alias for flatten-tree. All callers changed. * lisp/org/org-protocol.el (org-protocol-flatten): Make it an alias for flatten-tree if available. * lisp/progmodes/js.el (js--flatten-list): Remove alias. We shouldn’t need obsolete function aliases for private functions. diff --git a/lisp/allout.el b/lisp/allout.el index a123ece9b9..242b1f2c87 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -4351,7 +4351,7 @@ subtopics into siblings of the item." (let ((children-chart (allout-chart-subtree 1))) (if (listp (car children-chart)) ;; whoops: - (setq children-chart (allout-flatten children-chart))) + (setq children-chart (flatten-tree children-chart))) (save-excursion (dolist (child-point children-chart) (goto-char child-point) @@ -6547,14 +6547,7 @@ If BEG is bigger than END we return 0." (apply 'concat (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char))) string))) -;;;_ : lists -;;;_ > allout-flatten (list) -(defun allout-flatten (list) - "Return a list of all atoms in list." - ;; classic. - (cond ((null list) nil) - ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) - (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) +(define-obsolete-function-alias 'allout-flatten #'flatten-tree "27.1") ;;;_ : Compatibility: ;;;_ : xemacs undo-in-progress provision: (unless (boundp 'undo-in-progress) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 33957ee326..bb88c2fe1f 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -349,17 +349,20 @@ returned list." ret) l))) -(defun org-protocol-flatten (list) - "Transform LIST into a flat list. +(if (fboundp 'flatten-tree) + (defalias 'org-protocol-flatten 'flatten-tree) + (defun org-protocol-flatten (list) + "Transform LIST into a flat list. Greedy handlers might receive a list like this from emacsclient: \((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) where \"/dir/\" is the absolute path to emacsclients working directory. This function transforms it into a flat list." - (if (null list) () - (if (listp list) - (append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list))) - (list list)))) + (if (null list) () + (if (listp list) + (append (org-protocol-flatten (car list)) + (org-protocol-flatten (cdr list))) + (list list))))) (defun org-protocol-parse-parameters (info &optional new-style default-order) "Return a property list of parameters from INFO. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 62e8c45338..84cbb6e6d1 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -672,12 +672,7 @@ that form should be displayed.") result)) (nreverse result))) -(defun hif-flatten (l) - "Flatten a tree." - (apply #'nconc - (mapcar (lambda (x) (if (listp x) - (hif-flatten x) - (list x))) l))) +(define-obsolete-function-alias 'hif-flatten #'flatten-tree "27.1") (defun hif-expand-token-list (tokens &optional macroname expand_list) "Perform expansion on TOKENS till everything expanded. @@ -748,7 +743,7 @@ detecting self-reference." expanded)) - (hif-flatten (nreverse expanded))))) + (flatten-tree (nreverse expanded))))) (defun hif-parse-exp (token-list &optional macroname) "Parse the TOKEN-LIST. @@ -1166,7 +1161,7 @@ preprocessing token" (setq actual-parms (cdr actual-parms))) ;; Replacement completed, flatten the whole token list - (setq macro-body (hif-flatten macro-body)) + (setq macro-body (flatten-tree macro-body)) ;; Stringification and token concatenation happens here (hif-token-concatenation (hif-token-stringification macro-body))))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index ddba7636b4..11ccb5fc52 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -623,8 +623,6 @@ then the \".\"s will be lined up: "Parse state at `js--last-parse-pos'.") (make-variable-buffer-local 'js--state-at-last-parse-pos) -(define-obsolete-function-alias 'js--flatten-list #'flatten-tree "27.1") - (defun js--maybe-join (prefix separator suffix &rest list) "Helper function for `js--update-quick-match-re'. If LIST contains any element that is not nil, return its non-nil commit a5995a326d1dad9bccf1ad7eb96e4e8146f6dcbe Author: Paul Eggert Date: Mon Dec 17 09:55:06 2018 -0800 Improve flatten-tree documentation * doc/lispref/lists.texi (Building Lists): * lisp/subr.el (flatten-tree): Don’t imply that flatten-tree modifies its argument. Clarify wording. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 31cc319085..0a1d5b5dc3 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -668,10 +668,10 @@ their elements). @end defun @defun flatten-tree tree -Take @var{tree} and "flatten" it. -This always returns a list containing all the terminal nodes, or -leaves, of @var{tree}. Dotted pairs are flattened as well, and nil -elements are removed. +This function returns a ``flattened'' copy of @var{tree}, that is, +a list containing all the non-@code{nil} terminal nodes, or leaves, of +the tree of cons cells rooted at @var{tree}. Leaves in the returned +list are in the same order as in @var{tree}. @end defun @example @@ -680,7 +680,7 @@ elements are removed. @end example @defun number-sequence from &optional to separation -This returns a list of numbers starting with @var{from} and +This function returns a list of numbers starting with @var{from} and incrementing by @var{separation}, and ending at or just before @var{to}. @var{separation} can be positive or negative and defaults to 1. If @var{to} is @code{nil} or numerically equal to @var{from}, diff --git a/lisp/subr.el b/lisp/subr.el index 3dec6cf66c..c5004a539b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5449,17 +5449,13 @@ This function is called from lisp/Makefile and leim/Makefile." file) (defun flatten-tree (tree) - "Take TREE and \"flatten\" it. -This always returns a list containing all the terminal nodes, or -\"leaves\", of TREE. Dotted pairs are flattened as well, and nil -elements are removed. + "Return a \"flattened\" copy of TREE. +In other words, return a list of the non-nil terminal nodes, or +leaves, of the tree of cons cells rooted at TREE. Leaves in the +returned list are in the same order as in TREE. \(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) -=> (1 2 3 4 5 6 7) - -TREE can be anything that can be made into a list. For each -element in TREE, if it is a cons cell return its car -recursively. Otherwise return the element." +=> (1 2 3 4 5 6 7)" (let (elems) (while (consp tree) (let ((elem (pop tree))) commit 8664ba18c7c56bc463f69dd5b131b4071612d567 Author: Paul Eggert Date: Mon Dec 17 09:54:14 2018 -0800 Improve flatten-tree performance * lisp/subr.el (flatten-tree): Improve performance by calling ‘cons’ once rather than twice when a cons cell is popped. diff --git a/lisp/subr.el b/lisp/subr.el index 7a7c175db4..3dec6cf66c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5460,14 +5460,14 @@ elements are removed. TREE can be anything that can be made into a list. For each element in TREE, if it is a cons cell return its car recursively. Otherwise return the element." - (let (elems) - (setq tree (list tree)) - (while (let ((elem (pop tree))) - (cond ((consp elem) - (setq tree (cons (car elem) (cons (cdr elem) tree)))) - (elem - (push elem elems))) - tree)) + (let (elems) + (while (consp tree) + (let ((elem (pop tree))) + (while (consp elem) + (push (cdr elem) tree) + (setq elem (car elem))) + (if elem (push elem elems)))) + (if tree (push tree elems)) (nreverse elems))) ;; Technically, `flatten-list' is a misnomer, but we provide it here commit 4d77c4ac3b9c40c62b1505bcaa1e0377d63a4956 Author: Paul Eggert Date: Mon Dec 17 09:31:08 2018 -0800 Assume ‘emacs’ is defined in Emacs-only code * src/charset.c, src/coding.c, src/coding.h, src/gmalloc.c: * src/ralloc.c, src/regex-emacs.c: Simplify slightly by assuming that ‘emacs’ is defined. These modules have long been specific to Emacs, and are not used elsewhere. diff --git a/src/charset.c b/src/charset.c index 83f4de7ed2..8508b80677 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2328,8 +2328,6 @@ init_charset_once (void) charset_ksc5601 = -1; } -#ifdef emacs - /* Allocate an initial charset table that is large enough to handle Emacs while it is bootstrapping. As of September 2011, the size needs to be at least 166; make it a bit bigger to allow for future @@ -2430,5 +2428,3 @@ the value may be a list of mnemonics. */); MAX_5_BYTE_CHAR + 1); charset_unibyte = charset_iso_8859_1; } - -#endif /* emacs */ diff --git a/src/coding.c b/src/coding.c index c2945707e2..ba060878c7 100644 --- a/src/coding.c +++ b/src/coding.c @@ -307,16 +307,12 @@ Lisp_Object Vcoding_system_hash_table; file and process), not for in-buffer or Lisp string encoding. */ static Lisp_Object system_eol_type; -#ifdef emacs - /* Coding-systems are handed between Emacs Lisp programs and C internal routines by the following three variables. */ /* Coding system to be used to encode text for terminal display when terminal coding system is nil. */ struct coding_system safe_terminal_coding; -#endif /* emacs */ - /* Two special coding systems. */ static Lisp_Object Vsjis_coding_system; static Lisp_Object Vbig5_coding_system; @@ -8478,7 +8474,6 @@ to_unicode (Lisp_Object str, Lisp_Object *buf) #endif /* WINDOWSNT || CYGWIN */ -#ifdef emacs /*** 8. Emacs Lisp library functions ***/ DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0, @@ -10732,8 +10727,6 @@ coding system whose eol-type is N. */) return make_fixnum (n); } -#endif /* emacs */ - /*** 9. Post-amble ***/ @@ -10777,8 +10770,6 @@ init_coding_once (void) emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_22] = 4; } -#ifdef emacs - void syms_of_coding (void) { @@ -11321,4 +11312,3 @@ internal character representation. */); #endif staticpro (&system_eol_type); } -#endif /* emacs */ diff --git a/src/coding.h b/src/coding.h index d2cf4d8a7b..e984375bcc 100644 --- a/src/coding.h +++ b/src/coding.h @@ -762,15 +762,10 @@ surrogates_to_codepoint (int low, int high) extern Lisp_Object preferred_coding_system (void); - -#ifdef emacs - /* Coding system to be used to encode text for terminal display when terminal coding system is nil. */ extern struct coding_system safe_terminal_coding; -#endif - extern char emacs_mule_bytes[256]; INLINE_HEADER_END diff --git a/src/gmalloc.c b/src/gmalloc.c index ebba789f61..c07ead741e 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -36,9 +36,7 @@ License along with this library. If not, see . #include #endif -#ifdef emacs -# include "lisp.h" -#endif +#include "lisp.h" #include "ptr-bounds.h" @@ -2022,11 +2020,7 @@ mabort (enum mcheck_status status) #else fprintf (stderr, "mcheck: %s\n", msg); fflush (stderr); -# ifdef emacs emacs_abort (); -# else - abort (); -# endif #endif } diff --git a/src/ralloc.c b/src/ralloc.c index 046d550734..4dc9fe348b 100644 --- a/src/ralloc.c +++ b/src/ralloc.c @@ -26,11 +26,9 @@ along with GNU Emacs. If not, see . */ #include -#ifdef emacs -# include "lisp.h" -# include "blockinput.h" -# include -#endif +#include "lisp.h" +#include "blockinput.h" +#include #include "getpagesize.h" @@ -924,9 +922,7 @@ r_alloc_free (void **ptr) free_bloc (dead_bloc); *ptr = 0; -#ifdef emacs refill_memory_reserve (); -#endif } /* Given a pointer at address PTR to relocatable data, resize it to SIZE. @@ -1000,7 +996,7 @@ r_re_alloc (void **ptr, size_t size) } -#if defined (emacs) && defined (DOUG_LEA_MALLOC) +#ifdef DOUG_LEA_MALLOC /* Reinitialize the morecore hook variables after restarting a dumped Emacs. This is needed when using Doug Lea's malloc from GNU libc. */ diff --git a/src/regex-emacs.c b/src/regex-emacs.c index d19838a876..5cb7bba158 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -698,7 +698,6 @@ print_partial_compiled_pattern (re_char *start, re_char *end) fprintf (stderr, "/%d", mcnt); break; -# ifdef emacs case at_dot: fprintf (stderr, "/at_dot"); break; @@ -714,7 +713,6 @@ print_partial_compiled_pattern (re_char *start, re_char *end) mcnt = *p++; fprintf (stderr, "/%d", mcnt); break; -# endif /* emacs */ case begbuf: fprintf (stderr, "/begbuf"); @@ -753,9 +751,6 @@ print_compiled_pattern (struct re_pattern_buffer *bufp) printf ("re_nsub: %zu\t", bufp->re_nsub); printf ("regs_alloc: %d\t", bufp->regs_allocated); printf ("can_be_null: %d\t", bufp->can_be_null); -#ifndef emacs - printf ("syntax: %lx\n", bufp->syntax); -#endif fflush (stdout); /* Perhaps we should print the translate table? */ } commit 739dca7818514f1b7c318fd195f90535a416f57f Author: Michael Albinus Date: Mon Dec 17 12:26:58 2018 +0100 Use `flatten-tree' in Tramp * lisp/net/tramp-compat.el (tramp-compat-flatten-tree): New defun. (tramp-compat-flatten-list): Remove. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): Use it. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index df0e0887b4..e1bd18b0a9 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -264,24 +264,25 @@ If NAME is a remote file name, the local part of NAME is unquoted." A nil value for either argument stands for the current time." (equal (or t1 (current-time)) (or t2 (current-time))))) +(if (fboundp 'flatten-tree) + (defalias 'tramp-compat-flatten-tree 'flatten-tree) + (defun tramp-compat-flatten-tree (tree) + "Take TREE and \"flatten\" it." + (let (elems) + (setq tree (list tree)) + (while (let ((elem (pop tree))) + (cond ((consp elem) + (setq tree (cons (car elem) (cons (cdr elem) tree)))) + (elem + (push elem elems))) + tree)) + (nreverse elems)))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) (unload-feature 'tramp-compat 'force))) -;; There does not exist a common `flatten-list' yet, this is discussed -;; in Bug#33309. For the time being we implement our own version, -;; derived from `eshell-flatten-list'. -(defun tramp-compat-flatten-list (args) - "Flatten any lists within ARGS, so that there are no sublists." - (let ((new-list (list t))) - (dolist (a args) - (if (and (listp a) - (listp (cdr a))) - (nconc new-list (tramp-compat-flatten-list a)) - (nconc new-list (list a)))) - (cdr new-list))) - (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 08fc79de95..3d25e13073 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -798,13 +798,13 @@ in case of error, t otherwise." (user (or (tramp-file-name-user vec) "")) (spec (format-spec-make ?h host ?u user)) (args (append - (tramp-compat-flatten-list + (tramp-compat-flatten-tree (mapcar (lambda (x) (setq x (mapcar (lambda (y) (format-spec y spec)) x)) (unless (member "" x) x)) login)) - (tramp-compat-flatten-list (delq nil args)))) + (tramp-compat-flatten-tree (delq nil args)))) (delete-exited-processes t) (process-connection-type tramp-process-connection-type) (p (apply #'start-process commit 36b05dc84247db1391a423df94e4b9a478e29dc5 Author: Alex Branham Date: Mon Dec 17 12:15:09 2018 +0100 New function flatten-tree Co-authored-by: Basil L. Contovounesios * doc/lispref/lists.texi: Document `flatten-tree'. * lisp/progmodes/js.el (js--maybe-join): * lisp/printing.el (pr-switches): * lisp/lpr.el (lpr-print-region): * lisp/gnus/nnimap.el (nnimap-find-wanted-parts): * lisp/gnus/message.el (message-talkative-question): * lisp/gnus/gnus-sum.el (gnus-remove-thread) (gnus-thread-highest-number, gnus-thread-latest-date): * lisp/eshell/esh-util.el (eshell-flatten-and-stringify): * lisp/eshell/esh-opt.el (eshell-eval-using-options): * lisp/eshell/esh-ext.el (eshell-external-command): * lisp/eshell/em-xtra.el (eshell/expr): * lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template) (eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep) (eshell/du, eshell/time, eshell/diff, eshell/locate): * lisp/eshell/em-tramp.el (eshell/su, eshell/sudo): * lisp/eshell/em-term.el (eshell-exec-visual): * lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd): * lisp/eshell/em-basic.el (eshell/printnl): Use new flatten-tree. * lisp/progmodes/js.el (js--flatten-list): * lisp/lpr.el (lpr-flatten-list): * lisp/gnus/message.el (message-flatten-list): * lisp/eshell/esh-util.el (eshell-flatten-list): Obsolete in favor of Emacs-wide `flatten-tree'. * lisp/subr.el (flatten-list): Alias to `flatten-tree' for discoverability. * lisp/subr.el (flatten-tree): New defun. * test/lisp/subr-tests.el (subr-tests-flatten-tree): New test. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 69f9300952..31cc319085 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -667,6 +667,18 @@ non-@code{nil}, it copies vectors too (and operates recursively on their elements). @end defun +@defun flatten-tree tree +Take @var{tree} and "flatten" it. +This always returns a list containing all the terminal nodes, or +leaves, of @var{tree}. Dotted pairs are flattened as well, and nil +elements are removed. +@end defun + +@example +(flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + @result{}(1 2 3 4 5 6 7) +@end example + @defun number-sequence from &optional to separation This returns a list of numbers starting with @var{from} and incrementing by @var{separation}, and ending at or just before diff --git a/etc/NEWS b/etc/NEWS index c88f6ef5ca..327276eef9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1359,6 +1359,12 @@ are implemented in C using the Jansson library. ** New function 'ring-resize'. 'ring-resize' can be used to grow or shrink a ring. ++++ +** New function 'flatten-tree'. +'flatten-list' is provided as an alias. These functions take a tree +and 'flatten' it such that the result is a list of all the terminal +nodes. + ** Mailcap --- diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 5201076f48..4a99d83857 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -118,7 +118,7 @@ or `eshell-printn' for display." (defun eshell/printnl (&rest args) "Print out each of the arguments, separated by newlines." - (let ((elems (eshell-flatten-list args))) + (let ((elems (flatten-tree args))) (while elems (eshell-printn (eshell-echo (list (car elems)))) (setq elems (cdr elems))))) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 853382888c..b47f76fbfb 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -259,7 +259,7 @@ Thus, this does not include the current directory.") (if (> (length args) 1) (error "%s: command not found" (car args)) (throw 'eshell-replace-command - (eshell-parse-command "cd" (eshell-flatten-list args))))) + (eshell-parse-command "cd" (flatten-tree args))))) (defun eshell-parse-user-reference () "An argument beginning with ~ is a filename to be expanded." @@ -353,7 +353,7 @@ in the minibuffer: (defun eshell/cd (&rest args) ; all but first ignored "Alias to extend the behavior of `cd'." - (setq args (eshell-flatten-list args)) + (setq args (flatten-tree args)) (let ((path (car args)) (subpath (car (cdr args))) (case-fold-search (eshell-under-windows-p)) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index ddde47f73d..fdf40cae85 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -175,7 +175,7 @@ allowed." (let* (eshell-interpreter-alist (interp (eshell-find-interpreter (car args) (cdr args))) (program (car interp)) - (args (eshell-flatten-list + (args (flatten-tree (eshell-stringify-list (append (cdr interp) (cdr args))))) (term-buf diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 9475f4ed94..f77b84d851 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -62,7 +62,7 @@ "Alias \"su\" to call TRAMP. Uses the system su through TRAMP's su method." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options "su" args @@ -100,7 +100,7 @@ Become another USER during a login session.") "Alias \"sudo\" to call Tramp. Uses the system sudo through TRAMP's sudo method." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options "sudo" args diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 3aecebc2eb..e46e1c417d 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -231,7 +231,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." This is implemented to call either `delete-file', `kill-buffer', `kill-process', or `unintern', depending on the nature of the argument." - (setq args (eshell-flatten-list args)) + (setq args (flatten-tree args)) (eshell-eval-using-options "rm" args '((?h "help" nil nil "show this usage screen") @@ -481,7 +481,7 @@ Remove the DIRECTORY(ies), if they are empty.") (error "%s: missing destination file or directory" ,command)) (if (= len 1) (nconc args '("."))) - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (if (and ,(not (equal command "ln")) (string-match eshell-tar-regexp (car (last args))) (or (> (length args) 2) @@ -606,7 +606,7 @@ with `--symbolic'. When creating hard links, each TARGET must exist.") "Implementation of cat in Lisp. If in a pipeline, or the file is not a regular file, directory or symlink, then revert to the system's definition of cat." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (if (or eshell-in-pipeline-p (catch 'special (dolist (arg args) @@ -670,7 +670,7 @@ Fallback to standard make when called synchronously." (compile (concat "make " (eshell-flatten-and-stringify args)))) (throw 'eshell-replace-command (eshell-parse-command "*make" (eshell-stringify-list - (eshell-flatten-list args)))))) + (flatten-tree args)))))) (put 'eshell/make 'eshell-no-numeric-conversions t) @@ -705,7 +705,7 @@ available..." (erase-buffer) (occur-mode) (let ((files (eshell-stringify-list - (eshell-flatten-list (cdr args)))) + (flatten-tree (cdr args)))) (inhibit-redisplay t) string) (when (car args) @@ -750,11 +750,11 @@ external command." (throw 'eshell-replace-command (eshell-parse-command (concat "*" command) (eshell-stringify-list - (eshell-flatten-list args)))) + (flatten-tree args)))) (let* ((args (mapconcat 'identity (mapcar 'shell-quote-argument (eshell-stringify-list - (eshell-flatten-list args))) + (flatten-tree args))) " ")) (cmd (progn (set-text-properties 0 (length args) @@ -876,7 +876,7 @@ external command." (defun eshell/du (&rest args) "Implementation of \"du\" in Lisp, passing ARGS." (setq args (if args - (eshell-stringify-list (eshell-flatten-list args)) + (eshell-stringify-list (flatten-tree args)) '("."))) (let ((ext-du (eshell-search-path "du"))) (if (and ext-du @@ -976,7 +976,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (eshell-parse-command (car time-args) ;;; https://lists.gnu.org/r/bug-gnu-emacs/2007-08/msg00205.html (eshell-stringify-list - (eshell-flatten-list (cdr time-args)))))))) + (flatten-tree (cdr time-args)))))))) (defun eshell/whoami (&rest _args) "Make \"whoami\" Tramp aware." @@ -1000,7 +1000,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (defun eshell/diff (&rest args) "Alias \"diff\" to call Emacs `diff' function." - (let ((orig-args (eshell-stringify-list (eshell-flatten-list args)))) + (let ((orig-args (eshell-stringify-list (flatten-tree args)))) (if (or eshell-plain-diff-behavior (not (and (eshell-interactive-output-p) (not eshell-in-pipeline-p) @@ -1056,7 +1056,7 @@ Show wall-clock time elapsed during execution of COMMAND.") (string-match "^-" (car args)))) (throw 'eshell-replace-command (eshell-parse-command "*locate" (eshell-stringify-list - (eshell-flatten-list args)))) + (flatten-tree args)))) (save-selected-window (let ((locate-history-list (list (car args)))) (locate-with-filter (car args) (cadr args)))))) diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index cc84d19854..eb9847c60c 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -51,7 +51,7 @@ naturally accessible within Emacs." "Implementation of expr, using the calc package." (if (not (fboundp 'calc-eval)) (throw 'eshell-replace-command - (eshell-parse-command "*expr" (eshell-flatten-list args))) + (eshell-parse-command "*expr" (flatten-tree args))) ;; to fool the byte-compiler... (let ((func 'calc-eval)) (funcall func (eshell-flatten-and-stringify args))))) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 244cc7ff1f..9e7d8bb608 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -222,7 +222,7 @@ causing the user to wonder if anything's really going on..." (defun eshell-external-command (command args) "Insert output from an external COMMAND, using ARGS." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((interp (eshell-find-interpreter command args diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d7a449450f..69d10b4ccf 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -77,7 +77,7 @@ arguments, some do not. The recognized :KEYWORDS are: arguments. :preserve-args - If present, do not pass MACRO-ARGS through `eshell-flatten-list' + If present, do not pass MACRO-ARGS through `flatten-tree' and `eshell-stringify-list'. :parse-leading-options-only @@ -106,7 +106,7 @@ let-bound variable `args'." ,(if (memq ':preserve-args (cadr options)) macro-args (list 'eshell-stringify-list - (list 'eshell-flatten-list macro-args)))) + (list 'flatten-tree macro-args)))) (processed-args (eshell--do-opts ,name ,options temp-args)) ,@(delete-dups (delq nil (mapcar (lambda (opt) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8fe8c461fd..b55f873380 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -285,15 +285,7 @@ Prepend remote identification of `default-directory', if any." ,@forms) (setq list-iter (cdr list-iter))))) -(defun eshell-flatten-list (args) - "Flatten any lists within ARGS, so that there are no sublists." - (let ((new-list (list t))) - (dolist (a args) - (if (and (listp a) - (listp (cdr a))) - (nconc new-list (eshell-flatten-list a)) - (nconc new-list (list a)))) - (cdr new-list))) +(define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1") (defun eshell-uniquify-list (l) "Remove occurring multiples in L. You probably want to sort first." @@ -330,7 +322,7 @@ Prepend remote identification of `default-directory', if any." (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat 'eshell-stringify (eshell-flatten-list 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." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4baf4bc826..3f5362ba17 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4773,7 +4773,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (let (headers thread last-id) ;; First go up in this thread until we find the root. (setq last-id (gnus-root-id id) - headers (message-flatten-list (gnus-id-to-thread last-id))) + headers (flatten-tree (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -5069,7 +5069,7 @@ Unscored articles will be counted as having a score of zero." "Return the highest article number in THREAD." (apply 'max (mapcar (lambda (header) (mail-header-number header)) - (message-flatten-list thread)))) + (flatten-tree thread)))) (defun gnus-article-sort-by-most-recent-date (h1 h2) "Sort articles by number." @@ -5087,9 +5087,9 @@ Unscored articles will be counted as having a score of zero." "Return the highest article date in THREAD." (apply 'max (mapcar (lambda (header) (float-time - (gnus-date-get-time - (mail-header-date header)))) - (message-flatten-list thread)))) + (gnus-date-get-time + (mail-header-date header)))) + (flatten-tree thread)))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fdaa4e8272..03f80616d9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8051,7 +8051,7 @@ regular text mode tabbing command." If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer. The following arguments may contain lists of values." (if (and show - (setq text (message-flatten-list text))) + (setq text (flatten-tree text))) (save-window-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (with-current-buffer " *MESSAGE information message*" @@ -8061,15 +8061,7 @@ The following arguments may contain lists of values." (funcall ask question)) (funcall ask question))) -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (list list)))) +(define-obsolete-function-alias 'message-flatten-list #'flatten-tree "27.1") (defun message-generate-new-buffer-clone-locals (name &optional varstr) "Create and return a buffer with name based on NAME using `generate-new-buffer'. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 1a3b05ddb3..adbce25530 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -804,7 +804,7 @@ textual parts.") (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) - (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) + (flatten-tree (nnimap-find-wanted-parts-1 structure ""))) (defun nnimap-find-wanted-parts-1 (structure prefix) (let ((num 1) diff --git a/lisp/lpr.el b/lisp/lpr.el index 33b8da8d76..969b57d644 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -258,7 +258,7 @@ for further customization of the printer command." (defun lpr-print-region (start end switches name) (let ((buf (current-buffer)) - (nswitches (lpr-flatten-list + (nswitches (flatten-tree (mapcar #'lpr-eval-switch ; Dynamic evaluation switches))) (switch-string (if switches @@ -336,23 +336,7 @@ The characters tab, linefeed, space, return and formfeed are not affected." ((consp arg) (apply (car arg) (cdr arg))) (t nil))) -;; `lpr-flatten-list' is defined here (copied from "message.el" and -;; enhanced to handle dotted pairs as well) until we can get some -;; sensible autoloads, or `flatten-list' gets put somewhere decent. - -;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j)) -;; => (a b c d e f g h i j) - -(defun lpr-flatten-list (&rest list) - (lpr-flatten-list-1 list)) - -(defun lpr-flatten-list-1 (list) - (cond - ((null list) nil) - ((consp list) - (append (lpr-flatten-list-1 (car list)) - (lpr-flatten-list-1 (cdr list)))) - (t (list list)))) +(define-obsolete-function-alias 'lpr-flatten-list #'flatten-tree "27.1") (provide 'lpr) diff --git a/lisp/printing.el b/lisp/printing.el index 2fc2323028..c1a73df14c 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5672,7 +5672,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-switches (switches mess) (or (listp switches) (error "%S should have a list of strings" mess)) - (lpr-flatten-list ; dynamic evaluation + (flatten-tree ; dynamic evaluation (mapcar #'lpr-eval-switch switches))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cec48a82a2..ddba7636b4 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -623,11 +623,7 @@ then the \".\"s will be lined up: "Parse state at `js--last-parse-pos'.") (make-variable-buffer-local 'js--state-at-last-parse-pos) -(defun js--flatten-list (list) - (cl-loop for item in list - nconc (cond ((consp item) - (js--flatten-list item)) - (item (list item))))) +(define-obsolete-function-alias 'js--flatten-list #'flatten-tree "27.1") (defun js--maybe-join (prefix separator suffix &rest list) "Helper function for `js--update-quick-match-re'. @@ -636,7 +632,7 @@ elements, separated by SEPARATOR, prefixed by PREFIX, and ended with SUFFIX as with `concat'. Otherwise, if LIST is empty, return nil. If any element in LIST is itself a list, flatten that element." - (setq list (js--flatten-list list)) + (setq list (flatten-tree list)) (when list (concat prefix (mapconcat #'identity list separator) suffix))) diff --git a/lisp/subr.el b/lisp/subr.el index d3bc007293..7a7c175db4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5448,5 +5448,30 @@ This function is called from lisp/Makefile and leim/Makefile." (setq file (concat (substring file 1 2) ":" (substring file 2)))) file) +(defun flatten-tree (tree) + "Take TREE and \"flatten\" it. +This always returns a list containing all the terminal nodes, or +\"leaves\", of TREE. Dotted pairs are flattened as well, and nil +elements are removed. + +\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) +=> (1 2 3 4 5 6 7) + +TREE can be anything that can be made into a list. For each +element in TREE, if it is a cons cell return its car +recursively. Otherwise return the element." + (let (elems) + (setq tree (list tree)) + (while (let ((elem (pop tree))) + (cond ((consp elem) + (setq tree (cons (car elem) (cons (cdr elem) tree)))) + (elem + (push elem elems))) + tree)) + (nreverse elems))) + +;; Technically, `flatten-list' is a misnomer, but we provide it here +;; for discoverability: +(defalias 'flatten-list 'flatten-tree) ;;; subr.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index f218a7663e..08f9a697a3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -372,5 +372,22 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (shell-quote-argument "%ca%"))) "without-caret %ca%")))) +(ert-deftest subr-tests-flatten-tree () + "Test `flatten-tree' behavior." + (should (equal (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + '(1 2 3 4 5 6 7))) + (should (equal (flatten-tree '((1 . 2))) + '(1 2))) + (should (equal (flatten-tree '(1 nil 2)) + '(1 2))) + (should (equal (flatten-tree 42) + '(42))) + (should (equal (flatten-tree t) + '(t))) + (should (equal (flatten-tree nil) + nil)) + (should (equal (flatten-tree '(1 ("foo" "bar") 2)) + '(1 "foo" "bar" 2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit 09a6cc4778d4b90a0bb8da646425d04d8f8a6ec9 Author: Michael Albinus Date: Mon Dec 17 11:56:05 2018 +0100 Fix Bug#33524 * lisp/progmodes/flymake-proc.el (flymake-proc-create-temp-with-folder-structure): Unquote file-name. (Bug#33524) diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 8600be9b97..e969c5d992 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -874,7 +874,7 @@ can also be executed interactively independently of (unless (stringp file-name) (error "Invalid file-name")) - (let* ((dir (file-name-directory file-name)) + (let* ((dir (file-name-directory (file-name-unquote file-name))) ;; Not sure what this slash-pos is all about, but I guess it's just ;; trying to remove the leading / of absolute file names. (slash-pos (string-match "/" dir)) commit 3e9ecaec3b17e63a3832213f10cb5299f4883172 Author: Michael Albinus Date: Mon Dec 17 11:50:06 2018 +0100 Reduce autoloaded objects in Tramp * lisp/net/tramp-adb.el (tramp-adb-program) (tramp-adb-connect-if-not-connected, tramp-adb-prompt): Remove autoload cookie. * lisp/net/tramp-cache.el (tramp-connection-properties) (tramp-persistency-file-name): Remove autoload cookie. * lisp/net/tramp-ftp.el (tramp-ftp-enable-ange-ftp): Use `tramp-autoload' cookie. * lisp/net/tramp-gvfs.el (tramp-gvfs-zeroconf-domain): Remove autoload cookie. * lisp/net/tramp-rclone.el (tramp-rclone-program): Remove autoload cookie. (tramp-set-completion-function): Use `tramp--with-startup'. * lisp/net/tramp-sh.el (tramp-inline-compress-start-size) (tramp-copy-size-limit, tramp-histfile-override) (tramp-use-ssh-controlmaster-options, tramp-remote-path) (tramp-remote-process-environment, tramp-sh-extra-args): Remove autoload cookie. (tramp-stat-marker, tramp-stat-quoted-marker): Move to tramp.el. * lisp/net/tramp-smb.el (tramp-smb-program) (tramp-smb-acl-program, tramp-smb-conf) (tramp-smb-winexe-program, tramp-smb-winexe-shell-command) (tramp-smb-winexe-shell-command-switch): Remove autoload cookie. * lisp/net/tramp-sudoedit.el (server, tramp-sh): Do not require. * lisp/net/tramp.el (tramp--startup-hook): Define. (tramp-stat-marker, tramp-stat-quoted-marker): New defconsts, taken from tramp-sh.el. * test/lisp/net/tramp-archive-tests.el (tramp-copy-size-limit) (tramp-persistency-file-name): Declare. * test/lisp/net/tramp-tests.el (tramp-connection-properties) (tramp-display-escape-sequence-regexp) (tramp-inline-compress-start-size, tramp-remote-path): Declare. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4b839f5e2b..4d92ae91fa 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -35,14 +35,12 @@ (require 'tramp) -;;;###tramp-autoload (defcustom tramp-adb-program "adb" "Name of the Android Debug Bridge program." :group 'tramp :version "24.4" :type 'string) -;;;###tramp-autoload (defcustom tramp-adb-connect-if-not-connected nil "Try to run `adb connect' if provided device is not connected currently. It is used for TCP/IP devices." @@ -54,7 +52,6 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -;;;###tramp-autoload (defcustom tramp-adb-prompt "^\\(?:[[:digit:]]*|?\\)?\\(?:[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]" "Regexp used as prompt in almquist shell." diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 575d188c05..47066760fb 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -72,7 +72,6 @@ (defvar tramp-cache-data (make-hash-table :test 'equal) "Hash table for remote files properties.") -;;;###tramp-autoload (defcustom tramp-connection-properties nil "List of static connection properties. Every entry has the form (REGEXP PROPERTY VALUE). The regexp @@ -86,7 +85,6 @@ details see the info pages." (choice :tag " Property" string) (choice :tag " Value" sexp)))) -;;;###tramp-autoload (defcustom tramp-persistency-file-name (expand-file-name (locate-user-emacs-file "tramp")) "File which keeps connection history for Tramp connections." diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 8526b4e217..35f5c8f4da 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -57,7 +57,7 @@ present for backward compatibility." '(when (functionp 'tramp-disable-ange-ftp) (tramp-disable-ange-ftp))) -;;;###autoload +;;;###tramp-autoload (defun tramp-ftp-enable-ange-ftp () "Reenable Ange-FTP, when Tramp is unloaded." ;; The following code is commented out in Ange-FTP. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 047f4109d7..2321617b0a 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -155,7 +155,6 @@ (add-to-list 'tramp-default-host-alist '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address))))) -;;;###tramp-autoload (defcustom tramp-gvfs-zeroconf-domain "local" "Zeroconf domain to be used for discovering services, like host names." :group 'tramp diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 4b94ab6bdc..f1a2cd81c6 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -42,7 +42,6 @@ (defconst tramp-rclone-method "rclone" "When this method name is used, forward all calls to rclone mounts.") -;;;###tramp-autoload (defcustom tramp-rclone-program "rclone" "Name of the rclone program." :group 'tramp @@ -60,9 +59,9 @@ (tramp-about-args ("--full"))))) ;;;###tramp-autoload -(eval-after-load 'tramp - '(tramp-set-completion-function - tramp-rclone-method '((tramp-rclone-parse-device-names "")))) +(tramp--with-startup + (tramp-set-completion-function + tramp-rclone-method '((tramp-rclone-parse-device-names "")))) ;; New handlers should be added here. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1aecebb37f..05715f2477 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -41,8 +41,6 @@ (defvar vc-git-program) (defvar vc-hg-program) -;; FIXME: Why autoload all those defcustoms? -;;;###tramp-autoload (defcustom tramp-inline-compress-start-size 4096 "The minimum size of compressing where inline transfer. When inline transfer, compress transferred data of file @@ -51,7 +49,6 @@ If it is nil, no compression at all will be applied." :group 'tramp :type '(choice (const nil) integer)) -;;;###tramp-autoload (defcustom tramp-copy-size-limit 10240 "The maximum file size where inline copying is preferred over an \ out-of-the-band copy. @@ -68,7 +65,6 @@ files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) -;;;###tramp-autoload (defcustom tramp-histfile-override "~/.tramp_history" "When invoking a shell, override the HISTFILE with this value. When setting to a string, it redirects the shell history to that @@ -110,7 +106,6 @@ detected as prompt when being sent on echoing hosts, therefore.") (defconst tramp-end-of-heredoc (md5 tramp-end-of-output) "String used to recognize end of heredoc strings.") -;;;###tramp-autoload (defcustom tramp-use-ssh-controlmaster-options t "Whether to use `tramp-ssh-controlmaster-options'." :group 'tramp @@ -471,7 +466,6 @@ The string is used in `tramp-methods'.") ;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin ;; QNAP QTS: --- -;;;###tramp-autoload (defcustom tramp-remote-path '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin" "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin" @@ -501,7 +495,6 @@ the list by the special value `tramp-own-remote-path'." (const :tag "Private Directories" tramp-own-remote-path) (string :tag "Directory")))) -;;;###tramp-autoload (defcustom tramp-remote-process-environment '("ENV=''" "TMOUT=0" "LC_CTYPE=''" "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat" @@ -525,7 +518,6 @@ based on the Tramp and Emacs versions, and should not be set here." :version "26.1" :type '(repeat string)) -;;;###tramp-autoload (defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression @@ -920,13 +912,6 @@ od -v -t x1 -A n