aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorTom Tromey2018-08-09 17:56:53 -0600
committerTom Tromey2018-08-09 17:56:53 -0600
commitaccb7b7ecc19f85c2750ded1046a464bc73c6a52 (patch)
tree1aa94af022d6700a93a8ff2b73f5b210046ac010 /lisp
parentf822a2516d88eeb2118fbbc8554f155e86dfd74e (diff)
parent53483df0de0085dbc9ef0b15a0f629ab808b0147 (diff)
downloademacs-accb7b7ecc19f85c2750ded1046a464bc73c6a52.tar.gz
emacs-accb7b7ecc19f85c2750ded1046a464bc73c6a52.zip
Merge remote-tracking branch 'origin/master' into feature/bignum
Diffstat (limited to 'lisp')
-rw-r--r--lisp/auth-source.el2
-rw-r--r--lisp/bookmark.el7
-rw-r--r--lisp/calendar/todo-mode.el202
-rw-r--r--lisp/char-fold.el2
-rw-r--r--lisp/comint.el19
-rw-r--r--lisp/cus-theme.el63
-rw-r--r--lisp/custom.el257
-rw-r--r--lisp/dired-aux.el37
-rw-r--r--lisp/dired.el3
-rw-r--r--lisp/emacs-lisp/backtrace.el916
-rw-r--r--lisp/emacs-lisp/cl-macs.el5
-rw-r--r--lisp/emacs-lisp/cl-print.el301
-rw-r--r--lisp/emacs-lisp/debug.el463
-rw-r--r--lisp/emacs-lisp/easy-mmode.el28
-rw-r--r--lisp/emacs-lisp/edebug.el276
-rw-r--r--lisp/emacs-lisp/ert.el41
-rw-r--r--lisp/emacs-lisp/lisp-mode.el26
-rw-r--r--lisp/emacs-lisp/map-ynp.el18
-rw-r--r--lisp/emacs-lisp/rx.el32
-rw-r--r--lisp/emacs-lisp/subr-x.el12
-rw-r--r--lisp/env.el6
-rw-r--r--lisp/epg-config.el27
-rw-r--r--lisp/eshell/em-dirs.el3
-rw-r--r--lisp/eshell/em-ls.el1
-rw-r--r--lisp/eshell/em-unix.el10
-rw-r--r--lisp/eshell/esh-cmd.el51
-rw-r--r--lisp/eshell/esh-ext.el1
-rw-r--r--lisp/files.el22
-rw-r--r--lisp/format.el2
-rw-r--r--lisp/gnus/gnus-art.el6
-rw-r--r--lisp/gnus/gnus-sum.el8
-rw-r--r--lisp/ielm.el14
-rw-r--r--lisp/imenu.el13
-rw-r--r--lisp/indent.el9
-rw-r--r--lisp/international/fontset.el9
-rw-r--r--lisp/international/mule-cmds.el9
-rw-r--r--lisp/international/mule-conf.el9
-rw-r--r--lisp/international/mule-diag.el3
-rw-r--r--lisp/international/quail.el20
-rw-r--r--lisp/jsonrpc.el88
-rw-r--r--lisp/language/thai.el4
-rw-r--r--lisp/ldefs-boot.el874
-rw-r--r--lisp/mh-e/mh-comp.el100
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-identity.el27
-rw-r--r--lisp/net/rcirc.el2
-rw-r--r--lisp/net/rlogin.el8
-rw-r--r--lisp/net/soap-client.el21
-rw-r--r--lisp/net/tramp-gvfs.el37
-rw-r--r--lisp/net/tramp-sh.el6
-rw-r--r--lisp/net/tramp.el12
-rw-r--r--lisp/net/trampver.el2
-rw-r--r--lisp/profiler.el6
-rw-r--r--lisp/progmodes/cc-engine.el12
-rw-r--r--lisp/progmodes/elisp-mode.el2
-rw-r--r--lisp/progmodes/grep.el4
-rw-r--r--lisp/progmodes/hideif.el2
-rw-r--r--lisp/progmodes/python.el95
-rw-r--r--lisp/progmodes/subword.el4
-rw-r--r--lisp/register.el16
-rw-r--r--lisp/scroll-bar.el24
-rw-r--r--lisp/shadowfile.el478
-rw-r--r--lisp/shell.el4
-rw-r--r--lisp/simple.el12
-rw-r--r--lisp/subr.el31
-rw-r--r--lisp/term.el20
-rw-r--r--lisp/term/tty-colors.el14
-rw-r--r--lisp/textmodes/flyspell.el19
-rw-r--r--lisp/textmodes/ispell.el5
-rw-r--r--lisp/textmodes/reftex-vars.el6
-rw-r--r--lisp/thingatpt.el2
-rw-r--r--lisp/vc/add-log.el77
-rw-r--r--lisp/vc/diff-mode.el35
-rw-r--r--lisp/vc/diff.el5
-rw-r--r--lisp/vc/log-edit.el6
-rw-r--r--lisp/w32-fns.el2
-rw-r--r--lisp/wdired.el51
77 files changed, 3513 insertions, 1535 deletions
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index abff0def95f..261e9726131 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -779,7 +779,7 @@ Calls `auth-source-search' with the :delete property in SPEC set to t.
779The backend may not actually delete the entries. 779The backend may not actually delete the entries.
780 780
781Returns the deleted entries." 781Returns the deleted entries."
782 (auth-source-search (plist-put spec :delete t))) 782 (apply #'auth-source-search (plist-put spec :delete t)))
783 783
784(defun auth-source-search-collection (collection value) 784(defun auth-source-search-collection (collection value)
785 "Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE." 785 "Returns t is VALUE is t or COLLECTION is t or COLLECTION contains VALUE."
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 78f3e324034..58a279473d0 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1102,7 +1102,7 @@ BOOKMARK is usually a bookmark name (a string). It can also be a
1102bookmark record, but this is usually only done by programmatic callers. 1102bookmark record, but this is usually only done by programmatic callers.
1103 1103
1104If DISPLAY-FUNC is non-nil, it is a function to invoke to display the 1104If DISPLAY-FUNC is non-nil, it is a function to invoke to display the
1105bookmark. It defaults to `switch-to-buffer'. A typical value for 1105bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for
1106DISPLAY-FUNC would be `switch-to-buffer-other-window'." 1106DISPLAY-FUNC would be `switch-to-buffer-other-window'."
1107 (interactive 1107 (interactive
1108 (list (bookmark-completing-read "Jump to bookmark" 1108 (list (bookmark-completing-read "Jump to bookmark"
@@ -1110,7 +1110,10 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'."
1110 (unless bookmark 1110 (unless bookmark
1111 (error "No bookmark specified")) 1111 (error "No bookmark specified"))
1112 (bookmark-maybe-historicize-string bookmark) 1112 (bookmark-maybe-historicize-string bookmark)
1113 (bookmark--jump-via bookmark (or display-func 'switch-to-buffer))) 1113 ;; Don't use `switch-to-buffer' because it would let the
1114 ;; window-point override the bookmark's point when
1115 ;; `switch-to-buffer-preserve-window-point' is non-nil.
1116 (bookmark--jump-via bookmark (or display-func 'pop-to-buffer-same-window)))
1114 1117
1115 1118
1116;;;###autoload 1119;;;###autoload
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 5161ae8d668..c1c292129e2 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -853,17 +853,18 @@ category. With non-nil argument BACK, visit the numerically
853previous category (the highest numbered one, if the current 853previous category (the highest numbered one, if the current
854category is the first)." 854category is the first)."
855 (interactive) 855 (interactive)
856 (setq todo-category-number 856 (let ((setcatnum (lambda () (1+ (mod (- todo-category-number
857 (1+ (mod (- todo-category-number (if back 2 0)) 857 (if back 2 0))
858 (length todo-categories)))) 858 (length todo-categories))))))
859 (when todo-skip-archived-categories 859 (setq todo-category-number (funcall setcatnum))
860 (while (and (zerop (todo-get-count 'todo)) 860 (when todo-skip-archived-categories
861 (zerop (todo-get-count 'done)) 861 (while (and (zerop (todo-get-count 'todo))
862 (not (zerop (todo-get-count 'archived)))) 862 (zerop (todo-get-count 'done))
863 (setq todo-category-number 863 (not (zerop (todo-get-count 'archived))))
864 (funcall (if back #'1- #'1+) todo-category-number)))) 864 (setq todo-category-number (funcall setcatnum))))
865 (todo-category-select) 865 (todo-category-select)
866 (goto-char (point-min))) 866 (if transient-mark-mode (deactivate-mark))
867 (goto-char (point-min))))
867 868
868(defun todo-backward-category () 869(defun todo-backward-category ()
869 "Visit the numerically previous category in this todo file. 870 "Visit the numerically previous category in this todo file.
@@ -928,11 +929,13 @@ Categories mode."
928 (when goto-archive (todo-archive-mode)) 929 (when goto-archive (todo-archive-mode))
929 (set-window-buffer (selected-window) 930 (set-window-buffer (selected-window)
930 (set-buffer (find-buffer-visiting file0))) 931 (set-buffer (find-buffer-visiting file0)))
932 (if transient-mark-mode (deactivate-mark))
931 (unless todo-global-current-todo-file 933 (unless todo-global-current-todo-file
932 (setq todo-global-current-todo-file todo-current-todo-file)) 934 (setq todo-global-current-todo-file todo-current-todo-file))
933 (todo-category-number category) 935 (todo-category-number category)
934 (todo-category-select) 936 (todo-category-select)
935 (goto-char (point-min)) 937 (goto-char (point-min))
938 (if (bound-and-true-p hl-line-mode) (hl-line-highlight))
936 (when add-item (todo-insert-item--basic)))))) 939 (when add-item (todo-insert-item--basic))))))
937 940
938(defun todo-next-item (&optional count) 941(defun todo-next-item (&optional count)
@@ -1018,15 +1021,17 @@ empty line above the done items separator."
1018 (setq shown (progn 1021 (setq shown (progn
1019 (goto-char (point-min)) 1022 (goto-char (point-min))
1020 (re-search-forward todo-done-string-start nil t))) 1023 (re-search-forward todo-done-string-start nil t)))
1021 (if (not (pos-visible-in-window-p shown)) 1024 (if (pos-visible-in-window-p shown)
1022 (recenter) 1025 (goto-char opoint)
1023 (goto-char opoint))))))) 1026 (recenter)
1027 (if transient-mark-mode (deactivate-mark))))))))
1024 1028
1025(defun todo-toggle-view-done-only () 1029(defun todo-toggle-view-done-only ()
1026 "Switch between displaying only done or only todo items." 1030 "Switch between displaying only done or only todo items."
1027 (interactive) 1031 (interactive)
1028 (setq todo-show-done-only (not todo-show-done-only)) 1032 (setq todo-show-done-only (not todo-show-done-only))
1029 (todo-category-select)) 1033 (todo-category-select)
1034 (if transient-mark-mode (deactivate-mark)))
1030 1035
1031(defun todo-toggle-item-highlighting () 1036(defun todo-toggle-item-highlighting ()
1032 "Highlight or unhighlight the todo item the cursor is on." 1037 "Highlight or unhighlight the todo item the cursor is on."
@@ -1860,15 +1865,18 @@ their associated keys and their effects."
1860 (region (eq where 'region)) 1865 (region (eq where 'region))
1861 (here (eq where 'here)) 1866 (here (eq where 'here))
1862 diary-item) 1867 diary-item)
1863 (when copy 1868 (when (and arg here)
1864 (cond 1869 (user-error "Here insertion only valid in current category"))
1865 ((not (eq major-mode 'todo-mode)) 1870 (when (and (or copy here)
1866 (user-error "You must be in Todo mode to copy a todo item")) 1871 (or (not (eq major-mode 'todo-mode)) (todo-done-item-p)
1867 ((todo-done-item-p) 1872 (when copy (looking-at "^$"))
1868 (user-error "You cannot copy a done item as a new todo item")) 1873 (save-excursion
1869 ((looking-at "^$") 1874 (beginning-of-line)
1870 (user-error "Point must be on a todo item to copy it"))) 1875 ;; Point is on done items separator.
1871 (setq diary-item (todo-diary-item-p))) 1876 (looking-at todo-category-done))))
1877 (user-error (concat "Item " (if copy "copying" "insertion")
1878 " is not valid here")))
1879 (when copy (setq diary-item (todo-diary-item-p)))
1872 (when region 1880 (when region
1873 (let (use-empty-active-region) 1881 (let (use-empty-active-region)
1874 (unless (and todo-use-only-highlighted-region (use-region-p)) 1882 (unless (and todo-use-only-highlighted-region (use-region-p))
@@ -1876,7 +1884,6 @@ their associated keys and their effects."
1876 (let* ((obuf (current-buffer)) 1884 (let* ((obuf (current-buffer))
1877 (ocat (todo-current-category)) 1885 (ocat (todo-current-category))
1878 (opoint (point)) 1886 (opoint (point))
1879 (todo-mm (eq major-mode 'todo-mode))
1880 (cat+file (cond ((equal arg '(4)) 1887 (cat+file (cond ((equal arg '(4))
1881 (todo-read-category "Insert in category: ")) 1888 (todo-read-category "Insert in category: "))
1882 ((equal arg '(16)) 1889 ((equal arg '(16))
@@ -1894,7 +1901,10 @@ their associated keys and their effects."
1894 (new-item (cond (copy (todo-item-string)) 1901 (new-item (cond (copy (todo-item-string))
1895 (region (buffer-substring-no-properties 1902 (region (buffer-substring-no-properties
1896 (region-beginning) (region-end))) 1903 (region-beginning) (region-end)))
1897 (t (read-from-minibuffer "Todo item: ")))) 1904 (t (if (eq major-mode 'todo-archive-mode)
1905 (user-error (concat "Cannot insert a new Todo"
1906 " item in an archive"))
1907 (read-from-minibuffer "Todo item: ")))))
1898 (date-string (cond 1908 (date-string (cond
1899 ((eq date-type 'date) 1909 ((eq date-type 'date)
1900 (todo-read-date)) 1910 (todo-read-date))
@@ -1931,7 +1941,6 @@ their associated keys and their effects."
1931 (unless todo-global-current-todo-file 1941 (unless todo-global-current-todo-file
1932 (setq todo-global-current-todo-file todo-current-todo-file)) 1942 (setq todo-global-current-todo-file todo-current-todo-file))
1933 (let ((buffer-read-only nil) 1943 (let ((buffer-read-only nil)
1934 (called-from-outside (not (and todo-mm (equal cat ocat))))
1935 done-only item-added) 1944 done-only item-added)
1936 (unless copy 1945 (unless copy
1937 (setq new-item 1946 (setq new-item
@@ -1955,14 +1964,8 @@ their associated keys and their effects."
1955 "\n\t" new-item nil nil 1))) 1964 "\n\t" new-item nil nil 1)))
1956 (unwind-protect 1965 (unwind-protect
1957 (progn 1966 (progn
1958 ;; Make sure the correct category is selected. There 1967 ;; If we just visited the file, no category is selected yet.
1959 ;; are two cases: (i) we just visited the file, so no 1968 (when (= (- (point-max) (point-min)) (buffer-size))
1960 ;; category is selected yet, or (ii) we invoked
1961 ;; insertion "here" from outside the category we want
1962 ;; to insert in (with priority insertion, category
1963 ;; selection is done by todo-set-item-priority).
1964 (when (or (= (- (point-max) (point-min)) (buffer-size))
1965 (and here called-from-outside))
1966 (todo-category-number cat) 1969 (todo-category-number cat)
1967 (todo-category-select)) 1970 (todo-category-select))
1968 ;; If only done items are displayed in category, 1971 ;; If only done items are displayed in category,
@@ -1973,16 +1976,7 @@ their associated keys and their effects."
1973 (setq done-only t) 1976 (setq done-only t)
1974 (todo-toggle-view-done-only)) 1977 (todo-toggle-view-done-only))
1975 (if here 1978 (if here
1976 (progn 1979 (todo-insert-with-overlays new-item)
1977 ;; If command was invoked with point in done
1978 ;; items section or outside of the current
1979 ;; category, can't insert "here", so to be
1980 ;; useful give new item top priority.
1981 (when (or (todo-done-item-section-p)
1982 called-from-outside
1983 done-only)
1984 (goto-char (point-min)))
1985 (todo-insert-with-overlays new-item))
1986 (todo-set-item-priority new-item cat t)) 1980 (todo-set-item-priority new-item cat t))
1987 (setq item-added t)) 1981 (setq item-added t))
1988 ;; If user cancels before setting priority, restore 1982 ;; If user cancels before setting priority, restore
@@ -2097,7 +2091,14 @@ the item at point."
2097 (setq todo-categories-with-marks 2091 (setq todo-categories-with-marks
2098 (assq-delete-all cat todo-categories-with-marks))) 2092 (assq-delete-all cat todo-categories-with-marks)))
2099 (todo-update-categories-sexp) 2093 (todo-update-categories-sexp)
2100 (todo-prefix-overlays))) 2094 (todo-prefix-overlays)
2095 (when (and (zerop (todo-get-count 'diary))
2096 (save-excursion
2097 (goto-char (point-min))
2098 (re-search-forward
2099 (concat "^" (regexp-quote todo-category-done))
2100 nil t)))
2101 (let (todo-show-with-done) (todo-category-select)))))
2101 (if ov (delete-overlay ov))))) 2102 (if ov (delete-overlay ov)))))
2102 2103
2103(defvar todo-edit-item--param-key-alist) 2104(defvar todo-edit-item--param-key-alist)
@@ -2233,7 +2234,8 @@ made in the number or names of categories."
2233 (insert item)) 2234 (insert item))
2234 (kill-buffer) 2235 (kill-buffer)
2235 (unless (eq (current-buffer) buf) 2236 (unless (eq (current-buffer) buf)
2236 (set-window-buffer (selected-window) (set-buffer buf)))) 2237 (set-window-buffer (selected-window) (set-buffer buf)))
2238 (if transient-mark-mode (deactivate-mark)))
2237 ;; We got here via `F e'. 2239 ;; We got here via `F e'.
2238 (when (todo-check-format) 2240 (when (todo-check-format)
2239 ;; FIXME: separate out sexp check? 2241 ;; FIXME: separate out sexp check?
@@ -2340,7 +2342,7 @@ made in the number or names of categories."
2340 ((or (string= omonth "*") (= mm 13)) 2342 ((or (string= omonth "*") (= mm 13))
2341 (user-error "Cannot increment *")) 2343 (user-error "Cannot increment *"))
2342 (t 2344 (t
2343 (let ((mminc (+ mm inc))) 2345 (let ((mminc (+ mm inc (if (< inc 0) 12 0))))
2344 ;; Increment or decrement month by INC 2346 ;; Increment or decrement month by INC
2345 ;; modulo 12. 2347 ;; modulo 12.
2346 (setq mm (% mminc 12)) 2348 (setq mm (% mminc 12))
@@ -2549,7 +2551,11 @@ whose value can be either of the symbols `raise' or `lower',
2549meaning to raise or lower the item's priority by one." 2551meaning to raise or lower the item's priority by one."
2550 (interactive) 2552 (interactive)
2551 (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower))) 2553 (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower)))
2552 (or (todo-done-item-p) (looking-at "^$"))) 2554 ;; Noop if point is not on a todo (i.e. not done) item.
2555 (or (todo-done-item-p) (looking-at "^$")
2556 ;; On done items separator.
2557 (save-excursion (beginning-of-line)
2558 (looking-at todo-category-done))))
2553 (let* ((item (or item (todo-item-string))) 2559 (let* ((item (or item (todo-item-string)))
2554 (marked (todo-marked-item-p)) 2560 (marked (todo-marked-item-p))
2555 (cat (or cat (cond ((eq major-mode 'todo-mode) 2561 (cat (or cat (cond ((eq major-mode 'todo-mode)
@@ -2697,9 +2703,13 @@ section in the category moved to."
2697 (interactive "P") 2703 (interactive "P")
2698 (let* ((cat1 (todo-current-category)) 2704 (let* ((cat1 (todo-current-category))
2699 (marked (assoc cat1 todo-categories-with-marks))) 2705 (marked (assoc cat1 todo-categories-with-marks)))
2700 ;; Noop if point is not on an item and there are no marked items. 2706 (unless
2701 (unless (and (looking-at "^$") 2707 ;; Noop if point is not on an item and there are no marked items.
2702 (not marked)) 2708 (and (or (looking-at "^$")
2709 ;; On done items separator.
2710 (save-excursion (beginning-of-line)
2711 (looking-at todo-category-done)))
2712 (not marked))
2703 (let* ((buffer-read-only) 2713 (let* ((buffer-read-only)
2704 (file1 todo-current-todo-file) 2714 (file1 todo-current-todo-file)
2705 (item (todo-item-string)) 2715 (item (todo-item-string))
@@ -2856,10 +2866,14 @@ visible."
2856 (let* ((cat (todo-current-category)) 2866 (let* ((cat (todo-current-category))
2857 (marked (assoc cat todo-categories-with-marks))) 2867 (marked (assoc cat todo-categories-with-marks)))
2858 (when marked (todo--user-error-if-marked-done-item)) 2868 (when marked (todo--user-error-if-marked-done-item))
2859 (unless (and (not marked) 2869 (unless
2860 (or (todo-done-item-p) 2870 ;; Noop if point is not on a todo (i.e. not done) item and
2861 ;; Point is between todo and done items. 2871 ;; there are no marked items.
2862 (looking-at "^$"))) 2872 (and (or (todo-done-item-p) (looking-at "^$")
2873 ;; On done items separator.
2874 (save-excursion (beginning-of-line)
2875 (looking-at todo-category-done)))
2876 (not marked))
2863 (let* ((date-string (calendar-date-string (calendar-current-date) t t)) 2877 (let* ((date-string (calendar-date-string (calendar-current-date) t t))
2864 (time-string (if todo-always-add-time-string 2878 (time-string (if todo-always-add-time-string
2865 (concat " " (substring (current-time-string) 2879 (concat " " (substring (current-time-string)
@@ -3830,6 +3844,7 @@ face."
3830 (goto-char (point-min)) 3844 (goto-char (point-min))
3831 (while (not (eobp)) 3845 (while (not (eobp))
3832 (setq match (re-search-forward regex nil t)) 3846 (setq match (re-search-forward regex nil t))
3847 (if (and match transient-mark-mode) (deactivate-mark))
3833 (goto-char (line-beginning-position)) 3848 (goto-char (line-beginning-position))
3834 (unless (or (equal (point) 1) 3849 (unless (or (equal (point) 1)
3835 (looking-at (concat "^" (regexp-quote todo-category-beg)))) 3850 (looking-at (concat "^" (regexp-quote todo-category-beg))))
@@ -4028,19 +4043,22 @@ regexp items."
4028 (interactive "P") 4043 (interactive "P")
4029 (todo-filter-items 'regexp arg t)) 4044 (todo-filter-items 'regexp arg t))
4030 4045
4046(defvar todo--fifiles-history nil
4047 "List of short file names used by todo-find-filtered-items-file.")
4048
4031(defun todo-find-filtered-items-file () 4049(defun todo-find-filtered-items-file ()
4032 "Choose a filtered items file and visit it." 4050 "Choose a filtered items file and visit it."
4033 (interactive) 4051 (interactive)
4034 (let ((files (directory-files todo-directory t "\\.tod[rty]$" t)) 4052 (let ((files (directory-files todo-directory t "\\.tod[rty]$" t))
4035 falist file) 4053 falist file)
4036 (dolist (f files) 4054 (dolist (f files)
4037 (let ((type (cond ((equal (file-name-extension f) "todr") "regexp") 4055 (let ((sf-name (todo-short-file-name f))
4056 (type (cond ((equal (file-name-extension f) "todr") "regexp")
4038 ((equal (file-name-extension f) "todt") "top") 4057 ((equal (file-name-extension f) "todt") "top")
4039 ((equal (file-name-extension f) "tody") "diary")))) 4058 ((equal (file-name-extension f) "tody") "diary"))))
4040 (push (cons (concat (todo-short-file-name f) " (" type ")") f) 4059 (push (cons (concat sf-name " (" type ")") f) falist)))
4041 falist))) 4060 (setq file (completing-read "Choose a filtered items file: " falist nil t nil
4042 (setq file (completing-read "Choose a filtered items file: " 4061 'todo--fifiles-history (caar falist)))
4043 falist nil t nil nil (car falist)))
4044 (setq file (cdr (assoc-string file falist))) 4062 (setq file (cdr (assoc-string file falist)))
4045 (find-file file) 4063 (find-file file)
4046 (unless (derived-mode-p 'todo-filtered-items-mode) 4064 (unless (derived-mode-p 'todo-filtered-items-mode)
@@ -4050,25 +4068,27 @@ regexp items."
4050(defun todo-go-to-source-item () 4068(defun todo-go-to-source-item ()
4051 "Display the file and category of the filtered item at point." 4069 "Display the file and category of the filtered item at point."
4052 (interactive) 4070 (interactive)
4053 (let* ((str (todo-item-string)) 4071 (unless (looking-at "^$") ; Empty line at EOB.
4054 (buf (current-buffer)) 4072 (let* ((str (todo-item-string))
4055 (res (todo-find-item str)) 4073 (buf (current-buffer))
4056 (found (nth 0 res)) 4074 (res (todo-find-item str))
4057 (file (nth 1 res)) 4075 (found (nth 0 res))
4058 (cat (nth 2 res))) 4076 (file (nth 1 res))
4059 (if (not found) 4077 (cat (nth 2 res)))
4060 (message "Category %s does not contain this item." cat) 4078 (if (not found)
4061 (kill-buffer buf) 4079 (message "Category %s does not contain this item." cat)
4062 (set-window-buffer (selected-window) 4080 (kill-buffer buf)
4063 (set-buffer (find-buffer-visiting file))) 4081 (set-window-buffer (selected-window)
4064 (setq todo-current-todo-file file) 4082 (set-buffer (find-buffer-visiting file)))
4065 (setq todo-category-number (todo-category-number cat)) 4083 (setq todo-current-todo-file file)
4066 (let ((todo-show-with-done (if (or todo-filter-done-items 4084 (setq todo-category-number (todo-category-number cat))
4067 (eq (cdr found) 'done)) 4085 (let ((todo-show-with-done (if (or todo-filter-done-items
4068 t 4086 (eq (cdr found) 'done))
4069 todo-show-with-done))) 4087 t
4070 (todo-category-select)) 4088 todo-show-with-done)))
4071 (goto-char (car found))))) 4089 (todo-category-select))
4090 (if transient-mark-mode (deactivate-mark))
4091 (goto-char (car found))))))
4072 4092
4073(defvar todo-multiple-filter-files nil 4093(defvar todo-multiple-filter-files nil
4074 "List of files selected from `todo-multiple-filter-files' widget.") 4094 "List of files selected from `todo-multiple-filter-files' widget.")
@@ -4520,8 +4540,11 @@ its priority has changed, and `same' otherwise."
4520(defun todo-save-filtered-items-buffer () 4540(defun todo-save-filtered-items-buffer ()
4521 "Save current Filtered Items buffer to a file. 4541 "Save current Filtered Items buffer to a file.
4522If the file already exists, overwrite it only on confirmation." 4542If the file already exists, overwrite it only on confirmation."
4523 (let ((filename (or (buffer-file-name) (todo-filter-items-filename)))) 4543 (let ((filename (or (buffer-file-name) (todo-filter-items-filename)))
4524 (write-file filename t))) 4544 (bufname (buffer-name)))
4545 (write-file filename t)
4546 (setq buffer-read-only t)
4547 (rename-buffer bufname)))
4525 4548
4526;; ----------------------------------------------------------------------------- 4549;; -----------------------------------------------------------------------------
4527;;; Printing Todo mode buffers 4550;;; Printing Todo mode buffers
@@ -5132,6 +5155,8 @@ but the categories sexp differs from the current value of
5132 (forward-line) 5155 (forward-line)
5133 (looking-at (concat "^" 5156 (looking-at (concat "^"
5134 (regexp-quote todo-category-done)))))) 5157 (regexp-quote todo-category-done))))))
5158 ;; Point is on done items separator.
5159 (save-excursion (beginning-of-line) (looking-at todo-category-done))
5135 ;; Buffer is widened. 5160 ;; Buffer is widened.
5136 (looking-at (regexp-quote todo-category-beg))) 5161 (looking-at (regexp-quote todo-category-beg)))
5137 (goto-char (line-beginning-position)) 5162 (goto-char (line-beginning-position))
@@ -5141,8 +5166,11 @@ but the categories sexp differs from the current value of
5141 5166
5142(defun todo-item-end () 5167(defun todo-item-end ()
5143 "Move to end of current todo item and return its position." 5168 "Move to end of current todo item and return its position."
5144 ;; Items cannot end with a blank line. 5169 (unless (or
5145 (unless (looking-at "^$") 5170 ;; Items cannot end with a blank line.
5171 (looking-at "^$")
5172 ;; Point is on done items separator.
5173 (save-excursion (beginning-of-line) (looking-at todo-category-done)))
5146 (let* ((done (todo-done-item-p)) 5174 (let* ((done (todo-done-item-p))
5147 (to-lim nil) 5175 (to-lim nil)
5148 ;; For todo items, end is before the done items section, for done 5176 ;; For todo items, end is before the done items section, for done
@@ -5293,6 +5321,7 @@ Overrides `diary-goto-entry'."
5293 nil t) 5321 nil t)
5294 (todo-category-number (match-string 1)) 5322 (todo-category-number (match-string 1))
5295 (todo-category-select) 5323 (todo-category-select)
5324 (if transient-mark-mode (deactivate-mark))
5296 (goto-char opoint)))))) 5325 (goto-char opoint))))))
5297 5326
5298(add-function :override diary-goto-entry-function #'todo-diary-goto-entry) 5327(add-function :override diary-goto-entry-function #'todo-diary-goto-entry)
@@ -6419,9 +6448,6 @@ Filtered Items mode following todo (not done) items."
6419 ("N" todo-toggle-prefix-numbers) 6448 ("N" todo-toggle-prefix-numbers)
6420 ("PB" todo-print-buffer) 6449 ("PB" todo-print-buffer)
6421 ("PF" todo-print-buffer-to-file) 6450 ("PF" todo-print-buffer-to-file)
6422 ("b" todo-backward-category)
6423 ("d" todo-item-done)
6424 ("f" todo-forward-category)
6425 ("j" todo-jump-to-category) 6451 ("j" todo-jump-to-category)
6426 ("n" todo-next-item) 6452 ("n" todo-next-item)
6427 ("p" todo-previous-item) 6453 ("p" todo-previous-item)
@@ -6436,6 +6462,8 @@ Filtered Items mode following todo (not done) items."
6436 ("Fc" todo-show-categories-table) 6462 ("Fc" todo-show-categories-table)
6437 ("S" todo-search) 6463 ("S" todo-search)
6438 ("X" todo-clear-matches) 6464 ("X" todo-clear-matches)
6465 ("b" todo-backward-category)
6466 ("f" todo-forward-category)
6439 ("*" todo-toggle-mark-item) 6467 ("*" todo-toggle-mark-item)
6440 ) 6468 )
6441 "List of key bindings for Todo and Todo Archive modes.") 6469 "List of key bindings for Todo and Todo Archive modes.")
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 9c05e364dfd..86bd6038e36 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -214,7 +214,7 @@ from which to start."
214 (when (> spaces 0) 214 (when (> spaces 0)
215 (push (char-fold--make-space-string spaces) out)) 215 (push (char-fold--make-space-string spaces) out))
216 (let ((regexp (apply #'concat (nreverse out)))) 216 (let ((regexp (apply #'concat (nreverse out))))
217 ;; Limited by `MAX_BUF_SIZE' in `regex.c'. 217 ;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'.
218 (if (> (length regexp) 5000) 218 (if (> (length regexp) 5000)
219 (regexp-quote string) 219 (regexp-quote string)
220 regexp)))) 220 regexp))))
diff --git a/lisp/comint.el b/lisp/comint.el
index 71a2b5eca55..a9c3e47f88e 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -78,7 +78,7 @@
78;; 78;;
79;; Not bound by default in comint-mode (some are in shell mode) 79;; Not bound by default in comint-mode (some are in shell mode)
80;; comint-run Run a program under comint-mode 80;; comint-run Run a program under comint-mode
81;; send-invisible Read a line w/o echo, and send to proc 81;; comint-send-invisible Read a line w/o echo, and send to proc
82;; comint-dynamic-complete-filename Complete filename at point. 82;; comint-dynamic-complete-filename Complete filename at point.
83;; comint-dynamic-list-filename-completions List completions in help buffer. 83;; comint-dynamic-list-filename-completions List completions in help buffer.
84;; comint-replace-by-expanded-filename Expand and complete filename at point; 84;; comint-replace-by-expanded-filename Expand and complete filename at point;
@@ -632,7 +632,7 @@ Input ring history expansion can be achieved with the commands
632Input ring expansion is controlled by the variable `comint-input-autoexpand', 632Input ring expansion is controlled by the variable `comint-input-autoexpand',
633and addition is controlled by the variable `comint-input-ignoredups'. 633and addition is controlled by the variable `comint-input-ignoredups'.
634 634
635Commands with no default key bindings include `send-invisible', 635Commands with no default key bindings include `comint-send-invisible',
636`completion-at-point', `comint-dynamic-list-filename-completions', and 636`completion-at-point', `comint-dynamic-list-filename-completions', and
637`comint-magic-space'. 637`comint-magic-space'.
638 638
@@ -2247,7 +2247,7 @@ This function could be on `comint-output-filter-functions' or bound to a key."
2247 (error nil)) 2247 (error nil))
2248 (while (re-search-forward "\r+$" pmark t) 2248 (while (re-search-forward "\r+$" pmark t)
2249 (replace-match "" t t))))) 2249 (replace-match "" t t)))))
2250(defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m) 2250(define-obsolete-function-alias 'shell-strip-ctrl-m #'comint-strip-ctrl-m "27.1")
2251 2251
2252(defun comint-show-maximum-output () 2252(defun comint-show-maximum-output ()
2253 "Put the end of the buffer at the bottom of the window." 2253 "Put the end of the buffer at the bottom of the window."
@@ -2357,9 +2357,9 @@ a buffer local variable."
2357 2357
2358;; These three functions are for entering text you don't want echoed or 2358;; These three functions are for entering text you don't want echoed or
2359;; saved -- typically passwords to ftp, telnet, or somesuch. 2359;; saved -- typically passwords to ftp, telnet, or somesuch.
2360;; Just enter m-x send-invisible and type in your line. 2360;; Just enter m-x comint-send-invisible and type in your line.
2361 2361
2362(defun send-invisible (&optional prompt) 2362(defun comint-send-invisible (&optional prompt)
2363 "Read a string without echoing. 2363 "Read a string without echoing.
2364Then send it to the process running in the current buffer. 2364Then send it to the process running in the current buffer.
2365The string is sent using `comint-input-sender'. 2365The string is sent using `comint-input-sender'.
@@ -2382,18 +2382,19 @@ Security bug: your string can still be temporarily recovered with
2382 (message "Warning: text will be echoed"))) 2382 (message "Warning: text will be echoed")))
2383 (error "Buffer %s has no process" (current-buffer))))) 2383 (error "Buffer %s has no process" (current-buffer)))))
2384 2384
2385(define-obsolete-function-alias 'send-invisible #'comint-send-invisible "27.1")
2386
2385(defun comint-watch-for-password-prompt (string) 2387(defun comint-watch-for-password-prompt (string)
2386 "Prompt in the minibuffer for password and send without echoing. 2388 "Prompt in the minibuffer for password and send without echoing.
2387This function uses `send-invisible' to read and send a password to the buffer's 2389Looks for a match to `comint-password-prompt-regexp' in order
2388process if STRING contains a password prompt defined by 2390to detect the need to (prompt and) send a password.
2389`comint-password-prompt-regexp'.
2390 2391
2391This function could be in the list `comint-output-filter-functions'." 2392This function could be in the list `comint-output-filter-functions'."
2392 (when (let ((case-fold-search t)) 2393 (when (let ((case-fold-search t))
2393 (string-match comint-password-prompt-regexp string)) 2394 (string-match comint-password-prompt-regexp string))
2394 (when (string-match "^[ \n\r\t\v\f\b\a]+" string) 2395 (when (string-match "^[ \n\r\t\v\f\b\a]+" string)
2395 (setq string (replace-match "" t t string))) 2396 (setq string (replace-match "" t t string)))
2396 (send-invisible string))) 2397 (comint-send-invisible string)))
2397 2398
2398;; Low-level process communication 2399;; Low-level process communication
2399 2400
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index e5e787771b9..995c55b2b20 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -1,4 +1,4 @@
1;;; cus-theme.el -- custom theme creation user interface 1;;; cus-theme.el -- custom theme creation user interface -*- lexical-binding: t -*-
2;; 2;;
3;; Copyright (C) 2001-2018 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2018 Free Software Foundation, Inc.
4;; 4;;
@@ -47,7 +47,7 @@
47Do not call this mode function yourself. It is meant for internal use." 47Do not call this mode function yourself. It is meant for internal use."
48 (use-local-map custom-new-theme-mode-map) 48 (use-local-map custom-new-theme-mode-map)
49 (custom--initialize-widget-variables) 49 (custom--initialize-widget-variables)
50 (set (make-local-variable 'revert-buffer-function) 'custom-theme-revert)) 50 (setq-local revert-buffer-function #'custom-theme-revert))
51(put 'custom-new-theme-mode 'mode-class 'special) 51(put 'custom-new-theme-mode 'mode-class 'special)
52 52
53(defvar custom-theme-name nil) 53(defvar custom-theme-name nil)
@@ -93,15 +93,14 @@ named *Custom Theme*."
93 (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*"))) 93 (switch-to-buffer (get-buffer-create (or buffer "*Custom Theme*")))
94 (let ((inhibit-read-only t)) 94 (let ((inhibit-read-only t))
95 (erase-buffer) 95 (erase-buffer)
96 (dolist (ov (overlays-in (point-min) (point-max))) 96 (delete-all-overlays))
97 (delete-overlay ov)))
98 (custom-new-theme-mode) 97 (custom-new-theme-mode)
99 (make-local-variable 'custom-theme-name) 98 (make-local-variable 'custom-theme-name)
100 (set (make-local-variable 'custom-theme--save-name) theme) 99 (setq-local custom-theme--save-name theme)
101 (set (make-local-variable 'custom-theme-faces) nil) 100 (setq-local custom-theme-faces nil)
102 (set (make-local-variable 'custom-theme-variables) nil) 101 (setq-local custom-theme-variables nil)
103 (set (make-local-variable 'custom-theme-description) "") 102 (setq-local custom-theme-description "")
104 (set (make-local-variable 'custom-theme--migrate-settings) nil) 103 (setq-local custom-theme--migrate-settings nil)
105 (make-local-variable 'custom-theme-insert-face-marker) 104 (make-local-variable 'custom-theme-insert-face-marker)
106 (make-local-variable 'custom-theme-insert-variable-marker) 105 (make-local-variable 'custom-theme-insert-variable-marker)
107 (make-local-variable 'custom-theme--listed-faces) 106 (make-local-variable 'custom-theme--listed-faces)
@@ -118,13 +117,13 @@ remove them from your saved Custom file.\n\n"))
118 :tag " Visit Theme " 117 :tag " Visit Theme "
119 :help-echo "Insert the settings of a pre-defined theme." 118 :help-echo "Insert the settings of a pre-defined theme."
120 :action (lambda (_widget &optional _event) 119 :action (lambda (_widget &optional _event)
121 (call-interactively 'custom-theme-visit-theme))) 120 (call-interactively #'custom-theme-visit-theme)))
122 (widget-insert " ") 121 (widget-insert " ")
123 (widget-create 'push-button 122 (widget-create 'push-button
124 :tag " Merge Theme " 123 :tag " Merge Theme "
125 :help-echo "Merge in the settings of a pre-defined theme." 124 :help-echo "Merge in the settings of a pre-defined theme."
126 :action (lambda (_widget &optional _event) 125 :action (lambda (_widget &optional _event)
127 (call-interactively 'custom-theme-merge-theme))) 126 (call-interactively #'custom-theme-merge-theme)))
128 (widget-insert " ") 127 (widget-insert " ")
129 (widget-create 'push-button 128 (widget-create 'push-button
130 :tag " Revert " 129 :tag " Revert "
@@ -142,7 +141,7 @@ remove them from your saved Custom file.\n\n"))
142 (widget-create 'text 141 (widget-create 'text
143 :value (format-time-string "Created %Y-%m-%d."))) 142 :value (format-time-string "Created %Y-%m-%d.")))
144 (widget-create 'push-button 143 (widget-create 'push-button
145 :notify (function custom-theme-write) 144 :notify #'custom-theme-write
146 " Save Theme ") 145 " Save Theme ")
147 (when (eq theme 'user) 146 (when (eq theme 'user)
148 (setq custom-theme--migrate-settings t) 147 (setq custom-theme--migrate-settings t)
@@ -188,7 +187,7 @@ remove them from your saved Custom file.\n\n"))
188 :mouse-face 'highlight 187 :mouse-face 'highlight
189 :pressed-face 'highlight 188 :pressed-face 'highlight
190 :action (lambda (_widget &optional _event) 189 :action (lambda (_widget &optional _event)
191 (call-interactively 'custom-theme-add-face))) 190 (call-interactively #'custom-theme-add-face)))
192 191
193 ;; If THEME is non-nil, insert all of that theme's variables. 192 ;; If THEME is non-nil, insert all of that theme's variables.
194 (widget-insert "\n\n Theme variables:\n ") 193 (widget-insert "\n\n Theme variables:\n ")
@@ -207,7 +206,7 @@ remove them from your saved Custom file.\n\n"))
207 :mouse-face 'highlight 206 :mouse-face 'highlight
208 :pressed-face 'highlight 207 :pressed-face 'highlight
209 :action (lambda (_widget &optional _event) 208 :action (lambda (_widget &optional _event)
210 (call-interactively 'custom-theme-add-variable))) 209 (call-interactively #'custom-theme-add-variable)))
211 (widget-insert ?\n) 210 (widget-insert ?\n)
212 (widget-setup) 211 (widget-setup)
213 (goto-char (point-min)) 212 (goto-char (point-min))
@@ -254,7 +253,7 @@ interactively, this defaults to the current value of VAR."
254 :tag (custom-unlispify-tag-name symbol) 253 :tag (custom-unlispify-tag-name symbol)
255 :value symbol 254 :value symbol
256 :shown-value (list val) 255 :shown-value (list val)
257 :notify 'ignore 256 :notify #'ignore
258 :custom-level 0 257 :custom-level 0
259 :custom-state 'hidden 258 :custom-state 'hidden
260 :custom-style 'simple)) 259 :custom-style 'simple))
@@ -313,7 +312,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
313 (interactive 312 (interactive
314 (list 313 (list
315 (intern (completing-read "Find custom theme: " 314 (intern (completing-read "Find custom theme: "
316 (mapcar 'symbol-name 315 (mapcar #'symbol-name
317 (custom-available-themes)))))) 316 (custom-available-themes))))))
318 (unless (custom-theme-name-valid-p theme) 317 (unless (custom-theme-name-valid-p theme)
319 (error "No valid theme named `%s'" theme)) 318 (error "No valid theme named `%s'" theme))
@@ -328,7 +327,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
328 (interactive 327 (interactive
329 (list 328 (list
330 (intern (completing-read "Merge custom theme: " 329 (intern (completing-read "Merge custom theme: "
331 (mapcar 'symbol-name 330 (mapcar #'symbol-name
332 (custom-available-themes)))))) 331 (custom-available-themes))))))
333 (unless (eq theme 'user) 332 (unless (eq theme 'user)
334 (unless (custom-theme-name-valid-p theme) 333 (unless (custom-theme-name-valid-p theme)
@@ -343,8 +342,8 @@ SPEC, if non-nil, should be a face spec to which to set the widget."
343 (memq name '(custom-enabled-themes 342 (memq name '(custom-enabled-themes
344 custom-safe-themes))) 343 custom-safe-themes)))
345 (funcall (if option 344 (funcall (if option
346 'custom-theme-add-variable 345 #'custom-theme-add-variable
347 'custom-theme-add-face) 346 #'custom-theme-add-face)
348 name value))))) 347 name value)))))
349 theme) 348 theme)
350 349
@@ -475,7 +474,7 @@ It includes all faces in list FACES."
475 (interactive 474 (interactive
476 (list 475 (list
477 (intern (completing-read "Describe custom theme: " 476 (intern (completing-read "Describe custom theme: "
478 (mapcar 'symbol-name 477 (mapcar #'symbol-name
479 (custom-available-themes)))))) 478 (custom-available-themes))))))
480 (unless (custom-theme-name-valid-p theme) 479 (unless (custom-theme-name-valid-p theme)
481 (error "Invalid theme name `%s'" theme)) 480 (error "Invalid theme name `%s'" theme))
@@ -513,8 +512,7 @@ It includes all faces in list FACES."
513 (condition-case nil 512 (condition-case nil
514 (read (current-buffer)) 513 (read (current-buffer))
515 (end-of-file nil))))) 514 (end-of-file nil)))))
516 (and sexp (listp sexp) 515 (and (eq (car-safe sexp) 'deftheme)
517 (eq (car sexp) 'deftheme)
518 (setq doc (nth 2 sexp))))))) 516 (setq doc (nth 2 sexp)))))))
519 (princ "\n\nDocumentation:\n") 517 (princ "\n\nDocumentation:\n")
520 (princ (if (stringp doc) 518 (princ (if (stringp doc)
@@ -552,10 +550,10 @@ It includes all faces in list FACES."
552Do not call this mode function yourself. It is meant for internal use." 550Do not call this mode function yourself. It is meant for internal use."
553 (use-local-map custom-theme-choose-mode-map) 551 (use-local-map custom-theme-choose-mode-map)
554 (custom--initialize-widget-variables) 552 (custom--initialize-widget-variables)
555 (set (make-local-variable 'revert-buffer-function) 553 (setq-local revert-buffer-function
556 (lambda (_ignore-auto noconfirm) 554 (lambda (_ignore-auto noconfirm)
557 (when (or noconfirm (y-or-n-p "Discard current choices? ")) 555 (when (or noconfirm (y-or-n-p "Discard current choices? "))
558 (customize-themes (current-buffer)))))) 556 (customize-themes (current-buffer))))))
559(put 'custom-theme-choose-mode 'mode-class 'special) 557(put 'custom-theme-choose-mode 'mode-class 'special)
560 558
561;;;###autoload 559;;;###autoload
@@ -568,7 +566,7 @@ omitted, a buffer named *Custom Themes* is used."
568 (let ((inhibit-read-only t)) 566 (let ((inhibit-read-only t))
569 (erase-buffer)) 567 (erase-buffer))
570 (custom-theme-choose-mode) 568 (custom-theme-choose-mode)
571 (set (make-local-variable 'custom--listed-themes) nil) 569 (setq-local custom--listed-themes nil)
572 (make-local-variable 'custom-theme-allow-multiple-selections) 570 (make-local-variable 'custom-theme-allow-multiple-selections)
573 (and (null custom-theme-allow-multiple-selections) 571 (and (null custom-theme-allow-multiple-selections)
574 (> (length custom-enabled-themes) 1) 572 (> (length custom-enabled-themes) 1)
@@ -616,11 +614,11 @@ Theme files are named *-theme.el in `"))
616 (widget-create 'push-button 614 (widget-create 'push-button
617 :tag " Save Theme Settings " 615 :tag " Save Theme Settings "
618 :help-echo "Save the selected themes for future sessions." 616 :help-echo "Save the selected themes for future sessions."
619 :action 'custom-theme-save) 617 :action #'custom-theme-save)
620 (widget-insert ?\n) 618 (widget-insert ?\n)
621 (widget-create 'checkbox 619 (widget-create 'checkbox
622 :value custom-theme-allow-multiple-selections 620 :value custom-theme-allow-multiple-selections
623 :action 'custom-theme-selections-toggle) 621 :action #'custom-theme-selections-toggle)
624 (widget-insert (propertize " Select more than one theme at a time" 622 (widget-insert (propertize " Select more than one theme at a time"
625 'face '(variable-pitch (:height 0.9)))) 623 'face '(variable-pitch (:height 0.9))))
626 624
@@ -632,13 +630,13 @@ Theme files are named *-theme.el in `"))
632 :value (custom-theme-enabled-p theme) 630 :value (custom-theme-enabled-p theme)
633 :theme-name theme 631 :theme-name theme
634 :help-echo help-echo 632 :help-echo help-echo
635 :action 'custom-theme-checkbox-toggle)) 633 :action #'custom-theme-checkbox-toggle))
636 (push (cons theme widget) custom--listed-themes) 634 (push (cons theme widget) custom--listed-themes)
637 (widget-create-child-and-convert widget 'push-button 635 (widget-create-child-and-convert widget 'push-button
638 :button-face-get 'ignore 636 :button-face-get 'ignore
639 :mouse-face-get 'ignore 637 :mouse-face-get 'ignore
640 :value (format " %s" theme) 638 :value (format " %s" theme)
641 :action 'widget-parent-action 639 :action #'widget-parent-action
642 :help-echo help-echo) 640 :help-echo help-echo)
643 (widget-insert " -- " 641 (widget-insert " -- "
644 (propertize (custom-theme-summary theme) 642 (propertize (custom-theme-summary theme)
@@ -662,8 +660,7 @@ Theme files are named *-theme.el in `"))
662 (condition-case nil 660 (condition-case nil
663 (read (current-buffer)) 661 (read (current-buffer))
664 (end-of-file nil))))) 662 (end-of-file nil)))))
665 (and sexp (listp sexp) 663 (and (eq (car-safe sexp) 'deftheme)
666 (eq (car sexp) 'deftheme)
667 (setq doc (nth 2 sexp)))))))) 664 (setq doc (nth 2 sexp))))))))
668 (cond ((null doc) 665 (cond ((null doc)
669 "(no documentation available)") 666 "(no documentation available)")
diff --git a/lisp/custom.el b/lisp/custom.el
index 4a778a0573e..a08f7fda705 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1,4 +1,4 @@
1;;; custom.el --- tools for declaring and initializing options 1;;; custom.el --- tools for declaring and initializing options -*- lexical-binding: t -*-
2;; 2;;
3;; Copyright (C) 1996-1997, 1999, 2001-2018 Free Software Foundation, 3;; Copyright (C) 1996-1997, 1999, 2001-2018 Free Software Foundation,
4;; Inc. 4;; Inc.
@@ -150,7 +150,7 @@ set to nil, as the value is no longer rogue."
150 (put symbol 'force-value nil)) 150 (put symbol 'force-value nil))
151 (if (keywordp doc) 151 (if (keywordp doc)
152 (error "Doc string is missing")) 152 (error "Doc string is missing"))
153 (let ((initialize 'custom-initialize-reset) 153 (let ((initialize #'custom-initialize-reset)
154 (requests nil)) 154 (requests nil))
155 (unless (memq :group args) 155 (unless (memq :group args)
156 (custom-add-to-group (custom-current-group) symbol 'custom-variable)) 156 (custom-add-to-group (custom-current-group) symbol 'custom-variable))
@@ -426,7 +426,7 @@ information."
426(defun custom-declare-group (symbol members doc &rest args) 426(defun custom-declare-group (symbol members doc &rest args)
427 "Like `defgroup', but SYMBOL is evaluated as a normal argument." 427 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
428 (while members 428 (while members
429 (apply 'custom-add-to-group symbol (car members)) 429 (apply #'custom-add-to-group symbol (car members))
430 (setq members (cdr members))) 430 (setq members (cdr members)))
431 (when doc 431 (when doc
432 ;; This text doesn't get into DOC. 432 ;; This text doesn't get into DOC.
@@ -618,11 +618,8 @@ VARIABLE is a symbol that names a user option.
618The result is that the change is treated as having been made through Custom." 618The result is that the change is treated as having been made through Custom."
619 (put variable 'customized-value (list (custom-quote (eval variable))))) 619 (put variable 'customized-value (list (custom-quote (eval variable)))))
620 620
621 621;; Loading files needed to customize a symbol.
622;;; Custom Themes 622;; This is in custom.el because menu-bar.el needs it for toggle cmds.
623
624;;; Loading files needed to customize a symbol.
625;;; This is in custom.el because menu-bar.el needs it for toggle cmds.
626 623
627(defvar custom-load-recursion nil 624(defvar custom-load-recursion nil
628 "Hack to avoid recursive dependencies.") 625 "Hack to avoid recursive dependencies.")
@@ -633,14 +630,12 @@ The result is that the change is treated as having been made through Custom."
633 (let ((custom-load-recursion t)) 630 (let ((custom-load-recursion t))
634 ;; Load these files if not already done, 631 ;; Load these files if not already done,
635 ;; to make sure we know all the dependencies of SYMBOL. 632 ;; to make sure we know all the dependencies of SYMBOL.
636 (condition-case nil 633 (ignore-errors
637 (require 'cus-load) 634 (require 'cus-load))
638 (error nil)) 635 (ignore-errors
639 (condition-case nil 636 (require 'cus-start))
640 (require 'cus-start)
641 (error nil))
642 (dolist (load (get symbol 'custom-loads)) 637 (dolist (load (get symbol 'custom-loads))
643 (cond ((symbolp load) (condition-case nil (require load) (error nil))) 638 (cond ((symbolp load) (ignore-errors (require load)))
644 ;; This is subsumed by the test below, but it's much faster. 639 ;; This is subsumed by the test below, but it's much faster.
645 ((assoc load load-history)) 640 ((assoc load load-history))
646 ;; This was just (assoc (locate-library load) load-history) 641 ;; This was just (assoc (locate-library load) load-history)
@@ -658,7 +653,7 @@ The result is that the change is treated as having been made through Custom."
658 ;; We are still loading it when we call this, 653 ;; We are still loading it when we call this,
659 ;; and it is not in load-history yet. 654 ;; and it is not in load-history yet.
660 ((equal load "cus-edit")) 655 ((equal load "cus-edit"))
661 (t (condition-case nil (load load) (error nil)))))))) 656 (t (ignore-errors (load load))))))))
662 657
663(defvar custom-local-buffer nil 658(defvar custom-local-buffer nil
664 "Non-nil, in a Customization buffer, means customize a specific buffer. 659 "Non-nil, in a Customization buffer, means customize a specific buffer.
@@ -691,16 +686,12 @@ this sets the local binding in that buffer instead."
691 686
692(defun custom-quote (sexp) 687(defun custom-quote (sexp)
693 "Quote SEXP if it is not self quoting." 688 "Quote SEXP if it is not self quoting."
694 (if (or (memq sexp '(t nil)) 689 ;; Can't use `macroexp-quote' because it is loaded after `custom.el'
695 (keywordp sexp) 690 ;; during bootstrap. See `loadup.el'.
696 (and (listp sexp) 691 (if (and (not (consp sexp))
697 (memq (car sexp) '(lambda))) 692 (or (keywordp sexp)
698 (stringp sexp) 693 (not (symbolp sexp))
699 (numberp sexp) 694 (booleanp sexp)))
700 (vectorp sexp)
701;;; (and (fboundp 'characterp)
702;;; (characterp sexp))
703 )
704 sexp 695 sexp
705 (list 'quote sexp))) 696 (list 'quote sexp)))
706 697
@@ -715,18 +706,16 @@ To actually save the value, call `custom-save-all'.
715 706
716Return non-nil if the `saved-value' property actually changed." 707Return non-nil if the `saved-value' property actually changed."
717 (custom-load-symbol symbol) 708 (custom-load-symbol symbol)
718 (let* ((get (or (get symbol 'custom-get) 'default-value)) 709 (let* ((get (or (get symbol 'custom-get) #'default-value))
719 (value (funcall get symbol)) 710 (value (funcall get symbol))
720 (saved (get symbol 'saved-value)) 711 (saved (get symbol 'saved-value))
721 (standard (get symbol 'standard-value)) 712 (standard (get symbol 'standard-value))
722 (comment (get symbol 'customized-variable-comment))) 713 (comment (get symbol 'customized-variable-comment)))
723 ;; Save default value if different from standard value. 714 ;; Save default value if different from standard value.
724 (if (or (null standard) 715 (put symbol 'saved-value
725 (not (equal value (condition-case nil 716 (unless (and standard
726 (eval (car standard)) 717 (equal value (ignore-errors (eval (car standard)))))
727 (error nil))))) 718 (list (custom-quote value))))
728 (put symbol 'saved-value (list (custom-quote value)))
729 (put symbol 'saved-value nil))
730 ;; Clear customized information (set, but not saved). 719 ;; Clear customized information (set, but not saved).
731 (put symbol 'customized-value nil) 720 (put symbol 'customized-value nil)
732 ;; Save any comment that might have been set. 721 ;; Save any comment that might have been set.
@@ -744,15 +733,14 @@ default value. Otherwise, set it to nil.
744 733
745Return non-nil if the `customized-value' property actually changed." 734Return non-nil if the `customized-value' property actually changed."
746 (custom-load-symbol symbol) 735 (custom-load-symbol symbol)
747 (let* ((get (or (get symbol 'custom-get) 'default-value)) 736 (let* ((get (or (get symbol 'custom-get) #'default-value))
748 (value (funcall get symbol)) 737 (value (funcall get symbol))
749 (customized (get symbol 'customized-value)) 738 (customized (get symbol 'customized-value))
750 (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) 739 (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
751 ;; Mark default value as set if different from old value. 740 ;; Mark default value as set if different from old value.
752 (if (not (and old 741 (if (not (and old
753 (equal value (condition-case nil 742 (equal value (ignore-errors
754 (eval (car old)) 743 (eval (car old))))))
755 (error nil)))))
756 (progn (put symbol 'customized-value (list (custom-quote value))) 744 (progn (put symbol 'customized-value (list (custom-quote value)))
757 (custom-push-theme 'theme-value symbol 'user 'set 745 (custom-push-theme 'theme-value symbol 'user 'set
758 (custom-quote value))) 746 (custom-quote value)))
@@ -776,7 +764,7 @@ E.g. dumped variables whose default depends on run-time information."
776 ;; always do the funcall step, even if symbol was not bound before. 764 ;; always do the funcall step, even if symbol was not bound before.
777 (or (default-boundp symbol) 765 (or (default-boundp symbol)
778 (eval `(defvar ,symbol nil))) ; reset below, so any value is fine 766 (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
779 (funcall (or (get symbol 'custom-set) 'set-default) 767 (funcall (or (get symbol 'custom-set) #'set-default)
780 symbol 768 symbol
781 (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) 769 (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value))))))
782 770
@@ -946,7 +934,7 @@ the default value for the SYMBOL to the value of EXP.
946REQUEST is a list of features we must require in order to 934REQUEST is a list of features we must require in order to
947handle SYMBOL properly. 935handle SYMBOL properly.
948COMMENT is a comment string about SYMBOL." 936COMMENT is a comment string about SYMBOL."
949 (apply 'custom-theme-set-variables 'user args)) 937 (apply #'custom-theme-set-variables 'user args))
950 938
951(defun custom-theme-set-variables (theme &rest args) 939(defun custom-theme-set-variables (theme &rest args)
952 "Initialize variables for theme THEME according to settings in ARGS. 940 "Initialize variables for theme THEME according to settings in ARGS.
@@ -994,8 +982,8 @@ COMMENT is a comment string about SYMBOL."
994 set) 982 set)
995 (when requests 983 (when requests
996 (put symbol 'custom-requests requests) 984 (put symbol 'custom-requests requests)
997 (mapc 'require requests)) 985 (mapc #'require requests))
998 (setq set (or (get symbol 'custom-set) 'custom-set-default)) 986 (setq set (or (get symbol 'custom-set) #'custom-set-default))
999 (put symbol 'saved-value (list value)) 987 (put symbol 'saved-value (list value))
1000 (put symbol 'saved-variable-comment comment) 988 (put symbol 'saved-variable-comment comment)
1001 ;; Allow for errors in the case where the setter has 989 ;; Allow for errors in the case where the setter has
@@ -1091,26 +1079,29 @@ list, in which A occurs before B if B was defined with a
1091;; they were used to supply keyword-value pairs like `:immediate', 1079;; they were used to supply keyword-value pairs like `:immediate',
1092;; `:variable-reset-string', etc. We don't use any of these, so ignore them. 1080;; `:variable-reset-string', etc. We don't use any of these, so ignore them.
1093 1081
1094(defmacro deftheme (theme &optional doc &rest ignored) 1082(defmacro deftheme (theme &optional doc &rest _ignored)
1095 "Declare THEME to be a Custom theme. 1083 "Declare THEME to be a Custom theme.
1096The optional argument DOC is a doc string describing the theme. 1084The optional argument DOC is a doc string describing the theme.
1097 1085
1098Any theme `foo' should be defined in a file called `foo-theme.el'; 1086Any theme `foo' should be defined in a file called `foo-theme.el';
1099see `custom-make-theme-feature' for more information." 1087see `custom-make-theme-feature' for more information."
1100 (declare (doc-string 2)) 1088 (declare (doc-string 2)
1089 (advertised-calling-convention (theme &optional doc) "22.1"))
1101 (let ((feature (custom-make-theme-feature theme))) 1090 (let ((feature (custom-make-theme-feature theme)))
1102 ;; It is better not to use backquote in this file, 1091 ;; It is better not to use backquote in this file,
1103 ;; because that makes a bootstrapping problem 1092 ;; because that makes a bootstrapping problem
1104 ;; if you need to recompile all the Lisp files using interpreted code. 1093 ;; if you need to recompile all the Lisp files using interpreted code.
1105 (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc))) 1094 (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc)))
1106 1095
1107(defun custom-declare-theme (theme feature &optional doc &rest ignored) 1096(defun custom-declare-theme (theme feature &optional doc &rest _ignored)
1108 "Like `deftheme', but THEME is evaluated as a normal argument. 1097 "Like `deftheme', but THEME is evaluated as a normal argument.
1109FEATURE is the feature this theme provides. Normally, this is a symbol 1098FEATURE is the feature this theme provides. Normally, this is a symbol
1110created from THEME by `custom-make-theme-feature'." 1099created from THEME by `custom-make-theme-feature'."
1100 (declare (advertised-calling-convention (theme feature &optional doc) "22.1"))
1111 (unless (custom-theme-name-valid-p theme) 1101 (unless (custom-theme-name-valid-p theme)
1112 (error "Custom theme cannot be named %S" theme)) 1102 (error "Custom theme cannot be named %S" theme))
1113 (add-to-list 'custom-known-themes theme) 1103 (unless (memq theme custom-known-themes)
1104 (push theme custom-known-themes))
1114 (put theme 'theme-feature feature) 1105 (put theme 'theme-feature feature)
1115 (when doc (put theme 'theme-documentation doc))) 1106 (when doc (put theme 'theme-documentation doc)))
1116 1107
@@ -1218,7 +1209,7 @@ Return t if THEME was successfully loaded, nil otherwise."
1218 (interactive 1209 (interactive
1219 (list 1210 (list
1220 (intern (completing-read "Load custom theme: " 1211 (intern (completing-read "Load custom theme: "
1221 (mapcar 'symbol-name 1212 (mapcar #'symbol-name
1222 (custom-available-themes)))) 1213 (custom-available-themes))))
1223 nil nil)) 1214 nil nil))
1224 (unless (custom-theme-name-valid-p theme) 1215 (unless (custom-theme-name-valid-p theme)
@@ -1233,43 +1224,47 @@ Return t if THEME was successfully loaded, nil otherwise."
1233 (put theme 'theme-settings nil) 1224 (put theme 'theme-settings nil)
1234 (put theme 'theme-feature nil) 1225 (put theme 'theme-feature nil)
1235 (put theme 'theme-documentation nil)) 1226 (put theme 'theme-documentation nil))
1236 (let ((fn (locate-file (concat (symbol-name theme) "-theme.el") 1227 (let ((file (locate-file (concat (symbol-name theme) "-theme.el")
1237 (custom-theme--load-path) 1228 (custom-theme--load-path)
1238 '("" "c")))) 1229 '("" "c")))
1239 (unless fn 1230 (custom--inhibit-theme-enable t))
1240 (error "Unable to find theme file for `%s'" theme)) 1231 ;; Check file safety with `custom-safe-themes', prompting the
1241 (with-temp-buffer 1232 ;; user if necessary.
1242 (insert-file-contents fn) 1233 (cond ((not file)
1243 ;; Check file safety with `custom-safe-themes', prompting the 1234 (error "Unable to find theme file for `%s'" theme))
1244 ;; user if necessary. 1235 ((or no-confirm
1245 (when (or no-confirm 1236 (eq custom-safe-themes t)
1246 (eq custom-safe-themes t) 1237 (and (memq 'default custom-safe-themes)
1247 (and (memq 'default custom-safe-themes) 1238 (equal (file-name-directory file)
1248 (equal (file-name-directory fn) 1239 (expand-file-name "themes/" data-directory))))
1249 (expand-file-name "themes/" data-directory))) 1240 ;; Theme is safe; load byte-compiled version if available.
1250 (let ((hash (secure-hash 'sha256 (current-buffer)))) 1241 (load (file-name-sans-extension file) nil t nil t))
1251 (or (member hash custom-safe-themes) 1242 ((with-temp-buffer
1252 (custom-theme-load-confirm hash)))) 1243 (insert-file-contents file)
1253 (let ((custom--inhibit-theme-enable t) 1244 (let ((hash (secure-hash 'sha256 (current-buffer))))
1254 (buffer-file-name fn)) ;For load-history. 1245 (when (or (member hash custom-safe-themes)
1255 (eval-buffer)) 1246 (custom-theme-load-confirm hash))
1256 ;; Optimization: if the theme changes the `default' face, put that 1247 (eval-buffer nil nil file)
1257 ;; entry first. This avoids some `frame-set-background-mode' rigmarole 1248 t))))
1258 ;; by assigning the new background immediately. 1249 (t
1259 (let* ((settings (get theme 'theme-settings)) 1250 (error "Unable to load theme `%s'" theme))))
1260 (tail settings) 1251 ;; Optimization: if the theme changes the `default' face, put that
1261 found) 1252 ;; entry first. This avoids some `frame-set-background-mode' rigmarole
1262 (while (and tail (not found)) 1253 ;; by assigning the new background immediately.
1263 (and (eq (nth 0 (car tail)) 'theme-face) 1254 (let* ((settings (get theme 'theme-settings))
1264 (eq (nth 1 (car tail)) 'default) 1255 (tail settings)
1265 (setq found (car tail))) 1256 found)
1266 (setq tail (cdr tail))) 1257 (while (and tail (not found))
1267 (if found 1258 (and (eq (nth 0 (car tail)) 'theme-face)
1268 (put theme 'theme-settings (cons found (delq found settings))))) 1259 (eq (nth 1 (car tail)) 'default)
1269 ;; Finally, enable the theme. 1260 (setq found (car tail)))
1270 (unless no-enable 1261 (setq tail (cdr tail)))
1271 (enable-theme theme)) 1262 (when found
1272 t)))) 1263 (put theme 'theme-settings (cons found (delq found settings)))))
1264 ;; Finally, enable the theme.
1265 (unless no-enable
1266 (enable-theme theme))
1267 t)
1273 1268
1274(defun custom-theme-load-confirm (hash) 1269(defun custom-theme-load-confirm (hash)
1275 "Query the user about loading a Custom theme that may not be safe. 1270 "Query the user about loading a Custom theme that may not be safe.
@@ -1292,11 +1287,9 @@ query also about adding HASH to `custom-safe-themes'."
1292(defun custom-theme-name-valid-p (name) 1287(defun custom-theme-name-valid-p (name)
1293 "Return t if NAME is a valid name for a Custom theme, nil otherwise. 1288 "Return t if NAME is a valid name for a Custom theme, nil otherwise.
1294NAME should be a symbol." 1289NAME should be a symbol."
1295 (and (symbolp name) 1290 (and (not (memq name '(nil user changed)))
1296 name 1291 (symbolp name)
1297 (not (or (zerop (length (symbol-name name))) 1292 (not (string= "" (symbol-name name)))))
1298 (eq name 'user)
1299 (eq name 'changed)))))
1300 1293
1301(defun custom-available-themes () 1294(defun custom-available-themes ()
1302 "Return a list of Custom themes available for loading. 1295 "Return a list of Custom themes available for loading.
@@ -1307,19 +1300,25 @@ The returned symbols may not correspond to themes that have been
1307loaded, and no effort is made to check that the files contain 1300loaded, and no effort is made to check that the files contain
1308valid Custom themes. For a list of loaded themes, check the 1301valid Custom themes. For a list of loaded themes, check the
1309variable `custom-known-themes'." 1302variable `custom-known-themes'."
1310 (let (sym themes) 1303 (let ((suffix "-theme\\.el\\'")
1304 themes)
1311 (dolist (dir (custom-theme--load-path)) 1305 (dolist (dir (custom-theme--load-path))
1312 (when (file-directory-p dir) 1306 ;; `custom-theme--load-path' promises DIR exists and is a
1313 (dolist (file (file-expand-wildcards 1307 ;; directory, but `custom.el' is loaded too early during
1314 (expand-file-name "*-theme.el" dir) t)) 1308 ;; bootstrap to use `cl-lib' macros, so guard with
1315 (setq file (file-name-nondirectory file)) 1309 ;; `file-directory-p' instead of calling `cl-assert'.
1316 (and (string-match "\\`\\(.+\\)-theme.el\\'" file) 1310 (dolist (file (and (file-directory-p dir)
1317 (setq sym (intern (match-string 1 file))) 1311 (directory-files dir nil suffix)))
1318 (custom-theme-name-valid-p sym) 1312 (let ((theme (intern (substring file 0 (string-match-p suffix file)))))
1319 (push sym themes))))) 1313 (and (custom-theme-name-valid-p theme)
1320 (nreverse (delete-dups themes)))) 1314 (not (memq theme themes))
1315 (push theme themes)))))
1316 (nreverse themes)))
1321 1317
1322(defun custom-theme--load-path () 1318(defun custom-theme--load-path ()
1319 "Expand `custom-theme-load-path' into a list of directories.
1320Members of `custom-theme-load-path' that either don't exist or
1321are not directories are omitted from the expansion."
1323 (let (lpath) 1322 (let (lpath)
1324 (dolist (f custom-theme-load-path) 1323 (dolist (f custom-theme-load-path)
1325 (cond ((eq f 'custom-theme-directory) 1324 (cond ((eq f 'custom-theme-directory)
@@ -1346,8 +1345,8 @@ function runs. To disable other themes, use `disable-theme'."
1346 (completing-read 1345 (completing-read
1347 "Enable custom theme: " 1346 "Enable custom theme: "
1348 obarray (lambda (sym) (get sym 'theme-settings)) t)))) 1347 obarray (lambda (sym) (get sym 'theme-settings)) t))))
1349 (if (not (custom-theme-p theme)) 1348 (unless (custom-theme-p theme)
1350 (error "Undefined Custom theme %s" theme)) 1349 (error "Undefined Custom theme %s" theme))
1351 (let ((settings (get theme 'theme-settings))) 1350 (let ((settings (get theme 'theme-settings)))
1352 ;; Loop through theme settings, recalculating vars/faces. 1351 ;; Loop through theme settings, recalculating vars/faces.
1353 (dolist (s settings) 1352 (dolist (s settings)
@@ -1387,23 +1386,23 @@ Setting this variable through Customize calls `enable-theme' or
1387 (let (failures) 1386 (let (failures)
1388 (setq themes (delq 'user (delete-dups themes))) 1387 (setq themes (delq 'user (delete-dups themes)))
1389 ;; Disable all themes not in THEMES. 1388 ;; Disable all themes not in THEMES.
1390 (if (boundp symbol) 1389 (dolist (theme (and (boundp symbol)
1391 (dolist (theme (symbol-value symbol)) 1390 (symbol-value symbol)))
1392 (if (not (memq theme themes)) 1391 (unless (memq theme themes)
1393 (disable-theme theme)))) 1392 (disable-theme theme)))
1394 ;; Call `enable-theme' or `load-theme' on each of THEMES. 1393 ;; Call `enable-theme' or `load-theme' on each of THEMES.
1395 (dolist (theme (reverse themes)) 1394 (dolist (theme (reverse themes))
1396 (condition-case nil 1395 (condition-case nil
1397 (if (custom-theme-p theme) 1396 (if (custom-theme-p theme)
1398 (enable-theme theme) 1397 (enable-theme theme)
1399 (load-theme theme)) 1398 (load-theme theme))
1400 (error (setq failures (cons theme failures) 1399 (error (push theme failures)
1401 themes (delq theme themes))))) 1400 (setq themes (delq theme themes)))))
1402 (enable-theme 'user) 1401 (enable-theme 'user)
1403 (custom-set-default symbol themes) 1402 (custom-set-default symbol themes)
1404 (if failures 1403 (when failures
1405 (message "Failed to enable theme: %s" 1404 (message "Failed to enable theme(s): %s"
1406 (mapconcat 'symbol-name failures ", ")))))) 1405 (mapconcat #'symbol-name failures ", "))))))
1407 1406
1408(defsubst custom-theme-enabled-p (theme) 1407(defsubst custom-theme-enabled-p (theme)
1409 "Return non-nil if THEME is enabled." 1408 "Return non-nil if THEME is enabled."
@@ -1415,7 +1414,7 @@ See `custom-enabled-themes' for a list of enabled themes."
1415 (interactive (list (intern 1414 (interactive (list (intern
1416 (completing-read 1415 (completing-read
1417 "Disable custom theme: " 1416 "Disable custom theme: "
1418 (mapcar 'symbol-name custom-enabled-themes) 1417 (mapcar #'symbol-name custom-enabled-themes)
1419 nil t)))) 1418 nil t))))
1420 (when (custom-theme-enabled-p theme) 1419 (when (custom-theme-enabled-p theme)
1421 (let ((settings (get theme 'theme-settings))) 1420 (let ((settings (get theme 'theme-settings)))
@@ -1431,23 +1430,23 @@ See `custom-enabled-themes' for a list of enabled themes."
1431 ;; If the face spec specified by this theme is in the 1430 ;; If the face spec specified by this theme is in the
1432 ;; saved-face property, reset that property. 1431 ;; saved-face property, reset that property.
1433 (when (equal (nth 3 s) (get symbol 'saved-face)) 1432 (when (equal (nth 3 s) (get symbol 'saved-face))
1434 (put symbol 'saved-face (and val (cadr (car val))))))))) 1433 (put symbol 'saved-face (cadar val))))))))
1435 ;; Recompute faces on all frames. 1434 ;; Recompute faces on all frames.
1436 (dolist (frame (frame-list)) 1435 (dolist (frame (frame-list))
1437 ;; We must reset the fg and bg color frame parameters, or 1436 ;; We must reset the fg and bg color frame parameters, or
1438 ;; `face-set-after-frame-default' will use the existing 1437 ;; `face-set-after-frame-default' will use the existing
1439 ;; parameters, which could be from the disabled theme. 1438 ;; parameters, which could be from the disabled theme.
1440 (set-frame-parameter frame 'background-color 1439 (set-frame-parameter frame 'background-color
1441 (custom--frame-color-default 1440 (custom--frame-color-default
1442 frame :background "background" "Background" 1441 frame :background "background" "Background"
1443 "unspecified-bg" "white")) 1442 "unspecified-bg" "white"))
1444 (set-frame-parameter frame 'foreground-color 1443 (set-frame-parameter frame 'foreground-color
1445 (custom--frame-color-default 1444 (custom--frame-color-default
1446 frame :foreground "foreground" "Foreground" 1445 frame :foreground "foreground" "Foreground"
1447 "unspecified-fg" "black")) 1446 "unspecified-fg" "black"))
1448 (face-set-after-frame-default frame)) 1447 (face-set-after-frame-default frame))
1449 (setq custom-enabled-themes 1448 (setq custom-enabled-themes
1450 (delq theme custom-enabled-themes))))) 1449 (delq theme custom-enabled-themes))))
1451 1450
1452;; Only used if window-system not null. 1451;; Only used if window-system not null.
1453(declare-function x-get-resource "frame.c" 1452(declare-function x-get-resource "frame.c"
@@ -1481,7 +1480,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
1481 (if (and valspec 1480 (if (and valspec
1482 (or (get variable 'force-value) 1481 (or (get variable 'force-value)
1483 (default-boundp variable))) 1482 (default-boundp variable)))
1484 (funcall (or (get variable 'custom-set) 'set-default) variable 1483 (funcall (or (get variable 'custom-set) #'set-default) variable
1485 (eval (car valspec)))))) 1484 (eval (car valspec))))))
1486 1485
1487(defun custom-theme-recalc-face (face) 1486(defun custom-theme-recalc-face (face)
@@ -1522,7 +1521,7 @@ Each of the arguments ARGS has this form:
1522 (VARIABLE IGNORED) 1521 (VARIABLE IGNORED)
1523 1522
1524This means reset VARIABLE. (The argument IGNORED is ignored)." 1523This means reset VARIABLE. (The argument IGNORED is ignored)."
1525 (apply 'custom-theme-reset-variables 'user args)) 1524 (apply #'custom-theme-reset-variables 'user args))
1526 1525
1527;;; The End. 1526;;; The End.
1528 1527
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 925a7d50d6f..21ee50ce5cd 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1989,6 +1989,19 @@ Optional arg HOW-TO determines how to treat the target.
1989 dired-dirs))) 1989 dired-dirs)))
1990 1990
1991 1991
1992
1993;; We use this function in `dired-create-directory' and
1994;; `dired-create-empty-file'; the return value is the new entry
1995;; in the updated Dired buffer.
1996(defun dired--find-topmost-parent-dir (filename)
1997 "Return the topmost nonexistent parent dir of FILENAME.
1998FILENAME is a full file name."
1999 (let ((try filename) new)
2000 (while (and try (not (file-exists-p try)) (not (equal new try)))
2001 (setq new try
2002 try (directory-file-name (file-name-directory try))))
2003 new))
2004
1992;;;###autoload 2005;;;###autoload
1993(defun dired-create-directory (directory) 2006(defun dired-create-directory (directory)
1994 "Create a directory called DIRECTORY. 2007 "Create a directory called DIRECTORY.
@@ -1997,18 +2010,32 @@ If DIRECTORY already exists, signal an error."
1997 (interactive 2010 (interactive
1998 (list (read-file-name "Create directory: " (dired-current-directory)))) 2011 (list (read-file-name "Create directory: " (dired-current-directory))))
1999 (let* ((expanded (directory-file-name (expand-file-name directory))) 2012 (let* ((expanded (directory-file-name (expand-file-name directory)))
2000 (try expanded) new) 2013 new)
2001 (if (file-exists-p expanded) 2014 (if (file-exists-p expanded)
2002 (error "Cannot create directory %s: file exists" expanded)) 2015 (error "Cannot create directory %s: file exists" expanded))
2003 ;; Find the topmost nonexistent parent dir (variable `new') 2016 (setq new (dired--find-topmost-parent-dir expanded))
2004 (while (and try (not (file-exists-p try)) (not (equal new try)))
2005 (setq new try
2006 try (directory-file-name (file-name-directory try))))
2007 (make-directory expanded t) 2017 (make-directory expanded t)
2008 (when new 2018 (when new
2009 (dired-add-file new) 2019 (dired-add-file new)
2010 (dired-move-to-filename)))) 2020 (dired-move-to-filename))))
2011 2021
2022;;;###autoload
2023(defun dired-create-empty-file (file)
2024 "Create an empty file called FILE.
2025 Add a new entry for the new file in the Dired buffer.
2026 Parent directories of FILE are created as needed.
2027 If FILE already exists, signal an error."
2028 (interactive (list (read-file-name "Create empty file: ")))
2029 (let* ((expanded (expand-file-name file))
2030 new)
2031 (if (file-exists-p expanded)
2032 (error "Cannot create file %s: file exists" expanded))
2033 (setq new (dired--find-topmost-parent-dir expanded))
2034 (make-empty-file file 'parents)
2035 (when new
2036 (dired-add-file new)
2037 (dired-move-to-filename))))
2038
2012(defun dired-into-dir-with-symlinks (target) 2039(defun dired-into-dir-with-symlinks (target)
2013 (and (file-directory-p target) 2040 (and (file-directory-p target)
2014 (not (file-symlink-p target)))) 2041 (not (file-symlink-p target))))
diff --git a/lisp/dired.el b/lisp/dired.el
index 1348df6934b..26a7449e039 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1802,6 +1802,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1802 (define-key map [menu-bar immediate create-directory] 1802 (define-key map [menu-bar immediate create-directory]
1803 '(menu-item "Create Directory..." dired-create-directory 1803 '(menu-item "Create Directory..." dired-create-directory
1804 :help "Create a directory")) 1804 :help "Create a directory"))
1805 (define-key map [menu-bar immediate create-empty-file]
1806 '(menu-item "Create Empty file..." dired-create-empty-file
1807 :help "Create an empty file"))
1805 (define-key map [menu-bar immediate wdired-mode] 1808 (define-key map [menu-bar immediate wdired-mode]
1806 '(menu-item "Edit File Names" wdired-change-to-wdired-mode 1809 '(menu-item "Edit File Names" wdired-change-to-wdired-mode
1807 :help "Put a Dired buffer in a mode in which filenames are editable" 1810 :help "Put a Dired buffer in a mode in which filenames are editable"
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
new file mode 100644
index 00000000000..f13b43b465c
--- /dev/null
+++ b/lisp/emacs-lisp/backtrace.el
@@ -0,0 +1,916 @@
1;;; backtrace.el --- generic major mode for Elisp backtraces -*- lexical-binding: t -*-
2
3;; Copyright (C) 2018 Free Software Foundation, Inc.
4
5;; Author: Gemini Lasswell
6;; Keywords: lisp, tools, maint
7;; Version: 1.0
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; This file defines Backtrace mode, a generic major mode for displaying
27;; Elisp stack backtraces, which can be used as is or inherited from
28;; by another mode.
29
30;; For usage information, see the documentation of `backtrace-mode'.
31
32;;; Code:
33
34(eval-when-compile (require 'cl-lib))
35(eval-when-compile (require 'pcase))
36(eval-when-compile (require 'subr-x)) ; if-let
37(require 'help-mode) ; Define `help-function-def' button type.
38(require 'lisp-mode)
39
40;;; Options
41
42(defgroup backtrace nil
43 "Viewing of Elisp backtraces."
44 :group 'lisp)
45
46(defcustom backtrace-fontify t
47 "If non-nil, fontify Backtrace buffers.
48Set to nil to disable fontification, which may be necessary in
49order to debug the code that does fontification."
50 :type 'boolean
51 :group 'backtrace
52 :version "27.1")
53
54(defcustom backtrace-line-length 5000
55 "Target length for lines in Backtrace buffers.
56Backtrace mode will attempt to abbreviate printing of backtrace
57frames to make them shorter than this, but success is not
58guaranteed. If set to nil or zero, Backtrace mode will not
59abbreviate the forms it prints."
60 :type 'integer
61 :group 'backtrace
62 :version "27.1")
63
64;;; Backtrace frame data structure
65
66(cl-defstruct
67 (backtrace-frame
68 (:constructor backtrace-make-frame))
69 evald ; Non-nil if argument evaluation is complete.
70 fun ; The function called/to call in this frame.
71 args ; Either evaluated or unevaluated arguments to the function.
72 flags ; A plist, possible properties are :debug-on-exit and :source-available.
73 locals ; An alist containing variable names and values.
74 buffer ; If non-nil, the buffer in use by eval-buffer or eval-region.
75 pos ; The position in the buffer.
76 )
77
78(cl-defun backtrace-get-frames
79 (&optional base &key (constructor #'backtrace-make-frame))
80 "Collect all frames of current backtrace into a list.
81The list will contain objects made by CONSTRUCTOR, which
82defaults to `backtrace-make-frame' and which, if provided, should
83be the constructor of a structure which includes
84`backtrace-frame'. If non-nil, BASE should be a function, and
85frames before its nearest activation frame are discarded."
86 (let ((frames nil)
87 (eval-buffers eval-buffer-list))
88 (mapbacktrace (lambda (evald fun args flags)
89 (push (funcall constructor
90 :evald evald :fun fun
91 :args args :flags flags)
92 frames))
93 (or base 'backtrace-get-frames))
94 (setq frames (nreverse frames))
95 ;; Add local variables to each frame, and the buffer position
96 ;; to frames containing eval-buffer or eval-region.
97 (dotimes (idx (length frames))
98 (let ((frame (nth idx frames)))
99 ;; `backtrace--locals' gives an error when idx is 0. But the
100 ;; locals for frame 0 are not needed, because when we get here
101 ;; from debug-on-entry, the locals aren't bound yet, and when
102 ;; coming from Edebug or ERT there is an Edebug or ERT
103 ;; function at frame 0.
104 (when (> idx 0)
105 (setf (backtrace-frame-locals frame)
106 (backtrace--locals idx (or base 'backtrace-get-frames))))
107 (when (and eval-buffers (memq (backtrace-frame-fun frame)
108 '(eval-buffer eval-region)))
109 ;; This will get the wrong result if there are two nested
110 ;; eval-region calls for the same buffer. That's not a very
111 ;; useful case.
112 (with-current-buffer (pop eval-buffers)
113 (setf (backtrace-frame-buffer frame) (current-buffer))
114 (setf (backtrace-frame-pos frame) (point))))))
115 frames))
116
117;; Button definition for jumping to a buffer position.
118
119(define-button-type 'backtrace-buffer-pos
120 'action #'backtrace--pop-to-buffer-pos
121 'help-echo "mouse-2, RET: Show reading position")
122
123(defun backtrace--pop-to-buffer-pos (button)
124 "Pop to the buffer and position for the BUTTON at point."
125 (let* ((buffer (button-get button 'backtrace-buffer))
126 (pos (button-get button 'backtrace-pos)))
127 (if (buffer-live-p buffer)
128 (progn
129 (pop-to-buffer buffer)
130 (goto-char (max (point-min) (min (point-max) pos))))
131 (message "Buffer has been killed"))))
132
133;; Font Locking support
134
135(defconst backtrace--font-lock-keywords
136 '((backtrace--match-ellipsis-in-string
137 (1 'button prepend)))
138 "Expressions to fontify in Backtrace mode.
139Fontify these in addition to the expressions Emacs Lisp mode
140fontifies.")
141
142(defconst backtrace-font-lock-keywords
143 (append lisp-el-font-lock-keywords-for-backtraces
144 backtrace--font-lock-keywords)
145 "Default expressions to highlight in Backtrace mode.")
146(defconst backtrace-font-lock-keywords-1
147 (append lisp-el-font-lock-keywords-for-backtraces-1
148 backtrace--font-lock-keywords)
149 "Subdued level highlighting for Backtrace mode.")
150(defconst backtrace-font-lock-keywords-2
151 (append lisp-el-font-lock-keywords-for-backtraces-2
152 backtrace--font-lock-keywords)
153 "Gaudy level highlighting for Backtrace mode.")
154
155(defun backtrace--match-ellipsis-in-string (bound)
156 ;; Fontify ellipses within strings as buttons.
157 ;; This is necessary because ellipses are text property buttons
158 ;; instead of overlay buttons, which is done because there could
159 ;; be a large number of them.
160 (when (re-search-forward "\\(\\.\\.\\.\\)\"" bound t)
161 (and (get-text-property (- (point) 2) 'cl-print-ellipsis)
162 (get-text-property (- (point) 3) 'cl-print-ellipsis)
163 (get-text-property (- (point) 4) 'cl-print-ellipsis))))
164
165;;; Xref support
166
167(defun backtrace--xref-backend () 'elisp)
168
169;;; Backtrace mode variables
170
171(defvar-local backtrace-frames nil
172 "Stack frames displayed in the current Backtrace buffer.
173This should be a list of `backtrace-frame' objects.")
174
175(defvar-local backtrace-view nil
176 "A plist describing how to render backtrace frames.
177Possible entries are :show-flags, :show-locals and :print-circle.")
178
179(defvar-local backtrace-insert-header-function nil
180 "Function for inserting a header for the current Backtrace buffer.
181If nil, no header will be created. Note that Backtrace buffers
182are fontified as in Emacs Lisp Mode, the header text included.")
183
184(defvar backtrace-revert-hook nil
185 "Hook run before reverting a Backtrace buffer.
186This is commonly used to recompute `backtrace-frames'.")
187
188(defvar-local backtrace-print-function #'cl-prin1
189 "Function used to print values in the current Backtrace buffer.")
190
191(defvar-local backtrace-goto-source-functions nil
192 "Abnormal hook used to jump to the source code for the current frame.
193Each hook function is called with no argument, and should return
194non-nil if it is able to switch to the buffer containing the
195source code. Execution of the hook will stop if one of the
196functions returns non-nil. When adding a function to this hook,
197you should also set the :source-available flag for the backtrace
198frames where the source code location is known.")
199
200(defvar backtrace-mode-map
201 (let ((map (copy-keymap special-mode-map)))
202 (set-keymap-parent map button-buffer-map)
203 (define-key map "n" 'backtrace-forward-frame)
204 (define-key map "p" 'backtrace-backward-frame)
205 (define-key map "v" 'backtrace-toggle-locals)
206 (define-key map "#" 'backtrace-toggle-print-circle)
207 (define-key map "s" 'backtrace-goto-source)
208 (define-key map "\C-m" 'backtrace-help-follow-symbol)
209 (define-key map "+" 'backtrace-multi-line)
210 (define-key map "-" 'backtrace-single-line)
211 (define-key map "." 'backtrace-expand-ellipses)
212 (define-key map [follow-link] 'mouse-face)
213 (define-key map [mouse-2] 'mouse-select-window)
214 (easy-menu-define nil map ""
215 '("Backtrace"
216 ["Next Frame" backtrace-forward-frame
217 :help "Move cursor forwards to the start of a backtrace frame"]
218 ["Previous Frame" backtrace-backward-frame
219 :help "Move cursor backwards to the start of a backtrace frame"]
220 "--"
221 ["Show Variables" backtrace-toggle-locals
222 :style toggle
223 :active (backtrace-get-index)
224 :selected (plist-get (backtrace-get-view) :show-locals)
225 :help "Show or hide the local variables for the frame at point"]
226 ["Expand \"...\"s" backtrace-expand-ellipses
227 :help "Expand all the abbreviated forms in the current frame"]
228 ["Show on Multiple Lines" backtrace-multi-line
229 :help "Use line breaks and indentation to make a form more readable"]
230 ["Show on Single Line" backtrace-single-line]
231 "--"
232 ["Go to Source" backtrace-goto-source
233 :active (and (backtrace-get-index)
234 (plist-get (backtrace-frame-flags
235 (nth (backtrace-get-index) backtrace-frames))
236 :source-available))
237 :help "Show the source code for the current frame"]
238 ["Help for Symbol" backtrace-help-follow-symbol
239 :help "Show help for symbol at point"]
240 ["Describe Backtrace Mode" describe-mode
241 :help "Display documentation for backtrace-mode"]))
242 map)
243 "Local keymap for `backtrace-mode' buffers.")
244
245(defconst backtrace--flags-width 2
246 "Width in characters of the flags for a backtrace frame.")
247
248;;; Navigation and Text Properties
249
250;; This mode uses the following text properties:
251;; backtrace-index: The index into the buffer-local variable
252;; `backtrace-frames' for the frame at point, or nil if outside of a
253;; frame (in the buffer header).
254;; backtrace-view: A plist describing how the frame is printed. See
255;; the docstring for the buffer-local variable `backtrace-view.
256;; backtrace-section: The part of a frame which point is in. Either
257;; `func' or `locals'. At the moment just used to show and hide the
258;; local variables. Derived modes which do additional printing
259;; could define their own frame sections.
260;; backtrace-form: A value applied to each printed representation of a
261;; top-level s-expression, which needs to be different for sexps
262;; printed adjacent to each other, so the limits can be quickly
263;; found for pretty-printing.
264
265(defsubst backtrace-get-index (&optional pos)
266 "Return the index of the backtrace frame at POS.
267The value is an index into `backtrace-frames', or nil.
268POS, if omitted or nil, defaults to point."
269 (get-text-property (or pos (point)) 'backtrace-index))
270
271(defsubst backtrace-get-section (&optional pos)
272 "Return the section of a backtrace frame at POS.
273POS, if omitted or nil, defaults to point."
274 (get-text-property (or pos (point)) 'backtrace-section))
275
276(defsubst backtrace-get-view (&optional pos)
277 "Return the view plist of the backtrace frame at POS.
278POS, if omitted or nil, defaults to point."
279 (get-text-property (or pos (point)) 'backtrace-view))
280
281(defsubst backtrace-get-form (&optional pos)
282 "Return the backtrace form data for the form printed at POS.
283POS, if omitted or nil, defaults to point."
284 (get-text-property (or pos (point)) 'backtrace-form))
285
286(defun backtrace-get-frame-start (&optional pos)
287 "Return the beginning position of the frame at POS in the buffer.
288POS, if omitted or nil, defaults to point."
289 (let ((posn (or pos (point))))
290 (if (or (= (point-min) posn)
291 (not (eq (backtrace-get-index posn)
292 (backtrace-get-index (1- posn)))))
293 posn
294 (previous-single-property-change posn 'backtrace-index nil (point-min)))))
295
296(defun backtrace-get-frame-end (&optional pos)
297 "Return the position of the end of the frame at POS in the buffer.
298POS, if omitted or nil, defaults to point."
299 (next-single-property-change (or pos (point))
300 'backtrace-index nil (point-max)))
301
302(defun backtrace-forward-frame ()
303 "Move forward to the beginning of the next frame."
304 (interactive)
305 (let ((max (backtrace-get-frame-end)))
306 (when (= max (point-max))
307 (user-error "No next stack frame"))
308 (goto-char max)))
309
310(defun backtrace-backward-frame ()
311 "Move backward to the start of a stack frame."
312 (interactive)
313 (let ((current-index (backtrace-get-index))
314 (min (backtrace-get-frame-start)))
315 (if (or (and (/= (point) (point-max)) (null current-index))
316 (= min (point-min))
317 (and (= min (point))
318 (null (backtrace-get-index (1- min)))))
319 (user-error "No previous stack frame"))
320 (if (= min (point))
321 (goto-char (backtrace-get-frame-start (1- min)))
322 (goto-char min))))
323
324;; Other Backtrace mode commands
325
326(defun backtrace-revert (&rest _ignored)
327 "The `revert-buffer-function' for `backtrace-mode'.
328It runs `backtrace-revert-hook', then calls `backtrace-print'."
329 (interactive)
330 (unless (derived-mode-p 'backtrace-mode)
331 (error "The current buffer is not in Backtrace mode"))
332 (run-hooks 'backtrace-revert-hook)
333 (backtrace-print t))
334
335(defmacro backtrace--with-output-variables (view &rest body)
336 "Bind output variables according to VIEW and execute BODY."
337 (declare (indent 1))
338 `(let ((print-escape-control-characters t)
339 (print-escape-newlines t)
340 (print-circle (plist-get ,view :print-circle))
341 (standard-output (current-buffer)))
342 ,@body))
343
344(defun backtrace-toggle-locals (&optional all)
345 "Toggle the display of local variables for the backtrace frame at point.
346With prefix argument ALL, toggle the value of :show-locals in
347`backtrace-view', which affects all of the backtrace frames in
348the buffer."
349 (interactive "P")
350 (if all
351 (let ((pos (make-marker))
352 (visible (not (plist-get backtrace-view :show-locals))))
353 (setq backtrace-view (plist-put backtrace-view :show-locals visible))
354 (set-marker-insertion-type pos t)
355 (set-marker pos (point))
356 (goto-char (point-min))
357 ;; Skip the header.
358 (unless (backtrace-get-index)
359 (goto-char (backtrace-get-frame-end)))
360 (while (< (point) (point-max))
361 (backtrace--set-frame-locals-visible visible)
362 (goto-char (backtrace-get-frame-end)))
363 (goto-char pos)
364 (when (invisible-p pos)
365 (goto-char (backtrace-get-frame-start))))
366 (let ((index (backtrace-get-index)))
367 (unless index
368 (user-error "Not in a stack frame"))
369 (backtrace--set-frame-locals-visible
370 (not (plist-get (backtrace-get-view) :show-locals))))))
371
372(defun backtrace--set-frame-locals-visible (visible)
373 "Set the visibility of the local vars for the frame at point to VISIBLE."
374 (let ((pos (point))
375 (index (backtrace-get-index))
376 (start (backtrace-get-frame-start))
377 (end (backtrace-get-frame-end))
378 (view (copy-sequence (backtrace-get-view)))
379 (inhibit-read-only t))
380 (setq view (plist-put view :show-locals visible))
381 (goto-char (backtrace-get-frame-start))
382 (while (not (or (= (point) end)
383 (eq (backtrace-get-section) 'locals)))
384 (goto-char (next-single-property-change (point)
385 'backtrace-section nil end)))
386 (cond
387 ((and (= (point) end) visible)
388 ;; The locals section doesn't exist so create it.
389 (let ((standard-output (current-buffer)))
390 (backtrace--with-output-variables view
391 (backtrace--print-locals
392 (nth index backtrace-frames) view))
393 (add-text-properties end (point) `(backtrace-index ,index))
394 (goto-char pos)))
395 ((/= (point) end)
396 ;; The locals section does exist, so add or remove the overlay.
397 (backtrace--set-locals-visible-overlay (point) end visible)
398 (goto-char (if (invisible-p pos) start pos))))
399 (add-text-properties start (backtrace-get-frame-end)
400 `(backtrace-view ,view))))
401
402(defun backtrace--set-locals-visible-overlay (beg end visible)
403 (backtrace--change-button-skip beg end (not visible))
404 (if visible
405 (remove-overlays beg end 'invisible t)
406 (let ((o (make-overlay beg end)))
407 (overlay-put o 'invisible t)
408 (overlay-put o 'evaporate t))))
409
410(defun backtrace--change-button-skip (beg end value)
411 "Change the skip property on all buttons between BEG and END.
412Set it to VALUE unless the button is a `backtrace-ellipsis' button."
413 (let ((inhibit-read-only t))
414 (setq beg (next-button beg))
415 (while (and beg (< beg end))
416 (unless (eq (button-type beg) 'backtrace-ellipsis)
417 (button-put beg 'skip value))
418 (setq beg (next-button beg)))))
419
420(defun backtrace-toggle-print-circle (&optional all)
421 "Toggle `print-circle' for the backtrace frame at point.
422With prefix argument ALL, toggle the value of :print-circle in
423`backtrace-view', which affects all of the backtrace frames in
424the buffer."
425 (interactive "P")
426 (backtrace--toggle-feature :print-circle all))
427
428(defun backtrace--toggle-feature (feature all)
429 "Toggle FEATURE for the current backtrace frame or for the buffer.
430FEATURE should be one of the options in `backtrace-view'. If ALL
431is non-nil, toggle FEATURE for all frames in the buffer. After
432toggling the feature, reprint the affected frame(s). Afterwards
433position point at the start of the frame it was in before."
434 (if all
435 (let ((index (backtrace-get-index))
436 (pos (point))
437 (at-end (= (point) (point-max)))
438 (value (not (plist-get backtrace-view feature))))
439 (setq backtrace-view (plist-put backtrace-view feature value))
440 (goto-char (point-min))
441 ;; Skip the header.
442 (unless (backtrace-get-index)
443 (goto-char (backtrace-get-frame-end)))
444 (while (< (point) (point-max))
445 (backtrace--set-feature feature value)
446 (goto-char (backtrace-get-frame-end)))
447 (if (not index)
448 (goto-char (if at-end (point-max) pos))
449 (goto-char (point-min))
450 (while (and (not (eql index (backtrace-get-index)))
451 (< (point) (point-max)))
452 (goto-char (backtrace-get-frame-end)))))
453 (let ((index (backtrace-get-index)))
454 (unless index
455 (user-error "Not in a stack frame"))
456 (backtrace--set-feature feature
457 (not (plist-get (backtrace-get-view) feature))))))
458
459(defun backtrace--set-feature (feature value)
460 "Set FEATURE in the view plist of the frame at point to VALUE.
461Reprint the frame with the new view plist."
462 (let ((inhibit-read-only t)
463 (view (copy-sequence (backtrace-get-view)))
464 (index (backtrace-get-index))
465 (min (backtrace-get-frame-start))
466 (max (backtrace-get-frame-end)))
467 (setq view (plist-put view feature value))
468 (delete-region min max)
469 (goto-char min)
470 (backtrace-print-frame (nth index backtrace-frames) view)
471 (add-text-properties min (point)
472 `(backtrace-index ,index backtrace-view ,view))
473 (goto-char min)))
474
475(defun backtrace-expand-ellipsis (button)
476 "Expand display of the elided form at BUTTON."
477 (interactive)
478 (goto-char (button-start button))
479 (unless (get-text-property (point) 'cl-print-ellipsis)
480 (if (and (> (point) (point-min))
481 (get-text-property (1- (point)) 'cl-print-ellipsis))
482 (backward-char)
483 (user-error "No ellipsis to expand here")))
484 (let* ((end (next-single-property-change (point) 'cl-print-ellipsis))
485 (begin (previous-single-property-change end 'cl-print-ellipsis))
486 (value (get-text-property begin 'cl-print-ellipsis))
487 (props (backtrace-get-text-properties begin))
488 (inhibit-read-only t))
489 (backtrace--with-output-variables (backtrace-get-view)
490 (delete-region begin end)
491 (insert (cl-print-to-string-with-limit #'cl-print-expand-ellipsis value
492 backtrace-line-length))
493 (setq end (point))
494 (goto-char begin)
495 (while (< (point) end)
496 (let ((next (next-single-property-change (point) 'cl-print-ellipsis
497 nil end)))
498 (when (get-text-property (point) 'cl-print-ellipsis)
499 (make-text-button (point) next :type 'backtrace-ellipsis))
500 (goto-char next)))
501 (goto-char begin)
502 (add-text-properties begin end props))))
503
504(defun backtrace-expand-ellipses (&optional no-limit)
505 "Expand display of all \"...\"s in the backtrace frame at point.
506\\<backtrace-mode-map>
507Each ellipsis will be limited to `backtrace-line-length'
508characters in its expansion. With optional prefix argument
509NO-LIMIT, do not limit the number of characters. Note that with
510or without the argument, using this command can result in very
511long lines and very poor display performance. If this happens
512and is a problem, use `\\[revert-buffer]' to return to the
513initial state of the Backtrace buffer."
514 (interactive "P")
515 (save-excursion
516 (let ((start (backtrace-get-frame-start))
517 (end (backtrace-get-frame-end))
518 (backtrace-line-length (unless no-limit backtrace-line-length)))
519 (goto-char end)
520 (while (> (point) start)
521 (let ((next (previous-single-property-change (point) 'cl-print-ellipsis
522 nil start)))
523 (when (get-text-property (point) 'cl-print-ellipsis)
524 (push-button (point)))
525 (goto-char next))))))
526
527(defun backtrace-multi-line ()
528 "Show the top level s-expression at point on multiple lines with indentation."
529 (interactive)
530 (backtrace--reformat-sexp #'backtrace--multi-line))
531
532(defun backtrace--multi-line ()
533 "Pretty print the current buffer, then remove the trailing newline."
534 (set-syntax-table emacs-lisp-mode-syntax-table)
535 (pp-buffer)
536 (goto-char (1- (point-max)))
537 (delete-char 1))
538
539(defun backtrace-single-line ()
540 "Show the top level s-expression at point on one line."
541 (interactive)
542 (backtrace--reformat-sexp #'backtrace--single-line))
543
544(defun backtrace--single-line ()
545 "Replace line breaks and following indentation with spaces.
546Works on the current buffer."
547 (goto-char (point-min))
548 (while (re-search-forward "\n[[:blank:]]*" nil t)
549 (replace-match " ")))
550
551(defun backtrace--reformat-sexp (format-function)
552 "Reformat the top level sexp at point.
553Locate the top level sexp at or following point on the same line,
554and reformat it with FORMAT-FUNCTION, preserving the location of
555point within the sexp. If no sexp is found before the end of
556the line or buffer, signal an error.
557
558FORMAT-FUNCTION will be called without arguments, with the
559current buffer set to a temporary buffer containing only the
560content of the sexp."
561 (let* ((orig-pos (point))
562 (pos (point))
563 (tag (backtrace-get-form pos))
564 (end (next-single-property-change pos 'backtrace-form))
565 (begin (previous-single-property-change end 'backtrace-form
566 nil (point-min))))
567 (unless tag
568 (when (or (= end (point-max)) (> end (point-at-eol)))
569 (user-error "No form here to reformat"))
570 (goto-char end)
571 (setq pos end
572 end (next-single-property-change pos 'backtrace-form)
573 begin (previous-single-property-change end 'backtrace-form
574 nil (point-min))))
575 (let* ((offset (when (>= orig-pos begin) (- orig-pos begin)))
576 (offset-marker (when offset (make-marker)))
577 (content (buffer-substring begin end))
578 (props (backtrace-get-text-properties begin))
579 (inhibit-read-only t))
580 (delete-region begin end)
581 (insert (with-temp-buffer
582 (insert content)
583 (when offset
584 (set-marker-insertion-type offset-marker t)
585 (set-marker offset-marker (+ (point-min) offset)))
586 (funcall format-function)
587 (when offset
588 (setq offset (- (marker-position offset-marker) (point-min))))
589 (buffer-string)))
590 (when offset
591 (set-marker offset-marker (+ begin offset)))
592 (save-excursion
593 (goto-char begin)
594 (indent-sexp))
595 (add-text-properties begin (point) props)
596 (if offset
597 (goto-char (marker-position offset-marker))
598 (goto-char orig-pos)))))
599
600(defun backtrace-get-text-properties (pos)
601 "Return a plist of backtrace-mode's text properties at POS."
602 (apply #'append
603 (mapcar (lambda (prop)
604 (list prop (get-text-property pos prop)))
605 '(backtrace-section backtrace-index backtrace-view
606 backtrace-form))))
607
608(defun backtrace-goto-source ()
609 "If its location is known, jump to the source code for the frame at point."
610 (interactive)
611 (let* ((index (or (backtrace-get-index) (user-error "Not in a stack frame")))
612 (frame (nth index backtrace-frames))
613 (source-available (plist-get (backtrace-frame-flags frame)
614 :source-available)))
615 (unless (and source-available
616 (catch 'done
617 (dolist (func backtrace-goto-source-functions)
618 (when (funcall func)
619 (throw 'done t)))))
620 (user-error "Source code location not known"))))
621
622(defun backtrace-help-follow-symbol (&optional pos)
623 "Follow cross-reference at POS, defaulting to point.
624For the cross-reference format, see `help-make-xrefs'."
625 (interactive "d")
626 (unless pos
627 (setq pos (point)))
628 (unless (push-button pos)
629 ;; Check if the symbol under point is a function or variable.
630 (let ((sym
631 (intern
632 (save-excursion
633 (goto-char pos) (skip-syntax-backward "w_")
634 (buffer-substring (point)
635 (progn (skip-syntax-forward "w_")
636 (point)))))))
637 (when (or (boundp sym) (fboundp sym) (facep sym))
638 (describe-symbol sym)))))
639
640;; Print backtrace frames
641
642(defun backtrace-print (&optional remember-pos)
643 "Populate the current Backtrace mode buffer.
644This erases the buffer and inserts printed representations of the
645frames. Optional argument REMEMBER-POS, if non-nil, means to
646move point to the entry with the same ID element as the current
647line and recenter window line accordingly."
648 (let ((inhibit-read-only t)
649 entry-index saved-pt window-line)
650 (and remember-pos
651 (setq entry-index (backtrace-get-index))
652 (when (eq (window-buffer) (current-buffer))
653 (setq window-line
654 (count-screen-lines (window-start) (point)))))
655 (erase-buffer)
656 (when backtrace-insert-header-function
657 (funcall backtrace-insert-header-function))
658 (dotimes (idx (length backtrace-frames))
659 (let ((beg (point))
660 (elt (nth idx backtrace-frames)))
661 (and entry-index
662 (equal entry-index idx)
663 (setq entry-index nil
664 saved-pt (point)))
665 (backtrace-print-frame elt backtrace-view)
666 (add-text-properties
667 beg (point)
668 `(backtrace-index ,idx backtrace-view ,backtrace-view))))
669 (set-buffer-modified-p nil)
670 ;; If REMEMBER-POS was specified, move to the "old" location.
671 (if saved-pt
672 (progn (goto-char saved-pt)
673 (when window-line
674 (recenter window-line)))
675 (goto-char (point-min)))))
676
677;; Define button type used for ...'s.
678;; Set skip property so you don't have to TAB through 100 of them to
679;; get to the next function name.
680(define-button-type 'backtrace-ellipsis
681 'skip t 'action #'backtrace-expand-ellipsis
682 'help-echo "mouse-2, RET: expand this ellipsis")
683
684(defun backtrace-print-to-string (obj &optional limit)
685 "Return a printed representation of OBJ formatted for backtraces.
686Attempt to get the length of the returned string under LIMIT
687charcters with appropriate settings of `print-level' and
688`print-length.' LIMIT defaults to `backtrace-line-length'."
689 (backtrace--with-output-variables backtrace-view
690 (backtrace--print-to-string obj limit)))
691
692(defun backtrace--print-to-string (sexp &optional limit)
693 ;; This is for use by callers who wrap the call with
694 ;; backtrace--with-output-variables.
695 (setq limit (or limit backtrace-line-length))
696 (with-temp-buffer
697 (insert (cl-print-to-string-with-limit #'backtrace--print sexp limit))
698 ;; Add a unique backtrace-form property.
699 (put-text-property (point-min) (point) 'backtrace-form (gensym))
700 ;; Make buttons from all the "..."s. Since there might be many of
701 ;; them, use text property buttons.
702 (goto-char (point-min))
703 (while (< (point) (point-max))
704 (let ((end (next-single-property-change (point) 'cl-print-ellipsis
705 nil (point-max))))
706 (when (get-text-property (point) 'cl-print-ellipsis)
707 (make-text-button (point) end :type 'backtrace-ellipsis))
708 (goto-char end)))
709 (buffer-string)))
710
711(defun backtrace-print-frame (frame view)
712 "Insert a backtrace FRAME at point formatted according to VIEW.
713Tag the sections of the frame with the `backtrace-section' text
714property for use by navigation."
715 (backtrace--with-output-variables view
716 (backtrace--print-flags frame view)
717 (backtrace--print-func-and-args frame view)
718 (backtrace--print-locals frame view)))
719
720(defun backtrace--print-flags (frame view)
721 "Print the flags of a backtrace FRAME if enabled in VIEW."
722 (let ((beg (point))
723 (flag (plist-get (backtrace-frame-flags frame) :debug-on-exit))
724 (source (plist-get (backtrace-frame-flags frame) :source-available)))
725 (when (plist-get view :show-flags)
726 (when source (insert ">"))
727 (when flag (insert "*")))
728 (insert (make-string (- backtrace--flags-width (- (point) beg)) ?\s))
729 (put-text-property beg (point) 'backtrace-section 'func)))
730
731(defun backtrace--print-func-and-args (frame _view)
732 "Print the function, arguments and buffer position of a backtrace FRAME.
733Format it according to VIEW."
734 (let* ((beg (point))
735 (evald (backtrace-frame-evald frame))
736 (fun (backtrace-frame-fun frame))
737 (args (backtrace-frame-args frame))
738 (def (and (symbolp fun) (fboundp fun) (symbol-function fun)))
739 (fun-file (or (symbol-file fun 'defun)
740 (and (subrp def)
741 (not (eq 'unevalled (cdr (subr-arity def))))
742 (find-lisp-object-file-name fun def))))
743 (fun-pt (point)))
744 (cond
745 ((and evald (not debugger-stack-frame-as-list))
746 (if (atom fun)
747 (funcall backtrace-print-function fun)
748 (insert
749 (backtrace--print-to-string fun (when args (/ backtrace-line-length 2)))))
750 (if args
751 (insert (backtrace--print-to-string
752 args (max (truncate (/ backtrace-line-length 5))
753 (- backtrace-line-length (- (point) beg)))))
754 ;; The backtrace-form property is so that backtrace-multi-line
755 ;; will find it. backtrace-multi-line doesn't do anything
756 ;; useful with it, just being consistent.
757 (let ((start (point)))
758 (insert "()")
759 (put-text-property start (point) 'backtrace-form t))))
760 (t
761 (let ((fun-and-args (cons fun args)))
762 (insert (backtrace--print-to-string fun-and-args)))
763 (cl-incf fun-pt)))
764 (when fun-file
765 (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
766 :type 'help-function-def
767 'help-args (list fun fun-file)))
768 ;; After any frame that uses eval-buffer, insert a comment that
769 ;; states the buffer position it's reading at.
770 (when (backtrace-frame-pos frame)
771 (insert " ; Reading at ")
772 (let ((pos (point)))
773 (insert (format "buffer position %d" (backtrace-frame-pos frame)))
774 (make-button pos (point) :type 'backtrace-buffer-pos
775 'backtrace-buffer (backtrace-frame-buffer frame)
776 'backtrace-pos (backtrace-frame-pos frame))))
777 (insert "\n")
778 (put-text-property beg (point) 'backtrace-section 'func)))
779
780(defun backtrace--print-locals (frame view)
781 "Print a backtrace FRAME's local variables according to VIEW.
782Print them only if :show-locals is non-nil in the VIEW plist."
783 (when (plist-get view :show-locals)
784 (let* ((beg (point))
785 (locals (backtrace-frame-locals frame)))
786 (if (null locals)
787 (insert " [no locals]\n")
788 (pcase-dolist (`(,symbol . ,value) locals)
789 (insert " ")
790 (backtrace--print symbol)
791 (insert " = ")
792 (insert (backtrace--print-to-string value))
793 (insert "\n")))
794 (put-text-property beg (point) 'backtrace-section 'locals))))
795
796(defun backtrace--print (obj &optional stream)
797 "Attempt to print OBJ to STREAM using `backtrace-print-function'.
798Fall back to `prin1' if there is an error."
799 (condition-case err
800 (funcall backtrace-print-function obj stream)
801 (error
802 (message "Error in backtrace printer: %S" err)
803 (prin1 obj stream))))
804
805(defun backtrace-update-flags ()
806 "Update the display of the flags in the backtrace frame at point."
807 (let ((view (backtrace-get-view))
808 (begin (backtrace-get-frame-start)))
809 (when (plist-get view :show-flags)
810 (save-excursion
811 (goto-char begin)
812 (let ((props (backtrace-get-text-properties begin))
813 (inhibit-read-only t)
814 (standard-output (current-buffer)))
815 (delete-char backtrace--flags-width)
816 (backtrace--print-flags (nth (backtrace-get-index) backtrace-frames)
817 view)
818 (add-text-properties begin (point) props))))))
819
820(defun backtrace--filter-visible (beg end &optional _delete)
821 "Return the visible text between BEG and END."
822 (let ((result ""))
823 (while (< beg end)
824 (let ((next (next-single-char-property-change beg 'invisible)))
825 (unless (get-char-property beg 'invisible)
826 (setq result (concat result (buffer-substring beg (min end next)))))
827 (setq beg next)))
828 result))
829
830;;; The mode definition
831
832(define-derived-mode backtrace-mode special-mode "Backtrace"
833 "Generic major mode for examining an Elisp stack backtrace.
834This mode can be used directly, or other major modes can be
835derived from it, using `define-derived-mode'.
836
837In this major mode, the buffer contains some optional lines of
838header text followed by backtrace frames, each consisting of one
839or more whole lines.
840
841Letters in this mode do not insert themselves; instead they are
842commands.
843\\<backtrace-mode-map>
844\\{backtrace-mode-map}
845
846A mode which inherits from Backtrace mode, or a command which
847creates a backtrace-mode buffer, should usually do the following:
848
849 - Set `backtrace-revert-hook', if the buffer contents need
850 to be specially recomputed prior to `revert-buffer'.
851 - Maybe set `backtrace-insert-header-function' to a function to create
852 header text for the buffer.
853 - Set `backtrace-frames' (see below).
854 - Maybe modify `backtrace-view' (see below).
855 - Maybe set `backtrace-print-function'.
856
857A command which creates or switches to a Backtrace mode buffer,
858such as `ert-results-pop-to-backtrace-for-test-at-point', should
859initialize `backtrace-frames' to a list of `backtrace-frame'
860objects (`backtrace-get-frames' is provided for that purpose, if
861desired), and may optionally modify `backtrace-view', which is a
862plist describing the appearance of the backtrace. Finally, it
863should call `backtrace-print'.
864
865`backtrace-print' calls `backtrace-insert-header-function'
866followed by `backtrace-print-frame', once for each stack frame."
867 :syntax-table emacs-lisp-mode-syntax-table
868 (when backtrace-fontify
869 (setq font-lock-defaults
870 '((backtrace-font-lock-keywords
871 backtrace-font-lock-keywords-1
872 backtrace-font-lock-keywords-2)
873 nil nil nil nil
874 (font-lock-syntactic-face-function
875 . lisp-font-lock-syntactic-face-function))))
876 (setq truncate-lines t)
877 (buffer-disable-undo)
878 ;; In debug.el, from 1998 to 2009 this was set to nil, reason stated
879 ;; was because of bytecode. Since 2009 it's been set to t, but the
880 ;; default is t so I think this isn't necessary.
881 ;; (set-buffer-multibyte t)
882 (setq-local revert-buffer-function #'backtrace-revert)
883 (setq-local filter-buffer-substring-function #'backtrace--filter-visible)
884 (setq-local indent-line-function 'lisp-indent-line)
885 (setq-local indent-region-function 'lisp-indent-region)
886 (add-hook 'xref-backend-functions #'backtrace--xref-backend nil t))
887
888(put 'backtrace-mode 'mode-class 'special)
889
890;;; Backtrace printing
891
892;;;###autoload
893(defun backtrace ()
894 "Print a trace of Lisp function calls currently active.
895Output stream used is value of `standard-output'."
896 (princ (backtrace-to-string (backtrace-get-frames 'backtrace)))
897 nil)
898
899(defun backtrace-to-string(&optional frames)
900 "Format FRAMES, a list of `backtrace-frame' objects, for output.
901Return the result as a string. If FRAMES is nil, use all
902function calls currently active."
903 (unless frames (setq frames (backtrace-get-frames 'backtrace-to-string)))
904 (let ((backtrace-fontify nil))
905 (with-temp-buffer
906 (backtrace-mode)
907 (setq backtrace-view '(:show-flags t)
908 backtrace-frames frames
909 backtrace-print-function #'cl-prin1)
910 (backtrace-print)
911 (substring-no-properties (filter-buffer-substring (point-min)
912 (point-max))))))
913
914(provide 'backtrace)
915
916;;; backtrace.el ends here
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 011965acb54..d0d1c3b156a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2083,10 +2083,7 @@ This is like `cl-flet', but for macros instead of functions.
2083 2083
2084\(fn ((NAME ARGLIST BODY...) ...) FORM...)" 2084\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
2085 (declare (indent 1) 2085 (declare (indent 1)
2086 (debug 2086 (debug (cl-macrolet-expr)))
2087 ((&rest (&define name (&rest arg) cl-declarations-or-string
2088 def-body))
2089 cl-declarations body)))
2090 (if (cdr bindings) 2087 (if (cdr bindings)
2091 `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body)) 2088 `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
2092 (if (null bindings) (macroexp-progn body) 2089 (if (null bindings) (macroexp-progn body)
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 1eae8faf236..c63f5ac005c 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -55,10 +55,19 @@ call other entry points instead, such as `cl-prin1'."
55 ;; we should only use it for objects which don't have nesting. 55 ;; we should only use it for objects which don't have nesting.
56 (prin1 object stream)) 56 (prin1 object stream))
57 57
58(cl-defgeneric cl-print-object-contents (_object _start _stream)
59 "Dispatcher to print the contents of OBJECT on STREAM.
60Print the contents starting with the item at START, without
61delimiters."
62 ;; Every cl-print-object method which can print an ellipsis should
63 ;; have a matching cl-print-object-contents method to expand an
64 ;; ellipsis.
65 (error "Missing cl-print-object-contents method"))
66
58(cl-defmethod cl-print-object ((object cons) stream) 67(cl-defmethod cl-print-object ((object cons) stream)
59 (if (and cl-print--depth (natnump print-level) 68 (if (and cl-print--depth (natnump print-level)
60 (> cl-print--depth print-level)) 69 (> cl-print--depth print-level))
61 (princ "..." stream) 70 (cl-print-insert-ellipsis object 0 stream)
62 (let ((car (pop object)) 71 (let ((car (pop object))
63 (count 1)) 72 (count 1))
64 (if (and print-quoted 73 (if (and print-quoted
@@ -84,23 +93,60 @@ call other entry points instead, such as `cl-prin1'."
84 (princ " " stream) 93 (princ " " stream)
85 (if (or (not (natnump print-length)) (> print-length count)) 94 (if (or (not (natnump print-length)) (> print-length count))
86 (cl-print-object (pop object) stream) 95 (cl-print-object (pop object) stream)
87 (princ "..." stream) 96 (cl-print-insert-ellipsis object print-length stream)
88 (setq object nil)) 97 (setq object nil))
89 (cl-incf count)) 98 (cl-incf count))
90 (when object 99 (when object
91 (princ " . " stream) (cl-print-object object stream)) 100 (princ " . " stream) (cl-print-object object stream))
92 (princ ")" stream))))) 101 (princ ")" stream)))))
93 102
103(cl-defmethod cl-print-object-contents ((object cons) _start stream)
104 (let ((count 0))
105 (while (and (consp object)
106 (not (cond
107 (cl-print--number-table
108 (numberp (gethash object cl-print--number-table)))
109 ((memq object cl-print--currently-printing))
110 (t (push object cl-print--currently-printing)
111 nil))))
112 (unless (zerop count)
113 (princ " " stream))
114 (if (or (not (natnump print-length)) (> print-length count))
115 (cl-print-object (pop object) stream)
116 (cl-print-insert-ellipsis object print-length stream)
117 (setq object nil))
118 (cl-incf count))
119 (when object
120 (princ " . " stream) (cl-print-object object stream))))
121
94(cl-defmethod cl-print-object ((object vector) stream) 122(cl-defmethod cl-print-object ((object vector) stream)
95 (princ "[" stream) 123 (if (and cl-print--depth (natnump print-level)
96 (let ((count (length object))) 124 (> cl-print--depth print-level))
97 (dotimes (i (if (natnump print-length) 125 (cl-print-insert-ellipsis object 0 stream)
98 (min print-length count) count)) 126 (princ "[" stream)
99 (unless (zerop i) (princ " " stream)) 127 (let* ((len (length object))
100 (cl-print-object (aref object i) stream)) 128 (limit (if (natnump print-length)
101 (when (and (natnump print-length) (< print-length count)) 129 (min print-length len) len)))
102 (princ " ..." stream))) 130 (dotimes (i limit)
103 (princ "]" stream)) 131 (unless (zerop i) (princ " " stream))
132 (cl-print-object (aref object i) stream))
133 (when (< limit len)
134 (princ " " stream)
135 (cl-print-insert-ellipsis object limit stream)))
136 (princ "]" stream)))
137
138(cl-defmethod cl-print-object-contents ((object vector) start stream)
139 (let* ((len (length object))
140 (limit (if (natnump print-length)
141 (min (+ start print-length) len) len))
142 (i start))
143 (while (< i limit)
144 (unless (= i start) (princ " " stream))
145 (cl-print-object (aref object i) stream)
146 (cl-incf i))
147 (when (< limit len)
148 (princ " " stream)
149 (cl-print-insert-ellipsis object limit stream))))
104 150
105(cl-defmethod cl-print-object ((object hash-table) stream) 151(cl-defmethod cl-print-object ((object hash-table) stream)
106 (princ "#<hash-table " stream) 152 (princ "#<hash-table " stream)
@@ -109,7 +155,7 @@ call other entry points instead, such as `cl-prin1'."
109 (princ (hash-table-count object) stream) 155 (princ (hash-table-count object) stream)
110 (princ "/" stream) 156 (princ "/" stream)
111 (princ (hash-table-size object) stream) 157 (princ (hash-table-size object) stream)
112 (princ (format " 0x%x" (sxhash object)) stream) 158 (princ (format " %#x" (sxhash object)) stream)
113 (princ ">" stream)) 159 (princ ">" stream))
114 160
115(define-button-type 'help-byte-code 161(define-button-type 'help-byte-code
@@ -166,7 +212,7 @@ into a button whose action shows the function's disassembly.")
166 (let ((button-start (and cl-print-compiled-button 212 (let ((button-start (and cl-print-compiled-button
167 (bufferp stream) 213 (bufferp stream)
168 (with-current-buffer stream (point))))) 214 (with-current-buffer stream (point)))))
169 (princ (format "#<bytecode 0x%x>" (sxhash object)) stream) 215 (princ (format "#<bytecode %#x>" (sxhash object)) stream)
170 (when (eq cl-print-compiled 'static) 216 (when (eq cl-print-compiled 'static)
171 (princ " " stream) 217 (princ " " stream)
172 (cl-print-object (aref object 2) stream)) 218 (cl-print-object (aref object 2) stream))
@@ -199,21 +245,135 @@ into a button whose action shows the function's disassembly.")
199 (princ ")" stream))) 245 (princ ")" stream)))
200 246
201(cl-defmethod cl-print-object ((object cl-structure-object) stream) 247(cl-defmethod cl-print-object ((object cl-structure-object) stream)
202 (princ "#s(" stream) 248 (if (and cl-print--depth (natnump print-level)
249 (> cl-print--depth print-level))
250 (cl-print-insert-ellipsis object 0 stream)
251 (princ "#s(" stream)
252 (let* ((class (cl-find-class (type-of object)))
253 (slots (cl--struct-class-slots class))
254 (len (length slots))
255 (limit (if (natnump print-length)
256 (min print-length len) len)))
257 (princ (cl--struct-class-name class) stream)
258 (dotimes (i limit)
259 (let ((slot (aref slots i)))
260 (princ " :" stream)
261 (princ (cl--slot-descriptor-name slot) stream)
262 (princ " " stream)
263 (cl-print-object (aref object (1+ i)) stream)))
264 (when (< limit len)
265 (princ " " stream)
266 (cl-print-insert-ellipsis object limit stream)))
267 (princ ")" stream)))
268
269(cl-defmethod cl-print-object-contents ((object cl-structure-object) start stream)
203 (let* ((class (cl-find-class (type-of object))) 270 (let* ((class (cl-find-class (type-of object)))
204 (slots (cl--struct-class-slots class)) 271 (slots (cl--struct-class-slots class))
205 (count (length slots))) 272 (len (length slots))
206 (princ (cl--struct-class-name class) stream) 273 (limit (if (natnump print-length)
207 (dotimes (i (if (natnump print-length) 274 (min (+ start print-length) len) len))
208 (min print-length count) count)) 275 (i start))
276 (while (< i limit)
209 (let ((slot (aref slots i))) 277 (let ((slot (aref slots i)))
210 (princ " :" stream) 278 (unless (= i start) (princ " " stream))
279 (princ ":" stream)
211 (princ (cl--slot-descriptor-name slot) stream) 280 (princ (cl--slot-descriptor-name slot) stream)
212 (princ " " stream) 281 (princ " " stream)
213 (cl-print-object (aref object (1+ i)) stream))) 282 (cl-print-object (aref object (1+ i)) stream))
214 (when (and (natnump print-length) (< print-length count)) 283 (cl-incf i))
215 (princ " ..." stream))) 284 (when (< limit len)
216 (princ ")" stream)) 285 (princ " " stream)
286 (cl-print-insert-ellipsis object limit stream))))
287
288(cl-defmethod cl-print-object ((object string) stream)
289 (unless stream (setq stream standard-output))
290 (let* ((has-properties (or (text-properties-at 0 object)
291 (next-property-change 0 object)))
292 (len (length object))
293 (limit (if (natnump print-length) (min print-length len) len)))
294 (if (and has-properties
295 cl-print--depth
296 (natnump print-level)
297 (> cl-print--depth print-level))
298 (cl-print-insert-ellipsis object 0 stream)
299 ;; Print all or part of the string
300 (when has-properties
301 (princ "#(" stream))
302 (if (= limit len)
303 (prin1 (if has-properties (substring-no-properties object) object)
304 stream)
305 (let ((part (concat (substring-no-properties object 0 limit) "...")))
306 (prin1 part stream)
307 (when (bufferp stream)
308 (with-current-buffer stream
309 (cl-print-propertize-ellipsis object limit
310 (- (point) 4)
311 (- (point) 1) stream)))))
312 ;; Print the property list.
313 (when has-properties
314 (let* ((interval-limit (and (natnump print-length)
315 (max 1 (/ print-length 3))))
316 (interval-count 0)
317 (start-pos (if (text-properties-at 0 object)
318 0 (next-property-change 0 object)))
319 (end-pos (next-property-change start-pos object len)))
320 (while (and (or (null interval-limit)
321 (< interval-count interval-limit))
322 (< start-pos len))
323 (let ((props (text-properties-at start-pos object)))
324 (when props
325 (princ " " stream) (princ start-pos stream)
326 (princ " " stream) (princ end-pos stream)
327 (princ " " stream) (cl-print-object props stream)
328 (cl-incf interval-count))
329 (setq start-pos end-pos
330 end-pos (next-property-change start-pos object len))))
331 (when (< start-pos len)
332 (princ " " stream)
333 (cl-print-insert-ellipsis object (list start-pos) stream)))
334 (princ ")" stream)))))
335
336(cl-defmethod cl-print-object-contents ((object string) start stream)
337 ;; If START is an integer, it is an index into the string, and the
338 ;; ellipsis that needs to be expanded is part of the string. If
339 ;; START is a cons, its car is an index into the string, and the
340 ;; ellipsis that needs to be expanded is in the property list.
341 (let* ((len (length object)))
342 (if (atom start)
343 ;; Print part of the string.
344 (let* ((limit (if (natnump print-length)
345 (min (+ start print-length) len) len))
346 (substr (substring-no-properties object start limit))
347 (printed (prin1-to-string substr))
348 (trimmed (substring printed 1 (1- (length printed)))))
349 (princ trimmed)
350 (when (< limit len)
351 (cl-print-insert-ellipsis object limit stream)))
352
353 ;; Print part of the property list.
354 (let* ((first t)
355 (interval-limit (and (natnump print-length)
356 (max 1 (/ print-length 3))))
357 (interval-count 0)
358 (start-pos (car start))
359 (end-pos (next-property-change start-pos object len)))
360 (while (and (or (null interval-limit)
361 (< interval-count interval-limit))
362 (< start-pos len))
363 (let ((props (text-properties-at start-pos object)))
364 (when props
365 (if first
366 (setq first nil)
367 (princ " " stream))
368 (princ start-pos stream)
369 (princ " " stream) (princ end-pos stream)
370 (princ " " stream) (cl-print-object props stream)
371 (cl-incf interval-count))
372 (setq start-pos end-pos
373 end-pos (next-property-change start-pos object len))))
374 (when (< start-pos len)
375 (princ " " stream)
376 (cl-print-insert-ellipsis object (list start-pos) stream))))))
217 377
218;;; Circularity and sharing. 378;;; Circularity and sharing.
219 379
@@ -275,8 +435,17 @@ into a button whose action shows the function's disassembly.")
275 (push cdr stack) 435 (push cdr stack)
276 (push car stack)) 436 (push car stack))
277 ((pred stringp) 437 ((pred stringp)
278 ;; We presumably won't print its text-properties. 438 (let* ((len (length object))
279 nil) 439 (start (if (text-properties-at 0 object)
440 0 (next-property-change 0 object)))
441 (end (and start
442 (next-property-change start object len))))
443 (while (and start (< start len))
444 (let ((props (text-properties-at start object)))
445 (when props
446 (push props stack))
447 (setq start end
448 end (next-property-change start object len))))))
280 ((or (pred arrayp) (pred byte-code-function-p)) 449 ((or (pred arrayp) (pred byte-code-function-p))
281 ;; FIXME: Inefficient for char-tables! 450 ;; FIXME: Inefficient for char-tables!
282 (dotimes (i (length object)) 451 (dotimes (i (length object))
@@ -291,6 +460,48 @@ into a button whose action shows the function's disassembly.")
291 (cl-print--find-sharing object print-number-table))) 460 (cl-print--find-sharing object print-number-table)))
292 print-number-table)) 461 print-number-table))
293 462
463(defun cl-print-insert-ellipsis (object start stream)
464 "Print \"...\" to STREAM with the `cl-print-ellipsis' text property.
465Save state in the text property in order to print the elided part
466of OBJECT later. START should be 0 if the whole OBJECT is being
467elided, otherwise it should be an index or other pointer into the
468internals of OBJECT which can be passed to
469`cl-print-object-contents' at a future time."
470 (unless stream (setq stream standard-output))
471 (let ((ellipsis-start (and (bufferp stream)
472 (with-current-buffer stream (point)))))
473 (princ "..." stream)
474 (when ellipsis-start
475 (with-current-buffer stream
476 (cl-print-propertize-ellipsis object start ellipsis-start (point)
477 stream)))))
478
479(defun cl-print-propertize-ellipsis (object start beg end stream)
480 "Add the `cl-print-ellipsis' property between BEG and END.
481STREAM should be a buffer. OBJECT and START are as described in
482`cl-print-insert-ellipsis'."
483 (let ((value (list object start cl-print--number-table
484 cl-print--currently-printing)))
485 (with-current-buffer stream
486 (put-text-property beg end 'cl-print-ellipsis value stream))))
487
488;;;###autoload
489(defun cl-print-expand-ellipsis (value stream)
490 "Print the expansion of an ellipsis to STREAM.
491VALUE should be the value of the `cl-print-ellipsis' text property
492which was attached to the ellipsis by `cl-prin1'."
493 (let ((cl-print--depth 1)
494 (object (nth 0 value))
495 (start (nth 1 value))
496 (cl-print--number-table (nth 2 value))
497 (print-number-table (nth 2 value))
498 (cl-print--currently-printing (nth 3 value)))
499 (when (eq object (car cl-print--currently-printing))
500 (pop cl-print--currently-printing))
501 (if (equal start 0)
502 (cl-print-object object stream)
503 (cl-print-object-contents object start stream))))
504
294;;;###autoload 505;;;###autoload
295(defun cl-prin1 (object &optional stream) 506(defun cl-prin1 (object &optional stream)
296 "Print OBJECT on STREAM according to its type. 507 "Print OBJECT on STREAM according to its type.
@@ -313,5 +524,45 @@ node `(elisp)Output Variables'."
313 (cl-prin1 object (current-buffer)) 524 (cl-prin1 object (current-buffer))
314 (buffer-string))) 525 (buffer-string)))
315 526
527;;;###autoload
528(defun cl-print-to-string-with-limit (print-function value limit)
529 "Return a string containing a printed representation of VALUE.
530Attempt to get the length of the returned string under LIMIT
531characters with appropriate settings of `print-level' and
532`print-length.' Use PRINT-FUNCTION to print, which should take
533the arguments VALUE and STREAM and which should respect
534`print-length' and `print-level'. LIMIT may be nil or zero in
535which case PRINT-FUNCTION will be called with `print-level' and
536`print-length' bound to nil.
537
538Use this function with `cl-prin1' to print an object,
539abbreviating it with ellipses to fit within a size limit. Use
540this function with `cl-prin1-expand-ellipsis' to expand an
541ellipsis, abbreviating the expansion to stay within a size
542limit."
543 (setq limit (and (natnump limit)
544 (not (zerop limit))
545 limit))
546 ;; Since this is used by the debugger when stack space may be
547 ;; limited, if you increase print-level here, add more depth in
548 ;; call_debugger (bug#31919).
549 (let* ((print-length (when limit (min limit 50)))
550 (print-level (when limit (min 8 (truncate (log limit)))))
551 (delta (when limit
552 (max 1 (truncate (/ print-length print-level))))))
553 (with-temp-buffer
554 (catch 'done
555 (while t
556 (erase-buffer)
557 (funcall print-function value (current-buffer))
558 ;; Stop when either print-level is too low or the value is
559 ;; successfully printed in the space allowed.
560 (when (or (not limit)
561 (< (- (point-max) (point-min)) limit)
562 (= print-level 2))
563 (throw 'done (buffer-string)))
564 (cl-decf print-level)
565 (cl-decf print-length delta))))))
566
316(provide 'cl-print) 567(provide 'cl-print)
317;;; cl-print.el ends here 568;;; cl-print.el ends here
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0efaa637129..7fc2b41c70c 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -28,6 +28,7 @@
28;;; Code: 28;;; Code:
29 29
30(require 'cl-lib) 30(require 'cl-lib)
31(require 'backtrace)
31(require 'button) 32(require 'button)
32 33
33(defgroup debugger nil 34(defgroup debugger nil
@@ -133,6 +134,25 @@ where CAUSE can be:
133- exit: called because of exit of a flagged function. 134- exit: called because of exit of a flagged function.
134- error: called because of `debug-on-error'.") 135- error: called because of `debug-on-error'.")
135 136
137(cl-defstruct (debugger--buffer-state
138 (:constructor debugger--save-buffer-state
139 (&aux (mode major-mode)
140 (header backtrace-insert-header-function)
141 (frames backtrace-frames)
142 (content (buffer-string))
143 (pos (point)))))
144 mode header frames content pos)
145
146(defun debugger--restore-buffer-state (state)
147 (unless (derived-mode-p (debugger--buffer-state-mode state))
148 (funcall (debugger--buffer-state-mode state)))
149 (setq backtrace-insert-header-function (debugger--buffer-state-header state)
150 backtrace-frames (debugger--buffer-state-frames state))
151 (let ((inhibit-read-only t))
152 (erase-buffer)
153 (insert (debugger--buffer-state-content state)))
154 (goto-char (debugger--buffer-state-pos state)))
155
136;;;###autoload 156;;;###autoload
137(setq debugger 'debug) 157(setq debugger 'debug)
138;;;###autoload 158;;;###autoload
@@ -174,7 +194,7 @@ first will be printed into the backtrace buffer."
174 (debugger-previous-state 194 (debugger-previous-state
175 (if (get-buffer "*Backtrace*") 195 (if (get-buffer "*Backtrace*")
176 (with-current-buffer (get-buffer "*Backtrace*") 196 (with-current-buffer (get-buffer "*Backtrace*")
177 (list major-mode (buffer-string))))) 197 (debugger--save-buffer-state))))
178 (debugger-args args) 198 (debugger-args args)
179 (debugger-buffer (get-buffer-create "*Backtrace*")) 199 (debugger-buffer (get-buffer-create "*Backtrace*"))
180 (debugger-old-buffer (current-buffer)) 200 (debugger-old-buffer (current-buffer))
@@ -236,7 +256,8 @@ first will be printed into the backtrace buffer."
236 (window-total-height debugger-window))) 256 (window-total-height debugger-window)))
237 (error nil))) 257 (error nil)))
238 (setq debugger-previous-window debugger-window)) 258 (setq debugger-previous-window debugger-window))
239 (debugger-mode) 259 (unless (derived-mode-p 'debugger-mode)
260 (debugger-mode))
240 (debugger-setup-buffer debugger-args) 261 (debugger-setup-buffer debugger-args)
241 (when noninteractive 262 (when noninteractive
242 ;; If the backtrace is long, save the beginning 263 ;; If the backtrace is long, save the beginning
@@ -280,15 +301,14 @@ first will be printed into the backtrace buffer."
280 (setq debugger-previous-window nil)) 301 (setq debugger-previous-window nil))
281 ;; Restore previous state of debugger-buffer in case we were 302 ;; Restore previous state of debugger-buffer in case we were
282 ;; in a recursive invocation of the debugger, otherwise just 303 ;; in a recursive invocation of the debugger, otherwise just
283 ;; erase the buffer and put it into fundamental mode. 304 ;; erase the buffer.
284 (when (buffer-live-p debugger-buffer) 305 (when (buffer-live-p debugger-buffer)
285 (with-current-buffer debugger-buffer 306 (with-current-buffer debugger-buffer
286 (let ((inhibit-read-only t)) 307 (if debugger-previous-state
287 (erase-buffer) 308 (debugger--restore-buffer-state debugger-previous-state)
288 (if (null debugger-previous-state) 309 (setq backtrace-insert-header-function nil)
289 (fundamental-mode) 310 (setq backtrace-frames nil)
290 (insert (nth 1 debugger-previous-state)) 311 (backtrace-print))))
291 (funcall (nth 0 debugger-previous-state))))))
292 (with-timeout-unsuspend debugger-with-timeout-suspend) 312 (with-timeout-unsuspend debugger-with-timeout-suspend)
293 (set-match-data debugger-outer-match-data))) 313 (set-match-data debugger-outer-match-data)))
294 (setq debug-on-next-call debugger-step-after-exit) 314 (setq debug-on-next-call debugger-step-after-exit)
@@ -301,112 +321,80 @@ first will be printed into the backtrace buffer."
301 (message "Error in debug printer: %S" err) 321 (message "Error in debug printer: %S" err)
302 (prin1 obj stream)))) 322 (prin1 obj stream))))
303 323
304(defun debugger-insert-backtrace (frames do-xrefs)
305 "Format and insert the backtrace FRAMES at point.
306Make functions into cross-reference buttons if DO-XREFS is non-nil."
307 (let ((standard-output (current-buffer))
308 (eval-buffers eval-buffer-list))
309 (require 'help-mode) ; Define `help-function-def' button type.
310 (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
311 (insert (if (plist-get flags :debug-on-exit)
312 "* " " "))
313 (let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
314 (fun-pt (point)))
315 (cond
316 ((and evald (not debugger-stack-frame-as-list))
317 (debugger--print fun)
318 (if args (debugger--print args) (princ "()")))
319 (t
320 (debugger--print (cons fun args))
321 (cl-incf fun-pt)))
322 (when fun-file
323 (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
324 :type 'help-function-def
325 'help-args (list fun fun-file))))
326 ;; After any frame that uses eval-buffer, insert a line that
327 ;; states the buffer position it's reading at.
328 (when (and eval-buffers (memq fun '(eval-buffer eval-region)))
329 (insert (format " ; Reading at buffer position %d"
330 ;; This will get the wrong result if there are
331 ;; two nested eval-region calls for the same
332 ;; buffer. That's not a very useful case.
333 (with-current-buffer (pop eval-buffers)
334 (point)))))
335 (insert "\n"))))
336
337(defun debugger-setup-buffer (args) 324(defun debugger-setup-buffer (args)
338 "Initialize the `*Backtrace*' buffer for entry to the debugger. 325 "Initialize the `*Backtrace*' buffer for entry to the debugger.
339That buffer should be current already." 326That buffer should be current already and in debugger-mode."
340 (setq buffer-read-only nil) 327 (setq backtrace-frames (nthcdr
341 (erase-buffer) 328 ;; Remove debug--implement-debug-on-entry and the
342 (set-buffer-multibyte t) ;Why was it nil ? -stef 329 ;; advice's `apply' frame.
343 (setq buffer-undo-list t) 330 (if (eq (car args) 'debug) 3 1)
331 (backtrace-get-frames 'debug)))
332 (when (eq (car-safe args) 'exit)
333 (setq debugger-value (nth 1 args))
334 (setf (cl-getf (backtrace-frame-flags (car backtrace-frames))
335 :debug-on-exit)
336 nil))
337
338 (setq backtrace-view (plist-put backtrace-view :show-flags t)
339 backtrace-insert-header-function (lambda ()
340 (debugger--insert-header args))
341 backtrace-print-function debugger-print-function)
342 (backtrace-print)
343 ;; Place point on "stack frame 0" (bug#15101).
344 (goto-char (point-min))
345 (search-forward ":" (line-end-position) t)
346 (when (and (< (point) (line-end-position))
347 (= (char-after) ?\s))
348 (forward-char)))
349
350(defun debugger--insert-header (args)
351 "Insert the header for the debugger's Backtrace buffer.
352Include the reason for debugger entry from ARGS."
344 (insert "Debugger entered") 353 (insert "Debugger entered")
345 (let ((frames (nthcdr 354 (pcase (car args)
346 ;; Remove debug--implement-debug-on-entry and the 355 ;; lambda is for debug-on-call when a function call is next.
347 ;; advice's `apply' frame. 356 ;; debug is for debug-on-entry function called.
348 (if (eq (car args) 'debug) 3 1) 357 ((or `lambda `debug)
349 (backtrace-frames 'debug))) 358 (insert "--entering a function:\n"))
350 (print-escape-newlines t) 359 ;; Exiting a function.
351 (print-escape-control-characters t) 360 (`exit
352 ;; If you increase print-level, add more depth in call_debugger. 361 (insert "--returning value: ")
353 (print-level 8) 362 (insert (backtrace-print-to-string debugger-value))
354 (print-length 50) 363 (insert ?\n))
355 (pos (point))) 364 ;; Watchpoint triggered.
356 (pcase (car args) 365 ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
357 ;; lambda is for debug-on-call when a function call is next. 366 (insert
358 ;; debug is for debug-on-entry function called. 367 "--"
359 ((or `lambda `debug) 368 (pcase details
360 (insert "--entering a function:\n") 369 (`(makunbound nil) (format "making %s void" symbol))
361 (setq pos (1- (point)))) 370 (`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
362 ;; Exiting a function. 371 symbol buffer))
363 (`exit 372 (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
364 (insert "--returning value: ") 373 (`(let ,_) (format "let-binding %s to %s" symbol
365 (setq pos (point)) 374 (backtrace-print-to-string newval)))
366 (setq debugger-value (nth 1 args)) 375 (`(unlet ,_) (format "ending let-binding of %s" symbol))
367 (debugger--print debugger-value (current-buffer)) 376 (`(set nil) (format "setting %s to %s" symbol
368 (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) 377 (backtrace-print-to-string newval)))
369 (insert ?\n)) 378 (`(set ,buffer) (format "setting %s in buffer %s to %s"
370 ;; Watchpoint triggered. 379 symbol buffer
371 ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) 380 (backtrace-print-to-string newval)))
372 (insert 381 (_ (error "unrecognized watchpoint triggered %S" (cdr args))))
373 "--" 382 ": ")
374 (pcase details 383 (insert ?\n))
375 (`(makunbound nil) (format "making %s void" symbol)) 384 ;; Debugger entered for an error.
376 (`(makunbound ,buffer) (format "killing local value of %s in buffer %s" 385 (`error
377 symbol buffer)) 386 (insert "--Lisp error: ")
378 (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval)) 387 (insert (backtrace-print-to-string (nth 1 args)))
379 (`(let ,_) (format "let-binding %s to %S" symbol newval)) 388 (insert ?\n))
380 (`(unlet ,_) (format "ending let-binding of %s" symbol)) 389 ;; debug-on-call, when the next thing is an eval.
381 (`(set nil) (format "setting %s to %S" symbol newval)) 390 (`t
382 (`(set ,buffer) (format "setting %s in buffer %s to %S" 391 (insert "--beginning evaluation of function call form:\n"))
383 symbol buffer newval)) 392 ;; User calls debug directly.
384 (_ (error "unrecognized watchpoint triggered %S" (cdr args)))) 393 (_
385 ": ") 394 (insert ": ")
386 (setq pos (point)) 395 (insert (backtrace-print-to-string (if (eq (car args) 'nil)
387 (insert ?\n)) 396 (cdr args) args)))
388 ;; Debugger entered for an error. 397 (insert ?\n))))
389 (`error
390 (insert "--Lisp error: ")
391 (setq pos (point))
392 (debugger--print (nth 1 args) (current-buffer))
393 (insert ?\n))
394 ;; debug-on-call, when the next thing is an eval.
395 (`t
396 (insert "--beginning evaluation of function call form:\n")
397 (setq pos (1- (point))))
398 ;; User calls debug directly.
399 (_
400 (insert ": ")
401 (setq pos (point))
402 (debugger--print
403 (if (eq (car args) 'nil)
404 (cdr args) args)
405 (current-buffer))
406 (insert ?\n)))
407 (debugger-insert-backtrace frames t)
408 ;; Place point on "stack frame 0" (bug#15101).
409 (goto-char pos)))
410 398
411 399
412(defun debugger-step-through () 400(defun debugger-step-through ()
@@ -426,12 +414,12 @@ Enter another debugger on next entry to eval, apply or funcall."
426 (unless debugger-may-continue 414 (unless debugger-may-continue
427 (error "Cannot continue")) 415 (error "Cannot continue"))
428 (message "Continuing.") 416 (message "Continuing.")
429 (save-excursion 417
430 ;; Check to see if we've flagged some frame for debug-on-exit, in which 418 ;; Check to see if we've flagged some frame for debug-on-exit, in which
431 ;; case we'll probably come back to the debugger soon. 419 ;; case we'll probably come back to the debugger soon.
432 (goto-char (point-min)) 420 (dolist (frame backtrace-frames)
433 (if (re-search-forward "^\\* " nil t) 421 (when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
434 (setq debugger-will-be-back t))) 422 (setq debugger-will-be-back t)))
435 (exit-recursive-edit)) 423 (exit-recursive-edit))
436 424
437(defun debugger-return-value (val) 425(defun debugger-return-value (val)
@@ -446,12 +434,11 @@ will be used, such as in a debug on exit from a frame."
446 (setq debugger-value val) 434 (setq debugger-value val)
447 (princ "Returning " t) 435 (princ "Returning " t)
448 (debugger--print debugger-value) 436 (debugger--print debugger-value)
449 (save-excursion
450 ;; Check to see if we've flagged some frame for debug-on-exit, in which 437 ;; Check to see if we've flagged some frame for debug-on-exit, in which
451 ;; case we'll probably come back to the debugger soon. 438 ;; case we'll probably come back to the debugger soon.
452 (goto-char (point-min)) 439 (dolist (frame backtrace-frames)
453 (if (re-search-forward "^\\* " nil t) 440 (when (plist-get (backtrace-frame-flags frame) :debug-on-exit)
454 (setq debugger-will-be-back t))) 441 (setq debugger-will-be-back t)))
455 (exit-recursive-edit)) 442 (exit-recursive-edit))
456 443
457(defun debugger-jump () 444(defun debugger-jump ()
@@ -473,63 +460,40 @@ removes itself from that hook."
473 460
474(defun debugger-frame-number (&optional skip-base) 461(defun debugger-frame-number (&optional skip-base)
475 "Return number of frames in backtrace before the one point points at." 462 "Return number of frames in backtrace before the one point points at."
476 (save-excursion 463 (let ((index (backtrace-get-index))
477 (beginning-of-line) 464 (count 0))
478 (if (looking-at " *;;;\\|[a-z]") 465 (unless index
479 (error "This line is not a function call")) 466 (error "This line is not a function call"))
480 (let ((opoint (point)) 467 (unless skip-base
481 (count 0))
482 (unless skip-base
483 (while (not (eq (cadr (backtrace-frame count)) 'debug)) 468 (while (not (eq (cadr (backtrace-frame count)) 'debug))
484 (setq count (1+ count))) 469 (setq count (1+ count)))
485 ;; Skip debug--implement-debug-on-entry frame. 470 ;; Skip debug--implement-debug-on-entry frame.
486 (when (eq 'debug--implement-debug-on-entry 471 (when (eq 'debug--implement-debug-on-entry
487 (cadr (backtrace-frame (1+ count)))) 472 (cadr (backtrace-frame (1+ count))))
488 (setq count (+ 2 count)))) 473 (setq count (+ 2 count))))
489 (goto-char (point-min)) 474 (+ count index)))
490 (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
491 (goto-char (match-end 0))
492 (forward-sexp 1))
493 (forward-line 1)
494 (while (progn
495 (forward-char 2)
496 (cond ((debugger--locals-visible-p)
497 (goto-char (next-single-char-property-change
498 (point) 'locals-visible)))
499 ((= (following-char) ?\()
500 (forward-sexp 1))
501 (t
502 (forward-sexp 2)))
503 (forward-line 1)
504 (<= (point) opoint))
505 (if (looking-at " *;;;")
506 (forward-line 1))
507 (setq count (1+ count)))
508 count)))
509 475
510(defun debugger-frame () 476(defun debugger-frame ()
511 "Request entry to debugger when this frame exits. 477 "Request entry to debugger when this frame exits.
512Applies to the frame whose line point is on in the backtrace." 478Applies to the frame whose line point is on in the backtrace."
513 (interactive) 479 (interactive)
514 (backtrace-debug (debugger-frame-number) t) 480 (backtrace-debug (debugger-frame-number) t)
515 (beginning-of-line) 481 (setf
516 (if (= (following-char) ? ) 482 (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
517 (let ((inhibit-read-only t)) 483 :debug-on-exit)
518 (delete-char 1) 484 t)
519 (insert ?*))) 485 (backtrace-update-flags))
520 (beginning-of-line))
521 486
522(defun debugger-frame-clear () 487(defun debugger-frame-clear ()
523 "Do not enter debugger when this frame exits. 488 "Do not enter debugger when this frame exits.
524Applies to the frame whose line point is on in the backtrace." 489Applies to the frame whose line point is on in the backtrace."
525 (interactive) 490 (interactive)
526 (backtrace-debug (debugger-frame-number) nil) 491 (backtrace-debug (debugger-frame-number) nil)
527 (beginning-of-line) 492 (setf
528 (if (= (following-char) ?*) 493 (cl-getf (backtrace-frame-flags (nth (backtrace-get-index) backtrace-frames))
529 (let ((inhibit-read-only t)) 494 :debug-on-exit)
530 (delete-char 1) 495 nil)
531 (insert ? ))) 496 (backtrace-update-flags))
532 (beginning-of-line))
533 497
534(defmacro debugger-env-macro (&rest body) 498(defmacro debugger-env-macro (&rest body)
535 "Run BODY in original environment." 499 "Run BODY in original environment."
@@ -564,69 +528,10 @@ The environment used is the one when entering the activation frame at point."
564 (let ((str (eval-expression-print-format val))) 528 (let ((str (eval-expression-print-format val)))
565 (if str (princ str t)))))))) 529 (if str (princ str t))))))))
566 530
567(defun debugger--locals-visible-p ()
568 "Are the local variables of the current stack frame visible?"
569 (save-excursion
570 (move-to-column 2)
571 (get-text-property (point) 'locals-visible)))
572
573(defun debugger--insert-locals (locals)
574 "Insert the local variables LOCALS at point."
575 (cond ((null locals)
576 (insert "\n [no locals]"))
577 (t
578 (let ((print-escape-newlines t))
579 (dolist (s+v locals)
580 (let ((symbol (car s+v))
581 (value (cdr s+v)))
582 (insert "\n ")
583 (prin1 symbol (current-buffer))
584 (insert " = ")
585 (debugger--print value (current-buffer))))))))
586
587(defun debugger--show-locals ()
588 "For the frame at point, insert locals and add text properties."
589 (let* ((nframe (1+ (debugger-frame-number 'skip-base)))
590 (base (debugger--backtrace-base))
591 (locals (backtrace--locals nframe base))
592 (inhibit-read-only t))
593 (save-excursion
594 (let ((start (progn
595 (move-to-column 2)
596 (point))))
597 (end-of-line)
598 (debugger--insert-locals locals)
599 (add-text-properties start (point) '(locals-visible t))))))
600
601(defun debugger--hide-locals ()
602 "Delete local variables and remove the text property."
603 (let* ((col (current-column))
604 (end (progn
605 (move-to-column 2)
606 (next-single-char-property-change (point) 'locals-visible)))
607 (start (previous-single-char-property-change end 'locals-visible))
608 (inhibit-read-only t))
609 (remove-text-properties start end '(locals-visible))
610 (goto-char start)
611 (end-of-line)
612 (delete-region (point) end)
613 (move-to-column col)))
614
615(defun debugger-toggle-locals ()
616 "Show or hide local variables of the current stack frame."
617 (interactive)
618 (cond ((debugger--locals-visible-p)
619 (debugger--hide-locals))
620 (t
621 (debugger--show-locals))))
622
623 531
624(defvar debugger-mode-map 532(defvar debugger-mode-map
625 (let ((map (make-keymap)) 533 (let ((map (make-keymap)))
626 (menu-map (make-sparse-keymap))) 534 (set-keymap-parent map backtrace-mode-map)
627 (set-keymap-parent map button-buffer-map)
628 (suppress-keymap map)
629 (define-key map "-" 'negative-argument)
630 (define-key map "b" 'debugger-frame) 535 (define-key map "b" 'debugger-frame)
631 (define-key map "c" 'debugger-continue) 536 (define-key map "c" 'debugger-continue)
632 (define-key map "j" 'debugger-jump) 537 (define-key map "j" 'debugger-jump)
@@ -634,63 +539,47 @@ The environment used is the one when entering the activation frame at point."
634 (define-key map "u" 'debugger-frame-clear) 539 (define-key map "u" 'debugger-frame-clear)
635 (define-key map "d" 'debugger-step-through) 540 (define-key map "d" 'debugger-step-through)
636 (define-key map "l" 'debugger-list-functions) 541 (define-key map "l" 'debugger-list-functions)
637 (define-key map "h" 'describe-mode) 542 (define-key map "q" 'debugger-quit)
638 (define-key map "q" 'top-level)
639 (define-key map "e" 'debugger-eval-expression) 543 (define-key map "e" 'debugger-eval-expression)
640 (define-key map "v" 'debugger-toggle-locals) ; "v" is for "variables".
641 (define-key map " " 'next-line)
642 (define-key map "R" 'debugger-record-expression) 544 (define-key map "R" 'debugger-record-expression)
643 (define-key map "\C-m" 'debug-help-follow)
644 (define-key map [mouse-2] 'push-button) 545 (define-key map [mouse-2] 'push-button)
645 (define-key map [menu-bar debugger] (cons "Debugger" menu-map)) 546 (easy-menu-define nil map ""
646 (define-key menu-map [deb-top] 547 '("Debugger"
647 '(menu-item "Quit" top-level 548 ["Step through" debugger-step-through
648 :help "Quit debugging and return to top level")) 549 :help "Proceed, stepping through subexpressions of this expression"]
649 (define-key menu-map [deb-s0] '("--")) 550 ["Continue" debugger-continue
650 (define-key menu-map [deb-descr] 551 :help "Continue, evaluating this expression without stopping"]
651 '(menu-item "Describe Debugger Mode" describe-mode 552 ["Jump" debugger-jump
652 :help "Display documentation for debugger-mode")) 553 :help "Continue to exit from this frame, with all debug-on-entry suspended"]
653 (define-key menu-map [deb-hfol] 554 ["Eval Expression..." debugger-eval-expression
654 '(menu-item "Help Follow" debug-help-follow 555 :help "Eval an expression, in an environment like that outside the debugger"]
655 :help "Follow cross-reference")) 556 ["Display and Record Expression" debugger-record-expression
656 (define-key menu-map [deb-nxt] 557 :help "Display a variable's value and record it in `*Backtrace-record*' buffer"]
657 '(menu-item "Next Line" next-line 558 ["Return value..." debugger-return-value
658 :help "Move cursor down")) 559 :help "Continue, specifying value to return."]
659 (define-key menu-map [deb-s1] '("--")) 560 "--"
660 (define-key menu-map [deb-lfunc] 561 ["Debug frame" debugger-frame
661 '(menu-item "List debug on entry functions" debugger-list-functions 562 :help "Request entry to debugger when this frame exits"]
662 :help "Display a list of all the functions now set to debug on entry")) 563 ["Cancel debug frame" debugger-frame-clear
663 (define-key menu-map [deb-fclear] 564 :help "Do not enter debugger when this frame exits"]
664 '(menu-item "Cancel debug frame" debugger-frame-clear 565 ["List debug on entry functions" debugger-list-functions
665 :help "Do not enter debugger when this frame exits")) 566 :help "Display a list of all the functions now set to debug on entry"]
666 (define-key menu-map [deb-frame] 567 "--"
667 '(menu-item "Debug frame" debugger-frame 568 ["Next Line" next-line
668 :help "Request entry to debugger when this frame exits")) 569 :help "Move cursor down"]
669 (define-key menu-map [deb-s2] '("--")) 570 ["Help for Symbol" backtrace-help-follow-symbol
670 (define-key menu-map [deb-ret] 571 :help "Show help for symbol at point"]
671 '(menu-item "Return value..." debugger-return-value 572 ["Describe Debugger Mode" describe-mode
672 :help "Continue, specifying value to return.")) 573 :help "Display documentation for debugger-mode"]
673 (define-key menu-map [deb-rec] 574 "--"
674 '(menu-item "Display and Record Expression" debugger-record-expression 575 ["Quit" debugger-quit
675 :help "Display a variable's value and record it in `*Backtrace-record*' buffer")) 576 :help "Quit debugging and return to top level"]))
676 (define-key menu-map [deb-eval]
677 '(menu-item "Eval Expression..." debugger-eval-expression
678 :help "Eval an expression, in an environment like that outside the debugger"))
679 (define-key menu-map [deb-jump]
680 '(menu-item "Jump" debugger-jump
681 :help "Continue to exit from this frame, with all debug-on-entry suspended"))
682 (define-key menu-map [deb-cont]
683 '(menu-item "Continue" debugger-continue
684 :help "Continue, evaluating this expression without stopping"))
685 (define-key menu-map [deb-step]
686 '(menu-item "Step through" debugger-step-through
687 :help "Proceed, stepping through subexpressions of this expression"))
688 map)) 577 map))
689 578
690(put 'debugger-mode 'mode-class 'special) 579(put 'debugger-mode 'mode-class 'special)
691 580
692(define-derived-mode debugger-mode fundamental-mode "Debugger" 581(define-derived-mode debugger-mode backtrace-mode "Debugger"
693 "Mode for backtrace buffers, selected in debugger. 582 "Mode for debugging Emacs Lisp using a backtrace.
694\\<debugger-mode-map> 583\\<debugger-mode-map>
695A line starts with `*' if exiting that frame will call the debugger. 584A line starts with `*' if exiting that frame will call the debugger.
696Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'. 585Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
@@ -704,8 +593,6 @@ which functions will enter the debugger when called.
704 593
705Complete list of commands: 594Complete list of commands:
706\\{debugger-mode-map}" 595\\{debugger-mode-map}"
707 (setq truncate-lines t)
708 (set-syntax-table emacs-lisp-mode-syntax-table)
709 (add-hook 'kill-buffer-hook 596 (add-hook 'kill-buffer-hook
710 (lambda () (if (> (recursion-depth) 0) (top-level))) 597 (lambda () (if (> (recursion-depth) 0) (top-level)))
711 nil t) 598 nil t)
@@ -732,27 +619,6 @@ Complete list of commands:
732 (buffer-substring (line-beginning-position 0) 619 (buffer-substring (line-beginning-position 0)
733 (line-end-position 0))))) 620 (line-end-position 0)))))
734 621
735(defun debug-help-follow (&optional pos)
736 "Follow cross-reference at POS, defaulting to point.
737
738For the cross-reference format, see `help-make-xrefs'."
739 (interactive "d")
740 ;; Ideally we'd just do (call-interactively 'help-follow) except that this
741 ;; assumes we're already in a *Help* buffer and reuses it, so it ends up
742 ;; incorrectly "reusing" the *Backtrace* buffer to show the help info.
743 (unless pos
744 (setq pos (point)))
745 (unless (push-button pos)
746 ;; check if the symbol under point is a function or variable
747 (let ((sym
748 (intern
749 (save-excursion
750 (goto-char pos) (skip-syntax-backward "w_")
751 (buffer-substring (point)
752 (progn (skip-syntax-forward "w_")
753 (point)))))))
754 (when (or (boundp sym) (fboundp sym) (facep sym))
755 (describe-symbol sym)))))
756 622
757;; When you change this, you may also need to change the number of 623;; When you change this, you may also need to change the number of
758;; frames that the debugger skips. 624;; frames that the debugger skips.
@@ -853,6 +719,13 @@ To specify a nil argument interactively, exit with an empty minibuffer."
853 ;;(princ "be set to debug on entry, even if it is in the list.") 719 ;;(princ "be set to debug on entry, even if it is in the list.")
854 ))))) 720 )))))
855 721
722(defun debugger-quit ()
723 "Quit debugging and return to the top level."
724 (interactive)
725 (if (= (recursion-depth) 0)
726 (quit-window)
727 (top-level)))
728
856(defun debug--implement-debug-watch (symbol newval op where) 729(defun debug--implement-debug-watch (symbol newval op where)
857 "Conditionally call the debugger. 730 "Conditionally call the debugger.
858This function is called when SYMBOL's value is modified." 731This function is called when SYMBOL's value is modified."
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index b83b53a8e52..4d8a5020267 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -474,22 +474,26 @@ See `%s' for more information on %s."
474 474
475 ;; The function that calls TURN-ON in each buffer. 475 ;; The function that calls TURN-ON in each buffer.
476 (defun ,MODE-enable-in-buffers () 476 (defun ,MODE-enable-in-buffers ()
477 (dolist (buf ,MODE-buffers) 477 (let ((buffers ,MODE-buffers))
478 (when (buffer-live-p buf) 478 ;; Clear MODE-buffers to avoid scanning the same list of
479 (with-current-buffer buf 479 ;; buffers in recursive calls to MODE-enable-in-buffers.
480 (unless ,MODE-set-explicitly 480 ;; Otherwise it could lead to infinite recursion.
481 (unless (eq ,MODE-major-mode major-mode) 481 (setq ,MODE-buffers nil)
482 (if ,mode 482 (dolist (buf buffers)
483 (progn 483 (when (buffer-live-p buf)
484 (,mode -1) 484 (with-current-buffer buf
485 (funcall #',turn-on)) 485 (unless ,MODE-set-explicitly
486 (funcall #',turn-on)))) 486 (unless (eq ,MODE-major-mode major-mode)
487 (setq ,MODE-major-mode major-mode))))) 487 (if ,mode
488 (progn
489 (,mode -1)
490 (funcall #',turn-on))
491 (funcall #',turn-on))))
492 (setq ,MODE-major-mode major-mode))))))
488 (put ',MODE-enable-in-buffers 'definition-name ',global-mode) 493 (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
489 494
490 (defun ,MODE-check-buffers () 495 (defun ,MODE-check-buffers ()
491 (,MODE-enable-in-buffers) 496 (,MODE-enable-in-buffers)
492 (setq ,MODE-buffers nil)
493 (remove-hook 'post-command-hook ',MODE-check-buffers)) 497 (remove-hook 'post-command-hook ',MODE-check-buffers))
494 (put ',MODE-check-buffers 'definition-name ',global-mode) 498 (put ',MODE-check-buffers 'definition-name ',global-mode)
495 499
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index e759c5b5b24..fa418c68281 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -52,6 +52,7 @@
52 52
53;;; Code: 53;;; Code:
54 54
55(require 'backtrace)
55(require 'macroexp) 56(require 'macroexp)
56(require 'cl-lib) 57(require 'cl-lib)
57(eval-when-compile (require 'pcase)) 58(eval-when-compile (require 'pcase))
@@ -206,8 +207,7 @@ Use this with caution since it is not debugged."
206 "Non-nil if Edebug should unwrap results of expressions. 207 "Non-nil if Edebug should unwrap results of expressions.
207That is, Edebug will try to remove its own instrumentation from the result. 208That is, Edebug will try to remove its own instrumentation from the result.
208This is useful when debugging macros where the results of expressions 209This is useful when debugging macros where the results of expressions
209are instrumented expressions. But don't do this when results might be 210are instrumented expressions."
210circular or an infinite loop will result."
211 :type 'boolean 211 :type 'boolean
212 :group 'edebug) 212 :group 'edebug)
213 213
@@ -1198,6 +1198,8 @@ purpose by adding an entry to this alist, and setting
1198(defvar edebug-inside-func) ;; whether code is inside function context. 1198(defvar edebug-inside-func) ;; whether code is inside function context.
1199;; Currently def-form sets this to nil; def-body sets it to t. 1199;; Currently def-form sets this to nil; def-body sets it to t.
1200 1200
1201(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
1202
1201(defun edebug-interactive-p-name () 1203(defun edebug-interactive-p-name ()
1202 ;; Return a unique symbol for the variable used to store the 1204 ;; Return a unique symbol for the variable used to store the
1203 ;; status of interactive-p for this function. 1205 ;; status of interactive-p for this function.
@@ -1263,25 +1265,59 @@ purpose by adding an entry to this alist, and setting
1263(defun edebug-unwrap (sexp) 1265(defun edebug-unwrap (sexp)
1264 "Return the unwrapped SEXP or return it as is if it is not wrapped. 1266 "Return the unwrapped SEXP or return it as is if it is not wrapped.
1265The SEXP might be the result of wrapping a body, which is a list of 1267The SEXP might be the result of wrapping a body, which is a list of
1266expressions; a `progn' form will be returned enclosing these forms." 1268expressions; a `progn' form will be returned enclosing these forms.
1267 (if (consp sexp) 1269Does not unwrap inside vectors, records, structures, or hash tables."
1268 (cond 1270 (pcase sexp
1269 ((eq 'edebug-after (car sexp)) 1271 (`(edebug-after ,_before-form ,_after-index ,form)
1270 (nth 3 sexp)) 1272 form)
1271 ((eq 'edebug-enter (car sexp)) 1273 (`(lambda ,args (edebug-enter ',_sym ,_arglist
1272 (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp))))) 1274 (function (lambda nil . ,body))))
1273 (t sexp);; otherwise it is not wrapped, so just return it. 1275 `(lambda ,args ,@body))
1274 ) 1276 (`(closure ,env ,args (edebug-enter ',_sym ,_arglist
1275 sexp)) 1277 (function (lambda nil . ,body))))
1278 `(closure ,env ,args ,@body))
1279 (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
1280 (macroexp-progn body))
1281 (_ sexp)))
1276 1282
1277(defun edebug-unwrap* (sexp) 1283(defun edebug-unwrap* (sexp)
1278 "Return the SEXP recursively unwrapped." 1284 "Return the SEXP recursively unwrapped."
1285 (let ((ht (make-hash-table :test 'eq)))
1286 (edebug--unwrap1 sexp ht)))
1287
1288(defun edebug--unwrap1 (sexp hash-table)
1289 "Unwrap SEXP using HASH-TABLE of things already unwrapped.
1290HASH-TABLE contains the results of unwrapping cons cells within
1291SEXP, which are reused to avoid infinite loops when SEXP is or
1292contains a circular object."
1279 (let ((new-sexp (edebug-unwrap sexp))) 1293 (let ((new-sexp (edebug-unwrap sexp)))
1280 (while (not (eq sexp new-sexp)) 1294 (while (not (eq sexp new-sexp))
1281 (setq sexp new-sexp 1295 (setq sexp new-sexp
1282 new-sexp (edebug-unwrap sexp))) 1296 new-sexp (edebug-unwrap sexp)))
1283 (if (consp new-sexp) 1297 (if (consp new-sexp)
1284 (mapcar #'edebug-unwrap* new-sexp) 1298 (let ((result (gethash new-sexp hash-table nil)))
1299 (unless result
1300 (let ((remainder new-sexp)
1301 current)
1302 (setq result (cons nil nil)
1303 current result)
1304 (while
1305 (progn
1306 (puthash remainder current hash-table)
1307 (setf (car current)
1308 (edebug--unwrap1 (car remainder) hash-table))
1309 (setq remainder (cdr remainder))
1310 (cond
1311 ((atom remainder)
1312 (setf (cdr current)
1313 (edebug--unwrap1 remainder hash-table))
1314 nil)
1315 ((gethash remainder hash-table nil)
1316 (setf (cdr current) (gethash remainder hash-table nil))
1317 nil)
1318 (t (setq current
1319 (setf (cdr current) (cons nil nil)))))))))
1320 result)
1285 new-sexp))) 1321 new-sexp)))
1286 1322
1287 1323
@@ -1463,6 +1499,11 @@ expressions; a `progn' form will be returned enclosing these forms."
1463 ;; Helper for edebug-list-form 1499 ;; Helper for edebug-list-form
1464 (let ((spec (get-edebug-spec head))) 1500 (let ((spec (get-edebug-spec head)))
1465 (cond 1501 (cond
1502 ;; Treat cl-macrolet bindings like macros with no spec.
1503 ((member head edebug--cl-macrolet-defs)
1504 (if edebug-eval-macro-args
1505 (edebug-forms cursor)
1506 (edebug-sexps cursor)))
1466 (spec 1507 (spec
1467 (cond 1508 (cond
1468 ((consp spec) 1509 ((consp spec)
@@ -1651,6 +1692,9 @@ expressions; a `progn' form will be returned enclosing these forms."
1651 ;; (function . edebug-match-function) 1692 ;; (function . edebug-match-function)
1652 (lambda-expr . edebug-match-lambda-expr) 1693 (lambda-expr . edebug-match-lambda-expr)
1653 (cl-generic-method-args . edebug-match-cl-generic-method-args) 1694 (cl-generic-method-args . edebug-match-cl-generic-method-args)
1695 (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
1696 (cl-macrolet-name . edebug-match-cl-macrolet-name)
1697 (cl-macrolet-body . edebug-match-cl-macrolet-body)
1654 (&not . edebug-match-&not) 1698 (&not . edebug-match-&not)
1655 (&key . edebug-match-&key) 1699 (&key . edebug-match-&key)
1656 (place . edebug-match-place) 1700 (place . edebug-match-place)
@@ -1954,6 +1998,43 @@ expressions; a `progn' form will be returned enclosing these forms."
1954 (edebug-move-cursor cursor) 1998 (edebug-move-cursor cursor)
1955 (list args))) 1999 (list args)))
1956 2000
2001(defvar edebug--cl-macrolet-defs nil
2002 "List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
2003(defvar edebug--current-cl-macrolet-defs nil
2004 "List of symbols found within the bindings of the current `cl-macrolet' form.")
2005
2006(defun edebug-match-cl-macrolet-expr (cursor)
2007 "Match a `cl-macrolet' form at CURSOR."
2008 (let (edebug--current-cl-macrolet-defs)
2009 (edebug-match cursor
2010 '((&rest (&define cl-macrolet-name cl-macro-list
2011 cl-declarations-or-string
2012 def-body))
2013 cl-declarations cl-macrolet-body))))
2014
2015(defun edebug-match-cl-macrolet-name (cursor)
2016 "Match the name in a `cl-macrolet' binding at CURSOR.
2017Collect the names in `edebug--cl-macrolet-defs' where they
2018will be checked by `edebug-list-form-args' and treated as
2019macros without a spec."
2020 (let ((name (edebug-top-element-required cursor "Expected name")))
2021 (when (not (symbolp name))
2022 (edebug-no-match cursor "Bad name:" name))
2023 ;; Change edebug-def-name to avoid conflicts with
2024 ;; names at global scope.
2025 (setq edebug-def-name (gensym "edebug-anon"))
2026 (edebug-move-cursor cursor)
2027 (push name edebug--current-cl-macrolet-defs)
2028 (list name)))
2029
2030(defun edebug-match-cl-macrolet-body (cursor)
2031 "Match the body of a `cl-macrolet' expression at CURSOR.
2032Put the definitions collected in `edebug--current-cl-macrolet-defs'
2033into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
2034 (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
2035 edebug--cl-macrolet-defs)))
2036 (edebug-match-body cursor)))
2037
1957(defun edebug-match-arg (cursor) 2038(defun edebug-match-arg (cursor)
1958 ;; set the def-args bound in edebug-defining-form 2039 ;; set the def-args bound in edebug-defining-form
1959 (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) 2040 (let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
@@ -3611,7 +3692,7 @@ be installed in `emacs-lisp-mode-map'.")
3611 3692
3612 ;; misc 3693 ;; misc
3613 (define-key map "?" 'edebug-help) 3694 (define-key map "?" 'edebug-help)
3614 (define-key map "d" 'edebug-backtrace) 3695 (define-key map "d" 'edebug-pop-to-backtrace)
3615 3696
3616 (define-key map "-" 'negative-argument) 3697 (define-key map "-" 'negative-argument)
3617 3698
@@ -3869,8 +3950,10 @@ Global commands prefixed by `global-edebug-prefix':
3869;; (setq debugger 'debug) ; use the standard debugger 3950;; (setq debugger 'debug) ; use the standard debugger
3870 3951
3871;; Note that debug and its utilities must be byte-compiled to work, 3952;; Note that debug and its utilities must be byte-compiled to work,
3872;; since they depend on the backtrace looking a certain way. But 3953;; since they depend on the backtrace looking a certain way. Edebug
3873;; edebug is not dependent on this, yet. 3954;; will work if not byte-compiled, but it will not be able correctly
3955;; remove its instrumentation from backtraces unless it is
3956;; byte-compiled.
3874 3957
3875(defun edebug (&optional arg-mode &rest args) 3958(defun edebug (&optional arg-mode &rest args)
3876 "Replacement for `debug'. 3959 "Replacement for `debug'.
@@ -3900,49 +3983,136 @@ Otherwise call `debug' normally."
3900 (apply #'debug arg-mode args) 3983 (apply #'debug arg-mode args)
3901 )) 3984 ))
3902 3985
3903 3986;;; Backtrace buffer
3904(defun edebug-backtrace () 3987
3905 "Display a non-working backtrace. Better than nothing..." 3988(defvar-local edebug-backtrace-frames nil
3989 "Stack frames of the current Edebug Backtrace buffer without instrumentation.
3990This should be a list of `edebug---frame' objects.")
3991(defvar-local edebug-instrumented-backtrace-frames nil
3992 "Stack frames of the current Edebug Backtrace buffer with instrumentation.
3993This should be a list of `edebug---frame' objects.")
3994
3995;; Data structure for backtrace frames with information
3996;; from Edebug instrumentation found in the backtrace.
3997(cl-defstruct
3998 (edebug--frame
3999 (:constructor edebug--make-frame)
4000 (:include backtrace-frame))
4001 def-name before-index after-index)
4002
4003(defun edebug-pop-to-backtrace ()
4004 "Display the current backtrace in a `backtrace-mode' window."
3906 (interactive) 4005 (interactive)
3907 (if (or (not edebug-backtrace-buffer) 4006 (if (or (not edebug-backtrace-buffer)
3908 (null (buffer-name edebug-backtrace-buffer))) 4007 (null (buffer-name edebug-backtrace-buffer)))
3909 (setq edebug-backtrace-buffer 4008 (setq edebug-backtrace-buffer
3910 (generate-new-buffer "*Backtrace*")) 4009 (generate-new-buffer "*Edebug Backtrace*"))
3911 ;; Else, could just display edebug-backtrace-buffer. 4010 ;; Else, could just display edebug-backtrace-buffer.
3912 ) 4011 )
3913 (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) 4012 (pop-to-buffer edebug-backtrace-buffer)
3914 (setq edebug-backtrace-buffer standard-output) 4013 (unless (derived-mode-p 'backtrace-mode)
3915 (let ((print-escape-newlines t) 4014 (backtrace-mode)
3916 (print-length 50) ; FIXME cf edebug-safe-prin1-to-string 4015 (add-hook 'backtrace-goto-source-functions 'edebug--backtrace-goto-source))
3917 last-ok-point) 4016 (setq edebug-instrumented-backtrace-frames
3918 (backtrace) 4017 (backtrace-get-frames 'edebug-debugger
3919 4018 :constructor #'edebug--make-frame)
3920 ;; Clean up the backtrace. 4019 edebug-backtrace-frames (edebug--strip-instrumentation
3921 ;; Not quite right for current edebug scheme. 4020 edebug-instrumented-backtrace-frames)
3922 (set-buffer edebug-backtrace-buffer) 4021 backtrace-frames edebug-backtrace-frames)
3923 (setq truncate-lines t) 4022 (backtrace-print)
3924 (goto-char (point-min)) 4023 (goto-char (point-min)))
3925 (setq last-ok-point (point)) 4024
3926 (if t (progn 4025(defun edebug--strip-instrumentation (frames)
3927 4026 "Return a new list of backtrace frames with instrumentation removed.
3928 ;; Delete interspersed edebug internals. 4027Remove frames for Edebug's functions and the lambdas in
3929 (while (re-search-forward "^ (?edebug" nil t) 4028`edebug-enter' wrappers. Fill in the def-name, before-index
3930 (beginning-of-line) 4029and after-index fields in both FRAMES and the returned list
3931 (cond 4030of deinstrumented frames, for those frames where the source
3932 ((looking-at "^ (edebug-after") 4031code location is known."
3933 ;; Previous lines may contain code, so just delete this line. 4032 (let (skip-next-lambda def-name before-index after-index results
3934 (setq last-ok-point (point)) 4033 (index (length frames)))
3935 (forward-line 1) 4034 (dolist (frame (reverse frames))
3936 (delete-region last-ok-point (point))) 4035 (let ((new-frame (copy-edebug--frame frame))
3937 4036 (fun (edebug--frame-fun frame))
3938 ((looking-at (if debugger-stack-frame-as-list 4037 (args (edebug--frame-args frame)))
3939 "^ (edebug" 4038 (cl-decf index)
3940 "^ edebug")) 4039 (pcase fun
3941 (forward-line 1) 4040 ('edebug-enter
3942 (delete-region last-ok-point (point)) 4041 (setq skip-next-lambda t
3943 ))) 4042 def-name (nth 0 args)))
3944 ))))) 4043 ('edebug-after
4044 (setq before-index (if (consp (nth 0 args))
4045 (nth 1 (nth 0 args))
4046 (nth 0 args))
4047 after-index (nth 1 args)))
4048 ((pred edebug--symbol-not-prefixed-p)
4049 (edebug--unwrap-frame new-frame)
4050 (edebug--add-source-info new-frame def-name before-index after-index)
4051 (edebug--add-source-info frame def-name before-index after-index)
4052 (push new-frame results)
4053 (setq before-index nil
4054 after-index nil))
4055 (`(,(or 'lambda 'closure) . ,_)
4056 (unless skip-next-lambda
4057 (edebug--unwrap-frame new-frame)
4058 (edebug--add-source-info frame def-name before-index after-index)
4059 (edebug--add-source-info new-frame def-name before-index after-index)
4060 (push new-frame results))
4061 (setq before-index nil
4062 after-index nil
4063 skip-next-lambda nil)))))
4064 results))
4065
4066(defun edebug--symbol-not-prefixed-p (sym)
4067 "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
4068 (and (symbolp sym)
4069 (not (string-prefix-p "edebug-" (symbol-name sym)))))
4070
4071(defun edebug--unwrap-frame (frame)
4072 "Remove Edebug's instrumentation from FRAME.
4073Strip it from the function and any unevaluated arguments."
4074 (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
4075 (unless (edebug--frame-evald frame)
4076 (let (results)
4077 (dolist (arg (edebug--frame-args frame))
4078 (push (edebug-unwrap* arg) results))
4079 (setf (edebug--frame-args frame) (nreverse results)))))
4080
4081(defun edebug--add-source-info (frame def-name before-index after-index)
4082 "Update FRAME with the additional info needed by an edebug--frame.
4083Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
4084 (when (and before-index def-name)
4085 (setf (edebug--frame-flags frame)
4086 (plist-put (copy-sequence (edebug--frame-flags frame))
4087 :source-available t)))
4088 (setf (edebug--frame-def-name frame) (and before-index def-name))
4089 (setf (edebug--frame-before-index frame) before-index)
4090 (setf (edebug--frame-after-index frame) after-index))
4091
4092(defun edebug--backtrace-goto-source ()
4093 (let* ((index (backtrace-get-index))
4094 (frame (nth index backtrace-frames)))
4095 (when (edebug--frame-def-name frame)
4096 (let* ((data (get (edebug--frame-def-name frame) 'edebug))
4097 (marker (nth 0 data))
4098 (offsets (nth 2 data)))
4099 (pop-to-buffer (marker-buffer marker))
4100 (goto-char (+ (marker-position marker)
4101 (aref offsets (edebug--frame-before-index frame))))))))
4102
4103(defun edebug-backtrace-show-instrumentation ()
4104 "Show Edebug's instrumentation in an Edebug Backtrace buffer."
4105 (interactive)
4106 (unless (eq backtrace-frames edebug-instrumented-backtrace-frames)
4107 (setq backtrace-frames edebug-instrumented-backtrace-frames)
4108 (revert-buffer)))
3945 4109
4110(defun edebug-backtrace-hide-instrumentation ()
4111 "Hide Edebug's instrumentation in an Edebug Backtrace buffer."
4112 (interactive)
4113 (unless (eq backtrace-frames edebug-backtrace-frames)
4114 (setq backtrace-frames edebug-backtrace-frames)
4115 (revert-buffer)))
3946 4116
3947;;; Trace display 4117;;; Trace display
3948 4118
@@ -4116,7 +4286,7 @@ It is removed when you hit any char."
4116 ["Bounce to Current Point" edebug-bounce-point t] 4286 ["Bounce to Current Point" edebug-bounce-point t]
4117 ["View Outside Windows" edebug-view-outside t] 4287 ["View Outside Windows" edebug-view-outside t]
4118 ["Previous Result" edebug-previous-result t] 4288 ["Previous Result" edebug-previous-result t]
4119 ["Show Backtrace" edebug-backtrace t] 4289 ["Show Backtrace" edebug-pop-to-backtrace t]
4120 ["Display Freq Count" edebug-display-freq-count t]) 4290 ["Display Freq Count" edebug-display-freq-count t])
4121 4291
4122 ("Eval" 4292 ("Eval"
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index cad21044f15..eb9695d0c12 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -60,6 +60,7 @@
60(require 'cl-lib) 60(require 'cl-lib)
61(require 'button) 61(require 'button)
62(require 'debug) 62(require 'debug)
63(require 'backtrace)
63(require 'easymenu) 64(require 'easymenu)
64(require 'ewoc) 65(require 'ewoc)
65(require 'find-func) 66(require 'find-func)
@@ -677,13 +678,6 @@ and is displayed in front of the value of MESSAGE-FORM."
677(cl-defstruct (ert-test-aborted-with-non-local-exit 678(cl-defstruct (ert-test-aborted-with-non-local-exit
678 (:include ert-test-result))) 679 (:include ert-test-result)))
679 680
680(defun ert--print-backtrace (backtrace do-xrefs)
681 "Format the backtrace BACKTRACE to the current buffer."
682 (let ((print-escape-newlines t)
683 (print-level 8)
684 (print-length 50))
685 (debugger-insert-backtrace backtrace do-xrefs)))
686
687;; A container for the state of the execution of a single test and 681;; A container for the state of the execution of a single test and
688;; environment data needed during its execution. 682;; environment data needed during its execution.
689(cl-defstruct ert--test-execution-info 683(cl-defstruct ert--test-execution-info
@@ -732,7 +726,7 @@ run. ARGS are the arguments to `debugger'."
732 ;; use. 726 ;; use.
733 ;; 727 ;;
734 ;; Grab the frames above the debugger. 728 ;; Grab the frames above the debugger.
735 (backtrace (cdr (backtrace-frames debugger))) 729 (backtrace (cdr (backtrace-get-frames debugger)))
736 (infos (reverse ert--infos))) 730 (infos (reverse ert--infos)))
737 (setf (ert--test-execution-info-result info) 731 (setf (ert--test-execution-info-result info)
738 (cl-ecase type 732 (cl-ecase type
@@ -1406,9 +1400,8 @@ Returns the stats object."
1406 (ert-test-result-with-condition 1400 (ert-test-result-with-condition
1407 (message "Test %S backtrace:" (ert-test-name test)) 1401 (message "Test %S backtrace:" (ert-test-name test))
1408 (with-temp-buffer 1402 (with-temp-buffer
1409 (ert--print-backtrace 1403 (insert (backtrace-to-string
1410 (ert-test-result-with-condition-backtrace result) 1404 (ert-test-result-with-condition-backtrace result)))
1411 nil)
1412 (if (not ert-batch-backtrace-right-margin) 1405 (if (not ert-batch-backtrace-right-margin)
1413 (message "%s" 1406 (message "%s"
1414 (buffer-substring-no-properties (point-min) 1407 (buffer-substring-no-properties (point-min)
@@ -2450,20 +2443,20 @@ To be used in the ERT results buffer."
2450 (cl-etypecase result 2443 (cl-etypecase result
2451 (ert-test-passed (error "Test passed, no backtrace available")) 2444 (ert-test-passed (error "Test passed, no backtrace available"))
2452 (ert-test-result-with-condition 2445 (ert-test-result-with-condition
2453 (let ((backtrace (ert-test-result-with-condition-backtrace result)) 2446 (let ((buffer (get-buffer-create "*ERT Backtrace*")))
2454 (buffer (get-buffer-create "*ERT Backtrace*")))
2455 (pop-to-buffer buffer) 2447 (pop-to-buffer buffer)
2456 (let ((inhibit-read-only t)) 2448 (unless (derived-mode-p 'backtrace-mode)
2457 (buffer-disable-undo) 2449 (backtrace-mode))
2458 (erase-buffer) 2450 (setq backtrace-insert-header-function
2459 (ert-simple-view-mode) 2451 (lambda () (ert--insert-backtrace-header (ert-test-name test)))
2460 (set-buffer-multibyte t) ; mimic debugger-setup-buffer 2452 backtrace-frames (ert-test-result-with-condition-backtrace result))
2461 (setq truncate-lines t) 2453 (backtrace-print)
2462 (ert--print-backtrace backtrace t) 2454 (goto-char (point-min)))))))
2463 (goto-char (point-min)) 2455
2464 (insert (substitute-command-keys "Backtrace for test `")) 2456(defun ert--insert-backtrace-header (name)
2465 (ert-insert-test-name-button (ert-test-name test)) 2457 (insert (substitute-command-keys "Backtrace for test `"))
2466 (insert (substitute-command-keys "':\n")))))))) 2458 (ert-insert-test-name-button name)
2459 (insert (substitute-command-keys "':\n")))
2467 2460
2468(defun ert-results-pop-to-messages-for-test-at-point () 2461(defun ert-results-pop-to-messages-for-test-at-point ()
2469 "Display the part of the *Messages* buffer generated during the test at point. 2462 "Display the part of the *Messages* buffer generated during the test at point.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 4e5b1a7e4ff..afb7cbd1dd7 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -517,6 +517,16 @@ This will generate compile-time constants from BINDINGS."
517(defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 517(defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1
518 "Default expressions to highlight in Lisp modes.") 518 "Default expressions to highlight in Lisp modes.")
519 519
520;; Support backtrace mode.
521(defconst lisp-el-font-lock-keywords-for-backtraces lisp-el-font-lock-keywords
522 "Default highlighting from Emacs Lisp mod used in Backtrace mode.")
523(defconst lisp-el-font-lock-keywords-for-backtraces-1 lisp-el-font-lock-keywords-1
524 "Subdued highlighting from Emacs Lisp mode used in Backtrace mode.")
525(defconst lisp-el-font-lock-keywords-for-backtraces-2
526 (remove (assoc 'lisp--match-hidden-arg lisp-el-font-lock-keywords-2)
527 lisp-el-font-lock-keywords-2)
528 "Gaudy highlighting from Emacs Lisp mode used in Backtrace mode.")
529
520(defun lisp-string-in-doc-position-p (listbeg startpos) 530(defun lisp-string-in-doc-position-p (listbeg startpos)
521 "Return true if a doc string may occur at STARTPOS inside a list. 531 "Return true if a doc string may occur at STARTPOS inside a list.
522LISTBEG is the position of the start of the innermost list 532LISTBEG is the position of the start of the innermost list
@@ -1196,7 +1206,21 @@ ENDPOS is encountered."
1196 (if endpos endpos 1206 (if endpos endpos
1197 ;; Get error now if we don't have a complete sexp 1207 ;; Get error now if we don't have a complete sexp
1198 ;; after point. 1208 ;; after point.
1199 (save-excursion (forward-sexp 1) (point))))) 1209 (save-excursion
1210 (let ((eol (line-end-position)))
1211 (forward-sexp 1)
1212 ;; We actually look for a sexp which ends
1213 ;; after the current line so that we properly
1214 ;; indent things like #s(...). This might not
1215 ;; be needed if Bug#15998 is fixed.
1216 (condition-case ()
1217 (while (and (< (point) eol) (not (eobp)))
1218 (forward-sexp 1))
1219 ;; But don't signal an error for incomplete
1220 ;; sexps following the first complete sexp
1221 ;; after point.
1222 (scan-error nil)))
1223 (point)))))
1200 (save-excursion 1224 (save-excursion
1201 (while (let ((indent (lisp-indent-calc-next parse-state)) 1225 (while (let ((indent (lisp-indent-calc-next parse-state))
1202 (ppss (lisp-indent-state-ppss parse-state))) 1226 (ppss (lisp-indent-state-ppss parse-state)))
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 61c04ff7b3e..a61c0adc8fb 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -257,10 +257,15 @@ C-g to quit (cancel the whole command);
257;; either long or short answers. 257;; either long or short answers.
258 258
259;; For backward compatibility check if short y/n answers are preferred. 259;; For backward compatibility check if short y/n answers are preferred.
260(defcustom read-answer-short (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) 260(defcustom read-answer-short 'auto
261 "If non-nil, accept short answers to the question." 261 "If non-nil, `read-answer' accepts single-character answers.
262 :type 'boolean 262If t, accept short (single key-press) answers to the question.
263 :version "27.1" 263If nil, require long answers. If `auto', accept short answers if
264the function cell of `yes-or-no-p' is set to `y-or-on-p'."
265 :type '(choice (const :tag "Accept short answers" t)
266 (const :tag "Require long answer" nil)
267 (const :tag "Guess preference" auto))
268 :version "26.2"
264 :group 'minibuffer) 269 :group 'minibuffer)
265 270
266(defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal)) 271(defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal))
@@ -290,8 +295,9 @@ When `read-answer-short' is non-nil, accept short answers.
290Return a long answer even in case of accepting short ones. 295Return a long answer even in case of accepting short ones.
291 296
292When `use-dialog-box' is t, pop up a dialog window to get user input." 297When `use-dialog-box' is t, pop up a dialog window to get user input."
293 (custom-reevaluate-setting 'read-answer-short) 298 (let* ((short (if (eq read-answer-short 'auto)
294 (let* ((short read-answer-short) 299 (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
300 read-answer-short))
295 (answers-with-help 301 (answers-with-help
296 (if (assoc "help" answers) 302 (if (assoc "help" answers)
297 answers 303 answers
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 85e74f28ef0..bb759011513 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1183,24 +1183,28 @@ enclosed in `(and ...)'.
1183 1183
1184 1184
1185(pcase-defmacro rx (&rest regexps) 1185(pcase-defmacro rx (&rest regexps)
1186 "Build a `pcase' pattern matching `rx' regexps. 1186 "Build a `pcase' pattern matching `rx' REGEXPS in sexp form.
1187The REGEXPS are interpreted as by `rx'. The pattern matches if 1187The REGEXPS are interpreted as in `rx'. The pattern matches any
1188the regular expression so constructed matches EXPVAL, as if 1188string that is a match for the regular expression so constructed,
1189by `string-match'. 1189as if by `string-match'.
1190 1190
1191In addition to the usual `rx' constructs, REGEXPS can contain the 1191In addition to the usual `rx' constructs, REGEXPS can contain the
1192following constructs: 1192following constructs:
1193 1193
1194 (let VAR FORM...) creates a new explicitly numbered submatch 1194 (let REF SEXP...) creates a new explicitly named reference to
1195 that matches FORM and binds the match to 1195 a submatch that matches regular expressions
1196 VAR. 1196 SEXP, and binds the match to REF.
1197 (backref VAR) creates a backreference to the submatch 1197 (backref REF) creates a backreference to the submatch
1198 introduced by a previous (let VAR ...) 1198 introduced by a previous (let REF ...)
1199 construct. 1199 construct. REF can be the same symbol
1200 1200 in the first argument of the corresponding
1201The VARs are associated with explicitly numbered submatches 1201 (let REF ...) construct, or it can be a
1202starting from 1. Multiple occurrences of the same VAR refer to 1202 submatch number. It matches the referenced
1203the same submatch. 1203 submatch.
1204
1205The REFs are associated with explicitly named submatches starting
1206from 1. Multiple occurrences of the same REF refer to the same
1207submatch.
1204 1208
1205If a case matches, the match data is modified as usual so you can 1209If a case matches, the match data is modified as usual so you can
1206use it in the case body, but you still have to pass the correct 1210use it in the case body, but you still have to pass the correct
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index e03a81c892a..20eb0d5d05c 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -211,7 +211,7 @@ The variable list SPEC is the same as in `if-let'."
211 211
212(defsubst string-join (strings &optional separator) 212(defsubst string-join (strings &optional separator)
213 "Join all STRINGS using SEPARATOR." 213 "Join all STRINGS using SEPARATOR."
214 (mapconcat 'identity strings separator)) 214 (mapconcat #'identity strings separator))
215 215
216(define-obsolete-function-alias 'string-reverse 'reverse "25.1") 216(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
217 217
@@ -219,17 +219,17 @@ The variable list SPEC is the same as in `if-let'."
219 "Trim STRING of leading string matching REGEXP. 219 "Trim STRING of leading string matching REGEXP.
220 220
221REGEXP defaults to \"[ \\t\\n\\r]+\"." 221REGEXP defaults to \"[ \\t\\n\\r]+\"."
222 (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+")"\\)") string) 222 (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
223 (replace-match "" t t string) 223 (substring string (match-end 0))
224 string)) 224 string))
225 225
226(defsubst string-trim-right (string &optional regexp) 226(defsubst string-trim-right (string &optional regexp)
227 "Trim STRING of trailing string matching REGEXP. 227 "Trim STRING of trailing string matching REGEXP.
228 228
229REGEXP defaults to \"[ \\t\\n\\r]+\"." 229REGEXP defaults to \"[ \\t\\n\\r]+\"."
230 (if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string) 230 (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
231 (replace-match "" t t string) 231 string)))
232 string)) 232 (if i (substring string 0 i) string)))
233 233
234(defsubst string-trim (string &optional trim-left trim-right) 234(defsubst string-trim (string &optional trim-left trim-right)
235 "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT. 235 "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT.
diff --git a/lisp/env.el b/lisp/env.el
index e47eb57836f..7007ba33e58 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -113,11 +113,11 @@ Changes ENV by side-effect, and returns its new value."
113 (not keep-empty) 113 (not keep-empty)
114 env 114 env
115 (stringp (car env)) 115 (stringp (car env))
116 (string-match pattern (car env))) 116 (string-match-p pattern (car env)))
117 (cdr env) 117 (cdr env)
118 ;; Try to find existing entry for VARIABLE in ENV. 118 ;; Try to find existing entry for VARIABLE in ENV.
119 (while (and scan (stringp (car scan))) 119 (while (and scan (stringp (car scan)))
120 (when (string-match pattern (car scan)) 120 (when (string-match-p pattern (car scan))
121 (if value 121 (if value
122 (setcar scan (concat variable "=" value)) 122 (setcar scan (concat variable "=" value))
123 (if keep-empty 123 (if keep-empty
@@ -184,7 +184,7 @@ a side-effect."
184 (setq variable (encode-coding-string variable locale-coding-system))) 184 (setq variable (encode-coding-string variable locale-coding-system)))
185 (if (and value (multibyte-string-p value)) 185 (if (and value (multibyte-string-p value))
186 (setq value (encode-coding-string value locale-coding-system))) 186 (setq value (encode-coding-string value locale-coding-system)))
187 (if (string-match "=" variable) 187 (if (string-match-p "=" variable)
188 (error "Environment variable name `%s' contains `='" variable)) 188 (error "Environment variable name `%s' contains `='" variable))
189 (if (string-equal "TZ" variable) 189 (if (string-equal "TZ" variable)
190 (set-time-zone-rule value)) 190 (set-time-zone-rule value))
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 98f458d9962..fb866df3920 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -98,11 +98,14 @@ Note that the buffer name starts with a space."
98 :type 'boolean) 98 :type 'boolean)
99 99
100(defconst epg-gpg-minimum-version "1.4.3") 100(defconst epg-gpg-minimum-version "1.4.3")
101(defconst epg-gpg2-minimum-version "2.1.6")
101 102
102(defconst epg-config--program-alist 103(defconst epg-config--program-alist
103 `((OpenPGP 104 `((OpenPGP
104 epg-gpg-program 105 epg-gpg-program
105 ("gpg2" . "2.1.6") ("gpg" . ,epg-gpg-minimum-version)) 106 ("gpg2" . ,epg-gpg2-minimum-version)
107 ("gpg" . ((,epg-gpg-minimum-version . "2.0")
108 ,epg-gpg2-minimum-version)))
106 (CMS 109 (CMS
107 epg-gpgsm-program 110 epg-gpgsm-program
108 ("gpgsm" . "2.0.4"))) 111 ("gpgsm" . "2.0.4")))
@@ -228,14 +231,26 @@ version requirement is met."
228 (epg-config--make-gpg-configuration epg-gpg-program)) 231 (epg-config--make-gpg-configuration epg-gpg-program))
229 232
230;;;###autoload 233;;;###autoload
231(defun epg-check-configuration (config &optional minimum-version) 234(defun epg-check-configuration (config &optional req-versions)
232 "Verify that a sufficient version of GnuPG is installed." 235 "Verify that a sufficient version of GnuPG is installed.
236CONFIG should be a `epg-configuration' object (a plist).
237REQ-VERSIONS should be a list with elements of the form (MIN
238. MAX) where MIN and MAX are version strings indicating a
239semi-open range of acceptable versions. REQ-VERSIONS may also be
240a single minimum version string."
233 (let ((version (alist-get 'version config))) 241 (let ((version (alist-get 'version config)))
234 (unless (stringp version) 242 (unless (stringp version)
235 (error "Undetermined version: %S" version)) 243 (error "Undetermined version: %S" version))
236 (unless (version<= (or minimum-version 244 (catch 'version-ok
237 epg-gpg-minimum-version) 245 (pcase-dolist ((or `(,min . ,max)
238 version) 246 (and min (let max nil)))
247 (if (listp req-versions) req-versions
248 (list req-versions)))
249 (when (and (version<= (or min epg-gpg-minimum-version)
250 version)
251 (or (null max)
252 (version< version max)))
253 (throw 'version-ok t)))
239 (error "Unsupported version: %s" version)))) 254 (error "Unsupported version: %s" version))))
240 255
241;;;###autoload 256;;;###autoload
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index ec380e67011..5180a0700db 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -407,6 +407,7 @@ in the minibuffer:
407 nil)))) 407 nil))))
408 408
409(put 'eshell/cd 'eshell-no-numeric-conversions t) 409(put 'eshell/cd 'eshell-no-numeric-conversions t)
410(put 'eshell/cd 'eshell-filename-arguments t)
410 411
411(defun eshell-add-to-dir-ring (path) 412(defun eshell-add-to-dir-ring (path)
412 "Add PATH to the last-dir-ring, if applicable." 413 "Add PATH to the last-dir-ring, if applicable."
@@ -470,6 +471,7 @@ in the minibuffer:
470 nil) 471 nil)
471 472
472(put 'eshell/pushd 'eshell-no-numeric-conversions t) 473(put 'eshell/pushd 'eshell-no-numeric-conversions t)
474(put 'eshell/pushd 'eshell-filename-arguments t)
473 475
474;;; popd [+n] 476;;; popd [+n]
475(defun eshell/popd (&rest args) 477(defun eshell/popd (&rest args)
@@ -500,6 +502,7 @@ in the minibuffer:
500 nil) 502 nil)
501 503
502(put 'eshell/popd 'eshell-no-numeric-conversions t) 504(put 'eshell/popd 'eshell-no-numeric-conversions t)
505(put 'eshell/pop 'eshell-filename-arguments t)
503 506
504(defun eshell/dirs (&optional if-verbose) 507(defun eshell/dirs (&optional if-verbose)
505 "Implementation of dirs in Lisp." 508 "Implementation of dirs in Lisp."
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 900b28905b7..2b568a991a2 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -334,6 +334,7 @@ instead."
334 (apply 'eshell-do-ls args))) 334 (apply 'eshell-do-ls args)))
335 335
336(put 'eshell/ls 'eshell-no-numeric-conversions t) 336(put 'eshell/ls 'eshell-no-numeric-conversions t)
337(put 'eshell/ls 'eshell-filename-arguments t)
337 338
338(declare-function eshell-glob-regexp "em-glob" (pattern)) 339(declare-function eshell-glob-regexp "em-glob" (pattern))
339 340
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index a18fb85507d..c912c15ac75 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -307,6 +307,7 @@ Remove (unlink) the FILE(s).")
307 nil)) 307 nil))
308 308
309(put 'eshell/rm 'eshell-no-numeric-conversions t) 309(put 'eshell/rm 'eshell-no-numeric-conversions t)
310(put 'eshell/rm 'eshell-filename-arguments t)
310 311
311(defun eshell/mkdir (&rest args) 312(defun eshell/mkdir (&rest args)
312 "Implementation of mkdir in Lisp." 313 "Implementation of mkdir in Lisp."
@@ -324,6 +325,7 @@ Create the DIRECTORY(ies), if they do not already exist.")
324 nil)) 325 nil))
325 326
326(put 'eshell/mkdir 'eshell-no-numeric-conversions t) 327(put 'eshell/mkdir 'eshell-no-numeric-conversions t)
328(put 'eshell/mkdir 'eshell-filename-arguments t)
327 329
328(defun eshell/rmdir (&rest args) 330(defun eshell/rmdir (&rest args)
329 "Implementation of rmdir in Lisp." 331 "Implementation of rmdir in Lisp."
@@ -340,6 +342,7 @@ Remove the DIRECTORY(ies), if they are empty.")
340 nil)) 342 nil))
341 343
342(put 'eshell/rmdir 'eshell-no-numeric-conversions t) 344(put 'eshell/rmdir 'eshell-no-numeric-conversions t)
345(put 'eshell/rmdir 'eshell-filename-arguments t)
343 346
344(defvar no-dereference) 347(defvar no-dereference)
345 348
@@ -524,6 +527,7 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
524 eshell-mv-overwrite-files)))) 527 eshell-mv-overwrite-files))))
525 528
526(put 'eshell/mv 'eshell-no-numeric-conversions t) 529(put 'eshell/mv 'eshell-no-numeric-conversions t)
530(put 'eshell/mv 'eshell-filename-arguments t)
527 531
528(defun eshell/cp (&rest args) 532(defun eshell/cp (&rest args)
529 "Implementation of cp in Lisp." 533 "Implementation of cp in Lisp."
@@ -561,6 +565,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
561 eshell-cp-overwrite-files preserve))) 565 eshell-cp-overwrite-files preserve)))
562 566
563(put 'eshell/cp 'eshell-no-numeric-conversions t) 567(put 'eshell/cp 'eshell-no-numeric-conversions t)
568(put 'eshell/cp 'eshell-filename-arguments t)
564 569
565(defun eshell/ln (&rest args) 570(defun eshell/ln (&rest args)
566 "Implementation of ln in Lisp." 571 "Implementation of ln in Lisp."
@@ -593,6 +598,7 @@ with `--symbolic'. When creating hard links, each TARGET must exist.")
593 eshell-ln-overwrite-files)))) 598 eshell-ln-overwrite-files))))
594 599
595(put 'eshell/ln 'eshell-no-numeric-conversions t) 600(put 'eshell/ln 'eshell-no-numeric-conversions t)
601(put 'eshell/ln 'eshell-filename-arguments t)
596 602
597(defun eshell/cat (&rest args) 603(defun eshell/cat (&rest args)
598 "Implementation of cat in Lisp. 604 "Implementation of cat in Lisp.
@@ -645,6 +651,7 @@ Concatenate FILE(s), or standard input, to standard output.")
645 (setq eshell-ensure-newline-p nil)))) 651 (setq eshell-ensure-newline-p nil))))
646 652
647(put 'eshell/cat 'eshell-no-numeric-conversions t) 653(put 'eshell/cat 'eshell-no-numeric-conversions t)
654(put 'eshell/cat 'eshell-filename-arguments t)
648 655
649;; special front-end functions for compilation-mode buffers 656;; special front-end functions for compilation-mode buffers
650 657
@@ -927,6 +934,8 @@ Summarize disk usage of each FILE, recursively for directories.")
927 (eshell-print (concat (eshell-du-size-string size) 934 (eshell-print (concat (eshell-du-size-string size)
928 "total\n")))))))) 935 "total\n"))))))))
929 936
937(put 'eshell/du 'eshell-filename-arguments t)
938
930(defvar eshell-time-start nil) 939(defvar eshell-time-start nil)
931 940
932(defun eshell-show-elapsed-time () 941(defun eshell-show-elapsed-time ()
@@ -1029,6 +1038,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
1029 nil) 1038 nil)
1030 1039
1031(put 'eshell/diff 'eshell-no-numeric-conversions t) 1040(put 'eshell/diff 'eshell-no-numeric-conversions t)
1041(put 'eshell/diff 'eshell-filename-arguments t)
1032 1042
1033(defvar locate-history-list) 1043(defvar locate-history-list)
1034 1044
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 61c0ebc71d0..92cac612d4c 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1304,27 +1304,36 @@ messages, and errors."
1304 "Insert Lisp OBJECT, using ARGS if a function." 1304 "Insert Lisp OBJECT, using ARGS if a function."
1305 (catch 'eshell-external ; deferred to an external command 1305 (catch 'eshell-external ; deferred to an external command
1306 (let* ((eshell-ensure-newline-p (eshell-interactive-output-p)) 1306 (let* ((eshell-ensure-newline-p (eshell-interactive-output-p))
1307 (result 1307 (result
1308 (if (functionp object) 1308 (if (functionp object)
1309 (progn 1309 (progn
1310 (setq eshell-last-arguments args 1310 (setq eshell-last-arguments args
1311 eshell-last-command-name 1311 eshell-last-command-name
1312 (concat "#<function " (symbol-name object) ">")) 1312 (concat "#<function " (symbol-name object) ">"))
1313 ;; if any of the arguments are flagged as numbers 1313 (let ((numeric (not (get object
1314 ;; waiting for conversion, convert them now 1314 'eshell-no-numeric-conversions)))
1315 (unless (get object 'eshell-no-numeric-conversions) 1315 (fname-args (get object 'eshell-filename-arguments)))
1316 (while args 1316 (when (or numeric fname-args)
1317 (let ((arg (car args))) 1317 (while args
1318 (if (and (stringp arg) 1318 (let ((arg (car args)))
1319 (> (length arg) 0) 1319 (cond ((and numeric (stringp arg) (> (length arg) 0)
1320 (not (text-property-not-all 1320 (text-property-any 0 (length arg)
1321 0 (length arg) 'number t arg))) 1321 'number t arg))
1322 (setcar args (string-to-number arg)))) 1322 ;; If any of the arguments are
1323 (setq args (cdr args)))) 1323 ;; flagged as numbers waiting for
1324 (eshell-apply object eshell-last-arguments)) 1324 ;; conversion, convert them now.
1325 (setq eshell-last-arguments args 1325 (setcar args (string-to-number arg)))
1326 eshell-last-command-name "#<Lisp object>") 1326 ((and fname-args (stringp arg)
1327 (eshell-eval object)))) 1327 (string-equal arg "~"))
1328 ;; If any of the arguments match "~",
1329 ;; prepend "./" to treat it as a
1330 ;; regular file name.
1331 (setcar args (concat "./" arg)))))
1332 (setq args (cdr args)))))
1333 (eshell-apply object eshell-last-arguments))
1334 (setq eshell-last-arguments args
1335 eshell-last-command-name "#<Lisp object>")
1336 (eshell-eval object))))
1328 (if (and eshell-ensure-newline-p 1337 (if (and eshell-ensure-newline-p
1329 (save-excursion 1338 (save-excursion
1330 (goto-char eshell-last-output-end) 1339 (goto-char eshell-last-output-end)
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index ba5182deb45..244cc7ff1f3 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -259,6 +259,7 @@ Adds the given PATH to $PATH.")
259 (eshell-printn dir))))) 259 (eshell-printn dir)))))
260 260
261(put 'eshell/addpath 'eshell-no-numeric-conversions t) 261(put 'eshell/addpath 'eshell-no-numeric-conversions t)
262(put 'eshell/addpath 'eshell-filename-arguments t)
262 263
263(defun eshell-script-interpreter (file) 264(defun eshell-script-interpreter (file)
264 "Extract the script to run from FILE, if it has #!<interp> in it. 265 "Extract the script to run from FILE, if it has #!<interp> in it.
diff --git a/lisp/files.el b/lisp/files.el
index eabb3c0e06c..940bacde230 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1830,7 +1830,7 @@ killed."
1830 ;; Don't use `find-file' because it may end up using another window 1830 ;; Don't use `find-file' because it may end up using another window
1831 ;; in some corner cases, e.g. when the selected window is 1831 ;; in some corner cases, e.g. when the selected window is
1832 ;; softly-dedicated. 1832 ;; softly-dedicated.
1833 (let ((newbuf (find-file-noselect filename wildcards))) 1833 (let ((newbuf (find-file-noselect filename nil nil wildcards)))
1834 (switch-to-buffer newbuf))) 1834 (switch-to-buffer newbuf)))
1835 (when (eq obuf (current-buffer)) 1835 (when (eq obuf (current-buffer))
1836 ;; This executes if find-file gets an error 1836 ;; This executes if find-file gets an error
@@ -1954,7 +1954,7 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
1954 (save-match-data 1954 (save-match-data
1955 (string-match "^[a-zA-`]:/$" filename)))) 1955 (string-match "^[a-zA-`]:/$" filename))))
1956 (equal (get 'abbreviated-home-dir 'home) 1956 (equal (get 'abbreviated-home-dir 'home)
1957 (expand-file-name "~"))) 1957 (save-match-data (expand-file-name "~"))))
1958 (setq filename 1958 (setq filename
1959 (concat "~" 1959 (concat "~"
1960 (match-string 1 filename) 1960 (match-string 1 filename)
@@ -5091,6 +5091,9 @@ Before and after saving the buffer, this function runs
5091 (make-directory dir t) 5091 (make-directory dir t)
5092 (error "Canceled"))) 5092 (error "Canceled")))
5093 (setq setmodes (basic-save-buffer-1))))) 5093 (setq setmodes (basic-save-buffer-1)))))
5094 ;; We are hunting a nasty error, which happens on hydra.
5095 ;; Adding traces might help.
5096 (if (getenv "BUG_32226") (message "BUG_32226"))
5094 ;; Now we have saved the current buffer. Let's make sure 5097 ;; Now we have saved the current buffer. Let's make sure
5095 ;; that buffer-file-coding-system is fixed to what 5098 ;; that buffer-file-coding-system is fixed to what
5096 ;; actually used for saving by binding it locally. 5099 ;; actually used for saving by binding it locally.
@@ -5519,6 +5522,21 @@ raised."
5519 (dolist (dir create-list) 5522 (dolist (dir create-list)
5520 (files--ensure-directory dir))))))) 5523 (files--ensure-directory dir)))))))
5521 5524
5525(defun make-empty-file (filename &optional parents)
5526 "Create an empty file FILENAME.
5527Optional arg PARENTS, if non-nil then creates parent dirs as needed.
5528
5529If called interactively, then PARENTS is non-nil."
5530 (interactive
5531 (let ((filename (read-file-name "Create empty file: ")))
5532 (list filename t)))
5533 (when (and (file-exists-p filename) (null parents))
5534 (signal 'file-already-exists `("File exists" ,filename)))
5535 (let ((paren-dir (file-name-directory filename)))
5536 (when (and paren-dir (not (file-exists-p paren-dir)))
5537 (make-directory paren-dir parents)))
5538 (write-region "" nil filename nil 0))
5539
5522(defconst directory-files-no-dot-files-regexp 5540(defconst directory-files-no-dot-files-regexp
5523 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" 5541 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
5524 "Regexp matching any file name except \".\" and \"..\".") 5542 "Regexp matching any file name except \".\" and \"..\".")
diff --git a/lisp/format.el b/lisp/format.el
index 5bf1be39475..49d3c718abc 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -539,6 +539,8 @@ Compare using `equal'."
539 (setq tail next))) 539 (setq tail next)))
540 (cons acopy bcopy))) 540 (cons acopy bcopy)))
541 541
542(define-obsolete-function-alias 'format-proper-list-p 'proper-list-p "27.1")
543
542(defun format-reorder (items order) 544(defun format-reorder (items order)
543 "Arrange ITEMS to follow partial ORDER. 545 "Arrange ITEMS to follow partial ORDER.
544Elements of ITEMS equal to elements of ORDER will be rearranged 546Elements of ITEMS equal to elements of ORDER will be rearranged
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 055f02fb1ab..1b0dde94551 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1626,6 +1626,12 @@ resources when reading email groups (and therefore stops
1626tracking), but allows loading external resources when reading 1626tracking), but allows loading external resources when reading
1627from NNTP newsgroups and the like. 1627from NNTP newsgroups and the like.
1628 1628
1629People controlling these external resources won't be able to tell
1630that any one person in particular has read the message (since
1631it's in a public venue, many people will end up loading that
1632resource), but they'll be able to tell that somebody from your IP
1633address has accessed the resource.
1634
1629This can also be a function to be evaluated. If so, it will be 1635This can also be a function to be evaluated. If so, it will be
1630called with the group name as the parameter, and should return a 1636called with the group name as the parameter, and should return a
1631regexp." 1637regexp."
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index e562b30170a..ceb98421665 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -4310,10 +4310,10 @@ If SELECT-ARTICLES, only select those articles from GROUP."
4310If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even 4310If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
4311if it was already present. 4311if it was already present.
4312 4312
4313If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs 4313If `gnus-summary-ignore-duplicates' is non-nil then duplicate
4314will not be entered in the DEPENDENCIES table. Otherwise duplicate 4314Message-IDs will not be entered in the DEPENDENCIES table.
4315Message-IDs will be renamed to a unique Message-ID before being 4315Otherwise duplicate Message-IDs will be renamed to a unique
4316entered. 4316Message-ID before being entered.
4317 4317
4318Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." 4318Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
4319 (let* ((id (mail-header-id header)) 4319 (let* ((id (mail-header-id header))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index b4ad69e4c72..8d1efcdc3bf 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -612,17 +612,19 @@ Customized bindings may be defined in `ielm-map', which currently contains:
612;;; User command 612;;; User command
613 613
614;;;###autoload 614;;;###autoload
615(defun ielm nil 615(defun ielm (&optional buf-name)
616 "Interactively evaluate Emacs Lisp expressions. 616 "Interactively evaluate Emacs Lisp expressions.
617Switches to the buffer `*ielm*', or creates it if it does not exist. 617Switches to the buffer named BUF-NAME if provided (`*ielm*' by default),
618or creates it if it does not exist.
618See `inferior-emacs-lisp-mode' for details." 619See `inferior-emacs-lisp-mode' for details."
619 (interactive) 620 (interactive)
620 (let (old-point) 621 (let (old-point
621 (unless (comint-check-proc "*ielm*") 622 (buf-name (or buf-name "*ielm*")))
622 (with-current-buffer (get-buffer-create "*ielm*") 623 (unless (comint-check-proc buf-name)
624 (with-current-buffer (get-buffer-create buf-name)
623 (unless (zerop (buffer-size)) (setq old-point (point))) 625 (unless (zerop (buffer-size)) (setq old-point (point)))
624 (inferior-emacs-lisp-mode))) 626 (inferior-emacs-lisp-mode)))
625 (pop-to-buffer-same-window "*ielm*") 627 (pop-to-buffer-same-window buf-name)
626 (when old-point (push-mark old-point)))) 628 (when old-point (push-mark old-point))))
627 629
628(provide 'ielm) 630(provide 'ielm)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index edca51e3ade..7285b105748 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -832,15 +832,14 @@ depending on PATTERNS."
832 (dolist (item index-alist) 832 (dolist (item index-alist)
833 (when (listp item) 833 (when (listp item)
834 (setcdr item (sort (cdr item) 'imenu--sort-by-position)))) 834 (setcdr item (sort (cdr item) 'imenu--sort-by-position))))
835 (let ((main-element (assq nil index-alist)))
836 (nconc (delq main-element (delq 'dummy index-alist))
837 (cdr main-element)))
838 ;; Remove any empty menus. That can happen because of skipping 835 ;; Remove any empty menus. That can happen because of skipping
839 ;; things inside comments or strings. 836 ;; things inside comments or strings.
840 (when (consp (car index-alist)) 837 (setq index-alist (cl-delete-if
841 (setq index-alist (cl-delete-if-not 838 (lambda (it) (and (consp it) (null (cdr it))))
842 (lambda (it) (cdr it)) 839 index-alist))
843 index-alist))))) 840 (let ((main-element (assq nil index-alist)))
841 (nconc (delq main-element (delq 'dummy index-alist))
842 (cdr main-element)))))
844 843
845;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 844;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
846;;; 845;;;
diff --git a/lisp/indent.el b/lisp/indent.el
index 450632174fc..73a7d0ef4eb 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -292,7 +292,8 @@ indentation by specifying a large negative ARG."
292 "Indent current line to COLUMN. 292 "Indent current line to COLUMN.
293This function removes or adds spaces and tabs at beginning of line 293This function removes or adds spaces and tabs at beginning of line
294only if necessary. It leaves point at end of indentation." 294only if necessary. It leaves point at end of indentation."
295 (back-to-indentation) 295 (beginning-of-line 1)
296 (skip-chars-forward " \t")
296 (let ((cur-col (current-column))) 297 (let ((cur-col (current-column)))
297 (cond ((< cur-col column) 298 (cond ((< cur-col column)
298 (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width) 299 (if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width)
@@ -303,8 +304,10 @@ only if necessary. It leaves point at end of indentation."
303 (delete-region (progn (move-to-column column t) (point)) 304 (delete-region (progn (move-to-column column t) (point))
304 ;; The `move-to-column' call may replace 305 ;; The `move-to-column' call may replace
305 ;; tabs with spaces, so we can't reuse the 306 ;; tabs with spaces, so we can't reuse the
306 ;; previous `back-to-indentation' point. 307 ;; previous start point.
307 (progn (back-to-indentation) (point))))))) 308 (progn (beginning-of-line 1)
309 (skip-chars-forward " \t")
310 (point)))))))
308 311
309(defun current-left-margin () 312(defun current-left-margin ()
310 "Return the left margin to use for this line. 313 "Return the left margin to use for this line.
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index a023d4fbc85..d4ade3cc4c0 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -79,7 +79,7 @@
79 ("cns11643.92p7-0" . chinese-cns11643-7) 79 ("cns11643.92p7-0" . chinese-cns11643-7)
80 ("big5" . big5) 80 ("big5" . big5)
81 ("viscii" . viscii) 81 ("viscii" . viscii)
82 ("tis620" . tis620-2533) 82 ("tis620" . thai-iso8859-11)
83 ("microsoft-cp1251" . windows-1251) 83 ("microsoft-cp1251" . windows-1251)
84 ("koi8-r" . koi8-r) 84 ("koi8-r" . koi8-r)
85 ("jisx0213.2000-1" . japanese-jisx0213-1) 85 ("jisx0213.2000-1" . japanese-jisx0213-1)
@@ -139,7 +139,7 @@
139 (cyrillic-iso8859-5 . iso-8859-5) 139 (cyrillic-iso8859-5 . iso-8859-5)
140 (greek-iso8859-7 . iso-8859-7) 140 (greek-iso8859-7 . iso-8859-7)
141 (arabic-iso8859-6 . iso-8859-6) 141 (arabic-iso8859-6 . iso-8859-6)
142 (thai-tis620 . tis620-2533) 142 (thai-tis620 . thai-iso8859-11)
143 (latin-jisx0201 . jisx0201) 143 (latin-jisx0201 . jisx0201)
144 (katakana-jisx0201 . jisx0201) 144 (katakana-jisx0201 . jisx0201)
145 (chinese-big5-1 . big5) 145 (chinese-big5-1 . big5)
@@ -1233,11 +1233,12 @@ Done when `mouse-set-font' is called."
1233 (latin-iso8859-15 . latin) 1233 (latin-iso8859-15 . latin)
1234 (latin-iso8859-16 . latin) 1234 (latin-iso8859-16 . latin)
1235 (latin-jisx0201 . latin) 1235 (latin-jisx0201 . latin)
1236 (thai-iso8859-11 . thai)
1236 (thai-tis620 . thai) 1237 (thai-tis620 . thai)
1237 (cyrillic-iso8859-5 . cyrillic) 1238 (cyrillic-iso8859-5 . cyrillic)
1238 (arabic-iso8859-6 . arabic) 1239 (arabic-iso8859-6 . arabic)
1239 (greek-iso8859-7 . latin) 1240 (greek-iso8859-7 . greek)
1240 (hebrew-iso8859-8 . latin) 1241 (hebrew-iso8859-8 . hebrew)
1241 (katakana-jisx0201 . kana) 1242 (katakana-jisx0201 . kana)
1242 (chinese-gb2312 . han) 1243 (chinese-gb2312 . han)
1243 (chinese-gbk . han) 1244 (chinese-gbk . han)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index cf6a8c78d09..2bde83f4eab 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -300,8 +300,7 @@ wrong, use this command again to toggle back to the right mode."
300 (cmd (key-binding keyseq)) 300 (cmd (key-binding keyseq))
301 prefix) 301 prefix)
302 ;; read-key-sequence ignores quit, so make an explicit check. 302 ;; read-key-sequence ignores quit, so make an explicit check.
303 ;; Like many places, this assumes quit == C-g, but it need not be. 303 (if (equal last-input-event (nth 3 (current-input-mode)))
304 (if (equal last-input-event ?\C-g)
305 (keyboard-quit)) 304 (keyboard-quit))
306 (when (memq cmd '(universal-argument digit-argument)) 305 (when (memq cmd '(universal-argument digit-argument))
307 (call-interactively cmd) 306 (call-interactively cmd)
@@ -314,16 +313,16 @@ wrong, use this command again to toggle back to the right mode."
314 (let ((current-prefix-arg prefix-arg) 313 (let ((current-prefix-arg prefix-arg)
315 ;; Have to bind `last-command-event' here so that 314 ;; Have to bind `last-command-event' here so that
316 ;; `digit-argument', for instance, can compute the 315 ;; `digit-argument', for instance, can compute the
317 ;; prefix arg. 316 ;; `prefix-arg'.
318 (last-command-event (aref keyseq 0))) 317 (last-command-event (aref keyseq 0)))
319 (call-interactively cmd))) 318 (call-interactively cmd)))
320 319
321 ;; This is the final call to `universal-argument-other-key', which 320 ;; This is the final call to `universal-argument-other-key', which
322 ;; set's the final `prefix-arg. 321 ;; sets the final `prefix-arg'.
323 (let ((current-prefix-arg prefix-arg)) 322 (let ((current-prefix-arg prefix-arg))
324 (call-interactively cmd)) 323 (call-interactively cmd))
325 324
326 ;; Read the command to execute with the given prefix arg. 325 ;; Read the command to execute with the given `prefix-arg'.
327 (setq prefix prefix-arg 326 (setq prefix prefix-arg
328 keyseq (read-key-sequence nil t) 327 keyseq (read-key-sequence nil t)
329 cmd (key-binding keyseq))) 328 cmd (key-binding keyseq)))
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index dc095707a2c..a635c677705 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -201,6 +201,7 @@
201;; plus nbsp 201;; plus nbsp
202(define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11 202(define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11
203 "ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11") 203 "ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11")
204(define-charset-alias 'tis620-2533 'thai-iso8859-11)
204 205
205;; 8859-12 doesn't (yet?) exist. 206;; 8859-12 doesn't (yet?) exist.
206 207
@@ -229,14 +230,6 @@
229 :code-space [32 127] 230 :code-space [32 127]
230 :code-offset #x0E00) 231 :code-offset #x0E00)
231 232
232;; Fixme: doc for this, c.f. above
233(define-charset 'tis620-2533
234 "TIS620.2533"
235 :short-name "TIS620.2533"
236 :ascii-compatible-p t
237 :code-space [0 255]
238 :superset '(ascii eight-bit-control (thai-tis620 . 128)))
239
240(define-charset 'jisx0201 233(define-charset 'jisx0201
241 "JISX0201" 234 "JISX0201"
242 :short-name "JISX0201" 235 :short-name "JISX0201"
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 87a2e993bb4..c9829e352ec 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -355,7 +355,8 @@ meanings of these arguments."
355 (:iso-revision-number "ISO revision number: " 355 (:iso-revision-number "ISO revision number: "
356 number-to-string) 356 number-to-string)
357 (:supplementary-p 357 (:supplementary-p
358 "Used only as a parent of some other charset." nil))) 358 "Used only as a parent or a subset of some other charset,
359or provided just for backward compatibility." nil)))
359 (let ((val (get-charset-property charset (car elt)))) 360 (let ((val (get-charset-property charset (car elt))))
360 (when val 361 (when val
361 (if (cadr elt) (insert (cadr elt))) 362 (if (cadr elt) (insert (cadr elt)))
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index eece836354c..ec15ccaaf76 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1394,12 +1394,13 @@ Return the input string."
1394 (generated-events nil) ;FIXME: What is this? 1394 (generated-events nil) ;FIXME: What is this?
1395 (input-method-function nil) 1395 (input-method-function nil)
1396 (modified-p (buffer-modified-p)) 1396 (modified-p (buffer-modified-p))
1397 last-command-event last-command this-command) 1397 last-command-event last-command this-command inhibit-record)
1398 (setq quail-current-key "" 1398 (setq quail-current-key ""
1399 quail-current-str "" 1399 quail-current-str ""
1400 quail-translating t) 1400 quail-translating t)
1401 (if key 1401 (if key
1402 (setq unread-command-events (cons key unread-command-events))) 1402 (setq unread-command-events (cons key unread-command-events)
1403 inhibit-record t))
1403 (while quail-translating 1404 (while quail-translating
1404 (set-buffer-modified-p modified-p) 1405 (set-buffer-modified-p modified-p)
1405 (quail-show-guidance) 1406 (quail-show-guidance)
@@ -1408,8 +1409,13 @@ Return the input string."
1408 (or input-method-previous-message "") 1409 (or input-method-previous-message "")
1409 quail-current-str 1410 quail-current-str
1410 quail-guidance-str))) 1411 quail-guidance-str)))
1412 ;; We inhibit record_char only for the first key,
1413 ;; because it was already recorded before read_char
1414 ;; called quail-input-method.
1415 (inhibit--record-char inhibit-record)
1411 (keyseq (read-key-sequence prompt nil nil t)) 1416 (keyseq (read-key-sequence prompt nil nil t))
1412 (cmd (lookup-key (quail-translation-keymap) keyseq))) 1417 (cmd (lookup-key (quail-translation-keymap) keyseq)))
1418 (setq inhibit-record nil)
1413 (if (if key 1419 (if (if key
1414 (and (commandp cmd) (not (eq cmd 'quail-other-command))) 1420 (and (commandp cmd) (not (eq cmd 'quail-other-command)))
1415 (eq cmd 'quail-self-insert-command)) 1421 (eq cmd 'quail-self-insert-command))
@@ -1453,14 +1459,15 @@ Return the input string."
1453 (generated-events nil) ;FIXME: What is this? 1459 (generated-events nil) ;FIXME: What is this?
1454 (input-method-function nil) 1460 (input-method-function nil)
1455 (modified-p (buffer-modified-p)) 1461 (modified-p (buffer-modified-p))
1456 last-command-event last-command this-command) 1462 last-command-event last-command this-command inhibit-record)
1457 (setq quail-current-key "" 1463 (setq quail-current-key ""
1458 quail-current-str "" 1464 quail-current-str ""
1459 quail-translating t 1465 quail-translating t
1460 quail-converting t 1466 quail-converting t
1461 quail-conversion-str "") 1467 quail-conversion-str "")
1462 (if key 1468 (if key
1463 (setq unread-command-events (cons key unread-command-events))) 1469 (setq unread-command-events (cons key unread-command-events)
1470 inhibit-record t))
1464 (while quail-converting 1471 (while quail-converting
1465 (set-buffer-modified-p modified-p) 1472 (set-buffer-modified-p modified-p)
1466 (or quail-translating 1473 (or quail-translating
@@ -1476,8 +1483,13 @@ Return the input string."
1476 quail-conversion-str 1483 quail-conversion-str
1477 quail-current-str 1484 quail-current-str
1478 quail-guidance-str))) 1485 quail-guidance-str)))
1486 ;; We inhibit record_char only for the first key,
1487 ;; because it was already recorded before read_char
1488 ;; called quail-input-method.
1489 (inhibit--record-char inhibit-record)
1479 (keyseq (read-key-sequence prompt nil nil t)) 1490 (keyseq (read-key-sequence prompt nil nil t))
1480 (cmd (lookup-key (quail-conversion-keymap) keyseq))) 1491 (cmd (lookup-key (quail-conversion-keymap) keyseq)))
1492 (setq inhibit-record nil)
1481 (if (if key (commandp cmd) (eq cmd 'quail-self-insert-command)) 1493 (if (if key (commandp cmd) (eq cmd 'quail-self-insert-command))
1482 (progn 1494 (progn
1483 (setq last-command-event (aref keyseq (1- (length keyseq))) 1495 (setq last-command-event (aref keyseq (1- (length keyseq)))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index b2ccea5c143..a137616ecae 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -6,7 +6,7 @@
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Keywords: processes, languages, extensions 7;; Keywords: processes, languages, extensions
8;; Package-Requires: ((emacs "25.2")) 8;; Package-Requires: ((emacs "25.2"))
9;; Version: 1.0.0 9;; Version: 1.0.2
10 10
11;; This is an Elpa :core package. Don't use functionality that is not 11;; This is an Elpa :core package. Don't use functionality that is not
12;; compatible with Emacs 25.2. 12;; compatible with Emacs 25.2.
@@ -74,7 +74,11 @@
74 :documentation "A hash table of request ID to continuation lambdas.") 74 :documentation "A hash table of request ID to continuation lambdas.")
75 (-events-buffer 75 (-events-buffer
76 :accessor jsonrpc--events-buffer 76 :accessor jsonrpc--events-buffer
77 :documentation "A buffer pretty-printing the JSON-RPC RPC events") 77 :documentation "A buffer pretty-printing the JSONRPC events")
78 (-events-buffer-scrollback-size
79 :initarg :events-buffer-scrollback-size
80 :accessor jsonrpc--events-buffer-scrollback-size
81 :documentation "If non-nil, maximum size of events buffer.")
78 (-deferred-actions 82 (-deferred-actions
79 :initform (make-hash-table :test #'equal) 83 :initform (make-hash-table :test #'equal)
80 :accessor jsonrpc--deferred-actions 84 :accessor jsonrpc--deferred-actions
@@ -193,9 +197,7 @@ dispatcher in CONNECTION."
193 (when timer (cancel-timer timer))) 197 (when timer (cancel-timer timer)))
194 (remhash id (jsonrpc--request-continuations connection)) 198 (remhash id (jsonrpc--request-continuations connection))
195 (if error (funcall (nth 1 continuations) error) 199 (if error (funcall (nth 1 continuations) error)
196 (funcall (nth 0 continuations) result))) 200 (funcall (nth 0 continuations) result))))
197 (;; An abnormal situation
198 id (jsonrpc--warn "No continuation for id %s" id)))
199 (jsonrpc--call-deferred connection)))) 201 (jsonrpc--call-deferred connection))))
200 202
201 203
@@ -256,17 +258,30 @@ Returns nil."
256 (apply #'jsonrpc--async-request-1 connection method params args) 258 (apply #'jsonrpc--async-request-1 connection method params args)
257 nil) 259 nil)
258 260
259(cl-defun jsonrpc-request (connection method params &key deferred timeout) 261(cl-defun jsonrpc-request (connection
262 method params &key
263 deferred timeout
264 cancel-on-input
265 cancel-on-input-retval)
260 "Make a request to CONNECTION, wait for a reply. 266 "Make a request to CONNECTION, wait for a reply.
261Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS, 267Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS,
262but synchronous, i.e. this function doesn't exit until anything 268but synchronous.
263interesting (success, error or timeout) happens. Furthermore, it
264only exits locally (returning the JSONRPC result object) if the
265request is successful, otherwise exit non-locally with an error
266of type `jsonrpc-error'.
267 269
268DEFERRED is passed to `jsonrpc-async-request', which see." 270Except in the case of a non-nil CANCEL-ON-INPUT (explained
271below), this function doesn't exit until anything interesting
272happens (success reply, error reply, or timeout). Furthermore,
273it only exits locally (returning the JSONRPC result object) if
274the request is successful, otherwise it exits non-locally with an
275error of type `jsonrpc-error'.
276
277DEFERRED is passed to `jsonrpc-async-request', which see.
278
279If CANCEL-ON-INPUT is non-nil and the user inputs something while
280the functino is waiting, then it exits immediately, returning
281CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are
282ignored."
269 (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer 283 (let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer
284 cancelled
270 (retval 285 (retval
271 (unwind-protect ; protect against user-quit, for example 286 (unwind-protect ; protect against user-quit, for example
272 (catch tag 287 (catch tag
@@ -274,19 +289,27 @@ DEFERRED is passed to `jsonrpc-async-request', which see."
274 id-and-timer 289 id-and-timer
275 (jsonrpc--async-request-1 290 (jsonrpc--async-request-1
276 connection method params 291 connection method params
277 :success-fn (lambda (result) (throw tag `(done ,result))) 292 :success-fn (lambda (result)
293 (unless cancelled
294 (throw tag `(done ,result))))
278 :error-fn 295 :error-fn
279 (jsonrpc-lambda 296 (jsonrpc-lambda
280 (&key code message data) 297 (&key code message data)
281 (throw tag `(error (jsonrpc-error-code . ,code) 298 (unless cancelled
282 (jsonrpc-error-message . ,message) 299 (throw tag `(error (jsonrpc-error-code . ,code)
283 (jsonrpc-error-data . ,data)))) 300 (jsonrpc-error-message . ,message)
301 (jsonrpc-error-data . ,data)))))
284 :timeout-fn 302 :timeout-fn
285 (lambda () 303 (lambda ()
286 (throw tag '(error (jsonrpc-error-message . "Timed out")))) 304 (unless cancelled
305 (throw tag '(error (jsonrpc-error-message . "Timed out")))))
287 :deferred deferred 306 :deferred deferred
288 :timeout timeout)) 307 :timeout timeout))
289 (while t (accept-process-output nil 30))) 308 (cond (cancel-on-input
309 (while (sit-for 30))
310 (setq cancelled t)
311 `(cancelled ,cancel-on-input-retval))
312 (t (while t (accept-process-output nil 30)))))
290 (pcase-let* ((`(,id ,timer) id-and-timer)) 313 (pcase-let* ((`(,id ,timer) id-and-timer))
291 (remhash id (jsonrpc--request-continuations connection)) 314 (remhash id (jsonrpc--request-continuations connection))
292 (remhash (list deferred (current-buffer)) 315 (remhash (list deferred (current-buffer))
@@ -641,15 +664,26 @@ originated."
641 (if type 664 (if type
642 (format "-%s" subtype))))) 665 (format "-%s" subtype)))))
643 (goto-char (point-max)) 666 (goto-char (point-max))
644 (let ((msg (format "%s%s%s %s:\n%s\n" 667 (prog1
645 type 668 (let ((msg (format "%s%s%s %s:\n%s\n"
646 (if id (format " (id:%s)" id) "") 669 type
647 (if error " ERROR" "") 670 (if id (format " (id:%s)" id) "")
648 (current-time-string) 671 (if error " ERROR" "")
649 (pp-to-string message)))) 672 (current-time-string)
650 (when error 673 (pp-to-string message))))
651 (setq msg (propertize msg 'face 'error))) 674 (when error
652 (insert-before-markers msg)))))) 675 (setq msg (propertize msg 'face 'error)))
676 (insert-before-markers msg))
677 ;; Trim the buffer if it's too large
678 (let ((max (jsonrpc--events-buffer-scrollback-size connection)))
679 (when max
680 (save-excursion
681 (goto-char (point-min))
682 (while (> (buffer-size) max)
683 (delete-region (point) (progn (forward-line 1)
684 (forward-sexp 1)
685 (forward-line 2)
686 (point))))))))))))
653 687
654(provide 'jsonrpc) 688(provide 'jsonrpc)
655;;; jsonrpc.el ends here 689;;; jsonrpc.el ends here
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index a896fe59fd1..c655845e95d 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -36,7 +36,7 @@
36 "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)." 36 "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)."
37 :coding-type 'charset 37 :coding-type 'charset
38 :mnemonic ?T 38 :mnemonic ?T
39 :charset-list '(tis620-2533)) 39 :charset-list '(thai-iso8859-11))
40 40
41(define-coding-system-alias 'th-tis620 'thai-tis620) 41(define-coding-system-alias 'th-tis620 'thai-tis620)
42(define-coding-system-alias 'tis620 'thai-tis620) 42(define-coding-system-alias 'tis620 'thai-tis620)
@@ -47,7 +47,7 @@
47 (charset thai-tis620) 47 (charset thai-tis620)
48 (coding-system thai-tis620 iso-8859-11 cp874) 48 (coding-system thai-tis620 iso-8859-11 cp874)
49 (coding-priority thai-tis620) 49 (coding-priority thai-tis620)
50 (nonascii-translation . tis620-2533) 50 (nonascii-translation . iso-8859-11)
51 (input-method . "thai-kesmanee") 51 (input-method . "thai-kesmanee")
52 (unibyte-display . thai-tis620) 52 (unibyte-display . thai-tis620)
53 (features thai-util) 53 (features thai-util)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 5f26eba695e..3bd775f5152 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -176,12 +176,18 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'.
176\(fn &optional FILE-NAME BUFFER-FILE)" nil nil) 176\(fn &optional FILE-NAME BUFFER-FILE)" nil nil)
177 177
178(autoload 'add-change-log-entry "add-log" "\ 178(autoload 'add-change-log-entry "add-log" "\
179Find change log file, and add an entry for today and an item for this file. 179Find ChangeLog buffer, add an entry for today and an item for this file.
180Optional arg WHOAMI (interactive prefix) non-nil means prompt for user 180Optional arg WHOAMI (interactive prefix) non-nil means prompt for
181name and email (stored in `add-log-full-name' and `add-log-mailing-address'). 181user name and email (stored in `add-log-full-name'
182 182and `add-log-mailing-address').
183Second arg FILE-NAME is file name of the change log. 183
184If nil, use the value of `change-log-default-name'. 184Second arg CHANGELOG-FILE-NAME is the file name of the change log.
185If nil, use the value of `change-log-default-name'. If the file
186thus named exists, it is used for the new entry. If it doesn't
187exist, it is created, unless `add-log-dont-create-changelog-file' is t,
188in which case a suitably named buffer that doesn't visit any file
189is used for keeping entries pertaining to CHANGELOG-FILE-NAME's
190directory.
185 191
186Third arg OTHER-WINDOW non-nil means visit in other window. 192Third arg OTHER-WINDOW non-nil means visit in other window.
187 193
@@ -204,7 +210,7 @@ notices.
204Today's date is calculated according to `add-log-time-zone-rule' if 210Today's date is calculated according to `add-log-time-zone-rule' if
205non-nil, otherwise in local time. 211non-nil, otherwise in local time.
206 212
207\(fn &optional WHOAMI FILE-NAME OTHER-WINDOW NEW-ENTRY PUT-NEW-ENTRY-ON-NEW-LINE)" t nil) 213\(fn &optional WHOAMI CHANGELOG-FILE-NAME OTHER-WINDOW NEW-ENTRY PUT-NEW-ENTRY-ON-NEW-LINE)" t nil)
208 214
209(autoload 'add-change-log-entry-other-window "add-log" "\ 215(autoload 'add-change-log-entry-other-window "add-log" "\
210Find change log file in other window and add entry and item. 216Find change log file in other window and add entry and item.
@@ -577,9 +583,11 @@ Return t if `allout-mode' is active in current buffer.
577 583
578(autoload 'allout-mode "allout" "\ 584(autoload 'allout-mode "allout" "\
579Toggle Allout outline mode. 585Toggle Allout outline mode.
580With a prefix argument ARG, enable Allout outline mode if ARG is 586
581positive, and disable it otherwise. If called from Lisp, enable 587If called interactively, enable Allout mode if ARG is positive, and
582the mode if ARG is omitted or nil. 588disable it if ARG is zero or negative. If called from Lisp,
589also enable the mode if ARG is omitted or nil, and toggle it
590if ARG is `toggle'; disable the mode otherwise.
583 591
584\\<allout-mode-map-value> 592\\<allout-mode-map-value>
585Allout outline mode is a minor mode that provides extensive 593Allout outline mode is a minor mode that provides extensive
@@ -890,9 +898,11 @@ See `allout-widgets-mode' for allout widgets mode features.")
890 898
891(autoload 'allout-widgets-mode "allout-widgets" "\ 899(autoload 'allout-widgets-mode "allout-widgets" "\
892Toggle Allout Widgets mode. 900Toggle Allout Widgets mode.
893With a prefix argument ARG, enable Allout Widgets mode if ARG is 901
894positive, and disable it otherwise. If called from Lisp, enable 902If called interactively, enable Allout-Widgets mode if ARG is positive, and
895the mode if ARG is omitted or nil. 903disable it if ARG is zero or negative. If called from Lisp,
904also enable the mode if ARG is omitted or nil, and toggle it
905if ARG is `toggle'; disable the mode otherwise.
896 906
897Allout Widgets mode is an extension of Allout mode that provides 907Allout Widgets mode is an extension of Allout mode that provides
898graphical decoration of outline structure. It is meant to 908graphical decoration of outline structure. It is meant to
@@ -1300,7 +1310,12 @@ Entering array mode calls the function `array-mode-hook'.
1300 1310
1301(autoload 'artist-mode "artist" "\ 1311(autoload 'artist-mode "artist" "\
1302Toggle Artist mode. 1312Toggle Artist mode.
1303With argument ARG, turn Artist mode on if ARG is positive. 1313
1314If called interactively, enable Artist mode if ARG is positive, and
1315disable it if ARG is zero or negative. If called from Lisp,
1316also enable the mode if ARG is omitted or nil, and toggle it
1317if ARG is `toggle'; disable the mode otherwise.
1318
1304Artist lets you draw lines, squares, rectangles and poly-lines, 1319Artist lets you draw lines, squares, rectangles and poly-lines,
1305ellipses and circles with your mouse and/or keyboard. 1320ellipses and circles with your mouse and/or keyboard.
1306 1321
@@ -1571,9 +1586,6 @@ for a description of this minor mode.")
1571 1586
1572(autoload 'autoarg-mode "autoarg" "\ 1587(autoload 'autoarg-mode "autoarg" "\
1573Toggle Autoarg mode, a global minor mode. 1588Toggle Autoarg mode, a global minor mode.
1574With a prefix argument ARG, enable Autoarg mode if ARG is
1575positive, and disable it otherwise. If called from Lisp, enable
1576the mode if ARG is omitted or nil.
1577 1589
1578\\<autoarg-mode-map> 1590\\<autoarg-mode-map>
1579In Autoarg mode, digits are bound to `digit-argument', i.e. they 1591In Autoarg mode, digits are bound to `digit-argument', i.e. they
@@ -1607,9 +1619,11 @@ or call the function `autoarg-kp-mode'.")
1607 1619
1608(autoload 'autoarg-kp-mode "autoarg" "\ 1620(autoload 'autoarg-kp-mode "autoarg" "\
1609Toggle Autoarg-KP mode, a global minor mode. 1621Toggle Autoarg-KP mode, a global minor mode.
1610With a prefix argument ARG, enable Autoarg-KP mode if ARG is 1622
1611positive, and disable it otherwise. If called from Lisp, enable 1623If called interactively, enable Autoarg-Kp mode if ARG is positive, and
1612the mode if ARG is omitted or nil. 1624disable it if ARG is zero or negative. If called from Lisp,
1625also enable the mode if ARG is omitted or nil, and toggle it
1626if ARG is `toggle'; disable the mode otherwise.
1613 1627
1614\\<autoarg-kp-mode-map> 1628\\<autoarg-kp-mode-map>
1615This is similar to `autoarg-mode' but rebinds the keypad keys 1629This is similar to `autoarg-mode' but rebinds the keypad keys
@@ -1663,9 +1677,11 @@ or call the function `auto-insert-mode'.")
1663 1677
1664(autoload 'auto-insert-mode "autoinsert" "\ 1678(autoload 'auto-insert-mode "autoinsert" "\
1665Toggle Auto-insert mode, a global minor mode. 1679Toggle Auto-insert mode, a global minor mode.
1666With a prefix argument ARG, enable Auto-insert mode if ARG is 1680
1667positive, and disable it otherwise. If called from Lisp, enable 1681If called interactively, enable Auto-Insert mode if ARG is positive, and
1668the mode if ARG is omitted or nil. 1682disable it if ARG is zero or negative. If called from Lisp,
1683also enable the mode if ARG is omitted or nil, and toggle it
1684if ARG is `toggle'; disable the mode otherwise.
1669 1685
1670When Auto-insert mode is enabled, when new files are created you can 1686When Auto-insert mode is enabled, when new files are created you can
1671insert a template for the file depending on the mode of the buffer. 1687insert a template for the file depending on the mode of the buffer.
@@ -1735,9 +1751,11 @@ should be non-nil).
1735 1751
1736(autoload 'auto-revert-mode "autorevert" "\ 1752(autoload 'auto-revert-mode "autorevert" "\
1737Toggle reverting buffer when the file changes (Auto-Revert Mode). 1753Toggle reverting buffer when the file changes (Auto-Revert Mode).
1738With a prefix argument ARG, enable Auto-Revert Mode if ARG is 1754
1739positive, and disable it otherwise. If called from Lisp, enable 1755If called interactively, enable Auto-Revert mode if ARG is positive, and
1740the mode if ARG is omitted or nil. 1756disable it if ARG is zero or negative. If called from Lisp,
1757also enable the mode if ARG is omitted or nil, and toggle it
1758if ARG is `toggle'; disable the mode otherwise.
1741 1759
1742Auto-Revert Mode is a minor mode that affects only the current 1760Auto-Revert Mode is a minor mode that affects only the current
1743buffer. When enabled, it reverts the buffer when the file on 1761buffer. When enabled, it reverts the buffer when the file on
@@ -1762,9 +1780,11 @@ This function is designed to be added to hooks, for example:
1762 1780
1763(autoload 'auto-revert-tail-mode "autorevert" "\ 1781(autoload 'auto-revert-tail-mode "autorevert" "\
1764Toggle reverting tail of buffer when the file grows. 1782Toggle reverting tail of buffer when the file grows.
1765With a prefix argument ARG, enable Auto-Revert Tail Mode if ARG 1783
1766is positive, and disable it otherwise. If called from Lisp, 1784If called interactively, enable Auto-Revert-Tail mode if ARG is positive, and
1767enable the mode if ARG is omitted or nil. 1785disable it if ARG is zero or negative. If called from Lisp,
1786also enable the mode if ARG is omitted or nil, and toggle it
1787if ARG is `toggle'; disable the mode otherwise.
1768 1788
1769When Auto-Revert Tail Mode is enabled, the tail of the file is 1789When Auto-Revert Tail Mode is enabled, the tail of the file is
1770constantly followed, as with the shell command `tail -f'. This 1790constantly followed, as with the shell command `tail -f'. This
@@ -1803,9 +1823,11 @@ or call the function `global-auto-revert-mode'.")
1803 1823
1804(autoload 'global-auto-revert-mode "autorevert" "\ 1824(autoload 'global-auto-revert-mode "autorevert" "\
1805Toggle Global Auto-Revert Mode. 1825Toggle Global Auto-Revert Mode.
1806With a prefix argument ARG, enable Global Auto-Revert Mode if ARG 1826
1807is positive, and disable it otherwise. If called from Lisp, 1827If called interactively, enable Global Auto-Revert mode if ARG is positive, and
1808enable the mode if ARG is omitted or nil. 1828disable it if ARG is zero or negative. If called from Lisp,
1829also enable the mode if ARG is omitted or nil, and toggle it
1830if ARG is `toggle'; disable the mode otherwise.
1809 1831
1810Global Auto-Revert Mode is a global minor mode that reverts any 1832Global Auto-Revert Mode is a global minor mode that reverts any
1811buffer associated with a file when the file changes on disk. Use 1833buffer associated with a file when the file changes on disk. Use
@@ -1921,9 +1943,11 @@ or call the function `display-battery-mode'.")
1921 1943
1922(autoload 'display-battery-mode "battery" "\ 1944(autoload 'display-battery-mode "battery" "\
1923Toggle battery status display in mode line (Display Battery mode). 1945Toggle battery status display in mode line (Display Battery mode).
1924With a prefix argument ARG, enable Display Battery mode if ARG is 1946
1925positive, and disable it otherwise. If called from Lisp, enable 1947If called interactively, enable Display-Battery mode if ARG is positive, and
1926the mode if ARG is omitted or nil. 1948disable it if ARG is zero or negative. If called from Lisp,
1949also enable the mode if ARG is omitted or nil, and toggle it
1950if ARG is `toggle'; disable the mode otherwise.
1927 1951
1928The text displayed in the mode line is controlled by 1952The text displayed in the mode line is controlled by
1929`battery-mode-line-format' and `battery-status-function'. 1953`battery-mode-line-format' and `battery-status-function'.
@@ -2331,7 +2355,7 @@ BOOKMARK is usually a bookmark name (a string). It can also be a
2331bookmark record, but this is usually only done by programmatic callers. 2355bookmark record, but this is usually only done by programmatic callers.
2332 2356
2333If DISPLAY-FUNC is non-nil, it is a function to invoke to display the 2357If DISPLAY-FUNC is non-nil, it is a function to invoke to display the
2334bookmark. It defaults to `switch-to-buffer'. A typical value for 2358bookmark. It defaults to `pop-to-buffer-same-window'. A typical value for
2335DISPLAY-FUNC would be `switch-to-buffer-other-window'. 2359DISPLAY-FUNC would be `switch-to-buffer-other-window'.
2336 2360
2337\(fn BOOKMARK &optional DISPLAY-FUNC)" t nil) 2361\(fn BOOKMARK &optional DISPLAY-FUNC)" t nil)
@@ -2897,15 +2921,22 @@ columns on its right towards the left.
2897 2921
2898(autoload 'bug-reference-mode "bug-reference" "\ 2922(autoload 'bug-reference-mode "bug-reference" "\
2899Toggle hyperlinking bug references in the buffer (Bug Reference mode). 2923Toggle hyperlinking bug references in the buffer (Bug Reference mode).
2900With a prefix argument ARG, enable Bug Reference mode if ARG is 2924
2901positive, and disable it otherwise. If called from Lisp, enable 2925If called interactively, enable Bug-Reference mode if ARG is positive, and
2902the mode if ARG is omitted or nil. 2926disable it if ARG is zero or negative. If called from Lisp,
2927also enable the mode if ARG is omitted or nil, and toggle it
2928if ARG is `toggle'; disable the mode otherwise.
2903 2929
2904\(fn &optional ARG)" t nil) 2930\(fn &optional ARG)" t nil)
2905 2931
2906(autoload 'bug-reference-prog-mode "bug-reference" "\ 2932(autoload 'bug-reference-prog-mode "bug-reference" "\
2907Like `bug-reference-mode', but only buttonize in comments and strings. 2933Like `bug-reference-mode', but only buttonize in comments and strings.
2908 2934
2935If called interactively, enable Bug-Reference-Prog mode if ARG is positive, and
2936disable it if ARG is zero or negative. If called from Lisp,
2937also enable the mode if ARG is omitted or nil, and toggle it
2938if ARG is `toggle'; disable the mode otherwise.
2939
2909\(fn &optional ARG)" t nil) 2940\(fn &optional ARG)" t nil)
2910 2941
2911(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bug-reference" '("bug-reference-"))) 2942(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bug-reference" '("bug-reference-")))
@@ -4691,9 +4722,11 @@ Prefix argument is the same as for `checkdoc-defun'
4691 4722
4692(autoload 'checkdoc-minor-mode "checkdoc" "\ 4723(autoload 'checkdoc-minor-mode "checkdoc" "\
4693Toggle automatic docstring checking (Checkdoc minor mode). 4724Toggle automatic docstring checking (Checkdoc minor mode).
4694With a prefix argument ARG, enable Checkdoc minor mode if ARG is 4725
4695positive, and disable it otherwise. If called from Lisp, enable 4726If called interactively, enable Checkdoc minor mode if ARG is positive, and
4696the mode if ARG is omitted or nil. 4727disable it if ARG is zero or negative. If called from Lisp,
4728also enable the mode if ARG is omitted or nil, and toggle it
4729if ARG is `toggle'; disable the mode otherwise.
4697 4730
4698In Checkdoc minor mode, the usual bindings for `eval-defun' which is 4731In Checkdoc minor mode, the usual bindings for `eval-defun' which is
4699bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include 4732bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
@@ -4933,6 +4966,11 @@ This can be needed when using code byte-compiled using the old
4933macro-expansion of `cl-defstruct' that used vectors objects instead 4966macro-expansion of `cl-defstruct' that used vectors objects instead
4934of record objects. 4967of record objects.
4935 4968
4969If called interactively, enable Cl-Old-Struct-Compat mode if ARG is positive, and
4970disable it if ARG is zero or negative. If called from Lisp,
4971also enable the mode if ARG is omitted or nil, and toggle it
4972if ARG is `toggle'; disable the mode otherwise.
4973
4936\(fn &optional ARG)" t nil) 4974\(fn &optional ARG)" t nil)
4937 4975
4938(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-lib" '("cl-"))) 4976(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-lib" '("cl-")))
@@ -5150,7 +5188,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use.
5150 5188
5151\(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil) 5189\(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil)
5152 5190
5153(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-" "send-invisible" "shell-strip-ctrl-m"))) 5191(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-")))
5154 5192
5155;;;*** 5193;;;***
5156 5194
@@ -5346,9 +5384,11 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
5346 5384
5347(autoload 'compilation-shell-minor-mode "compile" "\ 5385(autoload 'compilation-shell-minor-mode "compile" "\
5348Toggle Compilation Shell minor mode. 5386Toggle Compilation Shell minor mode.
5349With a prefix argument ARG, enable Compilation Shell minor mode 5387
5350if ARG is positive, and disable it otherwise. If called from 5388If called interactively, enable Compilation-Shell minor mode if ARG is positive, and
5351Lisp, enable the mode if ARG is omitted or nil. 5389disable it if ARG is zero or negative. If called from Lisp,
5390also enable the mode if ARG is omitted or nil, and toggle it
5391if ARG is `toggle'; disable the mode otherwise.
5352 5392
5353When Compilation Shell minor mode is enabled, all the 5393When Compilation Shell minor mode is enabled, all the
5354error-parsing commands of the Compilation major mode are 5394error-parsing commands of the Compilation major mode are
@@ -5359,9 +5399,11 @@ See `compilation-mode'.
5359 5399
5360(autoload 'compilation-minor-mode "compile" "\ 5400(autoload 'compilation-minor-mode "compile" "\
5361Toggle Compilation minor mode. 5401Toggle Compilation minor mode.
5362With a prefix argument ARG, enable Compilation minor mode if ARG 5402
5363is positive, and disable it otherwise. If called from Lisp, 5403If called interactively, enable Compilation minor mode if ARG is positive, and
5364enable the mode if ARG is omitted or nil. 5404disable it if ARG is zero or negative. If called from Lisp,
5405also enable the mode if ARG is omitted or nil, and toggle it
5406if ARG is `toggle'; disable the mode otherwise.
5365 5407
5366When Compilation minor mode is enabled, all the error-parsing 5408When Compilation minor mode is enabled, all the error-parsing
5367commands of Compilation major mode are available. See 5409commands of Compilation major mode are available. See
@@ -5394,9 +5436,11 @@ or call the function `dynamic-completion-mode'.")
5394 5436
5395(autoload 'dynamic-completion-mode "completion" "\ 5437(autoload 'dynamic-completion-mode "completion" "\
5396Toggle dynamic word-completion on or off. 5438Toggle dynamic word-completion on or off.
5397With a prefix argument ARG, enable the mode if ARG is positive, 5439
5398and disable it otherwise. If called from Lisp, enable the mode 5440If called interactively, enable Dynamic-Completion mode if ARG is positive, and
5399if ARG is omitted or nil. 5441disable it if ARG is zero or negative. If called from Lisp,
5442also enable the mode if ARG is omitted or nil, and toggle it
5443if ARG is `toggle'; disable the mode otherwise.
5400 5444
5401\(fn &optional ARG)" t nil) 5445\(fn &optional ARG)" t nil)
5402 5446
@@ -5959,9 +6003,11 @@ or call the function `cua-mode'.")
5959 6003
5960(autoload 'cua-mode "cua-base" "\ 6004(autoload 'cua-mode "cua-base" "\
5961Toggle Common User Access style editing (CUA mode). 6005Toggle Common User Access style editing (CUA mode).
5962With a prefix argument ARG, enable CUA mode if ARG is positive, 6006
5963and disable it otherwise. If called from Lisp, enable the mode 6007If called interactively, enable Cua mode if ARG is positive, and
5964if ARG is omitted or nil. 6008disable it if ARG is zero or negative. If called from Lisp,
6009also enable the mode if ARG is omitted or nil, and toggle it
6010if ARG is `toggle'; disable the mode otherwise.
5965 6011
5966CUA mode is a global minor mode. When enabled, typed text 6012CUA mode is a global minor mode. When enabled, typed text
5967replaces the active selection, and you can use C-z, C-x, C-c, and 6013replaces the active selection, and you can use C-z, C-x, C-c, and
@@ -6006,6 +6052,11 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
6006Toggle the region as rectangular. 6052Toggle the region as rectangular.
6007Activates the region if needed. Only lasts until the region is deactivated. 6053Activates the region if needed. Only lasts until the region is deactivated.
6008 6054
6055If called interactively, enable Cua-Rectangle-Mark mode if ARG is positive, and
6056disable it if ARG is zero or negative. If called from Lisp,
6057also enable the mode if ARG is omitted or nil, and toggle it
6058if ARG is `toggle'; disable the mode otherwise.
6059
6009\(fn &optional ARG)" t nil) 6060\(fn &optional ARG)" t nil)
6010 6061
6011(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-rect" '("cua-"))) 6062(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-rect" '("cua-")))
@@ -6021,6 +6072,11 @@ Activates the region if needed. Only lasts until the region is deactivated.
6021(autoload 'cursor-intangible-mode "cursor-sensor" "\ 6072(autoload 'cursor-intangible-mode "cursor-sensor" "\
6022Keep cursor outside of any `cursor-intangible' text property. 6073Keep cursor outside of any `cursor-intangible' text property.
6023 6074
6075If called interactively, enable Cursor-Intangible mode if ARG is positive, and
6076disable it if ARG is zero or negative. If called from Lisp,
6077also enable the mode if ARG is omitted or nil, and toggle it
6078if ARG is `toggle'; disable the mode otherwise.
6079
6024\(fn &optional ARG)" t nil) 6080\(fn &optional ARG)" t nil)
6025 6081
6026(autoload 'cursor-sensor-mode "cursor-sensor" "\ 6082(autoload 'cursor-sensor-mode "cursor-sensor" "\
@@ -6031,6 +6087,11 @@ where WINDOW is the affected window, OLDPOS is the last known position of
6031the cursor and DIR can be `entered' or `left' depending on whether the cursor 6087the cursor and DIR can be `entered' or `left' depending on whether the cursor
6032is entering the area covered by the text-property property or leaving it. 6088is entering the area covered by the text-property property or leaving it.
6033 6089
6090If called interactively, enable Cursor-Sensor mode if ARG is positive, and
6091disable it if ARG is zero or negative. If called from Lisp,
6092also enable the mode if ARG is omitted or nil, and toggle it
6093if ARG is `toggle'; disable the mode otherwise.
6094
6034\(fn &optional ARG)" t nil) 6095\(fn &optional ARG)" t nil)
6035 6096
6036(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))) 6097(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-")))
@@ -6421,16 +6482,17 @@ Mode used for cvs status output.
6421(autoload 'cwarn-mode "cwarn" "\ 6482(autoload 'cwarn-mode "cwarn" "\
6422Minor mode that highlights suspicious C and C++ constructions. 6483Minor mode that highlights suspicious C and C++ constructions.
6423 6484
6485If called interactively, enable Cwarn mode if ARG is positive, and
6486disable it if ARG is zero or negative. If called from Lisp,
6487also enable the mode if ARG is omitted or nil, and toggle it
6488if ARG is `toggle'; disable the mode otherwise.
6489
6424Suspicious constructs are highlighted using `font-lock-warning-face'. 6490Suspicious constructs are highlighted using `font-lock-warning-face'.
6425 6491
6426Note, in addition to enabling this minor mode, the major mode must 6492Note, in addition to enabling this minor mode, the major mode must
6427be included in the variable `cwarn-configuration'. By default C and 6493be included in the variable `cwarn-configuration'. By default C and
6428C++ modes are included. 6494C++ modes are included.
6429 6495
6430With a prefix argument ARG, enable the mode if ARG is positive,
6431and disable it otherwise. If called from Lisp, enable the mode
6432if ARG is omitted or nil.
6433
6434\(fn &optional ARG)" t nil) 6496\(fn &optional ARG)" t nil)
6435 6497
6436(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") 6498(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
@@ -6849,12 +6911,11 @@ or call the function `delete-selection-mode'.")
6849 6911
6850(autoload 'delete-selection-mode "delsel" "\ 6912(autoload 'delete-selection-mode "delsel" "\
6851Toggle Delete Selection mode. 6913Toggle Delete Selection mode.
6852Interactively, with a prefix argument, enable 6914
6853Delete Selection mode if the prefix argument is positive, 6915If called interactively, enable Delete-Selection mode if ARG is positive, and
6854and disable it otherwise. If called from Lisp, toggle 6916disable it if ARG is zero or negative. If called from Lisp,
6855the mode if ARG is `toggle', disable the mode if ARG is 6917also enable the mode if ARG is omitted or nil, and toggle it
6856a non-positive integer, and enable the mode otherwise 6918if ARG is `toggle'; disable the mode otherwise.
6857\(including if ARG is omitted or nil or a positive integer).
6858 6919
6859When Delete Selection mode is enabled, typed text replaces the selection 6920When Delete Selection mode is enabled, typed text replaces the selection
6860if the selection is active. Otherwise, typed text is just inserted at 6921if the selection is active. Otherwise, typed text is just inserted at
@@ -7006,9 +7067,11 @@ or call the function `desktop-save-mode'.")
7006 7067
7007(autoload 'desktop-save-mode "desktop" "\ 7068(autoload 'desktop-save-mode "desktop" "\
7008Toggle desktop saving (Desktop Save mode). 7069Toggle desktop saving (Desktop Save mode).
7009With a prefix argument ARG, enable Desktop Save mode if ARG is positive, 7070
7010and disable it otherwise. If called from Lisp, enable the mode if ARG 7071If called interactively, enable Desktop-Save mode if ARG is positive, and
7011is omitted or nil. 7072disable it if ARG is zero or negative. If called from Lisp,
7073also enable the mode if ARG is omitted or nil, and toggle it
7074if ARG is `toggle'; disable the mode otherwise.
7012 7075
7013When Desktop Save mode is enabled, the state of Emacs is saved from 7076When Desktop Save mode is enabled, the state of Emacs is saved from
7014one session to another. In particular, Emacs will save the desktop when 7077one session to another. In particular, Emacs will save the desktop when
@@ -7371,9 +7434,11 @@ a diff with \\[diff-reverse-direction].
7371 7434
7372(autoload 'diff-minor-mode "diff-mode" "\ 7435(autoload 'diff-minor-mode "diff-mode" "\
7373Toggle Diff minor mode. 7436Toggle Diff minor mode.
7374With a prefix argument ARG, enable Diff minor mode if ARG is 7437
7375positive, and disable it otherwise. If called from Lisp, enable 7438If called interactively, enable Diff minor mode if ARG is positive, and
7376the mode if ARG is omitted or nil. 7439disable it if ARG is zero or negative. If called from Lisp,
7440also enable the mode if ARG is omitted or nil, and toggle it
7441if ARG is `toggle'; disable the mode otherwise.
7377 7442
7378\\{diff-minor-mode-map} 7443\\{diff-minor-mode-map}
7379 7444
@@ -7549,9 +7614,11 @@ Keybindings:
7549 7614
7550(autoload 'dirtrack-mode "dirtrack" "\ 7615(autoload 'dirtrack-mode "dirtrack" "\
7551Toggle directory tracking in shell buffers (Dirtrack mode). 7616Toggle directory tracking in shell buffers (Dirtrack mode).
7552With a prefix argument ARG, enable Dirtrack mode if ARG is 7617
7553positive, and disable it otherwise. If called from Lisp, enable 7618If called interactively, enable Dirtrack mode if ARG is positive, and
7554the mode if ARG is omitted or nil. 7619disable it if ARG is zero or negative. If called from Lisp,
7620also enable the mode if ARG is omitted or nil, and toggle it
7621if ARG is `toggle'; disable the mode otherwise.
7555 7622
7556This method requires that your shell prompt contain the current 7623This method requires that your shell prompt contain the current
7557working directory at all times, and that you set the variable 7624working directory at all times, and that you set the variable
@@ -7723,6 +7790,11 @@ in `.emacs'.
7723Toggle display of line numbers in the buffer. 7790Toggle display of line numbers in the buffer.
7724This uses `display-line-numbers' internally. 7791This uses `display-line-numbers' internally.
7725 7792
7793If called interactively, enable Display-Line-Numbers mode if ARG is positive, and
7794disable it if ARG is zero or negative. If called from Lisp,
7795also enable the mode if ARG is omitted or nil, and toggle it
7796if ARG is `toggle'; disable the mode otherwise.
7797
7726To change the type of line numbers displayed by default, 7798To change the type of line numbers displayed by default,
7727customize `display-line-numbers-type'. To change the type while 7799customize `display-line-numbers-type'. To change the type while
7728the mode is on, set `display-line-numbers' directly. 7800the mode is on, set `display-line-numbers' directly.
@@ -7856,9 +7928,11 @@ to the next best mode.
7856 7928
7857(autoload 'doc-view-minor-mode "doc-view" "\ 7929(autoload 'doc-view-minor-mode "doc-view" "\
7858Toggle displaying buffer via Doc View (Doc View minor mode). 7930Toggle displaying buffer via Doc View (Doc View minor mode).
7859With a prefix argument ARG, enable Doc View minor mode if ARG is 7931
7860positive, and disable it otherwise. If called from Lisp, enable 7932If called interactively, enable Doc-View minor mode if ARG is positive, and
7861the mode if ARG is omitted or nil. 7933disable it if ARG is zero or negative. If called from Lisp,
7934also enable the mode if ARG is omitted or nil, and toggle it
7935if ARG is `toggle'; disable the mode otherwise.
7862 7936
7863See the command `doc-view-mode' for more information on this mode. 7937See the command `doc-view-mode' for more information on this mode.
7864 7938
@@ -7918,9 +7992,11 @@ Switch to *doctor* buffer and start giving psychotherapy.
7918 7992
7919(autoload 'double-mode "double" "\ 7993(autoload 'double-mode "double" "\
7920Toggle special insertion on double keypresses (Double mode). 7994Toggle special insertion on double keypresses (Double mode).
7921With a prefix argument ARG, enable Double mode if ARG is 7995
7922positive, and disable it otherwise. If called from Lisp, enable 7996If called interactively, enable Double mode if ARG is positive, and
7923the mode if ARG is omitted or nil. 7997disable it if ARG is zero or negative. If called from Lisp,
7998also enable the mode if ARG is omitted or nil, and toggle it
7999if ARG is `toggle'; disable the mode otherwise.
7924 8000
7925When Double mode is enabled, some keys will insert different 8001When Double mode is enabled, some keys will insert different
7926strings when pressed twice. See `double-map' for details. 8002strings when pressed twice. See `double-map' for details.
@@ -7975,7 +8051,9 @@ non-positive integer, and enables the mode otherwise (including
7975if the argument is omitted or nil or a positive integer). 8051if the argument is omitted or nil or a positive integer).
7976 8052
7977If DOC is nil, give the mode command a basic doc-string 8053If DOC is nil, give the mode command a basic doc-string
7978documenting what its argument does. 8054documenting what its argument does. If the word \"ARG\" does not
8055appear in DOC, a paragraph is added to DOC explaining
8056usage of the mode argument.
7979 8057
7980Optional INIT-VALUE is the initial value of the mode's variable. 8058Optional INIT-VALUE is the initial value of the mode's variable.
7981Optional LIGHTER is displayed in the mode line when the mode is on. 8059Optional LIGHTER is displayed in the mode line when the mode is on.
@@ -8785,9 +8863,11 @@ or call the function `global-ede-mode'.")
8785 8863
8786(autoload 'global-ede-mode "ede" "\ 8864(autoload 'global-ede-mode "ede" "\
8787Toggle global EDE (Emacs Development Environment) mode. 8865Toggle global EDE (Emacs Development Environment) mode.
8788With a prefix argument ARG, enable global EDE mode if ARG is 8866
8789positive, and disable it otherwise. If called from Lisp, enable 8867If called interactively, enable Global Ede mode if ARG is positive, and
8790the mode if ARG is omitted or nil. 8868disable it if ARG is zero or negative. If called from Lisp,
8869also enable the mode if ARG is omitted or nil, and toggle it
8870if ARG is `toggle'; disable the mode otherwise.
8791 8871
8792This global minor mode enables `ede-minor-mode' in all buffers in 8872This global minor mode enables `ede-minor-mode' in all buffers in
8793an EDE controlled project. 8873an EDE controlled project.
@@ -9797,9 +9877,11 @@ or call the function `electric-pair-mode'.")
9797 9877
9798(autoload 'electric-pair-mode "elec-pair" "\ 9878(autoload 'electric-pair-mode "elec-pair" "\
9799Toggle automatic parens pairing (Electric Pair mode). 9879Toggle automatic parens pairing (Electric Pair mode).
9800With a prefix argument ARG, enable Electric Pair mode if ARG is 9880
9801positive, and disable it otherwise. If called from Lisp, enable 9881If called interactively, enable Electric-Pair mode if ARG is positive, and
9802the mode if ARG is omitted or nil. 9882disable it if ARG is zero or negative. If called from Lisp,
9883also enable the mode if ARG is omitted or nil, and toggle it
9884if ARG is `toggle'; disable the mode otherwise.
9803 9885
9804Electric Pair mode is a global minor mode. When enabled, typing 9886Electric Pair mode is a global minor mode. When enabled, typing
9805an open parenthesis automatically inserts the corresponding 9887an open parenthesis automatically inserts the corresponding
@@ -9814,6 +9896,11 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'.
9814(autoload 'electric-pair-local-mode "elec-pair" "\ 9896(autoload 'electric-pair-local-mode "elec-pair" "\
9815Toggle `electric-pair-mode' only in this buffer. 9897Toggle `electric-pair-mode' only in this buffer.
9816 9898
9899If called interactively, enable Electric-Pair-Local mode if ARG is positive, and
9900disable it if ARG is zero or negative. If called from Lisp,
9901also enable the mode if ARG is omitted or nil, and toggle it
9902if ARG is `toggle'; disable the mode otherwise.
9903
9817\(fn &optional ARG)" t nil) 9904\(fn &optional ARG)" t nil)
9818 9905
9819(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elec-pair" '("electric-pair-"))) 9906(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elec-pair" '("electric-pair-")))
@@ -10053,9 +10140,7 @@ displayed.
10053(autoload 'emacs-lock-mode "emacs-lock" "\ 10140(autoload 'emacs-lock-mode "emacs-lock" "\
10054Toggle Emacs Lock mode in the current buffer. 10141Toggle Emacs Lock mode in the current buffer.
10055If called with a plain prefix argument, ask for the locking mode 10142If called with a plain prefix argument, ask for the locking mode
10056to be used. With any other prefix ARG, turn mode on if ARG is 10143to be used.
10057positive, off otherwise. If called from Lisp, enable the mode if
10058ARG is omitted or nil.
10059 10144
10060Initially, if the user does not pass an explicit locking mode, it 10145Initially, if the user does not pass an explicit locking mode, it
10061defaults to `emacs-lock-default-locking-mode' (which see); 10146defaults to `emacs-lock-default-locking-mode' (which see);
@@ -10070,6 +10155,9 @@ When called from Elisp code, ARG can be any locking mode:
10070 10155
10071Other values are interpreted as usual. 10156Other values are interpreted as usual.
10072 10157
10158See also `emacs-lock-unlockable-modes', which exempts buffers under
10159some major modes from being locked under some circumstances.
10160
10073\(fn &optional ARG)" t nil) 10161\(fn &optional ARG)" t nil)
10074 10162
10075(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock"))) 10163(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock")))
@@ -10161,9 +10249,10 @@ Minor mode for editing text/enriched files.
10161These are files with embedded formatting information in the MIME standard 10249These are files with embedded formatting information in the MIME standard
10162text/enriched format. 10250text/enriched format.
10163 10251
10164With a prefix argument ARG, enable the mode if ARG is positive, 10252If called interactively, enable Enriched mode if ARG is positive, and
10165and disable it otherwise. If called from Lisp, enable the mode 10253disable it if ARG is zero or negative. If called from Lisp,
10166if ARG is omitted or nil. 10254also enable the mode if ARG is omitted or nil, and toggle it
10255if ARG is `toggle'; disable the mode otherwise.
10167 10256
10168Turning the mode on or off runs `enriched-mode-hook'. 10257Turning the mode on or off runs `enriched-mode-hook'.
10169 10258
@@ -10432,9 +10521,11 @@ Encrypt marked files.
10432 10521
10433(autoload 'epa-mail-mode "epa-mail" "\ 10522(autoload 'epa-mail-mode "epa-mail" "\
10434A minor-mode for composing encrypted/clearsigned mails. 10523A minor-mode for composing encrypted/clearsigned mails.
10435With a prefix argument ARG, enable the mode if ARG is positive, 10524
10436and disable it otherwise. If called from Lisp, enable the mode 10525If called interactively, enable epa-mail mode if ARG is positive, and
10437if ARG is omitted or nil. 10526disable it if ARG is zero or negative. If called from Lisp,
10527also enable the mode if ARG is omitted or nil, and toggle it
10528if ARG is `toggle'; disable the mode otherwise.
10438 10529
10439\(fn &optional ARG)" t nil) 10530\(fn &optional ARG)" t nil)
10440 10531
@@ -10497,9 +10588,11 @@ or call the function `epa-global-mail-mode'.")
10497 10588
10498(autoload 'epa-global-mail-mode "epa-mail" "\ 10589(autoload 'epa-global-mail-mode "epa-mail" "\
10499Minor mode to hook EasyPG into Mail mode. 10590Minor mode to hook EasyPG into Mail mode.
10500With a prefix argument ARG, enable the mode if ARG is positive, 10591
10501and disable it otherwise. If called from Lisp, enable the mode 10592If called interactively, enable Epa-Global-Mail mode if ARG is positive, and
10502if ARG is omitted or nil. 10593disable it if ARG is zero or negative. If called from Lisp,
10594also enable the mode if ARG is omitted or nil, and toggle it
10595if ARG is `toggle'; disable the mode otherwise.
10503 10596
10504\(fn &optional ARG)" t nil) 10597\(fn &optional ARG)" t nil)
10505 10598
@@ -10545,8 +10638,13 @@ Return a list of internal configuration parameters of `epg-gpg-program'.
10545 10638
10546(autoload 'epg-check-configuration "epg-config" "\ 10639(autoload 'epg-check-configuration "epg-config" "\
10547Verify that a sufficient version of GnuPG is installed. 10640Verify that a sufficient version of GnuPG is installed.
10641CONFIG should be a `epg-configuration' object (a plist).
10642REQ-VERSIONS should be a list with elements of the form (MIN
10643. MAX) where MIN and MAX are version strings indicating a
10644semi-open range of acceptable versions. REQ-VERSIONS may also be
10645a single minimum version string.
10548 10646
10549\(fn CONFIG &optional MINIMUM-VERSION)" nil nil) 10647\(fn CONFIG &optional REQ-VERSIONS)" nil nil)
10550 10648
10551(autoload 'epg-expand-group "epg-config" "\ 10649(autoload 'epg-expand-group "epg-config" "\
10552Look at CONFIG and try to expand GROUP. 10650Look at CONFIG and try to expand GROUP.
@@ -12087,10 +12185,14 @@ a top-level keymap, `text-scale-increase' or
12087 12185
12088(autoload 'buffer-face-mode "face-remap" "\ 12186(autoload 'buffer-face-mode "face-remap" "\
12089Minor mode for a buffer-specific default face. 12187Minor mode for a buffer-specific default face.
12090With a prefix argument ARG, enable the mode if ARG is positive, 12188
12091and disable it otherwise. If called from Lisp, enable the mode 12189If called interactively, enable Buffer-Face mode if ARG is positive, and
12092if ARG is omitted or nil. When enabled, the face specified by the 12190disable it if ARG is zero or negative. If called from Lisp,
12093variable `buffer-face-mode-face' is used to display the buffer text. 12191also enable the mode if ARG is omitted or nil, and toggle it
12192if ARG is `toggle'; disable the mode otherwise.
12193
12194When enabled, the face specified by the variable
12195`buffer-face-mode-face' is used to display the buffer text.
12094 12196
12095\(fn &optional ARG)" t nil) 12197\(fn &optional ARG)" t nil)
12096 12198
@@ -12972,9 +13074,11 @@ region is invalid.
12972 13074
12973(autoload 'flymake-mode "flymake" "\ 13075(autoload 'flymake-mode "flymake" "\
12974Toggle Flymake mode on or off. 13076Toggle Flymake mode on or off.
12975With a prefix argument ARG, enable Flymake mode if ARG is 13077
12976positive, and disable it otherwise. If called from Lisp, enable 13078If called interactively, enable Flymake mode if ARG is positive, and
12977the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. 13079disable it if ARG is zero or negative. If called from Lisp,
13080also enable the mode if ARG is omitted or nil, and toggle it
13081if ARG is `toggle'; disable the mode otherwise.
12978 13082
12979Flymake is an Emacs minor mode for on-the-fly syntax checking. 13083Flymake is an Emacs minor mode for on-the-fly syntax checking.
12980Flymake collects diagnostic information from multiple sources, 13084Flymake collects diagnostic information from multiple sources,
@@ -13060,9 +13164,11 @@ Turn on `flyspell-mode' for comments and strings.
13060 13164
13061(autoload 'flyspell-mode "flyspell" "\ 13165(autoload 'flyspell-mode "flyspell" "\
13062Toggle on-the-fly spell checking (Flyspell mode). 13166Toggle on-the-fly spell checking (Flyspell mode).
13063With a prefix argument ARG, enable Flyspell mode if ARG is 13167
13064positive, and disable it otherwise. If called from Lisp, enable 13168If called interactively, enable Flyspell mode if ARG is positive, and
13065the mode if ARG is omitted or nil. 13169disable it if ARG is zero or negative. If called from Lisp,
13170also enable the mode if ARG is omitted or nil, and toggle it
13171if ARG is `toggle'; disable the mode otherwise.
13066 13172
13067Flyspell mode is a buffer-local minor mode. When enabled, it 13173Flyspell mode is a buffer-local minor mode. When enabled, it
13068spawns a single Ispell process and checks each word. The default 13174spawns a single Ispell process and checks each word. The default
@@ -13110,6 +13216,9 @@ Turn Flyspell mode off.
13110(autoload 'flyspell-region "flyspell" "\ 13216(autoload 'flyspell-region "flyspell" "\
13111Flyspell text between BEG and END. 13217Flyspell text between BEG and END.
13112 13218
13219Make sure `flyspell-mode' is turned on if you want the highlight
13220of a misspelled word removed when you've corrected it.
13221
13113\(fn BEG END)" t nil) 13222\(fn BEG END)" t nil)
13114 13223
13115(autoload 'flyspell-buffer "flyspell" "\ 13224(autoload 'flyspell-buffer "flyspell" "\
@@ -13144,9 +13253,11 @@ Turn off Follow mode. Please see the function `follow-mode'.
13144 13253
13145(autoload 'follow-mode "follow" "\ 13254(autoload 'follow-mode "follow" "\
13146Toggle Follow mode. 13255Toggle Follow mode.
13147With a prefix argument ARG, enable Follow mode if ARG is 13256
13148positive, and disable it otherwise. If called from Lisp, enable 13257If called interactively, enable Follow mode if ARG is positive, and
13149the mode if ARG is omitted or nil. 13258disable it if ARG is zero or negative. If called from Lisp,
13259also enable the mode if ARG is omitted or nil, and toggle it
13260if ARG is `toggle'; disable the mode otherwise.
13150 13261
13151Follow mode is a minor mode that combines windows into one tall 13262Follow mode is a minor mode that combines windows into one tall
13152virtual window. This is accomplished by two main techniques: 13263virtual window. This is accomplished by two main techniques:
@@ -13267,9 +13378,11 @@ selected if the original window is the first one in the frame.
13267 13378
13268(autoload 'footnote-mode "footnote" "\ 13379(autoload 'footnote-mode "footnote" "\
13269Toggle Footnote mode. 13380Toggle Footnote mode.
13270With a prefix argument ARG, enable Footnote mode if ARG is 13381
13271positive, and disable it otherwise. If called from Lisp, enable 13382If called interactively, enable Footnote mode if ARG is positive, and
13272the mode if ARG is omitted or nil. 13383disable it if ARG is zero or negative. If called from Lisp,
13384also enable the mode if ARG is omitted or nil, and toggle it
13385if ARG is `toggle'; disable the mode otherwise.
13273 13386
13274Footnote mode is a buffer-local minor mode. If enabled, it 13387Footnote mode is a buffer-local minor mode. If enabled, it
13275provides footnote support for `message-mode'. To get started, 13388provides footnote support for `message-mode'. To get started,
@@ -13691,6 +13804,11 @@ being transferred. This list may grow up to a size of
13691`gdb-debug-log-max' after which the oldest element (at the end of 13804`gdb-debug-log-max' after which the oldest element (at the end of
13692the list) is deleted every time a new one is added (at the front). 13805the list) is deleted every time a new one is added (at the front).
13693 13806
13807If called interactively, enable Gdb-Enable-Debug mode if ARG is positive, and
13808disable it if ARG is zero or negative. If called from Lisp,
13809also enable the mode if ARG is omitted or nil, and toggle it
13810if ARG is `toggle'; disable the mode otherwise.
13811
13694\(fn &optional ARG)" t nil) 13812\(fn &optional ARG)" t nil)
13695 13813
13696(autoload 'gdb "gdb-mi" "\ 13814(autoload 'gdb "gdb-mi" "\
@@ -13859,10 +13977,14 @@ regular expression that can be used as an element of
13859 13977
13860(autoload 'glasses-mode "glasses" "\ 13978(autoload 'glasses-mode "glasses" "\
13861Minor mode for making identifiers likeThis readable. 13979Minor mode for making identifiers likeThis readable.
13862With a prefix argument ARG, enable the mode if ARG is positive, 13980
13863and disable it otherwise. If called from Lisp, enable the mode 13981If called interactively, enable Glasses mode if ARG is positive, and
13864if ARG is omitted or nil. When this mode is active, it tries to 13982disable it if ARG is zero or negative. If called from Lisp,
13865add virtual separators (like underscores) at places they belong to. 13983also enable the mode if ARG is omitted or nil, and toggle it
13984if ARG is `toggle'; disable the mode otherwise.
13985
13986When this mode is active, it tries to add virtual
13987separators (like underscores) at places they belong to.
13866 13988
13867\(fn &optional ARG)" t nil) 13989\(fn &optional ARG)" t nil)
13868 13990
@@ -14469,6 +14591,11 @@ If FORCE is non-nil, replace the old ones.
14469(autoload 'gnus-mailing-list-mode "gnus-ml" "\ 14591(autoload 'gnus-mailing-list-mode "gnus-ml" "\
14470Minor mode for providing mailing-list commands. 14592Minor mode for providing mailing-list commands.
14471 14593
14594If called interactively, enable Gnus-Mailing-List mode if ARG is positive, and
14595disable it if ARG is zero or negative. If called from Lisp,
14596also enable the mode if ARG is omitted or nil, and toggle it
14597if ARG is `toggle'; disable the mode otherwise.
14598
14472\\{gnus-mailing-list-mode-map} 14599\\{gnus-mailing-list-mode-map}
14473 14600
14474\(fn &optional ARG)" t nil) 14601\(fn &optional ARG)" t nil)
@@ -14889,7 +15016,14 @@ number with fewer than this number of bits, the handshake is
14889rejected. (The smaller the prime number, the less secure the 15016rejected. (The smaller the prime number, the less secure the
14890key exchange is against man-in-the-middle attacks.) 15017key exchange is against man-in-the-middle attacks.)
14891 15018
14892A value of nil says to use the default GnuTLS value.") 15019A value of nil says to use the default GnuTLS value.
15020
15021The default value of this variable is such that virtually any
15022connection can be established, whether this connection can be
15023considered cryptographically \"safe\" or not. However, Emacs
15024network security is handled at a higher level via
15025`open-network-stream' and the Network Security Manager. See Info
15026node `(emacs) Network Security'.")
14893 15027
14894(custom-autoload 'gnutls-min-prime-bits "gnutls" t) 15028(custom-autoload 'gnutls-min-prime-bits "gnutls" t)
14895 15029
@@ -14951,15 +15085,22 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
14951 15085
14952(autoload 'goto-address-mode "goto-addr" "\ 15086(autoload 'goto-address-mode "goto-addr" "\
14953Minor mode to buttonize URLs and e-mail addresses in the current buffer. 15087Minor mode to buttonize URLs and e-mail addresses in the current buffer.
14954With a prefix argument ARG, enable the mode if ARG is positive, 15088
14955and disable it otherwise. If called from Lisp, enable the mode 15089If called interactively, enable Goto-Address mode if ARG is positive, and
14956if ARG is omitted or nil. 15090disable it if ARG is zero or negative. If called from Lisp,
15091also enable the mode if ARG is omitted or nil, and toggle it
15092if ARG is `toggle'; disable the mode otherwise.
14957 15093
14958\(fn &optional ARG)" t nil) 15094\(fn &optional ARG)" t nil)
14959 15095
14960(autoload 'goto-address-prog-mode "goto-addr" "\ 15096(autoload 'goto-address-prog-mode "goto-addr" "\
14961Like `goto-address-mode', but only for comments and strings. 15097Like `goto-address-mode', but only for comments and strings.
14962 15098
15099If called interactively, enable Goto-Address-Prog mode if ARG is positive, and
15100disable it if ARG is zero or negative. If called from Lisp,
15101also enable the mode if ARG is omitted or nil, and toggle it
15102if ARG is `toggle'; disable the mode otherwise.
15103
14963\(fn &optional ARG)" t nil) 15104\(fn &optional ARG)" t nil)
14964 15105
14965(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "goto-addr" '("goto-address-"))) 15106(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "goto-addr" '("goto-address-")))
@@ -15017,7 +15158,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').")
15017 15158
15018(custom-autoload 'grep-setup-hook "grep" t) 15159(custom-autoload 'grep-setup-hook "grep" t)
15019 15160
15020(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ 15161(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\
15021Regexp used to match grep hits. 15162Regexp used to match grep hits.
15022See `compilation-error-regexp-alist' for format details.") 15163See `compilation-error-regexp-alist' for format details.")
15023 15164
@@ -15259,9 +15400,11 @@ or call the function `gud-tooltip-mode'.")
15259 15400
15260(autoload 'gud-tooltip-mode "gud" "\ 15401(autoload 'gud-tooltip-mode "gud" "\
15261Toggle the display of GUD tooltips. 15402Toggle the display of GUD tooltips.
15262With a prefix argument ARG, enable the feature if ARG is 15403
15263positive, and disable it otherwise. If called from Lisp, enable 15404If called interactively, enable Gud-Tooltip mode if ARG is positive, and
15264it if ARG is omitted or nil. 15405disable it if ARG is zero or negative. If called from Lisp,
15406also enable the mode if ARG is omitted or nil, and toggle it
15407if ARG is `toggle'; disable the mode otherwise.
15265 15408
15266\(fn &optional ARG)" t nil) 15409\(fn &optional ARG)" t nil)
15267 15410
@@ -15944,9 +16087,11 @@ This discards the buffer's undo information.
15944 16087
15945(autoload 'hi-lock-mode "hi-lock" "\ 16088(autoload 'hi-lock-mode "hi-lock" "\
15946Toggle selective highlighting of patterns (Hi Lock mode). 16089Toggle selective highlighting of patterns (Hi Lock mode).
15947With a prefix argument ARG, enable Hi Lock mode if ARG is 16090
15948positive, and disable it otherwise. If called from Lisp, enable 16091If called interactively, enable Hi-Lock mode if ARG is positive, and
15949the mode if ARG is omitted or nil. 16092disable it if ARG is zero or negative. If called from Lisp,
16093also enable the mode if ARG is omitted or nil, and toggle it
16094if ARG is `toggle'; disable the mode otherwise.
15950 16095
15951Hi Lock mode is automatically enabled when you invoke any of the 16096Hi Lock mode is automatically enabled when you invoke any of the
15952highlighting commands listed below, such as \\[highlight-regexp]. 16097highlighting commands listed below, such as \\[highlight-regexp].
@@ -16114,9 +16259,11 @@ be found in variable `hi-lock-interactive-patterns'.
16114 16259
16115(autoload 'hide-ifdef-mode "hideif" "\ 16260(autoload 'hide-ifdef-mode "hideif" "\
16116Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). 16261Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode).
16117With a prefix argument ARG, enable Hide-Ifdef mode if ARG is 16262
16118positive, and disable it otherwise. If called from Lisp, enable 16263If called interactively, enable Hide-Ifdef mode if ARG is positive, and
16119the mode if ARG is omitted or nil. 16264disable it if ARG is zero or negative. If called from Lisp,
16265also enable the mode if ARG is omitted or nil, and toggle it
16266if ARG is `toggle'; disable the mode otherwise.
16120 16267
16121Hide-Ifdef mode is a buffer-local minor mode for use with C and 16268Hide-Ifdef mode is a buffer-local minor mode for use with C and
16122C-like major modes. When enabled, code within #ifdef constructs 16269C-like major modes. When enabled, code within #ifdef constructs
@@ -16191,9 +16338,11 @@ whitespace. Case does not matter.")
16191 16338
16192(autoload 'hs-minor-mode "hideshow" "\ 16339(autoload 'hs-minor-mode "hideshow" "\
16193Minor mode to selectively hide/show code and comment blocks. 16340Minor mode to selectively hide/show code and comment blocks.
16194With a prefix argument ARG, enable the mode if ARG is positive, 16341
16195and disable it otherwise. If called from Lisp, enable the mode 16342If called interactively, enable Hs minor mode if ARG is positive, and
16196if ARG is omitted or nil. 16343disable it if ARG is zero or negative. If called from Lisp,
16344also enable the mode if ARG is omitted or nil, and toggle it
16345if ARG is `toggle'; disable the mode otherwise.
16197 16346
16198When hideshow minor mode is on, the menu bar is augmented with hideshow 16347When hideshow minor mode is on, the menu bar is augmented with hideshow
16199commands and the hideshow commands are enabled. 16348commands and the hideshow commands are enabled.
@@ -16227,9 +16376,11 @@ Unconditionally turn off `hs-minor-mode'.
16227 16376
16228(autoload 'highlight-changes-mode "hilit-chg" "\ 16377(autoload 'highlight-changes-mode "hilit-chg" "\
16229Toggle highlighting changes in this buffer (Highlight Changes mode). 16378Toggle highlighting changes in this buffer (Highlight Changes mode).
16230With a prefix argument ARG, enable Highlight Changes mode if ARG 16379
16231is positive, and disable it otherwise. If called from Lisp, 16380If called interactively, enable Highlight-Changes mode if ARG is positive, and
16232enable the mode if ARG is omitted or nil. 16381disable it if ARG is zero or negative. If called from Lisp,
16382also enable the mode if ARG is omitted or nil, and toggle it
16383if ARG is `toggle'; disable the mode otherwise.
16233 16384
16234When Highlight Changes is enabled, changes are marked with a text 16385When Highlight Changes is enabled, changes are marked with a text
16235property. Normally they are displayed in a distinctive face, but 16386property. Normally they are displayed in a distinctive face, but
@@ -16250,9 +16401,11 @@ buffer with the contents of a file
16250 16401
16251(autoload 'highlight-changes-visible-mode "hilit-chg" "\ 16402(autoload 'highlight-changes-visible-mode "hilit-chg" "\
16252Toggle visibility of highlighting due to Highlight Changes mode. 16403Toggle visibility of highlighting due to Highlight Changes mode.
16253With a prefix argument ARG, enable Highlight Changes Visible mode 16404
16254if ARG is positive, and disable it otherwise. If called from 16405If called interactively, enable Highlight-Changes-Visible mode if ARG is positive, and
16255Lisp, enable the mode if ARG is omitted or nil. 16406disable it if ARG is zero or negative. If called from Lisp,
16407also enable the mode if ARG is omitted or nil, and toggle it
16408if ARG is `toggle'; disable the mode otherwise.
16256 16409
16257Highlight Changes Visible mode only has an effect when Highlight 16410Highlight Changes Visible mode only has an effect when Highlight
16258Changes mode is on. When enabled, the changed text is displayed 16411Changes mode is on. When enabled, the changed text is displayed
@@ -16395,9 +16548,11 @@ argument VERBOSE non-nil makes the function verbose.
16395 16548
16396(autoload 'hl-line-mode "hl-line" "\ 16549(autoload 'hl-line-mode "hl-line" "\
16397Toggle highlighting of the current line (Hl-Line mode). 16550Toggle highlighting of the current line (Hl-Line mode).
16398With a prefix argument ARG, enable Hl-Line mode if ARG is 16551
16399positive, and disable it otherwise. If called from Lisp, enable 16552If called interactively, enable Hl-Line mode if ARG is positive, and
16400the mode if ARG is omitted or nil. 16553disable it if ARG is zero or negative. If called from Lisp,
16554also enable the mode if ARG is omitted or nil, and toggle it
16555if ARG is `toggle'; disable the mode otherwise.
16401 16556
16402Hl-Line mode is a buffer-local minor mode. If 16557Hl-Line mode is a buffer-local minor mode. If
16403`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the 16558`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the
@@ -16425,9 +16580,11 @@ or call the function `global-hl-line-mode'.")
16425 16580
16426(autoload 'global-hl-line-mode "hl-line" "\ 16581(autoload 'global-hl-line-mode "hl-line" "\
16427Toggle line highlighting in all buffers (Global Hl-Line mode). 16582Toggle line highlighting in all buffers (Global Hl-Line mode).
16428With a prefix argument ARG, enable Global Hl-Line mode if ARG is 16583
16429positive, and disable it otherwise. If called from Lisp, enable 16584If called interactively, enable Global Hl-Line mode if ARG is positive, and
16430the mode if ARG is omitted or nil. 16585disable it if ARG is zero or negative. If called from Lisp,
16586also enable the mode if ARG is omitted or nil, and toggle it
16587if ARG is `toggle'; disable the mode otherwise.
16431 16588
16432If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode 16589If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode
16433highlights the line about the current buffer's point in all live 16590highlights the line about the current buffer's point in all live
@@ -16841,9 +16998,11 @@ or call the function `icomplete-mode'.")
16841 16998
16842(autoload 'icomplete-mode "icomplete" "\ 16999(autoload 'icomplete-mode "icomplete" "\
16843Toggle incremental minibuffer completion (Icomplete mode). 17000Toggle incremental minibuffer completion (Icomplete mode).
16844With a prefix argument ARG, enable Icomplete mode if ARG is 17001
16845positive, and disable it otherwise. If called from Lisp, enable 17002If called interactively, enable Icomplete mode if ARG is positive, and
16846the mode if ARG is omitted or nil. 17003disable it if ARG is zero or negative. If called from Lisp,
17004also enable the mode if ARG is omitted or nil, and toggle it
17005if ARG is `toggle'; disable the mode otherwise.
16847 17006
16848When this global minor mode is enabled, typing in the minibuffer 17007When this global minor mode is enabled, typing in the minibuffer
16849continuously displays a list of possible completions that match 17008continuously displays a list of possible completions that match
@@ -17392,10 +17551,11 @@ DEF, if non-nil, is the default value.
17392 17551
17393(autoload 'ielm "ielm" "\ 17552(autoload 'ielm "ielm" "\
17394Interactively evaluate Emacs Lisp expressions. 17553Interactively evaluate Emacs Lisp expressions.
17395Switches to the buffer `*ielm*', or creates it if it does not exist. 17554Switches to the buffer named BUF-NAME if provided (`*ielm*' by default),
17555or creates it if it does not exist.
17396See `inferior-emacs-lisp-mode' for details. 17556See `inferior-emacs-lisp-mode' for details.
17397 17557
17398\(fn)" t nil) 17558\(fn &optional BUF-NAME)" t nil)
17399 17559
17400(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode"))) 17560(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode")))
17401 17561
@@ -17415,9 +17575,12 @@ See `inferior-emacs-lisp-mode' for details.
17415 17575
17416(autoload 'iimage-mode "iimage" "\ 17576(autoload 'iimage-mode "iimage" "\
17417Toggle Iimage mode on or off. 17577Toggle Iimage mode on or off.
17418With a prefix argument ARG, enable Iimage mode if ARG is 17578
17419positive, and disable it otherwise. If called from Lisp, enable 17579If called interactively, enable Iimage mode if ARG is positive, and
17420the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. 17580disable it if ARG is zero or negative. If called from Lisp,
17581also enable the mode if ARG is omitted or nil, and toggle it
17582if ARG is `toggle'; disable the mode otherwise.
17583
17421\\{iimage-mode-map} 17584\\{iimage-mode-map}
17422 17585
17423\(fn &optional ARG)" t nil) 17586\(fn &optional ARG)" t nil)
@@ -17710,6 +17873,11 @@ Setup easy-to-use keybindings for the commands to be used in dired mode.
17710Note that n, p and <down> and <up> will be hijacked and bound to 17873Note that n, p and <down> and <up> will be hijacked and bound to
17711`image-dired-dired-x-line'. 17874`image-dired-dired-x-line'.
17712 17875
17876If called interactively, enable Image-Dired minor mode if ARG is positive, and
17877disable it if ARG is zero or negative. If called from Lisp,
17878also enable the mode if ARG is omitted or nil, and toggle it
17879if ARG is `toggle'; disable the mode otherwise.
17880
17713\(fn &optional ARG)" t nil) 17881\(fn &optional ARG)" t nil)
17714 17882
17715(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode "26.1") 17883(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode "26.1")
@@ -17813,9 +17981,11 @@ or call the function `auto-image-file-mode'.")
17813 17981
17814(autoload 'auto-image-file-mode "image-file" "\ 17982(autoload 'auto-image-file-mode "image-file" "\
17815Toggle visiting of image files as images (Auto Image File mode). 17983Toggle visiting of image files as images (Auto Image File mode).
17816With a prefix argument ARG, enable Auto Image File mode if ARG is 17984
17817positive, and disable it otherwise. If called from Lisp, enable 17985If called interactively, enable Auto-Image-File mode if ARG is positive, and
17818the mode if ARG is omitted or nil. 17986disable it if ARG is zero or negative. If called from Lisp,
17987also enable the mode if ARG is omitted or nil, and toggle it
17988if ARG is `toggle'; disable the mode otherwise.
17819 17989
17820An image file is one whose name has an extension in 17990An image file is one whose name has an extension in
17821`image-file-name-extensions', or matches a regexp in 17991`image-file-name-extensions', or matches a regexp in
@@ -17842,9 +18012,11 @@ Key bindings:
17842 18012
17843(autoload 'image-minor-mode "image-mode" "\ 18013(autoload 'image-minor-mode "image-mode" "\
17844Toggle Image minor mode in this buffer. 18014Toggle Image minor mode in this buffer.
17845With a prefix argument ARG, enable Image minor mode if ARG is 18015
17846positive, and disable it otherwise. If called from Lisp, enable 18016If called interactively, enable Image minor mode if ARG is positive, and
17847the mode if ARG is omitted or nil. 18017disable it if ARG is zero or negative. If called from Lisp,
18018also enable the mode if ARG is omitted or nil, and toggle it
18019if ARG is `toggle'; disable the mode otherwise.
17848 18020
17849Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], 18021Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
17850to switch back to `image-mode' and display an image file as the 18022to switch back to `image-mode' and display an image file as the
@@ -17907,9 +18079,9 @@ string (which specifies the title of a submenu into which the
17907matches are put). 18079matches are put).
17908REGEXP is a regular expression matching a definition construct 18080REGEXP is a regular expression matching a definition construct
17909which is to be displayed in the menu. REGEXP may also be a 18081which is to be displayed in the menu. REGEXP may also be a
17910function, called without arguments. It is expected to search 18082function of no arguments. If REGEXP is a function, it is
17911backwards. It must return true and set `match-data' if it finds 18083expected to search backwards, return non-nil if it finds a
17912another element. 18084definition construct, and set `match-data' for that construct.
17913INDEX is an integer specifying which subexpression of REGEXP 18085INDEX is an integer specifying which subexpression of REGEXP
17914matches the definition's name; this subexpression is displayed as 18086matches the definition's name; this subexpression is displayed as
17915the menu item. 18087the menu item.
@@ -18824,9 +18996,11 @@ available on the net.
18824 18996
18825(autoload 'ispell-minor-mode "ispell" "\ 18997(autoload 'ispell-minor-mode "ispell" "\
18826Toggle last-word spell checking (Ispell minor mode). 18998Toggle last-word spell checking (Ispell minor mode).
18827With a prefix argument ARG, enable Ispell minor mode if ARG is 18999
18828positive, and disable it otherwise. If called from Lisp, enable 19000If called interactively, enable ISpell minor mode if ARG is positive, and
18829the mode if ARG is omitted or nil. 19001disable it if ARG is zero or negative. If called from Lisp,
19002also enable the mode if ARG is omitted or nil, and toggle it
19003if ARG is `toggle'; disable the mode otherwise.
18830 19004
18831Ispell minor mode is a buffer-local minor mode. When enabled, 19005Ispell minor mode is a buffer-local minor mode. When enabled,
18832typing SPC or RET warns you if the previous word is incorrectly 19006typing SPC or RET warns you if the previous word is incorrectly
@@ -19510,9 +19684,11 @@ generations (this defaults to 1).
19510 19684
19511(autoload 'linum-mode "linum" "\ 19685(autoload 'linum-mode "linum" "\
19512Toggle display of line numbers in the left margin (Linum mode). 19686Toggle display of line numbers in the left margin (Linum mode).
19513With a prefix argument ARG, enable Linum mode if ARG is positive, 19687
19514and disable it otherwise. If called from Lisp, enable the mode 19688If called interactively, enable Linum mode if ARG is positive, and
19515if ARG is omitted or nil. 19689disable it if ARG is zero or negative. If called from Lisp,
19690also enable the mode if ARG is omitted or nil, and toggle it
19691if ARG is `toggle'; disable the mode otherwise.
19516 19692
19517Linum mode is a buffer-local minor mode. 19693Linum mode is a buffer-local minor mode.
19518 19694
@@ -20085,9 +20261,11 @@ or call the function `mail-abbrevs-mode'.")
20085 20261
20086(autoload 'mail-abbrevs-mode "mailabbrev" "\ 20262(autoload 'mail-abbrevs-mode "mailabbrev" "\
20087Toggle abbrev expansion of mail aliases (Mail Abbrevs mode). 20263Toggle abbrev expansion of mail aliases (Mail Abbrevs mode).
20088With a prefix argument ARG, enable Mail Abbrevs mode if ARG is 20264
20089positive, and disable it otherwise. If called from Lisp, enable 20265If called interactively, enable Mail-Abbrevs mode if ARG is positive, and
20090the mode if ARG is omitted or nil. 20266disable it if ARG is zero or negative. If called from Lisp,
20267also enable the mode if ARG is omitted or nil, and toggle it
20268if ARG is `toggle'; disable the mode otherwise.
20091 20269
20092Mail Abbrevs mode is a global minor mode. When enabled, 20270Mail Abbrevs mode is a global minor mode. When enabled,
20093abbrev-like expansion is performed when editing certain mail 20271abbrev-like expansion is performed when editing certain mail
@@ -20431,9 +20609,11 @@ Default bookmark handler for Man buffers.
20431 20609
20432(autoload 'master-mode "master" "\ 20610(autoload 'master-mode "master" "\
20433Toggle Master mode. 20611Toggle Master mode.
20434With a prefix argument ARG, enable Master mode if ARG is 20612
20435positive, and disable it otherwise. If called from Lisp, enable 20613If called interactively, enable Master mode if ARG is positive, and
20436the mode if ARG is omitted or nil. 20614disable it if ARG is zero or negative. If called from Lisp,
20615also enable the mode if ARG is omitted or nil, and toggle it
20616if ARG is `toggle'; disable the mode otherwise.
20437 20617
20438When Master mode is enabled, you can scroll the slave buffer 20618When Master mode is enabled, you can scroll the slave buffer
20439using the following commands: 20619using the following commands:
@@ -20465,9 +20645,11 @@ or call the function `minibuffer-depth-indicate-mode'.")
20465 20645
20466(autoload 'minibuffer-depth-indicate-mode "mb-depth" "\ 20646(autoload 'minibuffer-depth-indicate-mode "mb-depth" "\
20467Toggle Minibuffer Depth Indication mode. 20647Toggle Minibuffer Depth Indication mode.
20468With a prefix argument ARG, enable Minibuffer Depth Indication 20648
20469mode if ARG is positive, and disable it otherwise. If called 20649If called interactively, enable Minibuffer-Depth-Indicate mode if ARG is positive, and
20470from Lisp, enable the mode if ARG is omitted or nil. 20650disable it if ARG is zero or negative. If called from Lisp,
20651also enable the mode if ARG is omitted or nil, and toggle it
20652if ARG is `toggle'; disable the mode otherwise.
20471 20653
20472Minibuffer Depth Indication mode is a global minor mode. When 20654Minibuffer Depth Indication mode is a global minor mode. When
20473enabled, any recursive use of the minibuffer will show the 20655enabled, any recursive use of the minibuffer will show the
@@ -21095,6 +21277,11 @@ or call the function `midnight-mode'.")
21095(autoload 'midnight-mode "midnight" "\ 21277(autoload 'midnight-mode "midnight" "\
21096Non-nil means run `midnight-hook' at midnight. 21278Non-nil means run `midnight-hook' at midnight.
21097 21279
21280If called interactively, enable Midnight mode if ARG is positive, and
21281disable it if ARG is zero or negative. If called from Lisp,
21282also enable the mode if ARG is omitted or nil, and toggle it
21283if ARG is `toggle'; disable the mode otherwise.
21284
21098\(fn &optional ARG)" t nil) 21285\(fn &optional ARG)" t nil)
21099 21286
21100(autoload 'clean-buffer-list "midnight" "\ 21287(autoload 'clean-buffer-list "midnight" "\
@@ -21137,9 +21324,11 @@ or call the function `minibuffer-electric-default-mode'.")
21137 21324
21138(autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\ 21325(autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\
21139Toggle Minibuffer Electric Default mode. 21326Toggle Minibuffer Electric Default mode.
21140With a prefix argument ARG, enable Minibuffer Electric Default 21327
21141mode if ARG is positive, and disable it otherwise. If called 21328If called interactively, enable Minibuffer-Electric-Default mode if ARG is positive, and
21142from Lisp, enable the mode if ARG is omitted or nil. 21329disable it if ARG is zero or negative. If called from Lisp,
21330also enable the mode if ARG is omitted or nil, and toggle it
21331if ARG is `toggle'; disable the mode otherwise.
21143 21332
21144Minibuffer Electric Default mode is a global minor mode. When 21333Minibuffer Electric Default mode is a global minor mode. When
21145enabled, minibuffer prompts that show a default value only show 21334enabled, minibuffer prompts that show a default value only show
@@ -21722,9 +21911,11 @@ or call the function `msb-mode'.")
21722 21911
21723(autoload 'msb-mode "msb" "\ 21912(autoload 'msb-mode "msb" "\
21724Toggle Msb mode. 21913Toggle Msb mode.
21725With a prefix argument ARG, enable Msb mode if ARG is positive, 21914
21726and disable it otherwise. If called from Lisp, enable the mode 21915If called interactively, enable Msb mode if ARG is positive, and
21727if ARG is omitted or nil. 21916disable it if ARG is zero or negative. If called from Lisp,
21917also enable the mode if ARG is omitted or nil, and toggle it
21918if ARG is `toggle'; disable the mode otherwise.
21728 21919
21729This mode overrides the binding(s) of `mouse-buffer-menu' to provide a 21920This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
21730different buffer menu using the function `msb'. 21921different buffer menu using the function `msb'.
@@ -23390,6 +23581,11 @@ modes. The following keys behave as if Org mode were active, if
23390the cursor is on a headline, or on a plain list item (both as 23581the cursor is on a headline, or on a plain list item (both as
23391defined by Org mode). 23582defined by Org mode).
23392 23583
23584If called interactively, enable OrgStruct mode if ARG is positive, and
23585disable it if ARG is zero or negative. If called from Lisp,
23586also enable the mode if ARG is omitted or nil, and toggle it
23587if ARG is `toggle'; disable the mode otherwise.
23588
23393\(fn &optional ARG)" t nil) 23589\(fn &optional ARG)" t nil)
23394 23590
23395(autoload 'turn-on-orgstruct "org" "\ 23591(autoload 'turn-on-orgstruct "org" "\
@@ -24302,9 +24498,11 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
24302 24498
24303(autoload 'outline-minor-mode "outline" "\ 24499(autoload 'outline-minor-mode "outline" "\
24304Toggle Outline minor mode. 24500Toggle Outline minor mode.
24305With a prefix argument ARG, enable Outline minor mode if ARG is 24501
24306positive, and disable it otherwise. If called from Lisp, enable 24502If called interactively, enable Outline minor mode if ARG is positive, and
24307the mode if ARG is omitted or nil. 24503disable it if ARG is zero or negative. If called from Lisp,
24504also enable the mode if ARG is omitted or nil, and toggle it
24505if ARG is `toggle'; disable the mode otherwise.
24308 24506
24309See the command `outline-mode' for more information on this mode. 24507See the command `outline-mode' for more information on this mode.
24310 24508
@@ -24579,9 +24777,11 @@ or call the function `show-paren-mode'.")
24579 24777
24580(autoload 'show-paren-mode "paren" "\ 24778(autoload 'show-paren-mode "paren" "\
24581Toggle visualization of matching parens (Show Paren mode). 24779Toggle visualization of matching parens (Show Paren mode).
24582With a prefix argument ARG, enable Show Paren mode if ARG is 24780
24583positive, and disable it otherwise. If called from Lisp, enable 24781If called interactively, enable Show-Paren mode if ARG is positive, and
24584the mode if ARG is omitted or nil. 24782disable it if ARG is zero or negative. If called from Lisp,
24783also enable the mode if ARG is omitted or nil, and toggle it
24784if ARG is `toggle'; disable the mode otherwise.
24585 24785
24586Show Paren mode is a global minor mode. When enabled, any 24786Show Paren mode is a global minor mode. When enabled, any
24587matching parenthesis is highlighted in `show-paren-style' after 24787matching parenthesis is highlighted in `show-paren-style' after
@@ -25300,9 +25500,11 @@ or call the function `pixel-scroll-mode'.")
25300 25500
25301(autoload 'pixel-scroll-mode "pixel-scroll" "\ 25501(autoload 'pixel-scroll-mode "pixel-scroll" "\
25302A minor mode to scroll text pixel-by-pixel. 25502A minor mode to scroll text pixel-by-pixel.
25303With a prefix argument ARG, enable Pixel Scroll mode if ARG is positive, 25503
25304and disable it otherwise. If called from Lisp, enable Pixel Scroll mode 25504If called interactively, enable Pixel-Scroll mode if ARG is positive, and
25305if ARG is omitted or nil. 25505disable it if ARG is zero or negative. If called from Lisp,
25506also enable the mode if ARG is omitted or nil, and toggle it
25507if ARG is `toggle'; disable the mode otherwise.
25306 25508
25307\(fn &optional ARG)" t nil) 25509\(fn &optional ARG)" t nil)
25308 25510
@@ -26959,9 +27161,11 @@ or call the function `rcirc-track-minor-mode'.")
26959 27161
26960(autoload 'rcirc-track-minor-mode "rcirc" "\ 27162(autoload 'rcirc-track-minor-mode "rcirc" "\
26961Global minor mode for tracking activity in rcirc buffers. 27163Global minor mode for tracking activity in rcirc buffers.
26962With a prefix argument ARG, enable the mode if ARG is positive, 27164
26963and disable it otherwise. If called from Lisp, enable the mode 27165If called interactively, enable Rcirc-Track minor mode if ARG is positive, and
26964if ARG is omitted or nil. 27166disable it if ARG is zero or negative. If called from Lisp,
27167also enable the mode if ARG is omitted or nil, and toggle it
27168if ARG is `toggle'; disable the mode otherwise.
26965 27169
26966\(fn &optional ARG)" t nil) 27170\(fn &optional ARG)" t nil)
26967 27171
@@ -27005,9 +27209,11 @@ or call the function `recentf-mode'.")
27005 27209
27006(autoload 'recentf-mode "recentf" "\ 27210(autoload 'recentf-mode "recentf" "\
27007Toggle \"Open Recent\" menu (Recentf mode). 27211Toggle \"Open Recent\" menu (Recentf mode).
27008With a prefix argument ARG, enable Recentf mode if ARG is 27212
27009positive, and disable it otherwise. If called from Lisp, enable 27213If called interactively, enable Recentf mode if ARG is positive, and
27010Recentf mode if ARG is omitted or nil. 27214disable it if ARG is zero or negative. If called from Lisp,
27215also enable the mode if ARG is omitted or nil, and toggle it
27216if ARG is `toggle'; disable the mode otherwise.
27011 27217
27012When Recentf mode is enabled, a \"Open Recent\" submenu is 27218When Recentf mode is enabled, a \"Open Recent\" submenu is
27013displayed in the \"File\" menu, containing a list of files that 27219displayed in the \"File\" menu, containing a list of files that
@@ -27157,6 +27363,12 @@ with a prefix argument, prompt for START-AT and FORMAT.
27157 27363
27158(autoload 'rectangle-mark-mode "rect" "\ 27364(autoload 'rectangle-mark-mode "rect" "\
27159Toggle the region as rectangular. 27365Toggle the region as rectangular.
27366
27367If called interactively, enable Rectangle-Mark mode if ARG is positive, and
27368disable it if ARG is zero or negative. If called from Lisp,
27369also enable the mode if ARG is omitted or nil, and toggle it
27370if ARG is `toggle'; disable the mode otherwise.
27371
27160Activates the region if needed. Only lasts until the region is deactivated. 27372Activates the region if needed. Only lasts until the region is deactivated.
27161 27373
27162\(fn &optional ARG)" t nil) 27374\(fn &optional ARG)" t nil)
@@ -27184,9 +27396,11 @@ Activates the region if needed. Only lasts until the region is deactivated.
27184 27396
27185(autoload 'refill-mode "refill" "\ 27397(autoload 'refill-mode "refill" "\
27186Toggle automatic refilling (Refill mode). 27398Toggle automatic refilling (Refill mode).
27187With a prefix argument ARG, enable Refill mode if ARG is 27399
27188positive, and disable it otherwise. If called from Lisp, enable 27400If called interactively, enable Refill mode if ARG is positive, and
27189the mode if ARG is omitted or nil. 27401disable it if ARG is zero or negative. If called from Lisp,
27402also enable the mode if ARG is omitted or nil, and toggle it
27403if ARG is `toggle'; disable the mode otherwise.
27190 27404
27191Refill mode is a buffer-local minor mode. When enabled, the 27405Refill mode is a buffer-local minor mode. When enabled, the
27192current paragraph is refilled as you edit. Self-inserting 27406current paragraph is refilled as you edit. Self-inserting
@@ -27216,6 +27430,11 @@ Turn on RefTeX mode.
27216(autoload 'reftex-mode "reftex" "\ 27430(autoload 'reftex-mode "reftex" "\
27217Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. 27431Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
27218 27432
27433If called interactively, enable Reftex mode if ARG is positive, and
27434disable it if ARG is zero or negative. If called from Lisp,
27435also enable the mode if ARG is omitted or nil, and toggle it
27436if ARG is `toggle'; disable the mode otherwise.
27437
27219\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing 27438\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing
27220capabilities is available with `\\[reftex-toc]'. 27439capabilities is available with `\\[reftex-toc]'.
27221 27440
@@ -27560,9 +27779,11 @@ first comment line visible (if point is in a comment).
27560 27779
27561(autoload 'reveal-mode "reveal" "\ 27780(autoload 'reveal-mode "reveal" "\
27562Toggle uncloaking of invisible text near point (Reveal mode). 27781Toggle uncloaking of invisible text near point (Reveal mode).
27563With a prefix argument ARG, enable Reveal mode if ARG is 27782
27564positive, and disable it otherwise. If called from Lisp, enable 27783If called interactively, enable Reveal mode if ARG is positive, and
27565Reveal mode if ARG is omitted or nil. 27784disable it if ARG is zero or negative. If called from Lisp,
27785also enable the mode if ARG is omitted or nil, and toggle it
27786if ARG is `toggle'; disable the mode otherwise.
27566 27787
27567Reveal mode is a buffer-local minor mode. When enabled, it 27788Reveal mode is a buffer-local minor mode. When enabled, it
27568reveals invisible text around point. 27789reveals invisible text around point.
@@ -27583,9 +27804,10 @@ or call the function `global-reveal-mode'.")
27583Toggle Reveal mode in all buffers (Global Reveal mode). 27804Toggle Reveal mode in all buffers (Global Reveal mode).
27584Reveal mode renders invisible text around point visible again. 27805Reveal mode renders invisible text around point visible again.
27585 27806
27586With a prefix argument ARG, enable Global Reveal mode if ARG is 27807If called interactively, enable Global Reveal mode if ARG is positive, and
27587positive, and disable it otherwise. If called from Lisp, enable 27808disable it if ARG is zero or negative. If called from Lisp,
27588the mode if ARG is omitted or nil. 27809also enable the mode if ARG is omitted or nil, and toggle it
27810if ARG is `toggle'; disable the mode otherwise.
27589 27811
27590\(fn &optional ARG)" t nil) 27812\(fn &optional ARG)" t nil)
27591 27813
@@ -28303,9 +28525,11 @@ highlighting.
28303 28525
28304(autoload 'rst-minor-mode "rst" "\ 28526(autoload 'rst-minor-mode "rst" "\
28305Toggle ReST minor mode. 28527Toggle ReST minor mode.
28306With a prefix argument ARG, enable ReST minor mode if ARG is 28528
28307positive, and disable it otherwise. If called from Lisp, enable 28529If called interactively, enable Rst minor mode if ARG is positive, and
28308the mode if ARG is omitted or nil. 28530disable it if ARG is zero or negative. If called from Lisp,
28531also enable the mode if ARG is omitted or nil, and toggle it
28532if ARG is `toggle'; disable the mode otherwise.
28309 28533
28310When ReST minor mode is enabled, the ReST mode keybindings 28534When ReST minor mode is enabled, the ReST mode keybindings
28311are installed on top of the major mode bindings. Use this 28535are installed on top of the major mode bindings. Use this
@@ -28352,9 +28576,11 @@ Use the command `ruler-mode' to change this variable.")
28352 28576
28353(autoload 'ruler-mode "ruler-mode" "\ 28577(autoload 'ruler-mode "ruler-mode" "\
28354Toggle display of ruler in header line (Ruler mode). 28578Toggle display of ruler in header line (Ruler mode).
28355With a prefix argument ARG, enable Ruler mode if ARG is positive, 28579
28356and disable it otherwise. If called from Lisp, enable the mode 28580If called interactively, enable Ruler mode if ARG is positive, and
28357if ARG is omitted or nil. 28581disable it if ARG is zero or negative. If called from Lisp,
28582also enable the mode if ARG is omitted or nil, and toggle it
28583if ARG is `toggle'; disable the mode otherwise.
28358 28584
28359\(fn &optional ARG)" t nil) 28585\(fn &optional ARG)" t nil)
28360 28586
@@ -28738,9 +28964,11 @@ or call the function `savehist-mode'.")
28738 28964
28739(autoload 'savehist-mode "savehist" "\ 28965(autoload 'savehist-mode "savehist" "\
28740Toggle saving of minibuffer history (Savehist mode). 28966Toggle saving of minibuffer history (Savehist mode).
28741With a prefix argument ARG, enable Savehist mode if ARG is 28967
28742positive, and disable it otherwise. If called from Lisp, enable 28968If called interactively, enable Savehist mode if ARG is positive, and
28743the mode if ARG is omitted or nil. 28969disable it if ARG is zero or negative. If called from Lisp,
28970also enable the mode if ARG is omitted or nil, and toggle it
28971if ARG is `toggle'; disable the mode otherwise.
28744 28972
28745When Savehist mode is enabled, minibuffer history is saved 28973When Savehist mode is enabled, minibuffer history is saved
28746periodically and when exiting Emacs. When Savehist mode is 28974periodically and when exiting Emacs. When Savehist mode is
@@ -28775,6 +29003,11 @@ Non-nil means automatically save place in each file.
28775This means when you visit a file, point goes to the last place 29003This means when you visit a file, point goes to the last place
28776where it was when you previously visited the same file. 29004where it was when you previously visited the same file.
28777 29005
29006If called interactively, enable Save-Place mode if ARG is positive, and
29007disable it if ARG is zero or negative. If called from Lisp,
29008also enable the mode if ARG is omitted or nil, and toggle it
29009if ARG is `toggle'; disable the mode otherwise.
29010
28778\(fn &optional ARG)" t nil) 29011\(fn &optional ARG)" t nil)
28779 29012
28780(autoload 'save-place-local-mode "saveplace" "\ 29013(autoload 'save-place-local-mode "saveplace" "\
@@ -28783,8 +29016,10 @@ If this mode is enabled, point is recorded when you kill the buffer
28783or exit Emacs. Visiting this file again will go to that position, 29016or exit Emacs. Visiting this file again will go to that position,
28784even in a later Emacs session. 29017even in a later Emacs session.
28785 29018
28786If called with a prefix arg, the mode is enabled if and only if 29019If called interactively, enable Save-Place-Local mode if ARG is positive, and
28787the argument is positive. 29020disable it if ARG is zero or negative. If called from Lisp,
29021also enable the mode if ARG is omitted or nil, and toggle it
29022if ARG is `toggle'; disable the mode otherwise.
28788 29023
28789To save places automatically in all files, put this in your init 29024To save places automatically in all files, put this in your init
28790file: 29025file:
@@ -28875,9 +29110,11 @@ or call the function `scroll-all-mode'.")
28875 29110
28876(autoload 'scroll-all-mode "scroll-all" "\ 29111(autoload 'scroll-all-mode "scroll-all" "\
28877Toggle shared scrolling in same-frame windows (Scroll-All mode). 29112Toggle shared scrolling in same-frame windows (Scroll-All mode).
28878With a prefix argument ARG, enable Scroll-All mode if ARG is 29113
28879positive, and disable it otherwise. If called from Lisp, enable 29114If called interactively, enable Scroll-All mode if ARG is positive, and
28880the mode if ARG is omitted or nil. 29115disable it if ARG is zero or negative. If called from Lisp,
29116also enable the mode if ARG is omitted or nil, and toggle it
29117if ARG is `toggle'; disable the mode otherwise.
28881 29118
28882When Scroll-All mode is enabled, scrolling commands invoked in 29119When Scroll-All mode is enabled, scrolling commands invoked in
28883one window apply to all visible windows in the same frame. 29120one window apply to all visible windows in the same frame.
@@ -28900,12 +29137,16 @@ one window apply to all visible windows in the same frame.
28900 29137
28901(autoload 'scroll-lock-mode "scroll-lock" "\ 29138(autoload 'scroll-lock-mode "scroll-lock" "\
28902Buffer-local minor mode for pager-like scrolling. 29139Buffer-local minor mode for pager-like scrolling.
28903With a prefix argument ARG, enable the mode if ARG is positive, 29140
28904and disable it otherwise. If called from Lisp, enable the mode 29141If called interactively, enable Scroll-Lock mode if ARG is positive, and
28905if ARG is omitted or nil. When enabled, keys that normally move 29142disable it if ARG is zero or negative. If called from Lisp,
28906point by line or paragraph will scroll the buffer by the 29143also enable the mode if ARG is omitted or nil, and toggle it
28907respective amount of lines instead and point will be kept 29144if ARG is `toggle'; disable the mode otherwise.
28908vertically fixed relative to window boundaries during scrolling. 29145
29146When enabled, keys that normally move point by line or paragraph
29147will scroll the buffer by the respective amount of lines instead
29148and point will be kept vertically fixed relative to window
29149boundaries during scrolling.
28909 29150
28910\(fn &optional ARG)" t nil) 29151\(fn &optional ARG)" t nil)
28911 29152
@@ -28964,9 +29205,11 @@ or call the function `semantic-mode'.")
28964 29205
28965(autoload 'semantic-mode "semantic" "\ 29206(autoload 'semantic-mode "semantic" "\
28966Toggle parser features (Semantic mode). 29207Toggle parser features (Semantic mode).
28967With a prefix argument ARG, enable Semantic mode if ARG is 29208
28968positive, and disable it otherwise. If called from Lisp, enable 29209If called interactively, enable Semantic mode if ARG is positive, and
28969Semantic mode if ARG is omitted or nil. 29210disable it if ARG is zero or negative. If called from Lisp,
29211also enable the mode if ARG is omitted or nil, and toggle it
29212if ARG is `toggle'; disable the mode otherwise.
28970 29213
28971In Semantic mode, Emacs parses the buffers you visit for their 29214In Semantic mode, Emacs parses the buffers you visit for their
28972semantic content. This information is used by a variety of 29215semantic content. This information is used by a variety of
@@ -29925,9 +30168,11 @@ or call the function `server-mode'.")
29925 30168
29926(autoload 'server-mode "server" "\ 30169(autoload 'server-mode "server" "\
29927Toggle Server mode. 30170Toggle Server mode.
29928With a prefix argument ARG, enable Server mode if ARG is 30171
29929positive, and disable it otherwise. If called from Lisp, enable 30172If called interactively, enable Server mode if ARG is positive, and
29930Server mode if ARG is omitted or nil. 30173disable it if ARG is zero or negative. If called from Lisp,
30174also enable the mode if ARG is omitted or nil, and toggle it
30175if ARG is `toggle'; disable the mode otherwise.
29931 30176
29932Server mode runs a process that accepts commands from the 30177Server mode runs a process that accepts commands from the
29933`emacsclient' program. See Info node `Emacs server' and 30178`emacsclient' program. See Info node `Emacs server' and
@@ -30550,9 +30795,12 @@ buffer names.
30550 30795
30551(autoload 'smerge-mode "smerge-mode" "\ 30796(autoload 'smerge-mode "smerge-mode" "\
30552Minor mode to simplify editing output from the diff3 program. 30797Minor mode to simplify editing output from the diff3 program.
30553With a prefix argument ARG, enable the mode if ARG is positive, 30798
30554and disable it otherwise. If called from Lisp, enable the mode 30799If called interactively, enable Smerge mode if ARG is positive, and
30555if ARG is omitted or nil. 30800disable it if ARG is zero or negative. If called from Lisp,
30801also enable the mode if ARG is omitted or nil, and toggle it
30802if ARG is `toggle'; disable the mode otherwise.
30803
30556\\{smerge-mode-map} 30804\\{smerge-mode-map}
30557 30805
30558\(fn &optional ARG)" t nil) 30806\(fn &optional ARG)" t nil)
@@ -31865,9 +32113,11 @@ or call the function `strokes-mode'.")
31865 32113
31866(autoload 'strokes-mode "strokes" "\ 32114(autoload 'strokes-mode "strokes" "\
31867Toggle Strokes mode, a global minor mode. 32115Toggle Strokes mode, a global minor mode.
31868With a prefix argument ARG, enable Strokes mode if ARG is 32116
31869positive, and disable it otherwise. If called from Lisp, 32117If called interactively, enable Strokes mode if ARG is positive, and
31870enable the mode if ARG is omitted or nil. 32118disable it if ARG is zero or negative. If called from Lisp,
32119also enable the mode if ARG is omitted or nil, and toggle it
32120if ARG is `toggle'; disable the mode otherwise.
31871 32121
31872\\<strokes-mode-map> 32122\\<strokes-mode-map>
31873Strokes are pictographic mouse gestures which invoke commands. 32123Strokes are pictographic mouse gestures which invoke commands.
@@ -31934,9 +32184,11 @@ Studlify-case the current buffer.
31934 32184
31935(autoload 'subword-mode "subword" "\ 32185(autoload 'subword-mode "subword" "\
31936Toggle subword movement and editing (Subword mode). 32186Toggle subword movement and editing (Subword mode).
31937With a prefix argument ARG, enable Subword mode if ARG is 32187
31938positive, and disable it otherwise. If called from Lisp, enable 32188If called interactively, enable Subword mode if ARG is positive, and
31939the mode if ARG is omitted or nil. 32189disable it if ARG is zero or negative. If called from Lisp,
32190also enable the mode if ARG is omitted or nil, and toggle it
32191if ARG is `toggle'; disable the mode otherwise.
31940 32192
31941Subword mode is a buffer-local minor mode. Enabling it changes 32193Subword mode is a buffer-local minor mode. Enabling it changes
31942the definition of a word so that word-based commands stop inside 32194the definition of a word so that word-based commands stop inside
@@ -31956,8 +32208,6 @@ called a `subword'. Here are some examples:
31956This mode changes the definition of a word so that word commands 32208This mode changes the definition of a word so that word commands
31957treat nomenclature boundaries as word boundaries. 32209treat nomenclature boundaries as word boundaries.
31958 32210
31959\\{subword-mode-map}
31960
31961\(fn &optional ARG)" t nil) 32211\(fn &optional ARG)" t nil)
31962 32212
31963(defvar global-subword-mode nil "\ 32213(defvar global-subword-mode nil "\
@@ -31984,9 +32234,11 @@ See `subword-mode' for more information on Subword mode.
31984 32234
31985(autoload 'superword-mode "subword" "\ 32235(autoload 'superword-mode "subword" "\
31986Toggle superword movement and editing (Superword mode). 32236Toggle superword movement and editing (Superword mode).
31987With a prefix argument ARG, enable Superword mode if ARG is 32237
31988positive, and disable it otherwise. If called from Lisp, enable 32238If called interactively, enable Superword mode if ARG is positive, and
31989the mode if ARG is omitted or nil. 32239disable it if ARG is zero or negative. If called from Lisp,
32240also enable the mode if ARG is omitted or nil, and toggle it
32241if ARG is `toggle'; disable the mode otherwise.
31990 32242
31991Superword mode is a buffer-local minor mode. Enabling it changes 32243Superword mode is a buffer-local minor mode. Enabling it changes
31992the definition of words such that symbols characters are treated 32244the definition of words such that symbols characters are treated
@@ -32081,9 +32333,11 @@ or call the function `gpm-mouse-mode'.")
32081 32333
32082(autoload 'gpm-mouse-mode "t-mouse" "\ 32334(autoload 'gpm-mouse-mode "t-mouse" "\
32083Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). 32335Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
32084With a prefix argument ARG, enable GPM Mouse mode if ARG is 32336
32085positive, and disable it otherwise. If called from Lisp, enable 32337If called interactively, enable Gpm-Mouse mode if ARG is positive, and
32086the mode if ARG is omitted or nil. 32338disable it if ARG is zero or negative. If called from Lisp,
32339also enable the mode if ARG is omitted or nil, and toggle it
32340if ARG is `toggle'; disable the mode otherwise.
32087 32341
32088This allows the use of the mouse when operating on a GNU/Linux console, 32342This allows the use of the mouse when operating on a GNU/Linux console,
32089in the same way as you can use the mouse under X11. 32343in the same way as you can use the mouse under X11.
@@ -32481,6 +32735,11 @@ location is indicated by `table-word-continuation-char'. This
32481variable's value can be toggled by \\[table-fixed-width-mode] at 32735variable's value can be toggled by \\[table-fixed-width-mode] at
32482run-time. 32736run-time.
32483 32737
32738If called interactively, enable Table-Fixed-Width mode if ARG is positive, and
32739disable it if ARG is zero or negative. If called from Lisp,
32740also enable the mode if ARG is omitted or nil, and toggle it
32741if ARG is `toggle'; disable the mode otherwise.
32742
32484\(fn &optional ARG)" t nil) 32743\(fn &optional ARG)" t nil)
32485 32744
32486(autoload 'table-query-dimension "table" "\ 32745(autoload 'table-query-dimension "table" "\
@@ -33667,6 +33926,11 @@ This function is meant to be used as a `post-self-insert-hook'.
33667(autoload 'tildify-mode "tildify" "\ 33926(autoload 'tildify-mode "tildify" "\
33668Adds electric behavior to space character. 33927Adds electric behavior to space character.
33669 33928
33929If called interactively, enable Tildify mode if ARG is positive, and
33930disable it if ARG is zero or negative. If called from Lisp,
33931also enable the mode if ARG is omitted or nil, and toggle it
33932if ARG is `toggle'; disable the mode otherwise.
33933
33670When space is inserted into a buffer in a position where hard space is required 33934When space is inserted into a buffer in a position where hard space is required
33671instead (determined by `tildify-space-pattern' and `tildify-space-predicates'), 33935instead (determined by `tildify-space-pattern' and `tildify-space-predicates'),
33672that space character is replaced by a hard space specified by 33936that space character is replaced by a hard space specified by
@@ -33712,9 +33976,11 @@ or call the function `display-time-mode'.")
33712 33976
33713(autoload 'display-time-mode "time" "\ 33977(autoload 'display-time-mode "time" "\
33714Toggle display of time, load level, and mail flag in mode lines. 33978Toggle display of time, load level, and mail flag in mode lines.
33715With a prefix argument ARG, enable Display Time mode if ARG is 33979
33716positive, and disable it otherwise. If called from Lisp, enable 33980If called interactively, enable Display-Time mode if ARG is positive, and
33717it if ARG is omitted or nil. 33981disable it if ARG is zero or negative. If called from Lisp,
33982also enable the mode if ARG is omitted or nil, and toggle it
33983if ARG is `toggle'; disable the mode otherwise.
33718 33984
33719When Display Time mode is enabled, it updates every minute (you 33985When Display Time mode is enabled, it updates every minute (you
33720can control the number of seconds between updates by customizing 33986can control the number of seconds between updates by customizing
@@ -34571,6 +34837,11 @@ or call the function `type-break-mode'.")
34571Enable or disable typing-break mode. 34837Enable or disable typing-break mode.
34572This is a minor mode, but it is global to all buffers by default. 34838This is a minor mode, but it is global to all buffers by default.
34573 34839
34840If called interactively, enable Type-Break mode if ARG is positive, and
34841disable it if ARG is zero or negative. If called from Lisp,
34842also enable the mode if ARG is omitted or nil, and toggle it
34843if ARG is `toggle'; disable the mode otherwise.
34844
34574When this mode is enabled, the user is encouraged to take typing breaks at 34845When this mode is enabled, the user is encouraged to take typing breaks at
34575appropriate intervals; either after a specified amount of time or when the 34846appropriate intervals; either after a specified amount of time or when the
34576user has exceeded a keystroke threshold. When the time arrives, the user 34847user has exceeded a keystroke threshold. When the time arrives, the user
@@ -34579,9 +34850,6 @@ again in a short period of time. The idea is to give the user enough time
34579to find a good breaking point in his or her work, but be sufficiently 34850to find a good breaking point in his or her work, but be sufficiently
34580annoying to discourage putting typing breaks off indefinitely. 34851annoying to discourage putting typing breaks off indefinitely.
34581 34852
34582A negative prefix argument disables this mode.
34583No argument or any non-negative argument enables it.
34584
34585The user may enable or disable this mode by setting the variable of the 34853The user may enable or disable this mode by setting the variable of the
34586same name, though setting it in that way doesn't reschedule a break or 34854same name, though setting it in that way doesn't reschedule a break or
34587reset the keystroke counter. 34855reset the keystroke counter.
@@ -35105,9 +35373,11 @@ or call the function `url-handler-mode'.")
35105 35373
35106(autoload 'url-handler-mode "url-handlers" "\ 35374(autoload 'url-handler-mode "url-handlers" "\
35107Toggle using `url' library for URL filenames (URL Handler mode). 35375Toggle using `url' library for URL filenames (URL Handler mode).
35108With a prefix argument ARG, enable URL Handler mode if ARG is 35376
35109positive, and disable it otherwise. If called from Lisp, enable 35377If called interactively, enable Url-Handler mode if ARG is positive, and
35110the mode if ARG is omitted or nil. 35378disable it if ARG is zero or negative. If called from Lisp,
35379also enable the mode if ARG is omitted or nil, and toggle it
35380if ARG is `toggle'; disable the mode otherwise.
35111 35381
35112\(fn &optional ARG)" t nil) 35382\(fn &optional ARG)" t nil)
35113 35383
@@ -37252,9 +37522,11 @@ own View-like bindings.
37252 37522
37253(autoload 'view-mode "view" "\ 37523(autoload 'view-mode "view" "\
37254Toggle View mode, a minor mode for viewing text but not editing it. 37524Toggle View mode, a minor mode for viewing text but not editing it.
37255With a prefix argument ARG, enable View mode if ARG is positive, 37525
37256and disable it otherwise. If called from Lisp, enable View mode 37526If called interactively, enable View mode if ARG is positive, and
37257if ARG is omitted or nil. 37527disable it if ARG is zero or negative. If called from Lisp,
37528also enable the mode if ARG is omitted or nil, and toggle it
37529if ARG is `toggle'; disable the mode otherwise.
37258 37530
37259When View mode is enabled, commands that do not change the buffer 37531When View mode is enabled, commands that do not change the buffer
37260contents are available as usual. Kill commands insert text in 37532contents are available as usual. Kill commands insert text in
@@ -37628,9 +37900,11 @@ or call the function `which-function-mode'.")
37628 37900
37629(autoload 'which-function-mode "which-func" "\ 37901(autoload 'which-function-mode "which-func" "\
37630Toggle mode line display of current function (Which Function mode). 37902Toggle mode line display of current function (Which Function mode).
37631With a prefix argument ARG, enable Which Function mode if ARG is 37903
37632positive, and disable it otherwise. If called from Lisp, enable 37904If called interactively, enable Which-Function mode if ARG is positive, and
37633the mode if ARG is omitted or nil. 37905disable it if ARG is zero or negative. If called from Lisp,
37906also enable the mode if ARG is omitted or nil, and toggle it
37907if ARG is `toggle'; disable the mode otherwise.
37634 37908
37635Which Function mode is a global minor mode. When enabled, the 37909Which Function mode is a global minor mode. When enabled, the
37636current function name is continuously displayed in the mode line, 37910current function name is continuously displayed in the mode line,
@@ -37648,11 +37922,11 @@ in certain major modes.
37648 37922
37649(autoload 'whitespace-mode "whitespace" "\ 37923(autoload 'whitespace-mode "whitespace" "\
37650Toggle whitespace visualization (Whitespace mode). 37924Toggle whitespace visualization (Whitespace mode).
37651With a prefix argument ARG, enable Whitespace mode if ARG is
37652positive, and disable it otherwise.
37653 37925
37654If called from Lisp, also enables the mode if ARG is omitted or nil, 37926If called interactively, enable Whitespace mode if ARG is positive, and
37655and toggles it if ARG is `toggle'. 37927disable it if ARG is zero or negative. If called from Lisp,
37928also enable the mode if ARG is omitted or nil, and toggle it
37929if ARG is `toggle'; disable the mode otherwise.
37656 37930
37657See also `whitespace-style', `whitespace-newline' and 37931See also `whitespace-style', `whitespace-newline' and
37658`whitespace-display-mappings'. 37932`whitespace-display-mappings'.
@@ -37661,11 +37935,11 @@ See also `whitespace-style', `whitespace-newline' and
37661 37935
37662(autoload 'whitespace-newline-mode "whitespace" "\ 37936(autoload 'whitespace-newline-mode "whitespace" "\
37663Toggle newline visualization (Whitespace Newline mode). 37937Toggle newline visualization (Whitespace Newline mode).
37664With a prefix argument ARG, enable Whitespace Newline mode if ARG
37665is positive, and disable it otherwise.
37666 37938
37667If called from Lisp, also enables the mode if ARG is omitted or nil, 37939If called interactively, enable Whitespace-Newline mode if ARG is positive, and
37668and toggles it if ARG is `toggle'. 37940disable it if ARG is zero or negative. If called from Lisp,
37941also enable the mode if ARG is omitted or nil, and toggle it
37942if ARG is `toggle'; disable the mode otherwise.
37669 37943
37670Use `whitespace-newline-mode' only for NEWLINE visualization 37944Use `whitespace-newline-mode' only for NEWLINE visualization
37671exclusively. For other visualizations, including NEWLINE 37945exclusively. For other visualizations, including NEWLINE
@@ -37688,11 +37962,11 @@ or call the function `global-whitespace-mode'.")
37688 37962
37689(autoload 'global-whitespace-mode "whitespace" "\ 37963(autoload 'global-whitespace-mode "whitespace" "\
37690Toggle whitespace visualization globally (Global Whitespace mode). 37964Toggle whitespace visualization globally (Global Whitespace mode).
37691With a prefix argument ARG, enable Global Whitespace mode if ARG
37692is positive, and disable it otherwise.
37693 37965
37694If called from Lisp, also enables the mode if ARG is omitted or nil, 37966If called interactively, enable Global Whitespace mode if ARG is positive, and
37695and toggles it if ARG is `toggle'. 37967disable it if ARG is zero or negative. If called from Lisp,
37968also enable the mode if ARG is omitted or nil, and toggle it
37969if ARG is `toggle'; disable the mode otherwise.
37696 37970
37697See also `whitespace-style', `whitespace-newline' and 37971See also `whitespace-style', `whitespace-newline' and
37698`whitespace-display-mappings'. 37972`whitespace-display-mappings'.
@@ -37711,11 +37985,11 @@ or call the function `global-whitespace-newline-mode'.")
37711 37985
37712(autoload 'global-whitespace-newline-mode "whitespace" "\ 37986(autoload 'global-whitespace-newline-mode "whitespace" "\
37713Toggle global newline visualization (Global Whitespace Newline mode). 37987Toggle global newline visualization (Global Whitespace Newline mode).
37714With a prefix argument ARG, enable Global Whitespace Newline mode
37715if ARG is positive, and disable it otherwise.
37716 37988
37717If called from Lisp, also enables the mode if ARG is omitted or nil, 37989If called interactively, enable Global Whitespace-Newline mode if ARG is positive, and
37718and toggles it if ARG is `toggle'. 37990disable it if ARG is zero or negative. If called from Lisp,
37991also enable the mode if ARG is omitted or nil, and toggle it
37992if ARG is `toggle'; disable the mode otherwise.
37719 37993
37720Use `global-whitespace-newline-mode' only for NEWLINE 37994Use `global-whitespace-newline-mode' only for NEWLINE
37721visualization exclusively. For other visualizations, including 37995visualization exclusively. For other visualizations, including
@@ -38037,9 +38311,11 @@ Show widget browser for WIDGET in other window.
38037 38311
38038(autoload 'widget-minor-mode "wid-browse" "\ 38312(autoload 'widget-minor-mode "wid-browse" "\
38039Minor mode for traversing widgets. 38313Minor mode for traversing widgets.
38040With a prefix argument ARG, enable the mode if ARG is positive, 38314
38041and disable it otherwise. If called from Lisp, enable the mode 38315If called interactively, enable Widget minor mode if ARG is positive, and
38042if ARG is omitted or nil. 38316disable it if ARG is zero or negative. If called from Lisp,
38317also enable the mode if ARG is omitted or nil, and toggle it
38318if ARG is `toggle'; disable the mode otherwise.
38043 38319
38044\(fn &optional ARG)" t nil) 38320\(fn &optional ARG)" t nil)
38045 38321
@@ -38161,9 +38437,11 @@ or call the function `winner-mode'.")
38161 38437
38162(autoload 'winner-mode "winner" "\ 38438(autoload 'winner-mode "winner" "\
38163Toggle Winner mode on or off. 38439Toggle Winner mode on or off.
38164With a prefix argument ARG, enable Winner mode if ARG is 38440
38165positive, and disable it otherwise. If called from Lisp, enable 38441If called interactively, enable Winner mode if ARG is positive, and
38166the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. 38442disable it if ARG is zero or negative. If called from Lisp,
38443also enable the mode if ARG is omitted or nil, and toggle it
38444if ARG is `toggle'; disable the mode otherwise.
38167 38445
38168Winner mode is a global minor mode that records the changes in 38446Winner mode is a global minor mode that records the changes in
38169the window configuration (i.e. how the frames are partitioned 38447the window configuration (i.e. how the frames are partitioned
@@ -38373,6 +38651,12 @@ With prefix argument, prompt for the identifier.
38373 38651
38374\(fn IDENTIFIER)" t nil) 38652\(fn IDENTIFIER)" t nil)
38375 38653
38654(autoload 'xref-find-definitions-at-mouse "xref" "\
38655Find the definition of identifier at or around mouse click.
38656This command is intended to be bound to a mouse event.
38657
38658\(fn EVENT)" t nil)
38659
38376(autoload 'xref-find-apropos "xref" "\ 38660(autoload 'xref-find-apropos "xref" "\
38377Find all meaningful symbols that match PATTERN. 38661Find all meaningful symbols that match PATTERN.
38378The argument has the same meaning as in `apropos'. 38662The argument has the same meaning as in `apropos'.
@@ -38425,9 +38709,11 @@ or call the function `xterm-mouse-mode'.")
38425 38709
38426(autoload 'xterm-mouse-mode "xt-mouse" "\ 38710(autoload 'xterm-mouse-mode "xt-mouse" "\
38427Toggle XTerm mouse mode. 38711Toggle XTerm mouse mode.
38428With a prefix argument ARG, enable XTerm mouse mode if ARG is 38712
38429positive, and disable it otherwise. If called from Lisp, enable 38713If called interactively, enable Xterm-Mouse mode if ARG is positive, and
38430the mode if ARG is omitted or nil. 38714disable it if ARG is zero or negative. If called from Lisp,
38715also enable the mode if ARG is omitted or nil, and toggle it
38716if ARG is `toggle'; disable the mode otherwise.
38431 38717
38432Turn it on to use Emacs mouse commands, and off to use xterm mouse commands. 38718Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
38433This works in terminal emulators compatible with xterm. It only 38719This works in terminal emulators compatible with xterm. It only
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 2b49fae2a6d..5c474b4b90c 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -77,6 +77,14 @@ Default is \"components\".
77If not an absolute file name, the file is searched for first in the 77If not an absolute file name, the file is searched for first in the
78user's MH directory, then in the system MH lib directory.") 78user's MH directory, then in the system MH lib directory.")
79 79
80(defvar mh-dist-formfile "distcomps"
81 "Name of file to be used as a skeleton for redistributing messages.
82
83Default is \"distcomps\".
84
85If not an absolute file name, the file is searched for first in the
86user's MH directory, then in the system MH lib directory.")
87
80(defvar mh-repl-formfile "replcomps" 88(defvar mh-repl-formfile "replcomps"
81 "Name of file to be used as a skeleton for replying to messages. 89 "Name of file to be used as a skeleton for replying to messages.
82 90
@@ -413,7 +421,7 @@ See also `mh-send'."
413 (interactive (list (mh-get-msg-num t))) 421 (interactive (list (mh-get-msg-num t)))
414 (let* ((from-folder mh-current-folder) 422 (let* ((from-folder mh-current-folder)
415 (config (current-window-configuration)) 423 (config (current-window-configuration))
416 (components-file (mh-bare-components)) 424 (components-file (mh-bare-components mh-comp-formfile))
417 (draft 425 (draft
418 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) 426 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
419 (pop-to-buffer (find-file-noselect (mh-msg-filename message)) 427 (pop-to-buffer (find-file-noselect (mh-msg-filename message))
@@ -649,15 +657,16 @@ Original message has headers FROM and SUBJECT."
649 (format mh-forward-subject-format from subject)) 657 (format mh-forward-subject-format from subject))
650 658
651;;;###mh-autoload 659;;;###mh-autoload
652(defun mh-redistribute (to cc &optional message) 660(defun mh-redistribute (to cc identity &optional message)
653 "Redistribute a message. 661 "Redistribute a message.
654 662
655This command is similar in function to forwarding mail, but it 663This command is similar in function to forwarding mail, but it
656does not allow you to edit the message, nor does it add your name 664does not allow you to edit the message, nor does it add your name
657to the \"From\" header field. It appears to the recipient as if 665to the \"From\" header field. It appears to the recipient as if
658the message had come from the original sender. When you run this 666the message had come from the original sender. When you run this
659command, you are prompted for the TO and CC recipients. The 667command, you are prompted for the TO and CC recipients. You are
660default MESSAGE is the current message. 668also prompted for the sending IDENTITY to use. The default
669MESSAGE is the current message.
661 670
662Also investigate the command \\[mh-edit-again] for another way to 671Also investigate the command \\[mh-edit-again] for another way to
663redistribute messages. 672redistribute messages.
@@ -668,6 +677,9 @@ The hook `mh-annotate-msg-hook' is run after annotating the
668message and scan line." 677message and scan line."
669 (interactive (list (mh-read-address "Redist-To: ") 678 (interactive (list (mh-read-address "Redist-To: ")
670 (mh-read-address "Redist-Cc: ") 679 (mh-read-address "Redist-Cc: ")
680 (if mh-identity-list
681 (mh-select-identity mh-identity-default)
682 nil)
671 (mh-get-msg-num t))) 683 (mh-get-msg-num t)))
672 (or message 684 (or message
673 (setq message (mh-get-msg-num t))) 685 (setq message (mh-get-msg-num t)))
@@ -677,14 +689,51 @@ message and scan line."
677 (if mh-redist-full-contents-flag 689 (if mh-redist-full-contents-flag
678 (mh-msg-filename message) 690 (mh-msg-filename message)
679 nil) 691 nil)
680 nil))) 692 nil))
681 (mh-goto-header-end 0) 693 (from (mh-identity-field identity "From"))
682 (insert "Resent-To: " to "\n") 694 (fcc (mh-identity-field identity "Fcc"))
683 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) 695 (bcc (mh-identity-field identity "Bcc"))
684 (mh-clean-msg-header 696 comp-fcc comp-to comp-cc comp-bcc)
685 (point-min) 697 (if mh-redist-full-contents-flag
686 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" 698 (mh-clean-msg-header
687 nil) 699 (point-min)
700 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Date:\\|^Resent-.*:"
701 nil))
702 ;; Read fields from the distcomps file and put them in our
703 ;; draft. For "To", "Cc", "Bcc", and "Fcc", multiple headers are
704 ;; combined into a single header with comma-separated entries.
705 ;; For "From", the first value wins, with the identity's "From"
706 ;; trumping anything in the distcomps file.
707 (let ((components-file (mh-bare-components mh-dist-formfile)))
708 (mh-mapc
709 (function
710 (lambda (header-field)
711 (let ((field (car header-field))
712 (value (cdr header-field))
713 (case-fold-search t))
714 (cond
715 ((string-match field "^Resent-Fcc$")
716 (setq comp-fcc value))
717 ((string-match field "^Resent-From$")
718 (or from
719 (setq from value)))
720 ((string-match field "^Resent-To$")
721 (setq comp-to value))
722 ((string-match field "^Resent-Cc$")
723 (setq comp-cc value))
724 ((string-match field "^Resent-Bcc$")
725 (setq comp-bcc value))
726 ((string-match field "^Resent-.*$")
727 (mh-insert-fields field value))))))
728 (mh-components-to-list components-file))
729 (delete-file components-file))
730 (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ")
731 "Resent-Cc:" (mapconcat 'identity (list cc comp-cc) ", ")
732 "Resent-Fcc:" (mapconcat 'identity (list fcc
733 comp-fcc) ", ")
734 "Resent-Bcc:" (mapconcat 'identity (list bcc
735 comp-bcc) ", ")
736 "Resent-From:" from)
688 (save-buffer) 737 (save-buffer)
689 (message "Redistributing...") 738 (message "Redistributing...")
690 (let ((env "mhdist=1")) 739 (let ((env "mhdist=1"))
@@ -702,7 +751,8 @@ message and scan line."
702 ;; Annotate... 751 ;; Annotate...
703 (mh-annotate-msg message folder mh-note-dist 752 (mh-annotate-msg message folder mh-note-dist
704 "-component" "Resent:" 753 "-component" "Resent:"
705 "-text" (format "\"%s %s\"" to cc))) 754 "-text" (format "\"To: %s Cc: %s From: %s\""
755 to cc from)))
706 (kill-buffer draft) 756 (kill-buffer draft)
707 (message "Redistributing...done")))) 757 (message "Redistributing...done"))))
708 758
@@ -898,7 +948,7 @@ CONFIG is the window configuration before sending mail."
898 (message "Composing a message...") 948 (message "Composing a message...")
899 (let ((draft (mh-read-draft 949 (let ((draft (mh-read-draft
900 "message" 950 "message"
901 (mh-bare-components) 951 (mh-bare-components mh-comp-formfile)
902 t))) 952 t)))
903 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) 953 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
904 (goto-char (point-max)) 954 (goto-char (point-max))
@@ -908,23 +958,25 @@ CONFIG is the window configuration before sending mail."
908 (mh-letter-mode-message) 958 (mh-letter-mode-message)
909 (mh-letter-adjust-point)))) 959 (mh-letter-adjust-point))))
910 960
911(defun mh-bare-components () 961(defun mh-bare-components (formfile)
912 "Generate a temporary, clean components file and return its path." 962 "Generate a temporary, clean components file from FORMFILE.
913 ;; Let comp(1) create the skeleton for us. This is particularly 963Return the path to the temporary file."
964 ;; Let comp(1) create the skeleton for us. This is particularly
914 ;; important with nmh-1.5, because its default "components" needs 965 ;; important with nmh-1.5, because its default "components" needs
915 ;; some processing before it can be used. Unfortunately, comp(1) 966 ;; some processing before it can be used. Unfortunately, comp(1)
916 ;; doesn't have a -build option. So, to avoid the possibility of 967 ;; didn't have a -build option until later versions of nmh. So, to
917 ;; clobbering an existing draft, create a temporary directory and 968 ;; avoid the possibility of clobbering an existing draft, create
918 ;; use it as the drafts folder. Then copy the skeleton to a regular 969 ;; a temporary directory and use it as the drafts folder. Then
919 ;; temp file, and return the regular temp file. 970 ;; copy the skeleton to a regular temp file, and return the
971 ;; regular temp file.
920 (let (new 972 (let (new
921 (temp-folder (make-temp-file 973 (temp-folder (make-temp-file
922 (concat mh-user-path "draftfolder.") t))) 974 (concat mh-user-path "draftfolder.") t)))
923 (mh-exec-cmd "comp" "-nowhatnowproc" 975 (mh-exec-cmd "comp" "-nowhatnowproc"
924 "-draftfolder" (format "+%s" 976 "-draftfolder" (format "+%s"
925 (file-name-nondirectory temp-folder)) 977 (file-name-nondirectory temp-folder))
926 (if (stringp mh-comp-formfile) 978 (if (stringp formfile)
927 (list "-form" mh-comp-formfile))) 979 (list "-form" formfile)))
928 (setq new (make-temp-file "comp.")) 980 (setq new (make-temp-file "comp."))
929 (rename-file (concat temp-folder "/" "1") new t) 981 (rename-file (concat temp-folder "/" "1") new t)
930 ;; The temp folder could contain various metadata files. Rather 982 ;; The temp folder could contain various metadata files. Rather
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 661d0ec7569..3574f8c801d 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -357,6 +357,8 @@ Arguments are IGNORED (for `revert-buffer')."
357 (yes-or-no-p "Undo all commands in folder? ")) 357 (yes-or-no-p "Undo all commands in folder? "))
358 (setq mh-delete-list nil 358 (setq mh-delete-list nil
359 mh-refile-list nil 359 mh-refile-list nil
360 mh-blacklist nil
361 mh-whitelist nil
360 mh-seq-list nil 362 mh-seq-list nil
361 mh-next-direction 'forward) 363 mh-next-direction 'forward)
362 (with-mh-folder-updating (nil) 364 (with-mh-folder-updating (nil)
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index fd7c2b83fe7..a1eb22ff18e 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -132,6 +132,33 @@ valid header field."
132 'mh-identity-handler-default)) 132 'mh-identity-handler-default))
133 133
134;;;###mh-autoload 134;;;###mh-autoload
135(defun mh-select-identity (default)
136 "Prompt for and return an identity.
137If DEFAULT is non-nil, it will be used if the user doesn't enter a
138different identity.
139
140See `mh-identity-list'."
141 (let (identity)
142 (setq identity
143 (completing-read
144 "Identity: "
145 (cons '("None")
146 (mapcar 'list (mapcar 'car mh-identity-list)))
147 nil t default nil default))
148 (if (eq identity "None")
149 nil
150 identity)))
151
152;;;###mh-autoload
153(defun mh-identity-field (identity field)
154 "Return the specified FIELD of the given IDENTITY.
155
156See `mh-identity-list'."
157 (let* ((pers-list (cadr (assoc identity mh-identity-list)))
158 (value (cdr (assoc field pers-list))))
159 value))
160
161;;;###mh-autoload
135(defun mh-insert-identity (identity &optional maybe-insert) 162(defun mh-insert-identity (identity &optional maybe-insert)
136 "Insert fields specified by given IDENTITY. 163 "Insert fields specified by given IDENTITY.
137 164
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 5b63e0c34df..108e368373f 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -583,7 +583,7 @@ If ARG is non-nil, instead prompt for connection parameters."
583 583
584 (setq-local rcirc-connection-info 584 (setq-local rcirc-connection-info
585 (list server port nick user-name full-name startup-channels 585 (list server port nick user-name full-name startup-channels
586 password encryption)) 586 password encryption server-alias))
587 (setq-local rcirc-process process) 587 (setq-local rcirc-process process)
588 (setq-local rcirc-server server) 588 (setq-local rcirc-server server)
589 (setq-local rcirc-server-name 589 (setq-local rcirc-server-name
diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el
index 3bfc4d7f356..015e04f4075 100644
--- a/lisp/net/rlogin.el
+++ b/lisp/net/rlogin.el
@@ -1,4 +1,4 @@
1;;; rlogin.el --- remote login interface 1;;; rlogin.el --- remote login interface -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1992-1995, 1997-1998, 2001-2018 Free Software 3;; Copyright (C) 1992-1995, 1997-1998, 2001-2018 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -30,9 +30,9 @@
30;; tracking and the sending of some special characters. 30;; tracking and the sending of some special characters.
31 31
32;; If you wish for rlogin mode to prompt you in the minibuffer for 32;; If you wish for rlogin mode to prompt you in the minibuffer for
33;; passwords when a password prompt appears, just enter m-x send-invisible 33;; passwords when a password prompt appears, just enter
34;; and type in your line, or add `comint-watch-for-password-prompt' to 34;; M-x comint-send-invisible and type in your line (or tweak
35;; `comint-output-filter-functions'. 35;; `comint-password-prompt-regexp' to match your password prompt).
36 36
37;;; Code: 37;;; Code:
38 38
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 17f83082f8d..f5de05dc3d7 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -685,14 +685,17 @@ This is a specialization of `soap-decode-type' for
685 (anyType (soap-decode-any-type node)) 685 (anyType (soap-decode-any-type node))
686 (Array (soap-decode-array node)))))) 686 (Array (soap-decode-array node))))))
687 687
688(defun soap-type-of (element) 688(defalias 'soap-type-of
689 "Return the type of ELEMENT." 689 (if (eq 'soap-xs-basic-type (type-of (make-soap-xs-basic-type)))
690 ;; Support Emacs < 26 byte-code running in Emacs >= 26 sessions 690 ;; `type-of' in Emacs ≥ 26 already does what we need.
691 ;; (Bug#31742). 691 #'type-of
692 (let ((type (type-of element))) 692 ;; For Emacs < 26, use our own function.
693 (if (eq type 'vector) 693 (lambda (element)
694 (aref element 0) ; For Emacs 25 and earlier. 694 "Return the type of ELEMENT."
695 type))) 695 (if (vectorp element)
696 (aref element 0) ;Assume this vector is actually a struct!
697 ;; This should never happen.
698 (type-of element)))))
696 699
697;; Register methods for `soap-xs-basic-type' 700;; Register methods for `soap-xs-basic-type'
698(let ((tag (soap-type-of (make-soap-xs-basic-type)))) 701(let ((tag (soap-type-of (make-soap-xs-basic-type))))
@@ -2881,6 +2884,8 @@ reference multiRef parts which are external to RESPONSE-NODE."
2881 2884
2882;;;; SOAP type encoding 2885;;;; SOAP type encoding
2883 2886
2887;; FIXME: Use `cl-defmethod' (but this requires Emacs-25).
2888
2884(defun soap-encode-attributes (value type) 2889(defun soap-encode-attributes (value type)
2885 "Encode XML attributes for VALUE according to TYPE. 2890 "Encode XML attributes for VALUE according to TYPE.
2886This is a generic function which determines the attribute encoder 2891This is a generic function which determines the attribute encoder
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 1f40339c271..84af410de07 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -49,9 +49,9 @@
49 49
50;; The user option `tramp-gvfs-methods' contains the list of supported 50;; The user option `tramp-gvfs-methods' contains the list of supported
51;; connection methods. Per default, these are "afp", "dav", "davs", 51;; connection methods. Per default, these are "afp", "dav", "davs",
52;; "gdrive", "owncloud" and "sftp". 52;; "gdrive", "nextcloud" and "sftp".
53 53
54;; "gdrive" and "owncloud" connection methods require a respective 54;; "gdrive" and "nextcloud" connection methods require a respective
55;; account in GNOME Online Accounts, with enabled "Files" service. 55;; account in GNOME Online Accounts, with enabled "Files" service.
56 56
57;; Other possible connection methods are "ftp", "http", "https" and 57;; Other possible connection methods are "ftp", "http", "https" and
@@ -121,7 +121,7 @@
121 121
122;;;###tramp-autoload 122;;;###tramp-autoload
123(defcustom tramp-gvfs-methods 123(defcustom tramp-gvfs-methods
124 '("afp" "dav" "davs" "gdrive" "owncloud" "sftp") 124 '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp")
125 "List of methods for remote files, accessed with GVFS." 125 "List of methods for remote files, accessed with GVFS."
126 :group 'tramp 126 :group 'tramp
127 :version "27.1" 127 :version "27.1"
@@ -132,11 +132,11 @@
132 (const "gdrive") 132 (const "gdrive")
133 (const "http") 133 (const "http")
134 (const "https") 134 (const "https")
135 (const "owncloud") 135 (const "nextcloud")
136 (const "sftp") 136 (const "sftp")
137 (const "smb")))) 137 (const "smb"))))
138 138
139(defconst tramp-goa-methods '("gdrive" "owncloud") 139(defconst tramp-goa-methods '("gdrive" "nextcloud")
140 "List of methods which require registration at GNOME Online Accounts.") 140 "List of methods which require registration at GNOME Online Accounts.")
141 141
142;; Remove GNOME Online Accounts methods if not supported. 142;; Remove GNOME Online Accounts methods if not supported.
@@ -511,11 +511,11 @@ It has been changed in GVFS 1.14.")
511 ":[[:blank:]]+\\(.*\\)$") 511 ":[[:blank:]]+\\(.*\\)$")
512 "Regexp to parse GVFS file system attributes with `gvfs-info'.") 512 "Regexp to parse GVFS file system attributes with `gvfs-info'.")
513 513
514(defconst tramp-gvfs-owncloud-default-prefix "/remote.php/webdav" 514(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav"
515 "Default prefix for owncloud / nextcloud methods.") 515 "Default prefix for owncloud / nextcloud methods.")
516 516
517(defconst tramp-gvfs-owncloud-default-prefix-regexp 517(defconst tramp-gvfs-nextcloud-default-prefix-regexp
518 (concat (regexp-quote tramp-gvfs-owncloud-default-prefix) "$") 518 (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$")
519 "Regexp of default prefix for owncloud / nextcloud methods.") 519 "Regexp of default prefix for owncloud / nextcloud methods.")
520 520
521 521
@@ -1380,7 +1380,7 @@ file-notify events."
1380 (with-parsed-tramp-file-name filename nil 1380 (with-parsed-tramp-file-name filename nil
1381 (when (string-equal "gdrive" method) 1381 (when (string-equal "gdrive" method)
1382 (setq method "google-drive")) 1382 (setq method "google-drive"))
1383 (when (string-equal "owncloud" method) 1383 (when (string-equal "nextcloud" method)
1384 (setq method "davs" 1384 (setq method "davs"
1385 localname 1385 localname
1386 (concat (tramp-gvfs-get-remote-prefix v) localname))) 1386 (concat (tramp-gvfs-get-remote-prefix v) localname)))
@@ -1543,8 +1543,8 @@ file-notify events."
1543 (setq method "davs")) 1543 (setq method "davs"))
1544 (when (and (string-equal "davs" method) 1544 (when (and (string-equal "davs" method)
1545 (string-match 1545 (string-match
1546 tramp-gvfs-owncloud-default-prefix-regexp prefix)) 1546 tramp-gvfs-nextcloud-default-prefix-regexp prefix))
1547 (setq method "owncloud")) 1547 (setq method "nextcloud"))
1548 (when (string-equal "google-drive" method) 1548 (when (string-equal "google-drive" method)
1549 (setq method "gdrive")) 1549 (setq method "gdrive"))
1550 (when (and (string-equal "http" method) (stringp uri)) 1550 (when (and (string-equal "http" method) (stringp uri))
@@ -1633,8 +1633,8 @@ file-notify events."
1633 (setq method "davs")) 1633 (setq method "davs"))
1634 (when (and (string-equal "davs" method) 1634 (when (and (string-equal "davs" method)
1635 (string-match 1635 (string-match
1636 tramp-gvfs-owncloud-default-prefix-regexp prefix)) 1636 tramp-gvfs-nextcloud-default-prefix-regexp prefix))
1637 (setq method "owncloud")) 1637 (setq method "nextcloud"))
1638 (when (string-equal "google-drive" method) 1638 (when (string-equal "google-drive" method)
1639 (setq method "gdrive")) 1639 (setq method "gdrive"))
1640 (when (and (string-equal "http" method) (stringp uri)) 1640 (when (and (string-equal "http" method) (stringp uri))
@@ -1688,7 +1688,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
1688 (localname (tramp-file-name-unquote-localname vec)) 1688 (localname (tramp-file-name-unquote-localname vec))
1689 (share (when (string-match "^/?\\([^/]+\\)" localname) 1689 (share (when (string-match "^/?\\([^/]+\\)" localname)
1690 (match-string 1 localname))) 1690 (match-string 1 localname)))
1691 (ssl (if (string-match "^davs\\|^owncloud" method) "true" "false")) 1691 (ssl (if (string-match "^davs\\|^nextcloud" method) "true" "false"))
1692 (mount-spec 1692 (mount-spec
1693 `(:array 1693 `(:array
1694 ,@(cond 1694 ,@(cond
@@ -1696,7 +1696,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
1696 (list (tramp-gvfs-mount-spec-entry "type" "smb-share") 1696 (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
1697 (tramp-gvfs-mount-spec-entry "server" host) 1697 (tramp-gvfs-mount-spec-entry "server" host)
1698 (tramp-gvfs-mount-spec-entry "share" share))) 1698 (tramp-gvfs-mount-spec-entry "share" share)))
1699 ((string-match "^dav\\|^owncloud" method) 1699 ((string-match "^dav\\|^nextcloud" method)
1700 (list (tramp-gvfs-mount-spec-entry "type" "dav") 1700 (list (tramp-gvfs-mount-spec-entry "type" "dav")
1701 (tramp-gvfs-mount-spec-entry "host" host) 1701 (tramp-gvfs-mount-spec-entry "host" host)
1702 (tramp-gvfs-mount-spec-entry "ssl" ssl))) 1702 (tramp-gvfs-mount-spec-entry "ssl" ssl)))
@@ -1707,6 +1707,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
1707 ((string-equal "gdrive" method) 1707 ((string-equal "gdrive" method)
1708 (list (tramp-gvfs-mount-spec-entry "type" "google-drive") 1708 (list (tramp-gvfs-mount-spec-entry "type" "google-drive")
1709 (tramp-gvfs-mount-spec-entry "host" host))) 1709 (tramp-gvfs-mount-spec-entry "host" host)))
1710 ((string-equal "nextcloud" method)
1711 (list (tramp-gvfs-mount-spec-entry "type" "owncloud")
1712 (tramp-gvfs-mount-spec-entry "host" host)))
1710 ((string-match "^http" method) 1713 ((string-match "^http" method)
1711 (list (tramp-gvfs-mount-spec-entry "type" "http") 1714 (list (tramp-gvfs-mount-spec-entry "type" "http")
1712 (tramp-gvfs-mount-spec-entry 1715 (tramp-gvfs-mount-spec-entry
@@ -1980,6 +1983,8 @@ VEC is used only for traces."
1980 :port (match-string 3 identity))) 1983 :port (match-string 3 identity)))
1981 (when (string-equal (tramp-goa-name-method key) "google") 1984 (when (string-equal (tramp-goa-name-method key) "google")
1982 (setf (tramp-goa-name-method key) "gdrive")) 1985 (setf (tramp-goa-name-method key) "gdrive"))
1986 (when (string-equal (tramp-goa-name-method key) "owncloud")
1987 (setf (tramp-goa-name-method key) "nextcloud"))
1983 ;; Cache all properties. 1988 ;; Cache all properties.
1984 (dolist (prop (nconc account-properties files-properties)) 1989 (dolist (prop (nconc account-properties files-properties))
1985 (tramp-set-connection-property key (car prop) (cdr prop))) 1990 (tramp-set-connection-property key (car prop) (cdr prop)))
@@ -2086,7 +2091,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
2086;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. 2091;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el.
2087 2092
2088;; * Host name completion for existing mount points (afp-server, 2093;; * Host name completion for existing mount points (afp-server,
2089;; smb-server, google-drive, owncloud) or via smb-network or network. 2094;; smb-server, google-drive, nextcloud) or via smb-network or network.
2090;; 2095;;
2091;; * Check, how two shares of the same SMB server can be mounted in 2096;; * Check, how two shares of the same SMB server can be mounted in
2092;; parallel. 2097;; parallel.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2d253506dde..86e82d40929 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2547,7 +2547,11 @@ The method used must be an out-of-band method."
2547 "Like `make-directory' for Tramp files." 2547 "Like `make-directory' for Tramp files."
2548 (setq dir (expand-file-name dir)) 2548 (setq dir (expand-file-name dir))
2549 (with-parsed-tramp-file-name dir nil 2549 (with-parsed-tramp-file-name dir nil
2550 (tramp-flush-directory-properties v (file-name-directory localname)) 2550 ;; When PARENTS is non-nil, DIR could be a chain of non-existent
2551 ;; directories a/b/c/... Instead of checking, we simply flush the
2552 ;; whole cache.
2553 (tramp-flush-directory-properties
2554 v (if parents "/" (file-name-directory localname)))
2551 (save-excursion 2555 (save-excursion
2552 (tramp-barf-unless-okay 2556 (tramp-barf-unless-okay
2553 v (format "%s %s" 2557 v (format "%s %s"
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d56b09a604d..1af2defd586 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3567,16 +3567,20 @@ support symbolic links."
3567 ;; First, we must replace environment variables. 3567 ;; First, we must replace environment variables.
3568 (setq filename (tramp-replace-environment-variables filename)) 3568 (setq filename (tramp-replace-environment-variables filename))
3569 (with-parsed-tramp-file-name filename nil 3569 (with-parsed-tramp-file-name filename nil
3570 ;; We do not want to replace environment variables, again. 3570 ;; We do not want to replace environment variables, again. "//"
3571 ;; has a special meaning at the beginning of a file name on
3572 ;; Cygwin and MS-Windows, we must remove it.
3571 (let (process-environment) 3573 (let (process-environment)
3572 ;; Ignore in LOCALNAME everything before "//" or "/~". 3574 ;; Ignore in LOCALNAME everything before "//" or "/~".
3573 (when (stringp localname) 3575 (when (stringp localname)
3574 (if (string-match "//\\(/\\|~\\)" localname) 3576 (if (string-match "//\\(/\\|~\\)" localname)
3575 (setq filename (substitute-in-file-name localname)) 3577 (setq filename
3578 (replace-regexp-in-string
3579 "\\`/+" "/" (substitute-in-file-name localname)))
3576 (setq filename 3580 (setq filename
3577 (concat (file-remote-p filename) 3581 (concat (file-remote-p filename)
3578 (tramp-run-real-handler 3582 (replace-regexp-in-string
3579 'substitute-in-file-name (list localname))))))) 3583 "\\`/+" "/" (substitute-in-file-name localname)))))))
3580 ;; "/m:h:~" does not work for completion. We use "/m:h:~/". 3584 ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
3581 (if (and (stringp localname) (string-equal "~" localname)) 3585 (if (and (stringp localname) (string-equal "~" localname))
3582 (concat filename "/") 3586 (concat filename "/")
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 0b83afcc590..9bc8768384e 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -69,7 +69,7 @@
69 ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") 69 ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5")
70 ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") 70 ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2")
71 ("2.2.13.25.2" . "25.3") 71 ("2.2.13.25.2" . "25.3")
72 ("2.3.3.26.1" . "26.1"))) 72 ("2.3.3.26.1" . "26.1") ("2.3.4.26.2" . "26.2")))
73 73
74(add-hook 'tramp-unload-hook 74(add-hook 'tramp-unload-hook
75 (lambda () 75 (lambda ()
diff --git a/lisp/profiler.el b/lisp/profiler.el
index eaeb69793fb..41dea68bd13 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -105,13 +105,13 @@
105 "Format ENTRY in human readable string. ENTRY would be a 105 "Format ENTRY in human readable string. ENTRY would be a
106function name of a function itself." 106function name of a function itself."
107 (cond ((memq (car-safe entry) '(closure lambda)) 107 (cond ((memq (car-safe entry) '(closure lambda))
108 (format "#<lambda 0x%x>" (sxhash entry))) 108 (format "#<lambda %#x>" (sxhash entry)))
109 ((byte-code-function-p entry) 109 ((byte-code-function-p entry)
110 (format "#<compiled 0x%x>" (sxhash entry))) 110 (format "#<compiled %#x>" (sxhash entry)))
111 ((or (subrp entry) (symbolp entry) (stringp entry)) 111 ((or (subrp entry) (symbolp entry) (stringp entry))
112 (format "%s" entry)) 112 (format "%s" entry))
113 (t 113 (t
114 (format "#<unknown 0x%x>" (sxhash entry))))) 114 (format "#<unknown %#x>" (sxhash entry)))))
115 115
116(defun profiler-fixup-entry (entry) 116(defun profiler-fixup-entry (entry)
117 (if (symbolp entry) 117 (if (symbolp entry)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 3961ea647cf..d1eb3c3d06f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -12607,7 +12607,11 @@ comment at the start of cc-engine.el for more info."
12607 (= (point) containing-sexp))) 12607 (= (point) containing-sexp)))
12608 (if (eq (point) (c-point 'boi)) 12608 (if (eq (point) (c-point 'boi))
12609 (c-add-syntax 'brace-list-close (point)) 12609 (c-add-syntax 'brace-list-close (point))
12610 (setq lim (c-most-enclosing-brace state-cache (point))) 12610 (setq lim (or (save-excursion
12611 (and
12612 (c-back-over-member-initializers)
12613 (point)))
12614 (c-most-enclosing-brace state-cache (point))))
12611 (c-beginning-of-statement-1 lim nil nil t) 12615 (c-beginning-of-statement-1 lim nil nil t)
12612 (c-add-stmt-syntax 'brace-list-close nil t lim paren-state))) 12616 (c-add-stmt-syntax 'brace-list-close nil t lim paren-state)))
12613 12617
@@ -12636,7 +12640,11 @@ comment at the start of cc-engine.el for more info."
12636 (goto-char containing-sexp)) 12640 (goto-char containing-sexp))
12637 (if (eq (point) (c-point 'boi)) 12641 (if (eq (point) (c-point 'boi))
12638 (c-add-syntax 'brace-list-intro (point)) 12642 (c-add-syntax 'brace-list-intro (point))
12639 (setq lim (c-most-enclosing-brace state-cache (point))) 12643 (setq lim (or (save-excursion
12644 (and
12645 (c-back-over-member-initializers)
12646 (point)))
12647 (c-most-enclosing-brace state-cache (point))))
12640 (c-beginning-of-statement-1 lim) 12648 (c-beginning-of-statement-1 lim)
12641 (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state))) 12649 (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state)))
12642 12650
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 58a58b46395..f694252c407 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -45,7 +45,7 @@ It has `lisp-mode-abbrev-table' as its parent."
45 "Syntax table used in `emacs-lisp-mode'.") 45 "Syntax table used in `emacs-lisp-mode'.")
46 46
47(defvar emacs-lisp-mode-map 47(defvar emacs-lisp-mode-map
48 (let ((map (make-sparse-keymap "Emacs-Lisp")) 48 (let ((map (make-sparse-keymap))
49 (menu-map (make-sparse-keymap "Emacs-Lisp")) 49 (menu-map (make-sparse-keymap "Emacs-Lisp"))
50 (lint-map (make-sparse-keymap)) 50 (lint-map (make-sparse-keymap))
51 (prof-map (make-sparse-keymap)) 51 (prof-map (make-sparse-keymap))
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 519b768ab40..0ededb1b155 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -374,7 +374,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
374 ;; to handle weird file names (with colons in them) as 374 ;; to handle weird file names (with colons in them) as
375 ;; well as possible. E.g., use [1-9][0-9]* rather than 375 ;; well as possible. E.g., use [1-9][0-9]* rather than
376 ;; [0-9]+ so as to accept ":034:" in file names. 376 ;; [0-9]+ so as to accept ":034:" in file names.
377 "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:" 377 "\\(?1:"
378 "\\(?:[a-zA-Z]:\\)?" ; Allow "C:..." for w32.
379 "[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:"
378 "\\)") 380 "\\)")
379 1 2 381 1 2
380 ;; Calculate column positions (col . end-col) of first grep match on a line 382 ;; Calculate column positions (col . end-col) of first grep match on a line
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index ce7127a3d77..24ad2ff6c75 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1625,7 +1625,7 @@ not be expanded."
1625 ((integerp result) 1625 ((integerp result)
1626 (if (or (= 0 result) (= 1 result)) 1626 (if (or (= 0 result) (= 1 result))
1627 (message "%S <= `%s'" result exprstring) 1627 (message "%S <= `%s'" result exprstring)
1628 (message "%S (0x%x) <= `%s'" result result exprstring))) 1628 (message "%S (%#x) <= `%s'" result result exprstring)))
1629 ((null result) (message "%S <= `%s'" 'false exprstring)) 1629 ((null result) (message "%S <= `%s'" 'false exprstring))
1630 ((eq t result) (message "%S <= `%s'" 'true exprstring)) 1630 ((eq t result) (message "%S <= `%s'" 'true exprstring))
1631 (t (message "%S <= `%s'" result exprstring))) 1631 (t (message "%S <= `%s'" result exprstring)))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index e39ff08739b..c55b69e33ec 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -526,9 +526,19 @@ The type returned can be `comment', `string' or `paren'."
526 font-lock-string-face) 526 font-lock-string-face)
527 font-lock-comment-face)) 527 font-lock-comment-face))
528 528
529(defvar python-font-lock-keywords 529(defvar python-font-lock-keywords-level-1
530 ;; Keywords 530 `((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_))))
531 `(,(rx symbol-start 531 (1 font-lock-function-name-face))
532 (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_))))
533 (1 font-lock-type-face)))
534 "Font lock keywords to use in python-mode for level 1 decoration.
535
536This is the minimum decoration level, including function and
537class declarations.")
538
539(defvar python-font-lock-keywords-level-2
540 `(,@python-font-lock-keywords-level-1
541 ,(rx symbol-start
532 (or 542 (or
533 "and" "del" "from" "not" "while" "as" "elif" "global" "or" "with" 543 "and" "del" "from" "not" "while" "as" "elif" "global" "or" "with"
534 "assert" "else" "if" "pass" "yield" "break" "except" "import" "class" 544 "assert" "else" "if" "pass" "yield" "break" "except" "import" "class"
@@ -548,12 +558,35 @@ The type returned can be `comment', `string' or `paren'."
548 ;; Extra: 558 ;; Extra:
549 "self") 559 "self")
550 symbol-end) 560 symbol-end)
551 ;; functions 561 ;; Builtins
552 (,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_)))) 562 (,(rx symbol-start
553 (1 font-lock-function-name-face)) 563 (or
554 ;; classes 564 "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod"
555 (,(rx symbol-start "class" (1+ space) (group (1+ (or word ?_)))) 565 "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate"
556 (1 font-lock-type-face)) 566 "eval" "filter" "float" "format" "frozenset" "getattr" "globals"
567 "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance"
568 "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview"
569 "min" "next" "object" "oct" "open" "ord" "pow" "print" "property"
570 "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted"
571 "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip"
572 "__import__"
573 ;; Python 2:
574 "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce"
575 "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce"
576 "intern"
577 ;; Python 3:
578 "ascii" "bytearray" "bytes" "exec"
579 ;; Extra:
580 "__all__" "__doc__" "__name__" "__package__")
581 symbol-end) . font-lock-builtin-face))
582 "Font lock keywords to use in python-mode for level 2 decoration.
583
584This is the medium decoration level, including everything in
585`python-font-lock-keywords-level-1', as well as keywords and
586builtins.")
587
588(defvar python-font-lock-keywords-maximum-decoration
589 `(,@python-font-lock-keywords-level-2
557 ;; Constants 590 ;; Constants
558 (,(rx symbol-start 591 (,(rx symbol-start
559 (or 592 (or
@@ -596,27 +629,6 @@ The type returned can be `comment', `string' or `paren'."
596 "VMSError" "WindowsError" 629 "VMSError" "WindowsError"
597 ) 630 )
598 symbol-end) . font-lock-type-face) 631 symbol-end) . font-lock-type-face)
599 ;; Builtins
600 (,(rx symbol-start
601 (or
602 "abs" "all" "any" "bin" "bool" "callable" "chr" "classmethod"
603 "compile" "complex" "delattr" "dict" "dir" "divmod" "enumerate"
604 "eval" "filter" "float" "format" "frozenset" "getattr" "globals"
605 "hasattr" "hash" "help" "hex" "id" "input" "int" "isinstance"
606 "issubclass" "iter" "len" "list" "locals" "map" "max" "memoryview"
607 "min" "next" "object" "oct" "open" "ord" "pow" "print" "property"
608 "range" "repr" "reversed" "round" "set" "setattr" "slice" "sorted"
609 "staticmethod" "str" "sum" "super" "tuple" "type" "vars" "zip"
610 "__import__"
611 ;; Python 2:
612 "basestring" "cmp" "execfile" "file" "long" "raw_input" "reduce"
613 "reload" "unichr" "unicode" "xrange" "apply" "buffer" "coerce"
614 "intern"
615 ;; Python 3:
616 "ascii" "bytearray" "bytes" "exec"
617 ;; Extra:
618 "__all__" "__doc__" "__name__" "__package__")
619 symbol-end) . font-lock-builtin-face)
620 ;; assignments 632 ;; assignments
621 ;; support for a = b = c = 5 633 ;; support for a = b = c = 5
622 (,(lambda (limit) 634 (,(lambda (limit)
@@ -640,7 +652,26 @@ The type returned can be `comment', `string' or `paren'."
640 (goto-char (match-end 1)) 652 (goto-char (match-end 1))
641 (python-syntax-context 'paren))) 653 (python-syntax-context 'paren)))
642 res)) 654 res))
643 (1 font-lock-variable-name-face nil nil)))) 655 (1 font-lock-variable-name-face nil nil)))
656 "Font lock keywords to use in python-mode for maximum decoration.
657
658This decoration level includes everything in
659`python-font-lock-keywords-level-2', as well as constants,
660decorators, exceptions, and assignments.")
661
662(defvar python-font-lock-keywords
663 '(python-font-lock-keywords-level-1 ; When `font-lock-maximum-decoration' is nil.
664 python-font-lock-keywords-level-1 ; When `font-lock-maximum-decoration' is 1.
665 python-font-lock-keywords-level-2 ; When `font-lock-maximum-decoration' is 2.
666 python-font-lock-keywords-maximum-decoration ; When `font-lock-maximum-decoration'
667 ; is more than 1, or t (which it is,
668 ; by default).
669 )
670 "List of font lock keyword specifications to use in python-mode.
671
672Which one will be chosen depends on the value of
673`font-lock-maximum-decoration'.")
674
644 675
645(defconst python-syntax-propertize-function 676(defconst python-syntax-propertize-function
646 (syntax-propertize-rules 677 (syntax-propertize-rules
@@ -5325,7 +5356,7 @@ REPORT-FN is Flymake's callback function."
5325 'python-nav-forward-sexp) 5356 'python-nav-forward-sexp)
5326 5357
5327 (set (make-local-variable 'font-lock-defaults) 5358 (set (make-local-variable 'font-lock-defaults)
5328 '(python-font-lock-keywords 5359 `(,python-font-lock-keywords
5329 nil nil nil nil 5360 nil nil nil nil
5330 (font-lock-syntactic-face-function 5361 (font-lock-syntactic-face-function
5331 . python-font-lock-syntactic-face-function))) 5362 . python-font-lock-syntactic-face-function)))
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index ed71b862cfd..685e171dd64 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -110,9 +110,7 @@ called a `subword'. Here are some examples:
110 NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" 110 NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
111 111
112This mode changes the definition of a word so that word commands 112This mode changes the definition of a word so that word commands
113treat nomenclature boundaries as word boundaries. 113treat nomenclature boundaries as word boundaries."
114
115\\{subword-mode-map}"
116 :lighter " ," 114 :lighter " ,"
117 (when subword-mode (superword-mode -1)) 115 (when subword-mode (superword-mode -1))
118 (subword-setup-buffer)) 116 (subword-setup-buffer))
diff --git a/lisp/register.el b/lisp/register.el
index 77d84c047a9..e25f9fd5889 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -231,6 +231,7 @@ Interactively, reads the register using `register-read-with-preview'."
231(defalias 'register-to-point 'jump-to-register) 231(defalias 'register-to-point 'jump-to-register)
232(defun jump-to-register (register &optional delete) 232(defun jump-to-register (register &optional delete)
233 "Move point to location stored in a register. 233 "Move point to location stored in a register.
234Push the mark if jumping moves point, unless called in succession.
234If the register contains a file name, find that file. 235If the register contains a file name, find that file.
235\(To put a file name in a register, you must use `set-register'.) 236\(To put a file name in a register, you must use `set-register'.)
236If the register contains a window configuration (one frame) or a frameset 237If the register contains a window configuration (one frame) or a frameset
@@ -390,7 +391,20 @@ Interactively, reads the register using `register-read-with-preview'."
390(cl-defmethod register-val-describe ((val cons) verbose) 391(cl-defmethod register-val-describe ((val cons) verbose)
391 (cond 392 (cond
392 ((window-configuration-p (car val)) 393 ((window-configuration-p (car val))
393 (princ "a window configuration.")) 394 (let* ((stored-window-config (car val))
395 (window-config-frame (window-configuration-frame stored-window-config))
396 (current-frame (selected-frame)))
397 (princ (format "a window configuration: %s."
398 (if (frame-live-p window-config-frame)
399 (with-selected-frame window-config-frame
400 (save-window-excursion
401 (set-window-configuration stored-window-config)
402 (concat
403 (mapconcat (lambda (w) (buffer-name (window-buffer w)))
404 (window-list (selected-frame)) ", ")
405 (unless (eq current-frame window-config-frame)
406 " in another frame"))))
407 "dead frame")))))
394 408
395 ((frame-configuration-p (car val)) 409 ((frame-configuration-p (car val))
396 (princ "a frame configuration.")) 410 (princ "a frame configuration."))
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 4d1ad03fa5f..7efbfc77742 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -254,14 +254,22 @@ EVENT should be a scroll bar click or drag event."
254 (let* ((start-position (event-start event)) 254 (let* ((start-position (event-start event))
255 (window (nth 0 start-position)) 255 (window (nth 0 start-position))
256 (portion-whole (nth 2 start-position))) 256 (portion-whole (nth 2 start-position)))
257 (save-excursion 257 ;; With 'scroll-bar-adjust-thumb-portion' nil and 'portion-whole'
258 (with-current-buffer (window-buffer window) 258 ;; indicating that the buffer is fully visible, do not scroll the
259 ;; Calculate position relative to the accessible part of the buffer. 259 ;; window since that might make it impossible to scroll it back
260 (goto-char (+ (point-min) 260 ;; with GTK's thumb (Bug#32002).
261 (scroll-bar-scale portion-whole 261 (when (or scroll-bar-adjust-thumb-portion
262 (- (point-max) (point-min))))) 262 (not (numberp (car portion-whole)))
263 (vertical-motion 0 window) 263 (not (numberp (cdr portion-whole)))
264 (set-window-start window (point)))))) 264 (/= (car portion-whole) (cdr portion-whole)))
265 (save-excursion
266 (with-current-buffer (window-buffer window)
267 ;; Calculate position relative to the accessible part of the buffer.
268 (goto-char (+ (point-min)
269 (scroll-bar-scale portion-whole
270 (- (point-max) (point-min)))))
271 (vertical-motion 0 window)
272 (set-window-start window (point)))))))
265 273
266(defun scroll-bar-drag (event) 274(defun scroll-bar-drag (event)
267 "Scroll the window by dragging the scroll bar slider. 275 "Scroll the window by dragging the scroll bar slider.
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 0095d6959ef..86280c38adf 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -25,37 +25,38 @@
25;; This package helps you to keep identical copies of files in more than one 25;; This package helps you to keep identical copies of files in more than one
26;; place - possibly on different machines. When you save a file, it checks 26;; place - possibly on different machines. When you save a file, it checks
27;; whether it is on the list of files with "shadows", and if so, it tries to 27;; whether it is on the list of files with "shadows", and if so, it tries to
28;; copy it when you exit Emacs (or use the shadow-copy-files command). 28;; copy it when you exit Emacs (or use the `shadow-copy-files' command).
29 29
30;; Installation & Use: 30;; Installation & Use:
31 31
32;; Add clusters (if necessary) and file groups with shadow-define-cluster, 32;; Add clusters (if necessary) and file groups with `shadow-define-cluster',
33;; shadow-define-literal-group, and shadow-define-regexp-group (see the 33;; `shadow-define-literal-group', and `shadow-define-regexp-group' (see the
34;; documentation for these functions for information on how and when to use 34;; documentation for these functions for information on how and when to use
35;; them). After doing this once, everything should be automatic. 35;; them). After doing this once, everything should be automatic.
36 36
37;; The lists of clusters and shadows are saved in a ~/.emacs.d/shadows 37;; The lists of clusters and shadows are saved in `shadow-info-file',
38;; (`shadow-info-file') file, so that they can be remembered from one 38;; so that they can be remembered from one Emacs session to another,
39;; Emacs session to another, even (as much as possible) if the Emacs 39;; even (as much as possible) if the Emacs session terminates
40;; session terminates abnormally. The files needing to be copied are 40;; abnormally. The files needing to be copied are stored in
41;; stored in `shadow-todo-file'; if a file cannot be copied for any 41;; `shadow-todo-file'; if a file cannot be copied for any reason, it
42;; reason, it will stay on the list to be tried again next time. The 42;; will stay on the list to be tried again next time. The
43;; `shadow-info-file' file should itself have shadows on all your accounts 43;; `shadow-info-file' file should itself have shadows on all your
44;; so that the information in it is consistent everywhere, but 44;; accounts so that the information in it is consistent everywhere,
45;; `shadow-todo-file' is local information and should have no shadows. 45;; but `shadow-todo-file' is local information and should have no
46;; shadows.
46 47
47;; If you do not want to copy a particular file, you can answer "no" and 48;; If you do not want to copy a particular file, you can answer "no" and
48;; be asked again next time you hit C-x 4 s or exit Emacs. If you do not 49;; be asked again next time you hit "C-x 4 s" or exit Emacs. If you do not
49;; want to be asked again, use shadow-cancel, and you will not be asked 50;; want to be asked again, use "M-x shadow-cancel", and you will not be asked
50;; until you change the file and save it again. If you do not want to 51;; until you change the file and save it again. If you do not want to
51;; shadow that file ever again, you can edit it out of the shadows 52;; shadow that file ever again, you can edit it out of the shadows
52;; buffer. Anytime you edit the shadows buffer, you must type M-x 53;; buffer. Anytime you edit the shadows buffer, you must type "M-x
53;; shadow-read-files to load in the new information, or your changes will 54;; shadow-read-files" to load in the new information, or your changes will
54;; be overwritten! 55;; be overwritten!
55 56
56;; Bugs & Warnings: 57;; Bugs & Warnings:
57;; 58;;
58;; - It is bad to have two emacses both running shadowfile at the same 59;; - It is bad to have two Emacsen both running shadowfile at the same
59;; time. It tries to detect this condition, but is not always successful. 60;; time. It tries to detect this condition, but is not always successful.
60;; 61;;
61;; - You have to be careful not to edit a file in two locations 62;; - You have to be careful not to edit a file in two locations
@@ -64,19 +65,16 @@
64;; 65;;
65;; - It ought to check modification times of both files to make sure 66;; - It ought to check modification times of both files to make sure
66;; it is doing the right thing. This will have to wait until 67;; it is doing the right thing. This will have to wait until
67;; file-newer-than-file-p works between machines. 68;; `file-newer-than-file-p' works between machines.
68;; 69;;
69;; - It will not make directories for you, it just fails to copy files 70;; - It will not make directories for you, it just fails to copy files
70;; that belong in non-existent directories. 71;; that belong in non-existent directories.
71;;
72;; Please report any bugs to me (boris@gnu.org). Also let me know
73;; if you have suggestions or would like to be informed of updates.
74 72
75 73
76;;; Code: 74;;; Code:
77 75
78(require 'cl-lib) 76(require 'cl-lib)
79(require 'ange-ftp) 77(require 'tramp)
80 78
81;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 79;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82;;; Variables 80;;; Variables
@@ -107,35 +105,35 @@ files that have been changed and need to be copied to other systems."
107 :type 'boolean 105 :type 'boolean
108 :group 'shadow) 106 :group 'shadow)
109 107
110;; FIXME in a sense, this changed in 24.4 (addition of locate-user-emacs-file), 108(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows")
111;; but due to the weird way this variable is initialized to nil, it didn't
112;; literally change. Same for shadow-todo-file.
113(defcustom shadow-info-file nil
114 "File to keep shadow information in. 109 "File to keep shadow information in.
115The `shadow-info-file' should be shadowed to all your accounts to 110The `shadow-info-file' should be shadowed to all your accounts to
116ensure consistency. Default: ~/.emacs.d/shadows" 111ensure consistency. Default: ~/.emacs.d/shadows"
117 :type '(choice (const nil) file) 112 :type 'file
118 :group 'shadow) 113 :group 'shadow
114 :version "26.2")
119 115
120(defcustom shadow-todo-file nil 116(defcustom shadow-todo-file
117 (locate-user-emacs-file "shadow_todo" ".shadow_todo")
121 "File to store the list of uncopied shadows in. 118 "File to store the list of uncopied shadows in.
122This means that if a remote system is down, or for any reason you cannot or 119This means that if a remote system is down, or for any reason you cannot or
123decide not to copy your shadow files at the end of one Emacs session, it will 120decide not to copy your shadow files at the end of one Emacs session, it will
124remember and ask you again in your next Emacs session. 121remember and ask you again in your next Emacs session.
125This file must NOT be shadowed to any other system, it is host-specific. 122This file must NOT be shadowed to any other system, it is host-specific.
126Default: ~/.emacs.d/shadow_todo" 123Default: ~/.emacs.d/shadow_todo"
127 :type '(choice (const nil) file) 124 :type 'file
128 :group 'shadow) 125 :group 'shadow
126 :version "26.2")
129 127
130 128
131;;; The following two variables should in most cases initialize themselves 129;;; The following two variables should in most cases initialize themselves
132;;; correctly. They are provided as variables in case the defaults are wrong 130;;; correctly. They are provided as variables in case the defaults are wrong
133;;; on your machine (and for efficiency). 131;;; on your machine (and for efficiency).
134 132
135(defvar shadow-system-name (system-name) 133(defvar shadow-system-name (concat "/" (system-name) ":")
136 "The complete hostname of this machine.") 134 "The identification for local files on this machine.")
137 135
138(defvar shadow-homedir nil 136(defvar shadow-homedir "~"
139 "Your home directory on this machine.") 137 "Your home directory on this machine.")
140 138
141;;; 139;;;
@@ -186,12 +184,12 @@ created by `shadow-define-regexp-group'.")
186 (car list)) 184 (car list))
187 185
188(defun shadow-regexp-superquote (string) 186(defun shadow-regexp-superquote (string)
189 "Like `regexp-quote', but includes the ^ and $. 187 "Like `regexp-quote', but includes the \\` and \\'.
190This makes sure regexp matches nothing but STRING." 188This makes sure regexp matches nothing but STRING."
191 (concat "^" (regexp-quote string) "$")) 189 (concat "\\`" (regexp-quote string) "\\'"))
192 190
193(defun shadow-suffix (prefix string) 191(defun shadow-suffix (prefix string)
194 "If PREFIX begins STRING, return the rest. 192 "If PREFIX begins with STRING, return the rest.
195Return value is non-nil if PREFIX and STRING are `string=' up to the length of 193Return value is non-nil if PREFIX and STRING are `string=' up to the length of
196PREFIX." 194PREFIX."
197 (let ((lp (length prefix)) 195 (let ((lp (length prefix))
@@ -204,70 +202,66 @@ PREFIX."
204;;; Clusters and sites 202;;; Clusters and sites
205;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 203;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
206 204
207;;; I use the term `site' to refer to a string which may be the name of a 205;;; I use the term `site' to refer to a string which may be the
208;;; cluster or a literal hostname. All user-level commands should accept 206;;; cluster identification "/name:", a remote identification
209;;; either. 207;;; "/method:user@host:", or "/system-name:' (the value of
210 208;;; `shadow-system-name') for the location of local files. All
211(defun shadow-make-cluster (name primary regexp) 209;;; user-level commands should accept either.
212 "Create a shadow cluster.
213It is called NAME, uses the PRIMARY hostname and REGEXP matching all
214hosts in the cluster. The variable `shadow-clusters' associates the
215names of clusters to these structures. This function is for program
216use: to create clusters interactively, use `shadow-define-cluster'
217instead."
218 (list name primary regexp))
219
220(defmacro shadow-cluster-name (cluster)
221 "Return the name of the CLUSTER."
222 (list 'elt cluster 0))
223 210
224(defmacro shadow-cluster-primary (cluster) 211(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp)
225 "Return the primary hostname of a CLUSTER."
226 (list 'elt cluster 1))
227
228(defmacro shadow-cluster-regexp (cluster)
229 "Return the regexp matching hosts in a CLUSTER."
230 (list 'elt cluster 2))
231 212
232(defun shadow-set-cluster (name primary regexp) 213(defun shadow-set-cluster (name primary regexp)
233 "Put cluster NAME on the list of clusters. 214 "Put cluster NAME on the list of clusters.
234Replace old definition, if any. PRIMARY and REGEXP are the 215Replace old definition, if any. PRIMARY and REGEXP are the
235information defining the cluster. For interactive use, call 216information defining the cluster. For interactive use, call
236`shadow-define-cluster' instead." 217`shadow-define-cluster' instead."
237 (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) 218 (let ((rest (cl-remove-if (lambda (x) (equal name (shadow-cluster-name x)))
238 shadow-clusters))) 219 shadow-clusters)))
239 (setq shadow-clusters 220 (setq shadow-clusters
240 (cons (shadow-make-cluster name primary regexp) 221 (cons (make-shadow-cluster :name name :primary primary :regexp regexp)
241 rest)))) 222 rest))))
242 223
243(defmacro shadow-get-cluster (name) 224(defun shadow-get-cluster (name)
244 "Return cluster named NAME, or nil." 225 "Return cluster named NAME, or nil."
245 (list 'assoc name 'shadow-clusters)) 226 (shadow-find
227 (lambda (x) (string-equal (shadow-cluster-name x) name))
228 shadow-clusters))
229
230;;; SITES
231
232(defun shadow-site-name (site)
233 "Return name if SITE has the form \"/name:\", otherwise SITE."
234 (if (string-match "\\`/\\([-.[:word:]]+\\):\\'" site)
235 (match-string 1 site) site))
236
237(defun shadow-name-site (name)
238 "Return \"/name:\" if NAME has word syntax, otherwise NAME."
239 (if (string-match "\\`[-.[:word:]]+\\'" name)
240 (format "/%s:"name) name))
246 241
247(defun shadow-site-primary (site) 242(defun shadow-site-primary (site)
248 "If SITE is a cluster, return primary host, otherwise return SITE." 243 "If SITE is a cluster, return primary identification, otherwise return SITE."
249 (let ((c (shadow-get-cluster site))) 244 (let ((cluster (shadow-get-cluster (shadow-site-name site))))
250 (if c 245 (if cluster
251 (shadow-cluster-primary c) 246 (shadow-cluster-primary cluster)
252 site))) 247 site)))
253 248
254;;; SITES
255
256(defun shadow-site-cluster (site) 249(defun shadow-site-cluster (site)
257 "Given a SITE (hostname or cluster name), return cluster it is in, or nil." 250 "Given a SITE, return cluster it is in, or nil."
258 (or (assoc site shadow-clusters) 251 (or (shadow-get-cluster (shadow-site-name site))
259 (shadow-find 252 (shadow-find
260 (function (lambda (x) 253 (lambda (x)
261 (string-match (shadow-cluster-regexp x) 254 (string-match (shadow-cluster-regexp x) (shadow-name-site site)))
262 site)))
263 shadow-clusters))) 255 shadow-clusters)))
264 256
265(defun shadow-read-site () 257(defun shadow-read-site ()
266 "Read a cluster name or hostname from the minibuffer." 258 "Read a cluster name or host identification from the minibuffer."
267 (let ((ans (completing-read "Host or cluster name [RET when done]: " 259 (let ((ans (completing-read "Host identification or cluster name: "
268 shadow-clusters))) 260 shadow-clusters)))
269 (if (equal "" ans) 261 (when (or (shadow-get-cluster (shadow-site-name ans))
270 nil 262 (string-equal ans shadow-system-name)
263 (string-equal ans (shadow-site-name shadow-system-name))
264 (setq ans (file-remote-p ans)))
271 ans))) 265 ans)))
272 266
273(defun shadow-site-match (site1 site2) 267(defun shadow-site-match (site1 site2)
@@ -281,63 +275,88 @@ be matched against the primary of SITE2."
281 (string-match (shadow-cluster-regexp cluster1) primary2) 275 (string-match (shadow-cluster-regexp cluster1) primary2)
282 (string-equal site1 primary2))))) 276 (string-equal site1 primary2)))))
283 277
284(defun shadow-get-user (site)
285 "Return the default username for a SITE."
286 (ange-ftp-get-user (shadow-site-primary site)))
287
288;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 278;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
289;;; Filename manipulation 279;;; Filename manipulation
290;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 280;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
291 281
292(defun shadow-parse-fullname (fullname)
293 "Parse FULLNAME into (site user path) list.
294Leave it alone if it already is one. Return nil if the argument is
295not a full ange-ftp pathname."
296 (if (listp fullname)
297 fullname
298 (ange-ftp-ftp-name fullname)))
299
300(defun shadow-parse-name (name) 282(defun shadow-parse-name (name)
301 "Parse any NAME into (site user name) list. 283 "Parse any NAME into a `tramp-file-name' structure.
302Argument can be a simple name, full ange-ftp name, or already a hup list." 284Argument can be a simple name, remote file name, or already a
303 (or (shadow-parse-fullname name) 285`tramp-file-name' structure."
304 (list shadow-system-name 286 (cond
305 (user-login-name) 287 ((null name) nil)
306 name))) 288 ((tramp-file-name-p name) name)
307 289 ((file-remote-p name) (tramp-dissect-file-name name))
308(defsubst shadow-make-fullname (host user name) 290 ((shadow-local-file name)
309 "Make an ange-ftp style fullname out of HOST, USER (optional), and NAME. 291 (make-tramp-file-name
310This is probably not as general as it ought to be." 292 :host (shadow-site-name shadow-system-name)
311 (concat "/" 293 :localname (shadow-local-file name)))
312 (if user (concat user "@")) 294 ;; Cluster name.
313 host ":" 295 ((string-match "^/\\([^:/]+\\):\\([^:]*\\)$" name)
314 name)) 296 (let ((name (match-string 1 name))
297 (file (match-string 2 name)))
298 (when (shadow-get-cluster name)
299 (make-tramp-file-name :host name :localname file))))))
300
301(defsubst shadow-make-fullname (hup &optional host name)
302 "Make a Tramp style fullname out of HUP, a `tramp-file-name' structure.
303Replace HOST, and NAME when non-nil."
304 (let ((hup (copy-tramp-file-name hup)))
305 (when host (setf (tramp-file-name-host hup) host))
306 (when name (setf (tramp-file-name-localname hup) name))
307 (if (null (tramp-file-name-method hup))
308 (format
309 "/%s:%s" (tramp-file-name-host hup) (tramp-file-name-localname hup))
310 (tramp-make-tramp-file-name hup))))
315 311
316(defun shadow-replace-name-component (fullname newname) 312(defun shadow-replace-name-component (fullname newname)
317 "Return FULLNAME with the name component changed to NEWNAME." 313 "Return FULLNAME with the name component changed to NEWNAME."
318 (let ((hup (shadow-parse-fullname fullname))) 314 (concat (file-remote-p fullname) newname))
319 (shadow-make-fullname (nth 0 hup) (nth 1 hup) newname)))
320 315
321(defun shadow-local-file (file) 316(defun shadow-local-file (file)
322 "If FILE is at this site, remove /user@host part. 317 "If FILE is not remote, return it.
323If refers to a different system or a different user on this system, 318If it refers to a different system, return nil."
324return nil." 319 (cond
325 (let ((hup (shadow-parse-fullname file))) 320 ((null file) nil)
326 (cond ((null hup) file) 321 ;; `tramp-file-name' structure.
327 ((and (shadow-site-match (nth 0 hup) shadow-system-name) 322 ((and (tramp-file-name-p file) (null (tramp-file-name-method file)))
328 (string-equal (nth 1 hup) (user-login-name))) 323 (tramp-file-name-localname file))
329 (nth 2 hup)) 324 ((tramp-file-name-p file) nil)
330 (t nil)))) 325 ;; Local host name.
326 ((string-match
327 (format "^%s\\([^:]*\\)$" (regexp-quote shadow-system-name)) file)
328 (match-string 1 file))
329 ;; Cluster name.
330 ((and (string-match "^/\\([^:/]+\\):\\([^:]*\\)$" file)
331 (shadow-get-cluster (match-string 1 file)))
332 (let ((file (match-string 2 file))
333 (primary
334 (shadow-cluster-primary
335 (shadow-get-cluster (match-string 1 file)))))
336 (when (string-equal primary shadow-system-name) (setq primary nil))
337 (shadow-local-file (concat primary file))))
338 ;; Local name.
339 ((null (file-remote-p file)) file)))
331 340
332(defun shadow-expand-cluster-in-file-name (file) 341(defun shadow-expand-cluster-in-file-name (file)
333 "If hostname part of FILE is a cluster, expand it to cluster's primary hostname. 342 "If hostname part of FILE is a cluster, expand it to cluster's primary hostname.
334Will return the name bare if it is a local file." 343Will return the name bare if it is a local file."
335 (let ((hup (shadow-parse-name file))) 344 (when (stringp file)
336 (cond ((null hup) file) 345 (cond
337 ((shadow-local-file hup)) 346 ;; Local file.
338 ((shadow-make-fullname (shadow-site-primary (nth 0 hup)) 347 ((shadow-local-file file))
339 (nth 1 hup) 348 ;; Cluster name.
340 (nth 2 hup)))))) 349 ((string-match "^\\(/[^:/]+:\\)[^:]*$" file)
350 (let ((primary
351 (save-match-data
352 (shadow-cluster-primary
353 (shadow-get-cluster
354 (shadow-site-name (match-string 1 file)))))))
355 (if (not primary)
356 file
357 (setq file (replace-match primary nil nil file 1))
358 (or (shadow-local-file file) file))))
359 (t file))))
341 360
342(defun shadow-expand-file-name (file &optional default) 361(defun shadow-expand-file-name (file &optional default)
343 "Expand file name and get FILE's true name." 362 "Expand file name and get FILE's true name."
@@ -352,46 +371,50 @@ true."
352 (homedir (if (shadow-local-file hup) 371 (homedir (if (shadow-local-file hup)
353 shadow-homedir 372 shadow-homedir
354 (file-name-as-directory 373 (file-name-as-directory
355 (nth 2 (shadow-parse-fullname 374 (file-local-name
356 (expand-file-name 375 (expand-file-name (shadow-make-fullname hup nil "~"))))))
357 (shadow-make-fullname 376 (suffix (shadow-suffix homedir (tramp-file-name-localname hup)))
358 (nth 0 hup) (nth 1 hup) "~"))))))) 377 (cluster (shadow-site-cluster (shadow-make-fullname hup nil ""))))
359 (suffix (shadow-suffix homedir (nth 2 hup))) 378 (when cluster
360 (cluster (shadow-site-cluster (nth 0 hup)))) 379 (setf (tramp-file-name-method hup) nil
380 (tramp-file-name-host hup) (shadow-cluster-name cluster)))
361 (shadow-make-fullname 381 (shadow-make-fullname
362 (if cluster 382 hup nil
363 (shadow-cluster-name cluster)
364 (nth 0 hup))
365 (nth 1 hup)
366 (if suffix 383 (if suffix
367 (concat "~/" suffix) 384 (concat "~/" suffix)
368 (nth 2 hup))))) 385 (tramp-file-name-localname hup)))))
369 386
370(defun shadow-same-site (pattern file) 387(defun shadow-same-site (pattern file)
371 "True if the site of PATTERN and of FILE are on the same site. 388 "True if the site of PATTERN and of FILE are on the same site.
372If usernames are supplied, they must also match exactly. PATTERN and FILE may 389PATTERN and FILE may be Tramp vectors, or remote file names.
373be lists of host, user, name, or ange-ftp file names. FILE may also be just a 390FILE may also be just a local filename."
374local filename." 391 (let ((pattern-sup (shadow-parse-name pattern))
375 (let ((pattern-sup (shadow-parse-fullname pattern))
376 (file-sup (shadow-parse-name file))) 392 (file-sup (shadow-parse-name file)))
377 (and 393 (and
378 (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup)) 394 (shadow-site-match
379 (or (null (nth 1 pattern-sup)) 395 (tramp-file-name-host pattern-sup) (tramp-file-name-host file-sup))
380 (string-equal (nth 1 pattern-sup) (nth 1 file-sup)))))) 396 (or (null (tramp-file-name-user pattern-sup))
397 (string-equal
398 (tramp-file-name-user pattern-sup)
399 (tramp-file-name-user file-sup))))))
381 400
382(defun shadow-file-match (pattern file &optional regexp) 401(defun shadow-file-match (pattern file &optional regexp)
383 "Return t if PATTERN matches FILE. 402 "Return t if PATTERN matches FILE.
384If REGEXP is supplied and non-nil, the file part of the pattern is a regular 403If REGEXP is supplied and non-nil, the file part of the pattern is a regular
385expression, otherwise it must match exactly. The sites and usernames must 404expression, otherwise it must match exactly. The sites must
386match---see `shadow-same-site'. The pattern must be in full ange-ftp format, 405match---see `shadow-same-site'. The pattern must be in full Tramp format,
387but the file can be any valid filename. This function does not do any 406but the file can be any valid filename. This function does not do any
388filename expansion or contraction, you must do that yourself first." 407filename expansion or contraction, you must do that yourself first."
389 (let* ((pattern-sup (shadow-parse-fullname pattern)) 408 (let* ((pattern-sup (shadow-parse-name pattern))
390 (file-sup (shadow-parse-name file))) 409 (file-sup (shadow-parse-name file)))
391 (and (shadow-same-site pattern-sup file-sup) 410 (and (shadow-same-site pattern-sup file-sup)
392 (if regexp 411 (if regexp
393 (string-match (nth 2 pattern-sup) (nth 2 file-sup)) 412 (string-match
394 (string-equal (nth 2 pattern-sup) (nth 2 file-sup)))))) 413 (tramp-file-name-localname pattern-sup)
414 (tramp-file-name-localname file-sup))
415 (string-equal
416 (tramp-file-name-localname pattern-sup)
417 (tramp-file-name-localname file-sup))))))
395 418
396;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 419;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
397;;; User-level Commands 420;;; User-level Commands
@@ -405,30 +428,34 @@ one of them is sufficient to update the file on all of them. Clusters are
405defined by a name, the network address of a primary host (the one we copy 428defined by a name, the network address of a primary host (the one we copy
406files to), and a regular expression that matches the hostnames of all the 429files to), and a regular expression that matches the hostnames of all the
407sites in the cluster." 430sites in the cluster."
408 (interactive (list (completing-read "Cluster name: " shadow-clusters () ()))) 431 (interactive (list (completing-read "Cluster name: " shadow-clusters)))
409 (let* ((old (shadow-get-cluster name)) 432 (let* ((old (shadow-get-cluster name))
410 (primary (read-string "Primary host: " 433 (primary (let (try-primary)
411 (if old (shadow-cluster-primary old) 434 (while (not
412 name))) 435 (or
413 (regexp (let (try-regexp) 436 (string-equal
414 (while (not 437 (setq try-primary
415 (string-match
416 (setq try-regexp
417 (read-string 438 (read-string
418 "Regexp matching all host names: " 439 "Primary host: "
419 (if old (shadow-cluster-regexp old) 440 (if old (shadow-cluster-primary old)
420 (shadow-regexp-superquote primary)))) 441 name)))
421 primary)) 442 shadow-system-name)
422 (message "Regexp doesn't include the primary host!") 443 (file-remote-p try-primary)))
423 (sit-for 2)) 444 (message "Not a valid primary!")
424 try-regexp)) 445 (sit-for 2))
425; (username (read-no-blanks-input 446 try-primary))
426; (format "Username (default %s): " 447 (regexp (let (try-regexp)
427; (shadow-get-user primary)) 448 (while (not
428; (if old (or (shadow-cluster-username old) "") 449 (string-match
429; (user-login-name)))) 450 (setq try-regexp
430 ) 451 (read-string
431; (if (string-equal "" username) (setq username nil)) 452 "Regexp matching all host names: "
453 (if old (shadow-cluster-regexp old)
454 (shadow-regexp-superquote primary))))
455 primary))
456 (message "Regexp doesn't include the primary host!")
457 (sit-for 2))
458 try-regexp)))
432 (shadow-set-cluster name primary regexp))) 459 (shadow-set-cluster name primary regexp)))
433 460
434;;;###autoload 461;;;###autoload
@@ -438,20 +465,14 @@ It may have different filenames on each site. When this file is edited, the
438new version will be copied to each of the other locations. Sites can be 465new version will be copied to each of the other locations. Sites can be
439specific hostnames, or names of clusters (see `shadow-define-cluster')." 466specific hostnames, or names of clusters (see `shadow-define-cluster')."
440 (interactive) 467 (interactive)
441 (let* ((hup (shadow-parse-fullname 468 (let* ((hup (shadow-parse-name
442 (shadow-contract-file-name (buffer-file-name)))) 469 (shadow-contract-file-name (buffer-file-name))))
443 (name (nth 2 hup)) 470 (name (tramp-file-name-localname hup))
444 user site group) 471 site group)
445 (while (setq site (shadow-read-site)) 472 (while (setq site (shadow-read-site))
446 (setq user (read-string (format "Username (default %s): " 473 (setq name (read-string "Filename: " name)
447 (shadow-get-user site))) 474 hup (shadow-parse-name (shadow-contract-file-name name))
448 name (read-string "Filename: " name)) 475 group (cons (shadow-make-fullname hup site) group)))
449 (setq group (cons (shadow-make-fullname site
450 (if (string-equal "" user)
451 (shadow-get-user site)
452 user)
453 name)
454 group)))
455 (setq shadow-literal-groups (cons group shadow-literal-groups))) 476 (setq shadow-literal-groups (cons group shadow-literal-groups)))
456 (shadow-write-info-file)) 477 (shadow-write-info-file))
457 478
@@ -468,19 +489,12 @@ function). Each site can be either a hostname or the name of a cluster (see
468 "Filename regexp: " 489 "Filename regexp: "
469 (if (buffer-file-name) 490 (if (buffer-file-name)
470 (shadow-regexp-superquote 491 (shadow-regexp-superquote
471 (nth 2 492 (file-local-name (buffer-file-name))))))
472 (shadow-parse-name 493 site sites)
473 (shadow-contract-file-name
474 (buffer-file-name))))))))
475 site sites usernames)
476 (while (setq site (shadow-read-site)) 494 (while (setq site (shadow-read-site))
477 (setq sites (cons site sites)) 495 (setq sites (cons site sites)))
478 (setq usernames
479 (cons (read-string (format "Username for %s: " site)
480 (shadow-get-user site))
481 usernames)))
482 (setq shadow-regexp-groups 496 (setq shadow-regexp-groups
483 (cons (shadow-make-group regexp sites usernames) 497 (cons (shadow-make-group regexp sites)
484 shadow-regexp-groups)) 498 shadow-regexp-groups))
485 (shadow-write-info-file))) 499 (shadow-write-info-file)))
486 500
@@ -537,14 +551,14 @@ permanently, remove the group from `shadow-literal-groups' or
537;;; Internal functions 551;;; Internal functions
538;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 552;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
539 553
540(defun shadow-make-group (regexp sites usernames) 554(defun shadow-make-group (regexp sites)
541 "Make a description of a file group--- 555 "Make a description of a file group---
542actually a list of regexp ange-ftp file names---from REGEXP (name of file to 556actually a list of regexp Tramp file names---from REGEXP (name of file to
543be shadowed), list of SITES, and corresponding list of USERNAMES for each 557be shadowed), and list of SITES"
544site."
545 (if sites 558 (if sites
546 (cons (shadow-make-fullname (car sites) (car usernames) regexp) 559 (cons (shadow-make-fullname
547 (shadow-make-group regexp (cdr sites) (cdr usernames))) 560 (shadow-parse-name (shadow-site-primary (car sites))) nil regexp)
561 (shadow-make-group regexp (cdr sites)))
548 nil)) 562 nil))
549 563
550(defun shadow-copy-file (s) 564(defun shadow-copy-file (s)
@@ -601,7 +615,9 @@ Consider them as regular expressions if third arg REGEXP is true."
601 (car groups)))) 615 (car groups))))
602 (append (cond ((equal nonmatching (car groups)) nil) 616 (append (cond ((equal nonmatching (car groups)) nil)
603 (regexp 617 (regexp
604 (let ((realname (nth 2 (shadow-parse-fullname file)))) 618 (let ((realname
619 (tramp-file-name-localname
620 (shadow-parse-name file))))
605 (mapcar 621 (mapcar
606 (function 622 (function
607 (lambda (x) 623 (lambda (x)
@@ -612,17 +628,26 @@ Consider them as regular expressions if third arg REGEXP is true."
612 628
613(defun shadow-add-to-todo () 629(defun shadow-add-to-todo ()
614 "If current buffer has shadows, add them to the list needing to be copied." 630 "If current buffer has shadows, add them to the list needing to be copied."
631 (message "shadow-add-to-todo 1 %s" (current-buffer))
632 (message "shadow-add-to-todo 2 %s" (buffer-file-name))
633 (message "shadow-add-to-todo 3 %s" (shadow-expand-file-name (buffer-file-name (current-buffer))))
634 (message "shadow-add-to-todo 4 %s" (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))
615 (let ((shadows (shadow-shadows-of 635 (let ((shadows (shadow-shadows-of
616 (shadow-expand-file-name 636 (shadow-expand-file-name
617 (buffer-file-name (current-buffer)))))) 637 (buffer-file-name (current-buffer))))))
618 (when shadows 638 (when shadows
639 (message "shadow-add-to-todo 5 %s" shadows)
640 (message "shadow-add-to-todo 6 %s" shadow-files-to-copy)
641 (message "shadow-add-to-todo 7 %s" (shadow-union shadows shadow-files-to-copy))
619 (setq shadow-files-to-copy 642 (setq shadow-files-to-copy
620 (shadow-union shadows shadow-files-to-copy)) 643 (shadow-union shadows shadow-files-to-copy))
621 (when (not shadow-inhibit-message) 644 (when (not shadow-inhibit-message)
622 (message "%s" (substitute-command-keys 645 (message "%s" (substitute-command-keys
623 "Use \\[shadow-copy-files] to update shadows.")) 646 "Use \\[shadow-copy-files] to update shadows."))
624 (sit-for 1)) 647 (sit-for 1))
625 (shadow-write-todo-file))) 648 (message "shadow-add-to-todo 8")
649 (shadow-write-todo-file)
650 (message "shadow-add-to-todo 9")))
626 nil) ; Return nil for write-file-functions 651 nil) ; Return nil for write-file-functions
627 652
628(defun shadow-remove-from-todo (pair) 653(defun shadow-remove-from-todo (pair)
@@ -636,9 +661,8 @@ PAIR must be `eq' to one of the elements of that list."
636Thus restores shadowfile's state from your last Emacs session. 661Thus restores shadowfile's state from your last Emacs session.
637Return t unless files were locked; then return nil." 662Return t unless files were locked; then return nil."
638 (interactive) 663 (interactive)
639 (if (and (fboundp 'file-locked-p) 664 (if (or (stringp (file-locked-p shadow-info-file))
640 (or (stringp (file-locked-p shadow-info-file)) 665 (stringp (file-locked-p shadow-todo-file)))
641 (stringp (file-locked-p shadow-todo-file))))
642 (progn 666 (progn
643 (message "Shadowfile is running in another Emacs; can't have two.") 667 (message "Shadowfile is running in another Emacs; can't have two.")
644 (beep) 668 (beep)
@@ -647,7 +671,7 @@ Return t unless files were locked; then return nil."
647 (save-current-buffer 671 (save-current-buffer
648 (when shadow-info-file 672 (when shadow-info-file
649 (set-buffer (setq shadow-info-buffer 673 (set-buffer (setq shadow-info-buffer
650 (find-file-noselect shadow-info-file))) 674 (find-file-noselect shadow-info-file 'nowarn)))
651 (when (and (not (buffer-modified-p)) 675 (when (and (not (buffer-modified-p))
652 (file-newer-than-file-p (make-auto-save-file-name) 676 (file-newer-than-file-p (make-auto-save-file-name)
653 shadow-info-file)) 677 shadow-info-file))
@@ -680,6 +704,7 @@ defined, the old hashtable info is invalid."
680 (if (not shadow-info-buffer) 704 (if (not shadow-info-buffer)
681 (setq shadow-info-buffer (find-file-noselect shadow-info-file))) 705 (setq shadow-info-buffer (find-file-noselect shadow-info-file)))
682 (set-buffer shadow-info-buffer) 706 (set-buffer shadow-info-buffer)
707 (setq buffer-read-only nil)
683 (delete-region (point-min) (point-max)) 708 (delete-region (point-min) (point-max))
684 (shadow-insert-var 'shadow-clusters) 709 (shadow-insert-var 'shadow-clusters)
685 (shadow-insert-var 'shadow-literal-groups) 710 (shadow-insert-var 'shadow-literal-groups)
@@ -689,17 +714,26 @@ defined, the old hashtable info is invalid."
689 "Write out information to `shadow-todo-file'. 714 "Write out information to `shadow-todo-file'.
690With non-nil argument also saves the buffer." 715With non-nil argument also saves the buffer."
691 (save-excursion 716 (save-excursion
717 (message "shadow-write-todo-file 1 %s" shadow-todo-buffer)
692 (if (not shadow-todo-buffer) 718 (if (not shadow-todo-buffer)
693 (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) 719 (setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
720 (message "shadow-write-todo-file 2 %s" shadow-todo-buffer)
694 (set-buffer shadow-todo-buffer) 721 (set-buffer shadow-todo-buffer)
722 (message "shadow-write-todo-file 3 %s" shadow-todo-buffer)
723 (setq buffer-read-only nil)
695 (delete-region (point-min) (point-max)) 724 (delete-region (point-min) (point-max))
725 (message "shadow-write-todo-file 4 %s" shadow-todo-buffer)
696 (shadow-insert-var 'shadow-files-to-copy) 726 (shadow-insert-var 'shadow-files-to-copy)
697 (if save (shadow-save-todo-file)))) 727 (message "shadow-write-todo-file 5 %s" save)
728 (if save (shadow-save-todo-file))
729 (message "shadow-write-todo-file 6 %s" save)))
698 730
699(defun shadow-save-todo-file () 731(defun shadow-save-todo-file ()
732 (message "shadow-save-todo-file 1 %s" shadow-todo-buffer)
700 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) 733 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
701 (with-current-buffer shadow-todo-buffer 734 (with-current-buffer shadow-todo-buffer
702 (condition-case nil ; have to continue even in case of 735 (message "shadow-save-todo-file 2 %s" shadow-todo-buffer)
736 (condition-case nil ; have to continue even in case of
703 (basic-save-buffer) ; error, otherwise kill-emacs might 737 (basic-save-buffer) ; error, otherwise kill-emacs might
704 (error ; not work! 738 (error ; not work!
705 (message "WARNING: Can't save shadow todo file; it is locked!") 739 (message "WARNING: Can't save shadow todo file; it is locked!")
@@ -765,24 +799,6 @@ look for files that have been changed and need to be copied to other systems."
765 (kill-emacs))) 799 (kill-emacs)))
766 800
767;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 801;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
768;;; Lucid Emacs compatibility
769;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
770
771;; This is on hold until someone tells me about a working version of
772;; map-ynp for Lucid Emacs.
773
774;(when (string-match "Lucid" emacs-version)
775; (require 'symlink-fix)
776; (require 'ange-ftp)
777; (require 'map-ynp)
778; (if (not (fboundp 'file-truename))
779; (fset 'shadow-expand-file-name
780; (symbol-function 'symlink-expand-file-name)))
781; (if (not (fboundp 'ange-ftp-ftp-name))
782; (fset 'ange-ftp-ftp-name
783; (symbol-function 'ange-ftp-ftp-name))))
784
785;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
786;;; Hook us up 802;;; Hook us up
787;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 803;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
788 804
@@ -790,18 +806,10 @@ look for files that have been changed and need to be copied to other systems."
790(defun shadow-initialize () 806(defun shadow-initialize ()
791 "Set up file shadowing." 807 "Set up file shadowing."
792 (interactive) 808 (interactive)
793 (if (null shadow-homedir) 809 (setq shadow-homedir
794 (setq shadow-homedir 810 (file-name-as-directory (shadow-expand-file-name shadow-homedir))
795 (file-name-as-directory (shadow-expand-file-name "~")))) 811 shadow-info-file (shadow-expand-file-name shadow-info-file)
796 (if (null shadow-info-file) 812 shadow-todo-file (shadow-expand-file-name shadow-todo-file))
797 (setq shadow-info-file
798 ;; FIXME: Move defaults to their defcustom.
799 (shadow-expand-file-name
800 (locate-user-emacs-file "shadows" ".shadows"))))
801 (if (null shadow-todo-file)
802 (setq shadow-todo-file
803 (shadow-expand-file-name
804 (locate-user-emacs-file "shadow_todo" ".shadow_todo"))))
805 (if (not (shadow-read-files)) 813 (if (not (shadow-read-files))
806 (progn 814 (progn
807 (message "Shadowfile information files not found - aborting") 815 (message "Shadowfile information files not found - aborting")
diff --git a/lisp/shell.el b/lisp/shell.el
index fa6eee0f187..ac6f11aeb40 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -73,7 +73,7 @@
73;; c-c c-o comint-delete-output Delete last batch of process output 73;; c-c c-o comint-delete-output Delete last batch of process output
74;; c-c c-r comint-show-output Show last batch of process output 74;; c-c c-r comint-show-output Show last batch of process output
75;; c-c c-l comint-dynamic-list-input-ring List input history 75;; c-c c-l comint-dynamic-list-input-ring List input history
76;; send-invisible Read line w/o echo & send to proc 76;; comint-send-invisible Read line w/o echo & send to proc
77;; comint-continue-subjob Useful if you accidentally suspend 77;; comint-continue-subjob Useful if you accidentally suspend
78;; top-level job 78;; top-level job
79;; comint-mode-hook is the comint mode hook. 79;; comint-mode-hook is the comint mode hook.
@@ -500,7 +500,7 @@ Shell buffers. It implements `shell-completion-execonly' for
500 the end of process to the end of the current line. 500 the end of process to the end of the current line.
501\\[comint-send-input] before end of process output copies the current line minus the prompt to 501\\[comint-send-input] before end of process output copies the current line minus the prompt to
502 the end of the buffer and sends it (\\[comint-copy-old-input] just copies the current line). 502 the end of the buffer and sends it (\\[comint-copy-old-input] just copies the current line).
503\\[send-invisible] reads a line of text without echoing it, and sends it to 503\\[comint-send-invisible] reads a line of text without echoing it, and sends it to
504 the shell. This is useful for entering passwords. Or, add the function 504 the shell. This is useful for entering passwords. Or, add the function
505 `comint-watch-for-password-prompt' to `comint-output-filter-functions'. 505 `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
506 506
diff --git a/lisp/simple.el b/lisp/simple.el
index 6459531a4ec..8d770478aa9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8346,14 +8346,12 @@ LSHIFTBY is the numeric value of this modifier, in keyboard events.
8346PREFIX is the string that represents this modifier in an event type symbol." 8346PREFIX is the string that represents this modifier in an event type symbol."
8347 (if (numberp event) 8347 (if (numberp event)
8348 (cond ((eq symbol 'control) 8348 (cond ((eq symbol 'control)
8349 (if (and (<= (downcase event) ?z) 8349 (if (<= 64 (upcase event) 95)
8350 (>= (downcase event) ?a)) 8350 (- (upcase event) 64)
8351 (- (downcase event) ?a -1) 8351 (logior (lsh 1 lshiftby) event)))
8352 (if (and (<= (downcase event) ?Z)
8353 (>= (downcase event) ?A))
8354 (- (downcase event) ?A -1)
8355 (logior (lsh 1 lshiftby) event))))
8356 ((eq symbol 'shift) 8352 ((eq symbol 'shift)
8353 ;; FIXME: Should we also apply this "upcase" behavior of shift
8354 ;; to non-ascii letters?
8357 (if (and (<= (downcase event) ?z) 8355 (if (and (<= (downcase event) ?z)
8358 (>= (downcase event) ?a)) 8356 (>= (downcase event) ?a))
8359 (upcase event) 8357 (upcase event)
diff --git a/lisp/subr.el b/lisp/subr.el
index 10343e69db8..fbb3e49a35c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -555,12 +555,6 @@ If N is omitted or nil, remove the last element."
555 (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) 555 (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
556 list)))) 556 list))))
557 557
558(defun proper-list-p (object)
559 "Return OBJECT's length if it is a proper list, nil otherwise.
560A proper list is neither circular nor dotted (i.e., its last cdr
561is nil)."
562 (and (listp object) (ignore-errors (length object))))
563
564(defun delete-dups (list) 558(defun delete-dups (list)
565 "Destructively remove `equal' duplicates from LIST. 559 "Destructively remove `equal' duplicates from LIST.
566Store the result in LIST and return it. LIST must be a proper list. 560Store the result in LIST and return it. LIST must be a proper list.
@@ -2305,7 +2299,7 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
2305If optional CONFIRM is non-nil, read the password twice to make sure. 2299If optional CONFIRM is non-nil, read the password twice to make sure.
2306Optional DEFAULT is a default password to use instead of empty input. 2300Optional DEFAULT is a default password to use instead of empty input.
2307 2301
2308This function echoes `.' for each character that the user types. 2302This function echoes `*' for each character that the user types.
2309You could let-bind `read-hide-char' to another hiding character, though. 2303You could let-bind `read-hide-char' to another hiding character, though.
2310 2304
2311Once the caller uses the password, it can erase the password 2305Once the caller uses the password, it can erase the password
@@ -2331,7 +2325,7 @@ by doing (clear-string STRING)."
2331 beg))) 2325 beg)))
2332 (dotimes (i (- end beg)) 2326 (dotimes (i (- end beg))
2333 (put-text-property (+ i beg) (+ 1 i beg) 2327 (put-text-property (+ i beg) (+ 1 i beg)
2334 'display (string (or read-hide-char ?.)))))) 2328 'display (string (or read-hide-char ?*))))))
2335 minibuf) 2329 minibuf)
2336 (minibuffer-with-setup-hook 2330 (minibuffer-with-setup-hook
2337 (lambda () 2331 (lambda ()
@@ -2346,7 +2340,7 @@ by doing (clear-string STRING)."
2346 (add-hook 'after-change-functions hide-chars-fun nil 'local)) 2340 (add-hook 'after-change-functions hide-chars-fun nil 'local))
2347 (unwind-protect 2341 (unwind-protect
2348 (let ((enable-recursive-minibuffers t) 2342 (let ((enable-recursive-minibuffers t)
2349 (read-hide-char (or read-hide-char ?.))) 2343 (read-hide-char (or read-hide-char ?*)))
2350 (read-string prompt nil t default)) ; t = "no history" 2344 (read-string prompt nil t default)) ; t = "no history"
2351 (when (buffer-live-p minibuf) 2345 (when (buffer-live-p minibuf)
2352 (with-current-buffer minibuf 2346 (with-current-buffer minibuf
@@ -4693,25 +4687,6 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
4693 (put symbol 'hookvar (or hookvar 'mail-send-hook))) 4687 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
4694 4688
4695 4689
4696(defun backtrace--print-frame (evald func args flags)
4697 "Print a trace of a single stack frame to `standard-output'.
4698EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
4699 (princ (if (plist-get flags :debug-on-exit) "* " " "))
4700 (cond
4701 ((and evald (not debugger-stack-frame-as-list))
4702 (cl-prin1 func)
4703 (if args (cl-prin1 args) (princ "()")))
4704 (t
4705 (cl-prin1 (cons func args))))
4706 (princ "\n"))
4707
4708(defun backtrace ()
4709 "Print a trace of Lisp function calls currently active.
4710Output stream used is value of `standard-output'."
4711 (let ((print-level (or print-level 8))
4712 (print-escape-control-characters t))
4713 (mapbacktrace #'backtrace--print-frame 'backtrace)))
4714
4715(defun backtrace-frames (&optional base) 4690(defun backtrace-frames (&optional base)
4716 "Collect all frames of current backtrace into a list. 4691 "Collect all frames of current backtrace into a list.
4717If non-nil, BASE should be a function, and frames before its 4692If non-nil, BASE should be a function, and frames before its
diff --git a/lisp/term.el b/lisp/term.el
index 121a22e7933..9f8f1f703a6 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -343,6 +343,7 @@
343(eval-when-compile (require 'cl-lib)) 343(eval-when-compile (require 'cl-lib))
344(require 'ring) 344(require 'ring)
345(require 'ehelp) 345(require 'ehelp)
346(require 'comint) ; Password regexp.
346 347
347(declare-function ring-empty-p "ring" (ring)) 348(declare-function ring-empty-p "ring" (ring))
348(declare-function ring-ref "ring" (ring index)) 349(declare-function ring-ref "ring" (ring index))
@@ -2215,6 +2216,7 @@ filter and C-g is pressed, this function returns nil rather than a string).
2215Note that the keystrokes comprising the text can still be recovered 2216Note that the keystrokes comprising the text can still be recovered
2216\(temporarily) with \\[view-lossage]. This may be a security bug for some 2217\(temporarily) with \\[view-lossage]. This may be a security bug for some
2217applications." 2218applications."
2219 (declare (obsolete read-passwd "27.1"))
2218 (let ((ans "") 2220 (let ((ans "")
2219 (c 0) 2221 (c 0)
2220 (echo-keystrokes 0) 2222 (echo-keystrokes 0)
@@ -2255,12 +2257,10 @@ applications."
2255(defun term-send-invisible (str &optional proc) 2257(defun term-send-invisible (str &optional proc)
2256 "Read a string without echoing. 2258 "Read a string without echoing.
2257Then send it to the process running in the current buffer. A new-line 2259Then send it to the process running in the current buffer. A new-line
2258is additionally sent. String is not saved on term input history list. 2260is additionally sent. String is not saved on term input history list."
2259Security bug: your string can still be temporarily recovered with
2260\\[view-lossage]."
2261 (interactive "P") ; Defeat snooping via C-x esc 2261 (interactive "P") ; Defeat snooping via C-x esc
2262 (when (not (stringp str)) 2262 (when (not (stringp str))
2263 (setq str (term-read-noecho "Non-echoed text: " t))) 2263 (setq str (read-passwd "Non-echoed text: ")))
2264 (when (not proc) 2264 (when (not proc)
2265 (setq proc (get-buffer-process (current-buffer)))) 2265 (setq proc (get-buffer-process (current-buffer))))
2266 (if (not proc) (error "Current buffer has no process") 2266 (if (not proc) (error "Current buffer has no process")
@@ -2269,6 +2269,16 @@ Security bug: your string can still be temporarily recovered with
2269 (term-send-string proc str) 2269 (term-send-string proc str)
2270 (term-send-string proc "\n"))) 2270 (term-send-string proc "\n")))
2271 2271
2272;; TODO: Maybe combine this with `comint-watch-for-password-prompt'.
2273(defun term-watch-for-password-prompt (string)
2274 "Prompt in the minibuffer for password and send without echoing.
2275Checks if STRING contains a password prompt as defined by
2276`comint-password-prompt-regexp'."
2277 (when (term-in-line-mode)
2278 (when (let ((case-fold-search t))
2279 (string-match comint-password-prompt-regexp string))
2280 (term-send-invisible (read-passwd string)))))
2281
2272 2282
2273;;; Low-level process communication 2283;;; Low-level process communication
2274 2284
@@ -3054,6 +3064,8 @@ See `term-prompt-regexp'."
3054 (term-handle-deferred-scroll)) 3064 (term-handle-deferred-scroll))
3055 3065
3056 (set-marker (process-mark proc) (point)) 3066 (set-marker (process-mark proc) (point))
3067 (when (stringp decoded-substring)
3068 (term-watch-for-password-prompt decoded-substring))
3057 (when save-point 3069 (when save-point
3058 (goto-char save-point) 3070 (goto-char save-point)
3059 (set-marker save-point nil)) 3071 (set-marker save-point nil))
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index ab9149e6b42..a776c830a25 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -824,10 +824,12 @@ A canonicalized color name is all-lower case, with any blanks removed."
824 (replace-regexp-in-string " +" "" (downcase color)) 824 (replace-regexp-in-string " +" "" (downcase color))
825 color))) 825 color)))
826 826
827(defun tty-color-24bit (rgb) 827(defun tty-color-24bit (rgb &optional display)
828 "Return pixel value on 24-bit terminals. Return nil if RGB is 828 "Return 24-bit color pixel value for RGB value on DISPLAY.
829nil or not on 24-bit terminal." 829DISPLAY can be a display name or a frame, and defaults to the
830 (when (and rgb (= (display-color-cells) 16777216)) 830selected frame's display.
831If DISPLAY is not on a 24-but TTY terminal, return nil."
832 (when (and rgb (= (display-color-cells display) 16777216))
831 (let ((r (lsh (car rgb) -8)) 833 (let ((r (lsh (car rgb) -8))
832 (g (lsh (cadr rgb) -8)) 834 (g (lsh (cadr rgb) -8))
833 (b (lsh (nth 2 rgb) -8))) 835 (b (lsh (nth 2 rgb) -8)))
@@ -850,7 +852,7 @@ If FRAME is not specified or is nil, it defaults to the selected frame."
850 (error "Invalid specification for tty color \"%s\"" name)) 852 (error "Invalid specification for tty color \"%s\"" name))
851 (tty-modify-color-alist 853 (tty-modify-color-alist
852 (append (list (tty-color-canonicalize name) 854 (append (list (tty-color-canonicalize name)
853 (or (tty-color-24bit rgb) index)) 855 (or (tty-color-24bit rgb frame) index))
854 rgb) 856 rgb)
855 frame)) 857 frame))
856 858
@@ -1026,7 +1028,7 @@ might need to be approximated if it is not supported directly."
1026 (or (assoc color (tty-color-alist frame)) 1028 (or (assoc color (tty-color-alist frame))
1027 (let ((rgb (tty-color-standard-values color))) 1029 (let ((rgb (tty-color-standard-values color)))
1028 (and rgb 1030 (and rgb
1029 (let ((pixel (tty-color-24bit rgb))) 1031 (let ((pixel (tty-color-24bit rgb frame)))
1030 (or (and pixel (cons color (cons pixel rgb))) 1032 (or (and pixel (cons color (cons pixel rgb)))
1031 (tty-color-approximate rgb frame))))))))) 1033 (tty-color-approximate rgb frame)))))))))
1032 1034
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 8ad6832880a..69bba100922 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -31,10 +31,10 @@
31;; 31;;
32;; To enable Flyspell in text representing computer programs, type 32;; To enable Flyspell in text representing computer programs, type
33;; M-x flyspell-prog-mode. 33;; M-x flyspell-prog-mode.
34;; In that mode only text inside comments is checked. 34;; In that mode only text inside comments and strings is checked.
35;; 35;;
36;; Some user variables control the behavior of flyspell. They are 36;; Some user variables control the behavior of flyspell. They are
37;; those defined under the `User variables' comment. 37;; those defined under the `User configuration' comment.
38 38
39;;; Code: 39;;; Code:
40 40
@@ -137,7 +137,10 @@ This variable specifies how far to search to find such a duplicate.
137(defcustom flyspell-persistent-highlight t 137(defcustom flyspell-persistent-highlight t
138 "Non-nil means misspelled words remain highlighted until corrected. 138 "Non-nil means misspelled words remain highlighted until corrected.
139If this variable is nil, only the most recently detected misspelled word 139If this variable is nil, only the most recently detected misspelled word
140is highlighted." 140is highlighted, and the highlight is turned off as soon as point moves
141off the misspelled word.
142
143Make sure this variable is non-nil if you use `flyspell-region'."
141 :group 'flyspell 144 :group 'flyspell
142 :type 'boolean) 145 :type 'boolean)
143 146
@@ -1371,7 +1374,10 @@ language."
1371;;* flyspell-small-region ... */ 1374;;* flyspell-small-region ... */
1372;;*---------------------------------------------------------------------*/ 1375;;*---------------------------------------------------------------------*/
1373(defun flyspell-small-region (beg end) 1376(defun flyspell-small-region (beg end)
1374 "Flyspell text between BEG and END." 1377 "Flyspell text between BEG and END.
1378
1379This function is intended to work on small regions, as
1380determined by `flyspell-large-region'."
1375 (save-excursion 1381 (save-excursion
1376 (if (> beg end) 1382 (if (> beg end)
1377 (let ((old beg)) 1383 (let ((old beg))
@@ -1642,7 +1648,10 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
1642;;*---------------------------------------------------------------------*/ 1648;;*---------------------------------------------------------------------*/
1643;;;###autoload 1649;;;###autoload
1644(defun flyspell-region (beg end) 1650(defun flyspell-region (beg end)
1645 "Flyspell text between BEG and END." 1651 "Flyspell text between BEG and END.
1652
1653Make sure `flyspell-mode' is turned on if you want the highlight
1654of a misspelled word removed when you've corrected it."
1646 (interactive "r") 1655 (interactive "r")
1647 (ispell-set-spellchecker-params) ; Initialize variables and dicts alists 1656 (ispell-set-spellchecker-params) ; Initialize variables and dicts alists
1648 (if (= beg end) 1657 (if (= beg end)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index d80447e0a5b..e6f436fa1a1 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -2262,8 +2262,9 @@ Global `ispell-quit' set to start location to continue spell session."
2262 (ispell-pdict-save ispell-silently-savep) 2262 (ispell-pdict-save ispell-silently-savep)
2263 (message "%s" 2263 (message "%s"
2264 (substitute-command-keys 2264 (substitute-command-keys
2265 (concat "Spell-checking suspended;" 2265 (concat
2266 " use C-u \\[ispell-word] to resume"))) 2266 "Spell-checking suspended; use "
2267 "\\[universal-argument] \\[ispell-word] to resume")))
2267 (setq ispell-quit start) 2268 (setq ispell-quit start)
2268 nil) 2269 nil)
2269 ((= char ?q) 2270 ((= char ?q)
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 11dbb8d5705..e7fe8ffe660 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1030,7 +1030,9 @@ This is used to string together whole reference sets, like
1030 ("Hyperref" "hyperref" 1030 ("Hyperref" "hyperref"
1031 (("\\autoref" ?a) ("\\autopageref" ?u))) 1031 (("\\autoref" ?a) ("\\autopageref" ?u)))
1032 ("Cleveref" "cleveref" 1032 ("Cleveref" "cleveref"
1033 (("\\cref" ?c) ("\\Cref" ?C) ("\\cpageref" ?d) ("\\Cpageref" ?D)))) 1033 (("\\cref" ?c) ("\\Cref" ?C) ("\\cpageref" ?d) ("\\Cpageref" ?D)))
1034 ("AMSmath" "amsmath"
1035 (("\\eqref" ?e))))
1034 "Alist of reference styles. 1036 "Alist of reference styles.
1035Each element is a list of the style name, the name of the LaTeX 1037Each element is a list of the style name, the name of the LaTeX
1036package associated with the style or t for any package, and an 1038package associated with the style or t for any package, and an
@@ -1040,7 +1042,7 @@ the macro type is being prompted for. (See also
1040`reftex-ref-macro-prompt'.) The keys, represented as characters, 1042`reftex-ref-macro-prompt'.) The keys, represented as characters,
1041have to be unique." 1043have to be unique."
1042 :group 'reftex-referencing-labels 1044 :group 'reftex-referencing-labels
1043 :version "24.3" 1045 :version "27.1"
1044 :type '(alist :key-type (string :tag "Style name") 1046 :type '(alist :key-type (string :tag "Style name")
1045 :value-type (group (choice :tag "Package" 1047 :value-type (group (choice :tag "Package"
1046 (const :tag "Any package" t) 1048 (const :tag "Any package" t)
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 4612e95bb0e..7fcb3bc2b73 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -484,7 +484,7 @@ looks like an email address, \"ftp://\" if it starts with
484 484
485(put 'url 'end-op (lambda () (end-of-thing 'url))) 485(put 'url 'end-op (lambda () (end-of-thing 'url)))
486 486
487(put 'url 'beginning-op (lambda () (end-of-thing 'url))) 487(put 'url 'beginning-op (lambda () (beginning-of-thing 'url)))
488 488
489;; The normal thingatpt mechanism doesn't work for complex regexps. 489;; The normal thingatpt mechanism doesn't work for complex regexps.
490;; This should work for almost any regexp wherever we are in the 490;; This should work for almost any regexp wherever we are in the
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 4d69aac454c..d6e85408608 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -744,6 +744,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
744 file-name) 744 file-name)
745 745
746(defun add-log-file-name (buffer-file log-file) 746(defun add-log-file-name (buffer-file log-file)
747 "Compute file-name of BUFFER-FILE to be used in entries in LOG-FILE."
747 ;; Never want to add a change log entry for the ChangeLog file itself. 748 ;; Never want to add a change log entry for the ChangeLog file itself.
748 (unless (or (null buffer-file) (string= buffer-file log-file)) 749 (unless (or (null buffer-file) (string= buffer-file log-file))
749 (if add-log-file-name-function 750 (if add-log-file-name-function
@@ -767,15 +768,57 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
767 (file-name-sans-versions buffer-file) 768 (file-name-sans-versions buffer-file)
768 buffer-file)))) 769 buffer-file))))
769 770
771(defcustom add-log-dont-create-changelog-file t
772 "If non-nil, don't create ChangeLog files for log entries.
773If a ChangeLog file does not already exist, a non-nil value
774means to put log entries in a suitably named buffer."
775 :type :boolean
776 :version "27.1")
777
778(put 'add-log-dont-create-changelog-file 'safe-local-variable 'booleanp)
779
780(defun add-log--pseudo-changelog-buffer-name (changelog-file-name)
781 "Compute a suitable name for a non-file visiting ChangeLog buffer.
782CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file
783if it were to exist."
784 (format "*changes to %s*"
785 (abbreviate-file-name
786 (file-name-directory changelog-file-name))))
787
788(defun add-log--changelog-buffer-p (changelog-file-name buffer)
789 "Return non-nil if BUFFER holds a change log for CHANGELOG-FILE-NAME."
790 (with-current-buffer buffer
791 (if buffer-file-name
792 (equal buffer-file-name changelog-file-name)
793 (equal (add-log--pseudo-changelog-buffer-name changelog-file-name)
794 (buffer-name)))))
795
796(defun add-log-find-changelog-buffer (changelog-file-name)
797 "Find a ChangeLog buffer for CHANGELOG-FILE-NAME.
798Respect `add-log-use-pseudo-changelog', which see."
799 (if (or (file-exists-p changelog-file-name)
800 (not add-log-dont-create-changelog-file))
801 (find-file-noselect changelog-file-name)
802 (get-buffer-create
803 (add-log--pseudo-changelog-buffer-name changelog-file-name))))
804
770;;;###autoload 805;;;###autoload
771(defun add-change-log-entry (&optional whoami file-name other-window new-entry 806(defun add-change-log-entry (&optional whoami
807 changelog-file-name
808 other-window new-entry
772 put-new-entry-on-new-line) 809 put-new-entry-on-new-line)
773 "Find change log file, and add an entry for today and an item for this file. 810 "Find ChangeLog buffer, add an entry for today and an item for this file.
774Optional arg WHOAMI (interactive prefix) non-nil means prompt for user 811Optional arg WHOAMI (interactive prefix) non-nil means prompt for
775name and email (stored in `add-log-full-name' and `add-log-mailing-address'). 812user name and email (stored in `add-log-full-name'
776 813and `add-log-mailing-address').
777Second arg FILE-NAME is file name of the change log. 814
778If nil, use the value of `change-log-default-name'. 815Second arg CHANGELOG-FILE-NAME is the file name of the change log.
816If nil, use the value of `change-log-default-name'. If the file
817thus named exists, it is used for the new entry. If it doesn't
818exist, it is created, unless `add-log-dont-create-changelog-file' is t,
819in which case a suitably named buffer that doesn't visit any file
820is used for keeping entries pertaining to CHANGELOG-FILE-NAME's
821directory.
779 822
780Third arg OTHER-WINDOW non-nil means visit in other window. 823Third arg OTHER-WINDOW non-nil means visit in other window.
781 824
@@ -804,20 +847,28 @@ non-nil, otherwise in local time."
804 (change-log-version-number-search))) 847 (change-log-version-number-search)))
805 (buf-file-name (funcall add-log-buffer-file-name-function)) 848 (buf-file-name (funcall add-log-buffer-file-name-function))
806 (buffer-file (if buf-file-name (expand-file-name buf-file-name))) 849 (buffer-file (if buf-file-name (expand-file-name buf-file-name)))
807 (file-name (expand-file-name (find-change-log file-name buffer-file))) 850 (changelog-file-name (expand-file-name (find-change-log
851 changelog-file-name
852 buffer-file)))
808 ;; Set ITEM to the file name to use in the new item. 853 ;; Set ITEM to the file name to use in the new item.
809 (item (add-log-file-name buffer-file file-name))) 854 (item (add-log-file-name buffer-file changelog-file-name)))
810 855
811 (unless (equal file-name buffer-file-name) 856 ;; don't add entries from the ChangeLog file/buffer to itself.
857 (unless (equal changelog-file-name buffer-file-name)
812 (cond 858 (cond
813 ((equal file-name (buffer-file-name (window-buffer))) 859 ((add-log--changelog-buffer-p
860 changelog-file-name
861 (window-buffer))
814 ;; If the selected window already shows the desired buffer don't show 862 ;; If the selected window already shows the desired buffer don't show
815 ;; it again (particularly important if other-window is true). 863 ;; it again (particularly important if other-window is true).
816 ;; This is important for diff-add-change-log-entries-other-window. 864 ;; This is important for diff-add-change-log-entries-other-window.
817 (set-buffer (window-buffer))) 865 (set-buffer (window-buffer)))
818 ((or other-window (window-dedicated-p)) 866 ((or other-window (window-dedicated-p))
819 (find-file-other-window file-name)) 867 (switch-to-buffer-other-window
820 (t (find-file file-name)))) 868 (add-log-find-changelog-buffer changelog-file-name)))
869 (t
870 (switch-to-buffer
871 (add-log-find-changelog-buffer changelog-file-name)))))
821 (or (derived-mode-p 'change-log-mode) 872 (or (derived-mode-p 'change-log-mode)
822 (change-log-mode)) 873 (change-log-mode))
823 (undo-boundary) 874 (undo-boundary)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index ffbd9e5479a..b91a2ba45a4 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -96,6 +96,11 @@ when editing big diffs)."
96 :version "27.1" 96 :version "27.1"
97 :type 'boolean) 97 :type 'boolean)
98 98
99(defcustom diff-font-lock-prettify nil
100 "If non-nil, font-lock will try and make the format prettier."
101 :version "27.1"
102 :type 'boolean)
103
99(defvar diff-vc-backend nil 104(defvar diff-vc-backend nil
100 "The VC backend that created the current Diff buffer, if any.") 105 "The VC backend that created the current Diff buffer, if any.")
101 106
@@ -396,6 +401,7 @@ and the face `diff-added' for added lines.")
396 (1 font-lock-comment-delimiter-face) 401 (1 font-lock-comment-delimiter-face)
397 (2 font-lock-comment-face)) 402 (2 font-lock-comment-face))
398 ("^[^-=+*!<>#].*\n" (0 'diff-context)) 403 ("^[^-=+*!<>#].*\n" (0 'diff-context))
404 (,#'diff--font-lock-prettify)
399 (,#'diff--font-lock-refined))) 405 (,#'diff--font-lock-refined)))
400 406
401(defconst diff-font-lock-defaults 407(defconst diff-font-lock-defaults
@@ -2195,6 +2201,35 @@ fixed, visit it in a buffer."
2195 modified-buffers ", ")) 2201 modified-buffers ", "))
2196 (message "No trailing whitespace to delete."))))) 2202 (message "No trailing whitespace to delete.")))))
2197 2203
2204
2205;;; Prettifying from font-lock
2206
2207(defun diff--font-lock-prettify (limit)
2208 ;; Mimicks the output of Magit's diff.
2209 ;; FIXME: This has only been tested with Git's diff output.
2210 (when diff-font-lock-prettify
2211 (while (re-search-forward "^diff " limit t)
2212 (when (save-excursion
2213 (forward-line 0)
2214 (looking-at (eval-when-compile
2215 (concat "diff.*\n"
2216 "\\(?:\\(?:new file\\|deleted\\).*\n\\)?"
2217 "\\(?:index.*\n\\)?"
2218 "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n"
2219 "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n"))))
2220 (put-text-property (match-beginning 0)
2221 (or (match-beginning 2) (match-beginning 1))
2222 'display (propertize
2223 (cond
2224 ((null (match-beginning 1)) "new file ")
2225 ((null (match-beginning 2)) "deleted ")
2226 (t "modified "))
2227 'face '(diff-file-header diff-header)))
2228 (unless (match-beginning 2)
2229 (put-text-property (match-end 1) (1- (match-end 0))
2230 'display "")))))
2231 nil)
2232
2198;;; Support for converting a diff to diff3 markers via `wiggle'. 2233;;; Support for converting a diff to diff3 markers via `wiggle'.
2199 2234
2200;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest 2235;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index b850350cd8a..ac94586cace 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -226,8 +226,9 @@ With prefix arg, prompt for diff switches."
226 "View the differences between BUFFER and its associated file. 226 "View the differences between BUFFER and its associated file.
227This requires the external program `diff' to be in your `exec-path'." 227This requires the external program `diff' to be in your `exec-path'."
228 (interactive "bBuffer: ") 228 (interactive "bBuffer: ")
229 (with-current-buffer (get-buffer (or buffer (current-buffer))) 229 (let ((buf (get-buffer (or buffer (current-buffer)))))
230 (diff buffer-file-name (current-buffer) nil 'noasync))) 230 (with-current-buffer (or (buffer-base-buffer buf) buf)
231 (diff buffer-file-name (current-buffer) nil 'noasync))))
231 232
232(provide 'diff) 233(provide 'diff)
233 234
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 6ff782a6061..90860fbdcfe 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -913,8 +913,10 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
913 (setq change-log-default-name nil) 913 (setq change-log-default-name nil)
914 (find-change-log))))) 914 (find-change-log)))))
915 (when (or (find-buffer-visiting changelog-file-name) 915 (when (or (find-buffer-visiting changelog-file-name)
916 (file-exists-p changelog-file-name)) 916 (file-exists-p changelog-file-name)
917 (with-current-buffer (find-file-noselect changelog-file-name) 917 add-log-dont-create-changelog-file)
918 (with-current-buffer
919 (add-log-find-changelog-buffer changelog-file-name)
918 (unless (eq major-mode 'change-log-mode) (change-log-mode)) 920 (unless (eq major-mode 'change-log-mode) (change-log-mode))
919 (goto-char (point-min)) 921 (goto-char (point-min))
920 (if (looking-at "\\s-*\n") (goto-char (match-end 0))) 922 (if (looking-at "\\s-*\n") (goto-char (match-end 0)))
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 825420c4261..bdba32c8067 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -280,7 +280,7 @@ bit output with no translation."
280 (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257) 280 (w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257)
281 (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866) 281 (w32-add-charset-info "koi8-r" 'w32-charset-russian 20866)
282 (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) 282 (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
283 (w32-add-charset-info "tis620-2533" 'w32-charset-thai 874) 283 (w32-add-charset-info "iso8859-11" 'w32-charset-thai 874)
284 (w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258) 284 (w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258)
285 (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361) 285 (w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361)
286 (w32-add-charset-info "mac-roman" 'w32-charset-mac 10000) 286 (w32-add-charset-info "mac-roman" 'w32-charset-mac 10000)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index bb60e777769..be0bde290ab 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -255,6 +255,7 @@ See `wdired-mode'."
255 (setq buffer-read-only nil) 255 (setq buffer-read-only nil)
256 (dired-unadvertise default-directory) 256 (dired-unadvertise default-directory)
257 (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t) 257 (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
258 (add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t)
258 (setq major-mode 'wdired-mode) 259 (setq major-mode 'wdired-mode)
259 (setq mode-name "Editable Dired") 260 (setq mode-name "Editable Dired")
260 (setq revert-buffer-function 'wdired-revert) 261 (setq revert-buffer-function 'wdired-revert)
@@ -363,6 +364,7 @@ non-nil means return old filename."
363 (setq mode-name "Dired") 364 (setq mode-name "Dired")
364 (dired-advertise) 365 (dired-advertise)
365 (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) 366 (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
367 (remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t)
366 (set (make-local-variable 'revert-buffer-function) 'dired-revert)) 368 (set (make-local-variable 'revert-buffer-function) 'dired-revert))
367 369
368 370
@@ -381,7 +383,6 @@ non-nil means return old filename."
381(defun wdired-finish-edit () 383(defun wdired-finish-edit ()
382 "Actually rename files based on your editing in the Dired buffer." 384 "Actually rename files based on your editing in the Dired buffer."
383 (interactive) 385 (interactive)
384 (wdired-change-to-dired-mode)
385 (let ((changes nil) 386 (let ((changes nil)
386 (errors 0) 387 (errors 0)
387 files-deleted 388 files-deleted
@@ -423,6 +424,11 @@ non-nil means return old filename."
423 (forward-line -1))) 424 (forward-line -1)))
424 (when files-renamed 425 (when files-renamed
425 (setq errors (+ errors (wdired-do-renames files-renamed)))) 426 (setq errors (+ errors (wdired-do-renames files-renamed))))
427 ;; We have to be in wdired-mode when wdired-do-renames is executed
428 ;; so that wdired--restore-dired-filename-prop runs, but we have
429 ;; to change back to dired-mode before reverting the buffer to
430 ;; avoid using wdired-revert, which changes back to wdired-mode.
431 (wdired-change-to-dired-mode)
426 (if changes 432 (if changes
427 (progn 433 (progn
428 ;; If we are displaying a single file (rather than the 434 ;; If we are displaying a single file (rather than the
@@ -543,19 +549,25 @@ and proceed depending on the answer."
543 (goto-char (point-max)) 549 (goto-char (point-max))
544 (forward-line -1) 550 (forward-line -1)
545 (let ((done nil) 551 (let ((done nil)
552 (failed t)
546 curr-filename) 553 curr-filename)
547 (while (and (not done) (not (bobp))) 554 (while (and (not done) (not (bobp)))
548 (setq curr-filename (wdired-get-filename nil t)) 555 (setq curr-filename (wdired-get-filename nil t))
549 (if (equal curr-filename filename-ori) 556 (if (equal curr-filename filename-ori)
550 (progn 557 (unwind-protect
551 (setq done t) 558 (progn
552 (let ((inhibit-read-only t)) 559 (setq done t)
553 (dired-move-to-filename) 560 (let ((inhibit-read-only t))
554 (search-forward (wdired-get-filename t) nil t) 561 (dired-move-to-filename)
555 (replace-match (file-name-nondirectory filename-ori) t t)) 562 (search-forward (wdired-get-filename t) nil t)
556 (dired-do-create-files-regexp 563 (replace-match (file-name-nondirectory filename-ori) t t))
557 (function dired-rename-file) 564 (dired-do-create-files-regexp
558 "Move" 1 ".*" filename-new nil t)) 565 (function dired-rename-file)
566 "Move" 1 ".*" filename-new nil t)
567 (setq failed nil))
568 ;; If user types C-g when prompted to change the file
569 ;; name, make sure we return to dired-mode.
570 (when failed (wdired-change-to-dired-mode)))
559 (forward-line -1)))))) 571 (forward-line -1))))))
560 572
561;; marks a list of files for deletion 573;; marks a list of files for deletion
@@ -586,6 +598,25 @@ Optional arguments are ignored."
586 (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? "))) 598 (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
587 (error "Error"))) 599 (error "Error")))
588 600
601;; Added to after-change-functions in wdired-change-to-wdired-mode to
602;; ensure that, on editing a file name, new characters get the
603;; dired-filename text property, which allows functions that look for
604;; this property (e.g. dired-isearch-filenames) to work in wdired-mode
605;; and also avoids an error with non-nil wdired-use-interactive-rename
606;; (bug#32173).
607(defun wdired--restore-dired-filename-prop (beg end _len)
608 (save-match-data
609 (save-excursion
610 (beginning-of-line)
611 (when (re-search-forward directory-listing-before-filename-regexp
612 (line-end-position) t)
613 (setq beg (point)
614 end (if (and (file-symlink-p (dired-get-filename))
615 (search-forward " -> " (line-end-position) t))
616 (goto-char (match-beginning 0))
617 (line-end-position)))
618 (put-text-property beg end 'dired-filename t)))))
619
589(defun wdired-next-line (arg) 620(defun wdired-next-line (arg)
590 "Move down lines then position at filename or the current column. 621 "Move down lines then position at filename or the current column.
591See `wdired-use-dired-vertical-movement'. Optional prefix ARG 622See `wdired-use-dired-vertical-movement'. Optional prefix ARG