diff options
| author | Andrea Corallo <akrl@sdf.org> | 2020-08-13 12:22:07 +0200 |
|---|---|---|
| committer | Andrea Corallo <akrl@sdf.org> | 2020-08-13 12:22:07 +0200 |
| commit | 46e7613ad3b88807d25cfab3d78bf46c9e2fe13e (patch) | |
| tree | a7b560c36e097660536697c9d0057c9273d779b2 /lisp | |
| parent | f6502f959253b8f705e324e137c2933c5a668f62 (diff) | |
| parent | e9eafd22681b8e95d8d642def0512d9290564206 (diff) | |
| download | emacs-46e7613ad3b88807d25cfab3d78bf46c9e2fe13e.tar.gz | |
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'lisp')
75 files changed, 1113 insertions, 706 deletions
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 2a8dced5e9c..03fc3e2f0e1 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -207,6 +207,7 @@ See `allout-widgets-mode' for allout widgets mode features." :version "24.1" :type 'plist :group 'allout-widgets) +(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1") ;;;_ . Developer ;;;_ = allout-widgets-run-unit-tests-on-load (defcustom allout-widgets-run-unit-tests-on-load nil @@ -323,8 +324,7 @@ In addition, you can invoked `allout-widgets-mode' allout-mode buffers where this is set to enable and disable widget enhancements, directly.") ;;;###autoload -(put 'allout-widgets-mode-inhibit 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp) (make-variable-buffer-local 'allout-widgets-mode-inhibit) ;;;_ = allout-inhibit-body-modification-hook (defvar allout-inhibit-body-modification-hook nil @@ -1510,8 +1510,7 @@ recursive operation." ;; the actual location of the item text: :location 'allout-item-location - :button-keymap allout-item-icon-keymap ; XEmacs - :keymap allout-item-icon-keymap ; Emacs + :keymap allout-item-icon-keymap ;; Element regions: :guides-span nil @@ -2329,15 +2328,13 @@ We use a caching strategy, so the caller doesn't need to do so." (allout-widgets-copy-list (cadr got)) (while (and types (not got)) (setq got - (allout-find-image + (find-image (list (append (list :type (car types) :file (concat use-dir (symbol-name name) "." (symbol-name (car types)))) - (if (featurep 'xemacs) - allout-widgets-item-image-properties-xemacs - allout-widgets-item-image-properties-emacs) + allout-widgets-item-image-properties-emacs )))) (setq types (cdr types))) (if got @@ -2358,11 +2355,7 @@ We use a caching strategy, so the caller doesn't need to do so." 'frame-property) (t nil))) ;;;_ > allout-find-image (specs) -(defalias 'allout-find-image - (if (fboundp 'find-image) - 'find-image - nil) ; aka, not-yet-implemented for xemacs. -) +(define-obsolete-function-alias 'allout-find-image #'find-image "28.1") ;;;_ > allout-widgets-copy-list (list) (defun allout-widgets-copy-list (list) ;; duplicated from cl.el 'copy-list' as of 2008-08-17 diff --git a/lisp/allout.el b/lisp/allout.el index dedad45f827..05d9153a31d 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -410,8 +410,7 @@ where auto-fill occurs." :group 'allout) (make-variable-buffer-local 'allout-use-hanging-indents) ;;;###autoload -(put 'allout-use-hanging-indents 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp) ;;;_ = allout-reindent-bodies (defcustom allout-reindent-bodies (if allout-use-hanging-indents 'text) @@ -440,8 +439,7 @@ just the header." :group 'allout) (make-variable-buffer-local 'allout-show-bodies) ;;;###autoload -(put 'allout-show-bodies 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-show-bodies 'safe-local-variable 'booleanp) ;;;_ = allout-beginning-of-line-cycles (defcustom allout-beginning-of-line-cycles t @@ -662,8 +660,7 @@ are always respected by the topic maneuvering functions." :group 'allout) (make-variable-buffer-local 'allout-old-style-prefixes) ;;;###autoload -(put 'allout-old-style-prefixes 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp) ;;;_ = allout-stylish-prefixes -- alternating bullets (defcustom allout-stylish-prefixes t "Do fancy stuff with topic prefix bullets according to level, etc. @@ -711,8 +708,7 @@ is non-nil." :group 'allout) (make-variable-buffer-local 'allout-stylish-prefixes) ;;;###autoload -(put 'allout-stylish-prefixes 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp) ;;;_ = allout-numbered-bullet (defcustom allout-numbered-bullet "#" @@ -726,10 +722,7 @@ disables numbering maintenance." :group 'allout) (make-variable-buffer-local 'allout-numbered-bullet) ;;;###autoload -(put 'allout-numbered-bullet 'safe-local-variable - (if (fboundp 'string-or-null-p) - 'string-or-null-p - (lambda (x) (or (stringp x) (null x))))) +(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p) ;;;_ = allout-file-xref-bullet (defcustom allout-file-xref-bullet "@" "Bullet signifying file cross-references, for `allout-resolve-xref'. @@ -738,10 +731,7 @@ Set this var to the bullet you want to use for file cross-references." :type '(choice (const nil) string) :group 'allout) ;;;###autoload -(put 'allout-file-xref-bullet 'safe-local-variable - (if (fboundp 'string-or-null-p) - 'string-or-null-p - (lambda (x) (or (stringp x) (null x))))) +(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p) ;;;_ = allout-presentation-padding (defcustom allout-presentation-padding 2 "Presentation-format white-space padding factor, for greater indent." @@ -2484,20 +2474,16 @@ Outermost is first." (allout-back-to-current-heading) (allout-end-of-current-line)) (t - (if (not (allout-mark-active-p)) + (if (not mark-active) (push-mark)) (allout-end-of-entry)))))) + ;;;_ > allout-mark-active-p () (defun allout-mark-active-p () "True if the mark is currently or always active." - ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler - ;; provisions, at least in GNU Emacs to prevent warnings about lack of, - ;; eg, region-active-p. - (cond ((boundp 'mark-active) - mark-active) - ((fboundp 'region-active-p) - (region-active-p)) - (t))) + (declare (obsolete nil "28.1")) + mark-active) + ;;;_ > allout-next-heading () (defsubst allout-next-heading () "Move to the heading for the topic (possibly invisible) after this one. @@ -5452,11 +5438,9 @@ header and body. The elements of that list are: (cdr format))))))) ;; Put the list with first at front, to last at back: (nreverse result)))) -;;;_ > allout-region-active-p () -(defmacro allout-region-active-p () - (cond ((fboundp 'use-region-p) '(use-region-p)) - ((fboundp 'region-active-p) '(region-active-p)) - (t 'mark-active))) + +(define-obsolete-function-alias 'allout-region-active-p 'region-active-p "28.1") + ;;_ > allout-process-exposed (&optional func from to frombuf ;;; tobuf format) (defun allout-process-exposed (&optional func from to frombuf tobuf @@ -5489,7 +5473,7 @@ Defaults: ; defaulting if necessary: (if (not func) (setq func 'allout-insert-listified)) (if (not (and from to)) - (if (allout-region-active-p) + (if (region-active-p) (setq from (region-beginning) to (region-end)) (setq from (point-min) to (point-max)))) (if frombuf diff --git a/lisp/apropos.el b/lisp/apropos.el index 2566d44dfcf..6d8c7847b02 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -543,6 +543,20 @@ will be buffer-local when set." (and (local-variable-if-set-p symbol) (get symbol 'variable-documentation))))) +;;;###autoload +(defun apropos-function (pattern) + "Show functions that match PATTERN. + +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +This is the same as running `apropos-command' with a \\[universal-argument] prefix, +or a non-nil `apropos-do-all' argument." + (interactive (list (apropos-read-pattern "function"))) + (apropos-command pattern t)) + ;; For auld lang syne: ;;;###autoload (defalias 'command-apropos 'apropos-command) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index fb293adb779..36a361c3f4b 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -200,6 +200,7 @@ A non-nil value may result in truncated bookmark names." (define-key map "f" 'bookmark-insert-location) ;"f"ind (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) + (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) @@ -1374,6 +1375,23 @@ probably because we were called from there." (bookmark-save))) +;;;###autoload +(defun bookmark-delete-all (&optional no-confirm) + "Permanently delete all bookmarks. +If optional argument NO-CONFIRM is non-nil, don't ask for +confirmation." + (interactive "P") + (when (or no-confirm + (yes-or-no-p "Permanently delete all bookmarks? ")) + (bookmark-maybe-load-default-file) + (setq bookmark-alist-modification-count + (+ bookmark-alist-modification-count (length bookmark-alist))) + (setq bookmark-alist nil) + (bookmark-bmenu-surreptitiously-rebuild-list) + (when (bookmark-time-to-save-p) + (bookmark-save)))) + + (defun bookmark-time-to-save-p (&optional final-time) "Return t if it is time to save bookmarks to disk, nil otherwise. Optional argument FINAL-TIME means this is being called when Emacs @@ -1600,12 +1618,15 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (define-key map "\C-d" 'bookmark-bmenu-delete-backwards) (define-key map "x" 'bookmark-bmenu-execute-deletions) (define-key map "d" 'bookmark-bmenu-delete) + (define-key map "D" 'bookmark-bmenu-delete-all) (define-key map " " 'next-line) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "\177" 'bookmark-bmenu-backup-unmark) (define-key map "u" 'bookmark-bmenu-unmark) + (define-key map "U" 'bookmark-bmenu-unmark-all) (define-key map "m" 'bookmark-bmenu-mark) + (define-key map "M" 'bookmark-bmenu-mark-all) (define-key map "l" 'bookmark-bmenu-load) (define-key map "r" 'bookmark-bmenu-rename) (define-key map "R" 'bookmark-bmenu-relocate) @@ -1627,8 +1648,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." ["Select Marked Bookmarks" bookmark-bmenu-select t] "---" ["Mark Bookmark" bookmark-bmenu-mark t] + ["Mark all Bookmarks" bookmark-bmenu-mark-all t] ["Unmark Bookmark" bookmark-bmenu-unmark t] ["Unmark Backwards" bookmark-bmenu-backup-unmark t] + ["Unmark all Bookmarks" bookmark-bmenu-unmark-all t] ["Toggle Display of Filenames" bookmark-bmenu-toggle-filenames t] ["Display Location of Bookmark" bookmark-bmenu-locate t] "---" @@ -1636,6 +1659,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." ["Rename Bookmark" bookmark-bmenu-rename t] ["Relocate Bookmark's File" bookmark-bmenu-relocate t] ["Mark Bookmark for Deletion" bookmark-bmenu-delete t] + ["Mark all Bookmarks for Deletion" bookmark-bmenu-delete-all t] ["Delete Marked Bookmarks" bookmark-bmenu-execute-deletions t]) ("Annotations" ["Show Annotation for Current Bookmark" bookmark-bmenu-show-annotation t] @@ -1761,6 +1785,7 @@ Letters do not insert themselves; instead, they are commands. Bookmark names preceded by a \"*\" have annotations. \\<bookmark-bmenu-mode-map> \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. +\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed. \\[bookmark-bmenu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). @@ -1777,13 +1802,15 @@ Bookmark names preceded by a \"*\" have annotations. \\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file). \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. -\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'. +\\[bookmark-bmenu-delete-all] -- mark all listed bookmarks as to be deleted. +\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]' or `\\[bookmark-bmenu-delete-all]'. \\[bookmark-bmenu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks. +\\[bookmark-bmenu-unmark-all] -- remove all kinds of marks from all listed bookmarks. \\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. @@ -1950,9 +1977,23 @@ If the annotation does not exist, do nothing." (bookmark-bmenu-ensure-position)))) +(defun bookmark-bmenu-mark-all () + "Mark all listed bookmarks to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert ?>) + (forward-line 1)))))) + + (defun bookmark-bmenu-select () "Select this line's bookmark; also display bookmarks marked with `>'. -You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command." +You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands." (interactive) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) @@ -2121,6 +2162,20 @@ Optional BACKUP means move up." (bookmark-bmenu-ensure-position)) +(defun bookmark-bmenu-unmark-all () + "Cancel all requested operations on all listed bookmarks." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert " ") + (forward-line 1)))))) + + (defun bookmark-bmenu-delete () "Mark bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]." @@ -2146,6 +2201,22 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ (bookmark-bmenu-ensure-position)) +(defun bookmark-bmenu-delete-all () + "Mark all listed bookmarks as to be deleted. +To remove all deletion marks, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all]. +To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert ?D) + (forward-line 1)))))) + + (defun bookmark-bmenu-execute-deletions () "Delete bookmarks flagged `D'." (interactive) @@ -2305,6 +2376,9 @@ strings returned are not." (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) + (bindings--define-key map [delete-all] + '(menu-item "Delete all Bookmarks..." bookmark-delete-all + :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index f5150ca552c..690aaf2687f 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -150,34 +150,16 @@ ;; otherwise it just parses the yanked string. ;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96 ;;;###autoload -(defun calc-yank (radix) - "Yank a value into the Calculator buffer. - -Valid numeric prefixes for RADIX: 0, 2, 6, 8 -No radix notation is prepended for any other numeric prefix. - -If RADIX is 2, prepend \"2#\" - Binary. -If RADIX is 8, prepend \"8#\" - Octal. -If RADIX is 0, prepend \"10#\" - Decimal. -If RADIX is 6, prepend \"16#\" - Hexadecimal. +(defun calc-yank-internal (radix thing-raw) + "Internal common implementation for yank functions. -If RADIX is a non-nil list (created using \\[universal-argument]), the user -will be prompted to enter the radix in the minibuffer. - -If RADIX is nil or if the yanked string already has a calc radix prefix, the -yanked string will be passed on directly to the Calculator buffer without any -alteration." - (interactive "P") +This function is used by both `calc-yank' and `calc-yank-mouse-primary'." (calc-wrapper (calc-pop-push-record-list 0 "yank" (let* (radix-num radix-notation valid-num-regexp - (thing-raw - (if (fboundp 'current-kill) - (current-kill 0 t) - (car kill-ring-yank-pointer))) (thing (if (or (null radix) ;; Match examples: -2#10, 10\n(10#10,01) @@ -232,6 +214,38 @@ alteration." val)) val)))))))) +;;;###autoload +(defun calc-yank-mouse-primary (radix) + "Yank the current primary selection into the Calculator buffer. +See `calc-yank' for details about RADIX." + (interactive "P") + (if (or select-enable-primary + select-enable-clipboard) + (calc-yank-internal radix (gui-get-primary-selection)) + ;; Yank from the kill ring. + (calc-yank radix))) + +;;;###autoload +(defun calc-yank (radix) + "Yank a value into the Calculator buffer. + +Valid numeric prefixes for RADIX: 0, 2, 6, 8 +No radix notation is prepended for any other numeric prefix. + +If RADIX is 2, prepend \"2#\" - Binary. +If RADIX is 8, prepend \"8#\" - Octal. +If RADIX is 0, prepend \"10#\" - Decimal. +If RADIX is 6, prepend \"16#\" - Hexadecimal. + +If RADIX is a non-nil list (created using \\[universal-argument]), the user +will be prompted to enter the radix in the minibuffer. + +If RADIX is nil or if the yanked string already has a calc radix prefix, the +yanked string will be passed on directly to the Calculator buffer without any +alteration." + (interactive "P") + (calc-yank-internal radix (current-kill 0 t))) + ;;; The Calc set- and get-register commands are modified versions of functions ;;; in register.el diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 09b49621070..fb1287baaa6 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1087,8 +1087,26 @@ Used by `calc-user-invocation'.") (append (where-is-internal 'delete-backward-char global-map) (where-is-internal 'backward-delete-char global-map) (where-is-internal 'backward-delete-char-untabify global-map) - '("\C-d")) - '("\177" "\C-d"))) + '("\177")) + '("\177"))) + +(mapc (lambda (x) + (ignore-errors + (define-key calc-digit-map x 'calcDigit-delchar) + (define-key calc-mode-map x 'calc-pop) + (define-key calc-mode-map + (if (and (vectorp x) (featurep 'xemacs)) + (if (= (length x) 1) + (vector (if (consp (aref x 0)) + (cons 'meta (aref x 0)) + (list 'meta (aref x 0)))) + "\e\C-d") + (vconcat "\e" x)) + 'calc-pop-above))) + (if calc-scan-for-dels + (append (where-is-internal 'delete-forward-char global-map) + '("\C-d")) + '("\C-d"))) (defvar calc-dispatch-map (let ((map (make-keymap))) @@ -2343,7 +2361,6 @@ the United States." (defun calcDigit-key () (interactive) - (goto-char (point-max)) (if (or (and (memq last-command-event '(?+ ?-)) (> (buffer-size) 0) (/= (preceding-char) ?e)) @@ -2386,8 +2403,7 @@ the United States." (delete-char 1)) (if (looking-at "-") (delete-char 1) - (insert "-"))) - (goto-char (point-max))) + (insert "-")))) ((eq last-command-event ?p) (if (or (calc-minibuffer-contains ".*\\+/-.*") (calc-minibuffer-contains ".*mod.*") @@ -2440,17 +2456,9 @@ the United States." (setq calc-prev-prev-char calc-prev-char calc-prev-char last-command-event)) - (defun calcDigit-backspace () (interactive) - (goto-char (point-max)) - (cond ((calc-minibuffer-contains ".* \\+/- \\'") - (backward-delete-char 5)) - ((calc-minibuffer-contains ".* mod \\'") - (backward-delete-char 5)) - ((calc-minibuffer-contains ".* \\'") - (backward-delete-char 2)) - ((eq last-command 'calcDigit-start) + (cond ((eq last-command 'calcDigit-start) (erase-buffer)) (t (backward-delete-char 1))) (if (= (calc-minibuffer-size) 0) @@ -2925,6 +2933,20 @@ the United States." (- (- (nth 2 a) (nth 2 b)) ldiff)))) +(defun calcDigit-delchar () + (interactive) + (cond ((looking-at-p " \\+/- \\'") + (delete-char 5)) + ((looking-at-p " mod \\'") + (delete-char 5)) + ((looking-at-p " \\'") + (delete-char 2)) + ((eq last-command 'calcDigit-start) + (erase-buffer)) + (t (unless (eobp) (delete-char 1)))) + (when (= (calc-minibuffer-size) 0) + (setq last-command-event 13) + (calcDigit-nondigit))) (defvar math-comp-selected) diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index af6acaf09ad..05768e10c01 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -350,7 +350,7 @@ If the locale never uses daylight saving time, set this to 0." :group 'calendar-dst) (defcustom calendar-standard-time-zone-name - (if calendar-use-numeric-time-zones + (if (eq calendar-time-zone-style 'numeric) (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (car calendar-current-time-zone-cache))) @@ -360,10 +360,11 @@ If the locale never uses daylight saving time, set this to 0." For example, \"EST\" in New York City, \"PST\" for Los Angeles." :type 'string :version "28.1" + :set-after '(calendar-time-zone-style) :group 'calendar-dst) (defcustom calendar-daylight-time-zone-name - (if calendar-use-numeric-time-zones + (if (eq calendar-time-zone-style 'numeric) (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) @@ -373,6 +374,7 @@ For example, \"EST\" in New York City, \"PST\" for Los Angeles." For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." :type 'string :version "28.1" + :set-after '(calendar-time-zone-style) :group 'calendar-dst) (defcustom calendar-daylight-savings-starts-time diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0efb2bc6607..574261456fc 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1061,10 +1061,12 @@ calendar." :type 'boolean :group 'holidays) -(defcustom calendar-use-numeric-time-zones nil - "If nil, use symbolic time zones like \"CET\" when displaying dates. -If non-nil, use numeric time zones like \"+0100\"." - :type 'boolean +;; fixme should have a :set that changes calendar-standard-time-zone-name etc. +(defcustom calendar-time-zone-style 'symbolic + "Your preferred style for time zones. +If 'numeric, use numeric time zones like \"+0100\". +Otherwise, use symbolic time zones like \"CET\"." + :type '(choice (const numeric) (other symbolic)) :version "28.1" :group 'calendar) diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 635bdd8f11c..05bb3164e12 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -840,8 +840,8 @@ This function is suitable for execution in an init file." (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name (cond ((zerop calendar-time-zone) - (if calendar-use-numeric-time-zones - "+0100" "UTC")) + (if (eq calendar-time-zone-style 'numeric) + "+0000" "UTC")) ((< calendar-time-zone 0) (format "UTC%dmin" calendar-time-zone)) (t (format "UTC+%dmin" calendar-time-zone))))) @@ -1016,7 +1016,7 @@ Requires floating point." (calendar-standard-time-zone-name (cond (calendar-time-zone calendar-standard-time-zone-name) - (calendar-use-numeric-time-zones "+0100") + ((eq calendar-time-zone-style 'numeric) "+0000") (t "UTC"))) (calendar-daylight-savings-starts (if calendar-time-zone calendar-daylight-savings-starts)) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 7a1273d6534..e347c99f191 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -68,13 +68,11 @@ ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to ;; run major mode hooks. -(defalias 'semantic-run-mode-hooks - (if (fboundp 'run-mode-hooks) - 'run-mode-hooks - 'run-hooks)) +(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1") - ;; Fancy compat usage now handled in cedet-compat -(defalias 'semantic-subst-char-in-string 'subst-char-in-string) +;; Fancy compat usage now handled in cedet-compat +(define-obsolete-function-alias 'semantic-subst-char-in-string + 'subst-char-in-string "28.1") (defun semantic-delete-overlay-maybe (overlay) "Delete OVERLAY if it is a semantic token overlay." diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 1ed18339a72..6cd4832165c 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1251,6 +1251,7 @@ common grammar menu." "Setup an XEmacs grammar menu in variable SYMBOL. MODE-MENU is an optional specific menu whose items are appended to the common grammar menu." + (declare (obsolete nil "28.1")) (let ((items (make-symbol "items")) (path (make-symbol "path"))) `(progn diff --git a/lisp/comint.el b/lisp/comint.el index 4b3b5838560..c3cb439d8b8 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -249,6 +249,10 @@ to set this in a mode hook, rather than customize the default value." file) :group 'comint) +(defvar comint-input-ring-file-prefix nil + "The prefix to skip when parsing the input ring file. +This is useful in Zsh when the extended_history option is on.") + (defcustom comint-scroll-to-bottom-on-input nil "Controls whether input to interpreter causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. @@ -731,7 +735,7 @@ contents are sent to the process as its initial input. If PROGRAM is a string, any more args are arguments to PROGRAM. Return the (possibly newly created) process buffer." - (or (fboundp 'start-file-process) + (or (fboundp 'make-process) (error "Multi-processing is not supported for this system")) (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in @@ -987,8 +991,20 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'." (setq end (match-beginning 0))) (setq start (if (re-search-backward ring-separator nil t) - (match-end 0) - (point-min))) + (progn + (when (and comint-input-ring-file-prefix + (looking-at + comint-input-ring-file-prefix)) + ;; Skip zsh extended_history stamps + (goto-char (match-end 0))) + (match-end 0)) + (progn + (goto-char (point-min)) + (when (and comint-input-ring-file-prefix + (looking-at + comint-input-ring-file-prefix)) + (goto-char (match-end 0))) + (point)))) (setq history (buffer-substring start end)) (goto-char start) (when (and (not (string-match history-ignore history)) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 84d8c36f45f..c197ed04fe2 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -688,7 +688,7 @@ are executed in the background on each file sequentially waiting for each command to terminate before running the next command. In shell syntax this means separating the individual commands with `;'. -The output appears in the buffer `shell-command-buffer-name-async'." +The output appears in the buffer named by `shell-command-buffer-name-async'." (interactive (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) (list @@ -726,16 +726,16 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just `*' in the shell, but avoids Dired's special handling. If COMMAND ends in `&', `;', or `;&', it is executed in the -background asynchronously, and the output appears in the buffer -`shell-command-buffer-name-async'. When operating on multiple files and COMMAND -ends in `&', the shell command is executed on each file in parallel. -However, when COMMAND ends in `;' or `;&' then commands are executed -in the background on each file sequentially waiting for each command -to terminate before running the next command. You can also use -`dired-do-async-shell-command' that automatically adds `&'. +background asynchronously, and the output appears in the buffer named +by `shell-command-buffer-name-async'. When operating on multiple files +and COMMAND ends in `&', the shell command is executed on each file +in parallel. However, when COMMAND ends in `;' or `;&', then commands +are executed in the background on each file sequentially waiting for +each command to terminate before running the next command. You can +also use `dired-do-async-shell-command' that automatically adds `&'. Otherwise, COMMAND is executed synchronously, and the output -appears in the buffer `shell-command-buffer-name'. +appears in the buffer named by `shell-command-buffer-name'. This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. @@ -1604,7 +1604,7 @@ Special value `always' suppresses confirmation." (defun dired-copy-file (from to ok-flag) (dired-handle-overwrite to) (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t - dired-recursive-copies)) + dired-recursive-copies dired-copy-dereference)) (declare-function make-symbolic-link "fileio.c") @@ -1627,7 +1627,8 @@ If `ask', ask for user confirmation." (dired-create-directory dir)))) (defun dired-copy-file-recursive (from to ok-flag &optional - preserve-time top recursive) + preserve-time top recursive + dereference) (when (and (eq t (file-attribute-type (file-attributes from))) (file-in-directory-p to from)) (error "Cannot copy `%s' into its subdirectory `%s'" from to)) @@ -1639,7 +1640,8 @@ If `ask', ask for user confirmation." (copy-directory from to preserve-time) (or top (dired-handle-overwrite to)) (condition-case err - (if (stringp (file-attribute-type attrs)) + (if (and (not dereference) + (stringp (file-attribute-type attrs))) ;; It is a symlink (make-symbolic-link (file-attribute-type attrs) to ok-flag) (dired-maybe-create-dirs (file-name-directory to)) @@ -2165,6 +2167,9 @@ See HOW-TO argument for `dired-do-create-files'.") ;;;###autoload (defun dired-do-copy (&optional arg) "Copy all marked (or next ARG) files, or copy the current file. +ARG has to be numeric for above functionality. See +`dired-get-marked-files' for more details. + When operating on just the current file, prompt for the new name. When operating on multiple or marked files, prompt for a target @@ -2178,10 +2183,18 @@ If `dired-copy-preserve-time' is non-nil, this command preserves the modification time of each old file in the copy, similar to the \"-p\" option for the \"cp\" shell command. -This command copies symbolic links by creating new ones, similar -to the \"-d\" option for the \"cp\" shell command." +This command copies symbolic links by creating new ones, +similar to the \"-d\" option for the \"cp\" shell command. +But if `dired-copy-dereference' is non-nil, the symbolic +links are dereferenced and then copied, similar to the \"-L\" +option for the \"cp\" shell command. If ARG is a cons with +element 4 (`\\[universal-argument]'), the inverted value of +`dired-copy-dereference' will be used." (interactive "P") - (let ((dired-recursive-copies dired-recursive-copies)) + (let ((dired-recursive-copies dired-recursive-copies) + (dired-copy-dereference (if (equal arg '(4)) + (not dired-copy-dereference) + dired-copy-dereference))) (dired-do-create-files 'copy #'dired-copy-file "Copy" arg dired-keep-marker-copy diff --git a/lisp/dired.el b/lisp/dired.el index d19d6d1581d..77bb6cfa9ca 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -216,6 +216,12 @@ The target is used in the prompt for file copy, rename etc." :type 'boolean :group 'dired) +(defcustom dired-copy-dereference nil + "If non-nil, Dired dereferences symlinks when copying them. +This is similar to the \"-L\" option for the \"cp\" shell command." + :type 'boolean + :group 'dired) + ; ; These variables were deleted and the replacements are on files.el. ; We leave aliases behind for back-compatibility. (define-obsolete-variable-alias 'dired-free-space-program diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 05eb0ac5693..592f1b695f7 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1,4 +1,4 @@ -;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- +;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- ;; Copyright (C) 1991-1997, 2001-2020 Free Software Foundation, Inc. @@ -606,9 +606,8 @@ Don't try to split prefixes that are already longer than that.") prefix file dropped) nil)))) prefixes))) - `(if (fboundp 'register-definition-prefixes) - (register-definition-prefixes ,file ',(sort (delq nil strings) - 'string<))))))) + `(register-definition-prefixes ,file ',(sort (delq nil strings) + 'string<)))))) (defun autoload--setup-output (otherbuf outbuf absfile load-name) (let ((outbuf diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index e4b800786cc..1029b52220d 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1249,13 +1249,8 @@ checking of documentation strings. ;;; Subst utils ;; -(defsubst checkdoc-run-hooks (hookvar &rest args) - "Run hooks in HOOKVAR with ARGS." - (if (fboundp 'run-hook-with-args-until-success) - (apply #'run-hook-with-args-until-success hookvar args) - ;; This method was similar to above. We ignore the warning - ;; since we will use the above for future Emacs versions - (apply #'run-hook-with-args hookvar args))) +(define-obsolete-function-alias 'checkdoc-run-hooks + #'run-hook-with-args-until-success "28.1") (defsubst checkdoc-create-common-verbs-regexp () "Rebuild the contents of `checkdoc-common-verbs-regexp'." @@ -1873,7 +1868,7 @@ Replace with \"%s\"? " original replace) ;; and reliance on the Ispell program. (checkdoc-ispell-docstring-engine e take-notes) ;; User supplied checks - (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e)) + (save-excursion (run-hook-with-args-until-success 'checkdoc-style-functions fp e)) ;; Done! ))) @@ -2384,7 +2379,7 @@ Code:, and others referenced in the style guide." err (or ;; Generic Full-file checks (should be comment related) - (checkdoc-run-hooks 'checkdoc-comment-style-functions) + (run-hook-with-args-until-success 'checkdoc-comment-style-functions) err)) ;; Done with full file comment checks err))) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 19b3bd78aea..4825b5c5e6c 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -289,13 +289,13 @@ Otherwise work like `message'." (or (window-in-direction 'above (minibuffer-window)) (minibuffer-selected-window) (get-largest-window))) - (when mode-line-format - (unless (and (listp mode-line-format) - (assq 'eldoc-mode-line-string mode-line-format)) + (when (and mode-line-format + (not (and (listp mode-line-format) + (assq 'eldoc-mode-line-string mode-line-format)))) (setq mode-line-format (list "" '(eldoc-mode-line-string (" " eldoc-mode-line-string " ")) - mode-line-format)))) + mode-line-format))) (setq eldoc-mode-line-string (when (stringp format-string) (apply #'format-message format-string args))) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 043cf01d2e9..8c18557c79a 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -482,7 +482,8 @@ is called as a function to find the defun's end." (if (looking-at "\\s<\\|\n") (forward-line 1)))))) (funcall end-of-defun-function) - (funcall skip) + (when (<= arg 1) + (funcall skip)) (cond ((> arg 0) ;; Moving forward. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index ca7fcaf2d91..77f1b291043 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -466,24 +466,7 @@ (assoc major-mode viper-emacs-state-modifier-alist))) (cdr (assoc major-mode viper-emacs-state-modifier-alist)) - viper-empty-keymap)) - )) - - ;; This var is not local in Emacs, so we make it local. It must be local - ;; because although the stack of minor modes can be the same for all buffers, - ;; the associated *keymaps* can be different. In Viper, - ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have - ;; different keymaps for different buffers. Also, the keymaps associated - ;; with viper-vi/insert-state-modifier-minor-mode can be different. - ;; ***This is needed only in case emulation-mode-map-alists is not defined. - ;; In emacs with emulation-mode-map-alists, nothing needs to be done - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (set (make-local-variable 'minor-mode-map-alist) - (viper-append-filter-alist - (append viper--intercept-key-maps viper--key-maps) - minor-mode-map-alist))) - ) + viper-empty-keymap))))) @@ -893,16 +876,7 @@ LOAD-FILE is the name of the file where the specific minor mode is defined. Suffixes such as .el or .elc should be stripped." (interactive "sEnter name of the load file: ") - - (eval-after-load load-file '(viper-normalize-minor-mode-map-alist)) - - ;; Change the default for minor-mode-map-alist each time a harnessed minor - ;; mode adds its own keymap to the a-list. - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (eval-after-load - load-file '(setq-default minor-mode-map-alist minor-mode-map-alist))) - ) + (eval-after-load load-file '(viper-normalize-minor-mode-map-alist))) (defun viper-ESC (arg) @@ -4721,8 +4695,7 @@ Please, specify your level now: ")) (interactive "cViper register to point: ") (let ((val (get-register char))) (cond - ((and (fboundp 'frame-configuration-p) - (frame-configuration-p val)) + ((frame-configuration-p val) (set-frame-configuration val)) ((window-configuration-p val) (set-window-configuration val)) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 8e7a34fc69c..59ca6298eb9 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -695,9 +695,6 @@ It also can't undo some Viper settings." 'mark-even-if-inactive viper-saved-non-viper-variables)) ;; Ideally, we would like to be able to de-localize local variables - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (viper-delocalize-var 'minor-mode-map-alist)) (viper-delocalize-var 'require-final-newline) ;; deactivate all advices done by Viper. @@ -705,11 +702,9 @@ It also can't undo some Viper settings." (setq viper-mode nil) - (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq emulation-mode-map-alists - (delq 'viper--intercept-key-maps - (delq 'viper--key-maps emulation-mode-map-alists)) - )) + (setq emulation-mode-map-alists + (delq 'viper--intercept-key-maps + (delq 'viper--key-maps emulation-mode-map-alists))) (viper-delocalize-var 'viper-vi-minibuffer-minor-mode) (viper-delocalize-var 'viper-insert-minibuffer-minor-mode) @@ -943,13 +938,11 @@ Two differences: (setq viper-vi-state-cursor-color color-name))) - (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - ;; needs to be as early as possible - (add-to-ordered-list - 'emulation-mode-map-alists 'viper--intercept-key-maps 100) - ;; needs to be after cua-mode - (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500) - ) + ;; needs to be as early as possible + (add-to-ordered-list + 'emulation-mode-map-alists 'viper--intercept-key-maps 100) + ;; needs to be after cua-mode + (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500) ;; Emacs shell, ange-ftp, and comint-based modes (add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint @@ -1062,10 +1055,7 @@ This may be needed if the previous `:map' command terminated abnormally." (viper--advice-add 'add-minor-mode :after (lambda (&rest _) "Run viper-normalize-minor-mode-map-alist after adding a minor mode." - (viper-normalize-minor-mode-map-alist) - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)))) + (viper-normalize-minor-mode-map-alist))) ;; catch frame switching event (if (viper-window-display-p) @@ -1253,12 +1243,7 @@ These two lines must come in the order given.")) ;; Without setting the default, new buffers that come up in emacs mode have ;; minor-mode-map-alist = nil, unless we call viper-change-state-* (when (eq viper-current-state 'emacs-state) - (viper-change-state-to-emacs) - (unless - (and (fboundp 'add-to-ordered-list) - (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)) - ) + (viper-change-state-to-emacs)) (if (this-major-mode-requires-vi-state major-mode) (viper-mode)) diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el index 9269ea97070..4ff1ba33941 100644 --- a/lisp/epa-dired.el +++ b/lisp/epa-dired.el @@ -1,4 +1,5 @@ ;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> diff --git a/lisp/epa-file.el b/lisp/epa-file.el index bbd9279a9a8..3b0cc84e5f6 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -1,4 +1,5 @@ ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> @@ -21,10 +22,13 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Dependencies (require 'epa) (require 'epa-hook) +;;; Options + (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil "If non-nil, cache passphrase for symmetric encryption. @@ -49,6 +53,8 @@ encryption is used." (const :tag "Don't ask" silent)) :group 'epa-file) +;;; Other + (defvar epa-file-passphrase-alist nil) (defun epa-file-passphrase-callback-function (context key-id file) @@ -72,6 +78,8 @@ encryption is used." passphrase)))) (epa-passphrase-callback-function context key-id file))) +;;; File Handler + (defvar epa-inhibit nil "Non-nil means don't try to decrypt .gpg files when operating on them.") @@ -311,6 +319,8 @@ If no one is selected, symmetric encryption will be performed. " (message "Wrote %s" buffer-file-name)))) (put 'write-region 'epa-file 'epa-file-write-region) +;;; Commands + (defun epa-file-select-keys () "Select recipients for encryption." (interactive) diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index a86f23eb688..6f12f8a6bfa 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -1,4 +1,5 @@ ;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 63475256ca8..6e6c0a498d2 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -1,4 +1,5 @@ ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> @@ -21,10 +22,13 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Dependencies (require 'epa) (require 'mail-utils) +;;; Local Mode + (defvar epa-mail-mode-map (let ((keymap (make-sparse-keymap))) (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt) @@ -50,6 +54,8 @@ "A minor-mode for composing encrypted/clearsigned mails." nil " epa-mail" epa-mail-mode-map) +;;; Utilities + (defun epa-mail--find-usable-key (keys usage) "Find a usable key from KEYS for USAGE. USAGE would be `sign' or `encrypt'." @@ -64,6 +70,8 @@ USAGE would be `sign' or `encrypt'." (setq pointer (cdr pointer)))) (setq keys (cdr keys))))) +;;; Commands + ;;;###autoload (defun epa-mail-decrypt () "Decrypt OpenPGP armors in the current buffer. @@ -241,6 +249,8 @@ The buffer is expected to contain a mail message." (interactive) (epa-import-armor-in-region (point-min) (point-max))) +;;; Global Mode + ;;;###autoload (define-minor-mode epa-global-mail-mode "Minor mode to hook EasyPG into Mail mode." diff --git a/lisp/epa.el b/lisp/epa.el index 3c7dd8309a8..d190824293f 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -21,6 +21,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Dependencies (require 'epg) (require 'font-lock) @@ -30,6 +31,8 @@ (require 'wid-edit)) (require 'derived) +;;; Options + (defgroup epa nil "The EasyPG Assistant" :version "23.1" @@ -73,6 +76,8 @@ The command `epa-mail-encrypt' uses this." :group 'epa :version "24.4") +;;; Faces + (defgroup epa-faces nil "Faces for epa-mode." :version "23.1" @@ -146,6 +151,8 @@ The command `epa-mail-encrypt' uses this." :type '(repeat (cons symbol face)) :group 'epa-faces) +;;; Variables + (defvar epa-font-lock-keywords '(("^\\*" (0 'epa-mark)) @@ -252,6 +259,8 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-exit-buffer-function #'quit-window) +;;; Key Widget + (define-widget 'epa-key 'push-button "Button for representing an epg-key object." :format "%[%v%]" @@ -293,6 +302,8 @@ You should bind this variable with `let', but do not set it globally.") (epg-sub-key-id (car (epg-key-sub-key-list (widget-get widget :value)))))) +;;; Modes + (define-derived-mode epa-key-list-mode special-mode "EPA Keys" "Major mode for `epa-list-keys'." (buffer-disable-undo) @@ -316,6 +327,9 @@ You should bind this variable with `let', but do not set it globally.") (setq truncate-lines t buffer-read-only t)) +;;; Commands +;;;; Marking + (defun epa-mark-key (&optional arg) "Mark a key on the current line. If ARG is non-nil, unmark the key." @@ -338,11 +352,15 @@ If ARG is non-nil, mark the key." (interactive "P") (epa-mark-key (not arg))) +;;;; Quitting + (defun epa-exit-buffer () "Exit the current buffer using `epa-exit-buffer-function'." (interactive) (funcall epa-exit-buffer-function)) +;;;; Listing and Selecting + (defun epa--insert-keys (keys) (save-excursion (save-restriction @@ -505,6 +523,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (let ((keys (epg-list-keys context names secret))) (epa--select-keys prompt keys))) +;;;; Key Details + (defun epa-show-key () "Show a key on the current line." (interactive) @@ -591,6 +611,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (goto-char (point-min)) (pop-to-buffer (current-buffer)))) +;;;; Encryption and Signatures + (defun epa-display-info (info) (if epa-popup-info-window (save-selected-window @@ -1105,16 +1127,7 @@ If no one is selected, default secret key is used. " 'start-open t 'end-open t))))) -(defalias 'epa--derived-mode-p - (if (fboundp 'derived-mode-p) - #'derived-mode-p - (lambda (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards." - (let ((parent major-mode)) - (while (and (not (memq parent modes)) - (setq parent (get parent 'derived-mode-parent)))) - parent)))) +(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1") ;;;###autoload (defun epa-encrypt-region (start end recipients sign signers) @@ -1191,6 +1204,8 @@ If no one is selected, symmetric encryption will be performed. ") 'start-open t 'end-open t))))) +;;;; Key Management + ;;;###autoload (defun epa-delete-keys (keys &optional allow-secret) "Delete selected KEYS." @@ -1227,7 +1242,7 @@ If no one is selected, symmetric encryption will be performed. ") (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string (epg-context-result-for context 'import)))) - ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p? + ;; FIXME: Why not use the derived-mode-p? (if (eq major-mode 'epa-key-list-mode) (apply #'epa--list-keys epa-list-keys-arguments)))) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 1c429246529..9f0c7e4c509 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -22,6 +22,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Prelude (eval-when-compile (require 'cl-lib)) @@ -34,6 +35,8 @@ (define-obsolete-variable-alias 'epg-bug-report-address 'report-emacs-bug-address "27.1") +;;; Options + (defgroup epg () "Interface to the GNU Privacy Guard (GnuPG)." :tag "EasyPG" @@ -106,6 +109,8 @@ through the minibuffer, instead of external Pinentry program." Note that the buffer name starts with a space." :type 'boolean) +;;; Constants + (defconst epg-gpg-minimum-version "1.4.3") (defconst epg-gpg2-minimum-version "2.1.6") @@ -133,6 +138,8 @@ The first element of each entry is protocol symbol, which is either `OpenPGP' or `CMS'. The second element is a function which constructs a configuration object (actually a plist).") +;;; "Configuration" + (defvar epg--configurations nil) ;;;###autoload diff --git a/lisp/epg.el b/lisp/epg.el index 5b90bc290ab..96af3ad4bca 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1,4 +1,5 @@ ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*- + ;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> @@ -21,10 +22,15 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Prelude (require 'epg-config) (eval-when-compile (require 'cl-lib)) +(define-error 'epg-error "GPG error") + +;;; Variables + (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -41,6 +47,8 @@ (defvar epg-agent-file nil) (defvar epg-agent-mtime nil) +;;; Enums + ;; from gnupg/common/openpgpdefs.h (defconst epg-cipher-algorithm-alist '((0 . "NONE") @@ -123,7 +131,7 @@ (defconst epg-no-data-reason-alist '((1 . "No armored data") - (2 . "Expected a packet but did not found one") + (2 . "Expected a packet but did not find one") (3 . "Invalid packet found, this may indicate a non OpenPGP message") (4 . "Signature expected but not found"))) @@ -169,7 +177,8 @@ (defvar epg-prompt-alist nil) -(define-error 'epg-error "GPG error") +;;; Structs +;;;; Data Struct (cl-defstruct (epg-data (:constructor nil) @@ -180,6 +189,8 @@ (file nil :read-only t) (string nil :read-only t)) +;;;; Context Struct + (cl-defstruct (epg-context (:constructor nil) (:constructor epg-context--make @@ -218,6 +229,8 @@ (error-output "") error-buffer) +;;;; Context Methods + ;; This is not an alias, just so we can mark it as autoloaded. ;;;###autoload (defun epg-make-context (&optional protocol armor textmode include-certs @@ -281,6 +294,8 @@ callback data (if any)." (declare (obsolete setf "25.1")) (setf (epg-context-signers context) signers)) +;;;; Other Structs + (cl-defstruct (epg-signature (:constructor nil) (:constructor epg-make-signature @@ -385,6 +400,8 @@ callback data (if any)." secret-unchanged not-imported imports) +;;; Functions + (defun epg-context-result-for (context name) "Return the result of CONTEXT associated with NAME." (cdr (assq name (epg-context-result context)))) @@ -404,37 +421,28 @@ callback data (if any)." (pubkey-algorithm (epg-signature-pubkey-algorithm signature)) (key-id (epg-signature-key-id signature))) (concat - (cond ((eq (epg-signature-status signature) 'good) - "Good signature from ") - ((eq (epg-signature-status signature) 'bad) - "Bad signature from ") - ((eq (epg-signature-status signature) 'expired) - "Expired signature from ") - ((eq (epg-signature-status signature) 'expired-key) - "Signature made by expired key ") - ((eq (epg-signature-status signature) 'revoked-key) - "Signature made by revoked key ") - ((eq (epg-signature-status signature) 'no-pubkey) - "No public key for ")) + (cl-case (epg-signature-status signature) + (good "Good signature from ") + (bad "Bad signature from ") + (expired "Expired signature from ") + (expired-key "Signature made by expired key ") + (revoked-key "Signature made by revoked key ") + (no-pubkey "No public key for ")) key-id - (if user-id - (concat " " - (if (stringp user-id) - (epg--decode-percent-escape-as-utf-8 user-id) - (epg-decode-dn user-id))) - "") - (if (epg-signature-validity signature) - (format " (trust %s)" (epg-signature-validity signature)) - "") - (if (epg-signature-creation-time signature) - (format-time-string " created at %Y-%m-%dT%T%z" - (epg-signature-creation-time signature)) - "") - (if pubkey-algorithm - (concat " using " - (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist)) - (format "(unknown algorithm %d)" pubkey-algorithm))) - "")))) + (and user-id + (concat " " + (if (stringp user-id) + (epg--decode-percent-escape-as-utf-8 user-id) + (epg-decode-dn user-id)))) + (and (epg-signature-validity signature) + (format " (trust %s)" (epg-signature-validity signature))) + (and (epg-signature-creation-time signature) + (format-time-string " created at %Y-%m-%dT%T%z" + (epg-signature-creation-time signature))) + (and pubkey-algorithm + (concat " using " + (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist)) + (format "(unknown algorithm %d)" pubkey-algorithm))))))) (defun epg-verify-result-to-string (verify-result) "Convert VERIFY-RESULT to a human readable string." @@ -859,6 +867,8 @@ callback data (if any)." (format "Untrusted key %s %s. Use anyway? " key-id user-id)) "Use untrusted key anyway? "))) +;;; Status Functions + (defun epg--status-GET_BOOL (context string) (let (inhibit-quit) (condition-case nil @@ -1234,6 +1244,8 @@ callback data (if any)." (epg-context-result-for context 'import-status))) (epg-context-set-result-for context 'import-status nil))) +;;; Functions + (defun epg-passphrase-callback-function (context key-id _handback) (declare (obsolete epa-passphrase-callback-function "23.1")) (if (eq key-id 'SYM) @@ -1303,6 +1315,8 @@ callback data (if any)." (if (aref line 6) (epg--time-from-seconds (aref line 6))))) +;;; Public Functions + (defun epg-list-keys (context &optional name mode) "Return a list of epg-key objects matched with NAME. If MODE is nil or `public', only public keyring should be searched. @@ -2032,6 +2046,8 @@ If you are unsure, use synchronous version of this function (epg-errors-to-string errors)))))) (epg-reset context))) +;;; Decode Functions + (defun epg--decode-percent-escape (string) (setq string (encode-coding-string string 'raw-text)) (let ((index 0)) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 94d5de280c6..ff7a77f1265 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -232,6 +232,10 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC bold face." :group 'erc-faces) +(defface erc-italic-face '((t :slant italic)) + "ERC italic face." + :group 'erc-faces) + (defface erc-inverse-face '((t :foreground "White" :background "Black")) "ERC inverse face." @@ -383,6 +387,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (erc-controls-strip s)) (erc-interpret-controls-p (let ((boldp nil) + (italicp nil) (inversep nil) (underlinep nil) (fg nil) @@ -401,6 +406,8 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (setq bg bg-color)) ((string= control "\C-b") (setq boldp (not boldp))) + ((string= control "\C-]") + (setq italicp (not italicp))) ((string= control "\C-v") (setq inversep (not inversep))) ((string= control "\C-_") @@ -413,13 +420,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (ding))) ((string= control "\C-o") (setq boldp nil + italicp nil inversep nil underlinep nil fg nil bg nil)) (t nil)) (erc-controls-propertize - start end boldp inversep underlinep fg bg s))) + start end boldp italicp inversep underlinep fg bg s))) s)) (t s))))) @@ -432,13 +440,13 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." s))) (defvar erc-controls-remove-regexp - "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" + "\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" "Regular expression which matches control characters to remove.") (defvar erc-controls-highlight-regexp - (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" + (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)" - "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)") + "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)") "Regular expression which matches control chars and the text to highlight.") (defun erc-controls-highlight () @@ -451,6 +459,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (replace-match ""))) (erc-interpret-controls-p (let ((boldp nil) + (italicp nil) (inversep nil) (underlinep nil) (fg nil) @@ -467,6 +476,8 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (setq bg bg-color)) ((string= control "\C-b") (setq boldp (not boldp))) + ((string= control "\C-]") + (setq italicp (not italicp))) ((string= control "\C-v") (setq inversep (not inversep))) ((string= control "\C-_") @@ -479,16 +490,17 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (ding))) ((string= control "\C-o") (setq boldp nil + italicp nil inversep nil underlinep nil fg nil bg nil)) (t nil)) (erc-controls-propertize start end - boldp inversep underlinep fg bg))))) + boldp italicp inversep underlinep fg bg))))) (t nil))) -(defun erc-controls-propertize (from to boldp inversep underlinep fg bg +(defun erc-controls-propertize (from to boldp italicp inversep underlinep fg bg &optional str) "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties @@ -500,6 +512,9 @@ to a region in the current buffer." (append (if boldp '(erc-bold-face) nil) + (if italicp + '(erc-italic-face) + nil) (if inversep '(erc-inverse-face) nil) diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index e4faf6bd797..79c111082f6 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -153,18 +153,20 @@ This function is run from `erc-nickserv-identified-hook'." 'erc-autojoin-channels-delayed server nick (current-buffer)))) ;; `erc-autojoin-timing' is `connect': - (dolist (l erc-autojoin-channels-alist) - (when (string-match (car l) server) - (let ((server (or erc-session-server erc-server-announced-name))) + (let ((server (or erc-session-server erc-server-announced-name))) + (dolist (l erc-autojoin-channels-alist) + (when (string-match-p (car l) server) (dolist (chan (cdr l)) - (let ((buffer (erc-get-buffer chan))) - ;; Only auto-join the channels that we aren't already in - ;; using a different nick. + (let ((buffer + (car (erc-buffer-filter + (lambda () + (let ((current (erc-default-target))) + (and (stringp current) + (string-match-p (car l) + (or erc-session-server erc-server-announced-name)) + (string-equal (erc-downcase chan) + (erc-downcase current))))))))) (when (or (not buffer) - ;; If the same channel is joined on another - ;; server the best-effort is to just join - (not (string-match (car l) - (process-name erc-server-process))) (not (with-current-buffer buffer (erc-server-process-alive)))) (erc-server-join-channel server chan)))))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 404a4c09975..41d7516fbb4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1608,36 +1608,47 @@ symbol, it may have these values: (defun erc-generate-new-buffer-name (server port target) "Create a new buffer name based on the arguments." (when (numberp port) (setq port (number-to-string port))) - (let ((buf-name (or target - (or (let ((name (concat server ":" port))) - (when (> (length name) 1) - name)) - ;; This fallback should in fact never happen - "*erc-server-buffer*"))) - buffer-name) + (let* ((buf-name (or target + (let ((name (concat server ":" port))) + (when (> (length name) 1) + name)) + ;; This fallback should in fact never happen. + "*erc-server-buffer*")) + (full-buf-name (concat buf-name "/" server)) + (dup-buf-name (buffer-name (car (erc-channel-list nil)))) + buffer-name) ;; Reuse existing buffers, but not if the buffer is a connected server ;; buffer and not if its associated with a different server than the ;; current ERC buffer. - ;; if buf-name is taken by a different connection (or by something !erc) - ;; then see if "buf-name/server" meets the same criteria - (dolist (candidate (list buf-name (concat buf-name "/" server))) - (if (and (not buffer-name) - erc-reuse-buffers - (or (not (get-buffer candidate)) - ;; Looking for a server buffer, so there's no target. - (and (not target) - (with-current-buffer (get-buffer candidate) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) - ;; Channel buffer; check that it's from the right server. - (and target - (with-current-buffer (get-buffer candidate) - (and (string= erc-session-server server) - (erc-port-equal erc-session-port port)))))) - (setq buffer-name candidate))) - ;; if buffer-name is unset, neither candidate worked out for us, + ;; If buf-name is taken by a different connection (or by something !erc) + ;; then see if "buf-name/server" meets the same criteria. + (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name)) + (setq buffer-name full-buf-name) ; ERC buffer with full name already exists. + (dolist (candidate (list buf-name full-buf-name)) + (if (and (not buffer-name) + erc-reuse-buffers + (or (not (get-buffer candidate)) + ;; Looking for a server buffer, so there's no target. + (and (not target) + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) + ;; Channel buffer; check that it's from the right server. + (and target + (with-current-buffer (get-buffer candidate) + (and (string= erc-session-server server) + (erc-port-equal erc-session-port port)))))) + (setq buffer-name candidate) + (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers) + ;; A new buffer will be created with the name buf-name/server, rename + ;; the existing name-duplicated buffer with the same format as well. + (with-current-buffer (get-buffer buf-name) + (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer + (rename-buffer + (concat buf-name "/" (or erc-session-server erc-server-announced-name))))))))) + ;; If buffer-name is unset, neither candidate worked out for us, ;; fallback to the old <N> uniquification method: - (or buffer-name (generate-new-buffer-name (concat buf-name "/" server))))) + (or buffer-name (generate-new-buffer-name full-buf-name)))) (defun erc-get-buffer-create (server port target) "Create a new buffer based on the arguments." @@ -3153,16 +3164,18 @@ were most recently invited. See also `invitation'." (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. - (let ((joined-channels - (mapcar #'(lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) - (erc-channel-list erc-server-process)))) - (if (erc-member-ignore-case chnl joined-channels) - (switch-to-buffer (car (erc-member-ignore-case chnl - joined-channels))) - (let ((server (with-current-buffer (process-buffer erc-server-process) - (or erc-session-server erc-server-announced-name)))) - (erc-server-join-channel server chnl key)))))) + (let* ((joined-channels + (mapcar #'(lambda (chanbuf) + (with-current-buffer chanbuf (erc-default-target))) + (erc-channel-list erc-server-process))) + (server (with-current-buffer (process-buffer erc-server-process) + (or erc-session-server erc-server-announced-name))) + (chnl-name (car (erc-member-ignore-case chnl joined-channels)))) + (if chnl-name + (switch-to-buffer (if (get-buffer chnl-name) + chnl-name + (concat chnl-name "/" server))) + (erc-server-join-channel server chnl key))))) t) (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d2c17fe1f77..db1b258c8f5 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -295,7 +295,7 @@ See `eshell-needs-pipe'." (process-environment (eshell-environment-variables)) proc decoding encoding changed) (cond - ((fboundp 'start-file-process) + ((fboundp 'make-process) (setq proc (let ((process-connection-type (unless (eshell-needs-pipe-p command) diff --git a/lisp/files.el b/lisp/files.el index 19096693461..9270f334afa 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -752,10 +752,16 @@ resulting list of directory names. For an empty path element (i.e., a leading or trailing separator, or two adjacent separators), return nil (meaning `default-directory') as the associated list element." (when (stringp search-path) - (mapcar (lambda (f) - (if (equal "" f) nil - (substitute-in-file-name (file-name-as-directory f)))) - (split-string search-path path-separator)))) + (let ((spath (substitute-env-vars search-path))) + (mapcar (lambda (f) + (if (equal "" f) nil + (let ((dir (expand-file-name (file-name-as-directory f)))) + ;; Previous implementation used `substitute-in-file-name' + ;; which collapse multiple "/" in front. Do the same for + ;; backward compatibility. + (if (string-match "\\`/+" dir) + (substring dir (1- (match-end 0))) dir)))) + (split-string spath path-separator))))) (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 5cda4a693db..c633877e640 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -51,7 +51,7 @@ ;; also the variable `font-lock-maximum-size'. Support modes for Font Lock ;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'. -;;; How Font Lock mode fontifies: +;;;; How Font Lock mode fontifies: ;; When Font Lock mode is turned on in a buffer, it (a) fontifies the entire ;; buffer and (b) installs one of its fontification functions on one of the @@ -96,7 +96,7 @@ ;; some syntactic parsers for common languages and a son-of-font-lock.el could ;; use them rather then relying so heavily on the keyword (regexp) pass. -;;; How Font Lock mode supports modes or is supported by modes: +;;;; How Font Lock mode supports modes or is supported by modes: ;; Modes that support Font Lock mode do so by defining one or more variables ;; whose values specify the fontification. Font Lock mode knows of these @@ -112,7 +112,7 @@ ;; Font Lock mode fontification behavior can be modified in a number of ways. ;; See the below comments and the comments distributed throughout this file. -;;; Constructing patterns: +;;;; Constructing patterns: ;; See the documentation for the variable `font-lock-keywords'. ;; @@ -120,7 +120,7 @@ ;; `font-lock-syntactic-keywords' can be generated via the function ;; `regexp-opt'. -;;; Adding patterns for modes that already support Font Lock: +;;;; Adding patterns for modes that already support Font Lock: ;; Though Font Lock highlighting patterns already exist for many modes, it's ;; likely there's something that you want fontified that currently isn't, even @@ -135,7 +135,7 @@ ;; other variables. For example, additional C types can be specified via the ;; variable `c-font-lock-extra-types'. -;;; Adding patterns for modes that do not support Font Lock: +;;;; Adding patterns for modes that do not support Font Lock: ;; Not all modes support Font Lock mode. If you (as a user of the mode) add ;; patterns for a new mode, you must define in your ~/.emacs a variable or @@ -155,7 +155,7 @@ ;; (set (make-local-variable 'font-lock-defaults) ;; '(foo-font-lock-keywords t)))) -;;; Adding Font Lock support for modes: +;;;; Adding Font Lock support for modes: ;; Of course, it would be better that the mode already supports Font Lock mode. ;; The package author would do something similar to above. The mode must @@ -986,7 +986,7 @@ The value of this variable is used when Font Lock mode is turned on." ((bound-and-true-p lazy-lock-mode) (lazy-lock-after-unfontify-buffer)))) -;;; End of Font Lock Support mode. +;; End of Font Lock Support mode. ;;; Fontification functions. @@ -1393,7 +1393,7 @@ delimit the region to fontify." (font-lock-fontify-region (point) (mark))) ((error quit) (message "Fontifying block...%s" error-data))))))) -;;; End of Fontification functions. +;; End of Fontification functions. ;;; Additional text property functions. @@ -1485,7 +1485,7 @@ Optional argument OBJECT is the string or buffer containing the text." (put-text-property start next prop new object)))))) (setq start (text-property-not-all next end prop nil object))))) -;;; End of Additional text property functions. +;; End of Additional text property functions. ;;; Syntactic regexp fontification functions. @@ -1591,7 +1591,7 @@ START should be at the beginning of a line." (setq highlights (cdr highlights)))) (setq keywords (cdr keywords))))) -;;; End of Syntactic regexp fontification functions. +;; End of Syntactic regexp fontification functions. ;;; Syntactic fontification functions. @@ -1650,7 +1650,7 @@ START should be at the beginning of a line." (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table)))))) -;;; End of Syntactic fontification functions. +;; End of Syntactic fontification functions. ;;; Keyword regexp fontification functions. @@ -1784,9 +1784,9 @@ LOUDLY, if non-nil, allows progress-meter bar." (setq keywords (cdr keywords))) (set-marker pos nil))) -;;; End of Keyword regexp fontification functions. +;; End of Keyword regexp fontification functions. -;; Various functions. +;;; Various functions. (defun font-lock-compile-keywords (keywords &optional syntactic-keywords) "Compile KEYWORDS into the form (t KEYWORDS COMPILED...) @@ -2102,7 +2102,7 @@ Sets various variables using `font-lock-defaults' and "Font Lock mode face used to highlight grouping constructs in Lisp regexps." :group 'font-lock-faces) -;;; End of Color etc. support. +;; End of Color etc. support. ;;; Menu support. @@ -2204,7 +2204,7 @@ Sets various variables using `font-lock-defaults' and ;; ;; Deactivate less/more fontification entries. ;; (setq font-lock-fontify-level nil)) -;;; End of Menu support. +;; End of Menu support. ;;; Various regexp information shared by several modes. ;; ;; Information specific to a single mode should go in its load library. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index abe546b8cb6..4876715ae6a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -455,9 +455,7 @@ displayed in the echo area." (> message-log-max 0) (/= (length str) 0)) (setq time (current-time)) - (with-current-buffer (if (fboundp 'messages-buffer) - (messages-buffer) - (get-buffer-create "*Messages*")) + (with-current-buffer (messages-buffer) (goto-char (point-max)) (let ((inhibit-read-only t)) (insert ,timestamp str "\n") diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index ae4517ec104..b41609406c3 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1029,8 +1029,7 @@ Check the NNTPSERVER environment variable and the ;; `M-x customize-variable RET gnus-select-method RET' should work without ;; starting or even loading Gnus. -;;;###autoload(when (fboundp 'custom-autoload) -;;;###autoload (custom-autoload 'gnus-select-method "gnus")) +;;;###autoload(custom-autoload 'gnus-select-method "gnus") (defcustom gnus-select-method (list 'nntp (or (gnus-getenv-nntpserver) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 7629d5cb151..282465722de 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -131,10 +131,6 @@ is not available." (cond ((null charset) charset) - ;; Running in a non-MULE environment. - ((or (null (mm-get-coding-system-list)) - (not (fboundp 'coding-system-get))) - charset) ;; Check override list quite early. Should only used for decoding, not for ;; encoding! ((and allow-override @@ -295,77 +291,16 @@ superset of iso-8859-1." (defvar mm-universal-coding-system mm-auto-save-coding-system "The universal coding system.") -;; Fixme: some of the cars here aren't valid MIME charsets. That -;; should only matter with XEmacs, though. (defvar mm-mime-mule-charset-alist - '((us-ascii ascii) - (iso-8859-1 latin-iso8859-1) - (iso-8859-2 latin-iso8859-2) - (iso-8859-3 latin-iso8859-3) - (iso-8859-4 latin-iso8859-4) - (iso-8859-5 cyrillic-iso8859-5) - ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. - ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default - ;; charset is koi8-r, not iso-8859-5. - (koi8-r cyrillic-iso8859-5 gnus-koi8-r) - (iso-8859-6 arabic-iso8859-6) - (iso-8859-7 greek-iso8859-7) - (iso-8859-8 hebrew-iso8859-8) - (iso-8859-9 latin-iso8859-9) - (iso-8859-14 latin-iso8859-14) - (iso-8859-15 latin-iso8859-15) - (viscii vietnamese-viscii-lower) - (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) - (euc-kr korean-ksc5601) - (gb2312 chinese-gb2312) - (gbk chinese-gbk) - (gb18030 gb18030-2-byte - gb18030-4-byte-bmp gb18030-4-byte-smp - gb18030-4-byte-ext-1 gb18030-4-byte-ext-2) - (big5 chinese-big5-1 chinese-big5-2) - (tibetan tibetan) - (thai-tis620 thai-tis620) - (windows-1251 cyrillic-iso8859-5) - (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) - (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) - (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2) - (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2 - cyrillic-iso8859-5 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2 - chinese-cns11643-3 chinese-cns11643-4 - chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7) - (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 - japanese-jisx0213-1 japanese-jisx0213-2) - (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - (utf-8)) - "Alist of MIME-charset/MULE-charsets.") - -;; Correct by construction, but should be unnecessary for Emacs: -(when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) + (let (mime mule alist) + (dolist (cs (sort-coding-systems (coding-system-list 'base-only))) + (setq mime (coding-system-get cs 'mime-charset)) (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) + (not (eq t (setq mule (coding-system-get cs 'safe-charsets)))) (not (assq mime alist))) (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist)))) + (nreverse alist)) + "Alist of MIME-charset/MULE-charsets.") (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d40b9286f8e..afca2cd932e 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -371,6 +371,7 @@ suitable file is found, return nil." (help-C-file-name type 'subr) 'C-source)) ((and (not file-name) (symbolp object) + (eq type 'defvar) (integerp (get object 'variable-documentation))) ;; A variable defined in C. The form is from `describe-variable'. (if (get-buffer " *DOC*") diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 7f2a99a41a2..1888c8f86a2 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -23,7 +23,6 @@ ;;; Commentary: -;; Aung San Suu Kyi says to call her country "Burma". ;; The murderous generals say to call it "Myanmar". ;; We will call it "Burma". -- rms, Chief GNUisance. diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index a3a6f3fdd94..ce60d1a3ad4 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -47,7 +47,7 @@ ;;;###autoload (defun standard-display-cyrillic-translit (&optional cyrillic-language) - "Display a cyrillic buffer using a transliteration. + "Display a Cyrillic buffer using a transliteration. For readability, the table is slightly different from the one used for the input method `cyrillic-translit'. diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index 19cba91556b..f38dead5a23 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -22,7 +22,7 @@ ;;; Commentary: -;; This file defines korean hanja table and symbol table. +;; This file defines the Korean Hanja table and symbol table. ;;; Code: @@ -31,7 +31,7 @@ (defvar hanja-table nil "A char table for Hanja characters. -It maps a hangul character to a list of the corresponding Hanja characters. +It maps a Hangul character to a list of the corresponding Hanja characters. Each element of the list has the form CHAR or (CHAR . STRING) where CHAR is a Hanja character and STRING is the meaning of that character. This variable is initialized by `hanja-init-load'.") diff --git a/lisp/language/indian.el b/lisp/language/indian.el index eb882c810e1..657ad6915eb 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file contains definitions of Indian language environments, and -;; setups for displaying the scrtipts used there. +;; setups for displaying the scripts used there. ;;; Code: diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 78ffca9e2fa..6a2508ba31d 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -242,12 +242,14 @@ system, including many technical ones. Examples: ((lambda (name char) ;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL" ;; (which is \varphi) are reversed in `ucs-names', so we define - ;; them manually. - (unless (string-match-p "\\<PHI\\>" name) + ;; them manually. Also ignore "GREEK SMALL LETTER EPSILON" and + ;; add the correct value for \epsilon manually. + (unless (string-match-p "\\<\\(?:PHI\\|GREEK SMALL LETTER EPSILON\\)\\>" name) (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase) (match-string 2 name))))) "\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'") + ("\\epsilon" ?ϵ) ("\\phi" ?ϕ) ("\\Box" ?□) ("\\Bumpeq" ?≎) @@ -641,6 +643,7 @@ system, including many technical ones. Examples: (concat "\\var" (downcase (match-string 1 name))))) "\\`GREEK \\([^- ]+\\) SYMBOL\\'") + ("\\varepsilon" ?ε) ("\\varphi" ?φ) ("\\varprime" ?′) ("\\varpropto" ?∝) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f5c9432879f..666395e0b9e 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -53,6 +53,7 @@ ;; See http://www.ietf.org/rfc/rfc2554.txt ;;; Code: +;;; Dependencies (require 'sendmail) (require 'auth-source) @@ -61,12 +62,12 @@ (autoload 'message-make-message-id "message") (autoload 'rfc2104-hash "rfc2104") -;;; +;;; Options + (defgroup smtpmail nil "SMTP protocol for sending mail." :group 'mail) - (defcustom smtpmail-default-smtp-server nil "Specify default SMTP server. This only has effect if you specify it before loading the smtpmail library." @@ -172,8 +173,7 @@ mean \"try again\"." :type 'integer :version "27.1") -;; End of customizable variables. - +;;; Variables (defvar smtpmail-address-buffer) (defvar smtpmail-recipient-address-list) @@ -192,6 +192,8 @@ for `smtpmail-try-auth-method'.") (defvar smtpmail-mail-address nil "Value to use for envelope-from address for mail from ambient buffer.") +;;; Functions + ;;;###autoload (defun smtpmail-send-it () (let ((errbuf (if mail-interactive diff --git a/lisp/man.el b/lisp/man.el index e1dd5037c46..da8a15f69b9 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -836,9 +836,10 @@ POS defaults to `point'." ;; ====================================================================== ;; Top level command and background process sentinel -;; For compatibility with older versions. +;; This alias was originally for compatibility with older versions. +;; Some users got used to having it, so we will not remove it. ;;;###autoload -(define-obsolete-function-alias 'manual-entry 'man "28.1") +(defalias 'manual-entry 'man) (defvar Man-completion-cache nil ;; On my machine, "man -k" is so fast that a cache makes no sense, diff --git a/lisp/net/dns.el b/lisp/net/dns.el index c3c294395cb..c368cd773c2 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -316,8 +316,6 @@ If TCP-P, the first two bytes of the packet will be the length field." "Return false if we need to recheck the list of DNS servers." (and dns-servers (or (eq dns-servers-valid-for-interfaces t) - ;; `network-interface-list' was introduced in Emacs 22.1. - (not (fboundp 'network-interface-list)) (equal dns-servers-valid-for-interfaces (network-interface-list))))) @@ -339,8 +337,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (when (re-search-forward "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t) (setq dns-servers (list (match-string 1))))))) - (when (fboundp 'network-interface-list) - (setq dns-servers-valid-for-interfaces (network-interface-list)))) + (setq dns-servers-valid-for-interfaces (network-interface-list))) (defun dns-read-txt (string) (if (> (length string) 1) diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 20a5c5f6075..56ea033a963 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -71,7 +71,7 @@ `("EUDC Sound Menu" ["---" nil nil] ["Play sound" eudc-bob-play-sound-at-point - (fboundp 'play-sound)] + (fboundp 'play-sound-internal)] ,@(cdr (cdr eudc-bob-generic-menu)))) (defun eudc-jump-to-event (event) @@ -197,7 +197,7 @@ display a button." (let (sound) (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data))) (error "No sound data available here") - (unless (fboundp 'play-sound) + (unless (fboundp 'play-sound-internal) (error "Playing sounds not supported on this system")) (play-sound (list 'sound :data sound))))) @@ -214,8 +214,7 @@ display a button." (let ((data (eudc-bob-get-overlay-prop 'object-data)) (buffer (generate-new-buffer "*eudc-tmp*"))) (save-excursion - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system 'binary)) + (set-buffer-file-coding-system 'binary) (set-buffer buffer) (set-buffer-multibyte nil) (insert data) @@ -231,8 +230,7 @@ display a button." viewer) (condition-case nil (save-excursion - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system 'binary)) + (set-buffer-file-coding-system 'binary) (set-buffer buffer) (insert data) (setq program (completing-read "Viewer: " eudc-external-viewers)) diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el index f258d5cb9fb..e2d10e33d49 100644 --- a/lisp/net/eudcb-macos-contacts.el +++ b/lisp/net/eudcb-macos-contacts.el @@ -1,19 +1,23 @@ ;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend -;; Copyright (C) 2020 condition-alpha.com +;; Copyright (C) 2020 Free Software Foundation, Inc. -;; This program is free software: you can redistribute it and/or modify +;; Author: Alexander Adolf + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, + +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; This library provides an interface to the macOS Contacts app as diff --git a/lisp/net/imap.el b/lisp/net/imap.el index a492dc8c798..22b59084004 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -134,6 +134,7 @@ ;; ;;; Code: +;;; Dependencies (eval-when-compile (require 'cl-lib)) (require 'utf7) @@ -145,7 +146,7 @@ (declare-function digest-md5-digest-uri "ext:digest-md5") (declare-function digest-md5-challenge "ext:digest-md5") -;; User variables. +;;; User variables (defgroup imap nil "Low-level IMAP issues." @@ -257,7 +258,7 @@ Shorter values mean quicker response, but is more CPU intensive." :group 'imap :type 'boolean) -;; Various variables. +;;; Various variables (defvar imap-fetch-data-hook nil "Hooks called after receiving each FETCH response.") @@ -316,7 +317,9 @@ the value of this variable will be bound to a certain value to which an application program that uses this module specifies on a per-server basis.") -;; Internal constants. Change these and die. +;;; Internal constants + +;; Change these and die. (defconst imap-default-port 143) (defconst imap-default-ssl-port 993) @@ -348,7 +351,7 @@ basis.") (defconst imap-log-buffer "*imap-log*") (defconst imap-debug-buffer "*imap-debug*") -;; Internal variables. +;;; Internal variables (defvar imap-stream nil) (defvar imap-auth nil) @@ -437,7 +440,7 @@ This variable is set to t automatically per server if the canonical form fails.") -;; Utility functions: +;;; Utility functions (defun imap-remassoc (key alist) "Delete by side effect any elements of ALIST whose car is `equal' to KEY. @@ -489,7 +492,8 @@ sure of changing the value of `foo'." (nth 3 (car imap-failed-tags)))) -;; Server functions; stream stuff: +;;; Server functions +;;;; Stream functions (defun imap-log (string-or-buffer) (when imap-log @@ -747,7 +751,7 @@ sure of changing the value of `foo'." (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed")) done)) -;; Server functions; authenticator stuff: +;;;; Authenticator functions (defun imap-interactive-login (buffer loginfunc) "Login to server in BUFFER. @@ -871,7 +875,7 @@ t if it successfully authenticates, nil otherwise." (concat "LOGIN anonymous \"" (concat (user-login-name) "@" (system-name)) "\""))))) -;;; Compiler directives. +;;; Compiler directives (defvar imap-sasl-client) (defvar imap-sasl-step) @@ -969,7 +973,7 @@ t if it successfully authenticates, nil otherwise." (imap-send-command-1 "") (imap-ok-p (imap-wait-for-tag tag))))))) -;; Server functions: +;;; Server functions (defun imap-open-1 (buffer) (with-current-buffer buffer @@ -1228,7 +1232,7 @@ If BUFFER is nil, the current buffer is assumed." (imap-send-command-wait "LOGOUT" buffer))) -;; Mailbox functions: +;;; Mailbox functions (defun imap-mailbox-put (propname value &optional mailbox buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1520,7 +1524,7 @@ or `unseen'. The IMAP command tag is returned." identifier)))))) -;; Message functions: +;;; Message functions (defun imap-current-message (&optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1832,7 +1836,7 @@ on failure." (if (aref from 0) ">")))) -;; Internal functions. +;;; Internal functions (defun imap-add-callback (tag func) (setq imap-callbacks (append (list (cons tag func)) imap-callbacks))) @@ -1969,7 +1973,7 @@ Return nil if no complete line has arrived." (delete-region (point-min) (point-max))))))))) -;; Imap parser. +;;; Imap parser (defsubst imap-forward () (or (eobp) (forward-char))) @@ -2850,6 +2854,8 @@ Return nil if no complete line has arrived." (imap-forward) (nreverse body))))) +;;; Debug + (when imap-debug ; (untrace-all) (require 'trace) (buffer-disable-undo (get-buffer-create imap-debug-buffer)) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 86f9d2bf07c..f01a5deb7ec 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -269,11 +269,6 @@ is consulted." (viewer . "display %s") (type . "image/*") (test . (eq window-system 'x)) - ("needsx11")) - (".*" - (viewer . "ee %s") - (type . "image/*") - (test . (eq window-system 'x)) ("needsx11"))) ("text" ("plain" diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 88f5c2928e3..49ecaa58ee8 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -890,8 +890,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `make-process' for Tramp files. If connection property \"direct-async-process\" is non-nil, an alternative implementation will be used." - (if (tramp-get-connection-property - (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3e2eb023a33..ca43475f453 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2790,8 +2790,7 @@ the result will be a local, non-Tramp, file name." STDERR can also be a file name. If connection property \"direct-async-process\" is non-nil, an alternative implementation will be used." - (if (tramp-get-connection-property - (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fdf26f6b782..ab52bec39eb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3633,18 +3633,29 @@ User is always nil." (load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) + +(defun tramp-direct-async-process-p (&rest args) + "Whether direct async `make-process' can be called." + (let ((v (tramp-dissect-file-name default-directory))) + (and (tramp-get-connection-property v"direct-async-process" nil) + (not (tramp-multi-hop-p v)) + (not (plist-get args :stderr))))) + ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. (defun tramp-handle-make-process (&rest args) - "An alternative `make-process' implementation for Tramp files." + "An alternative `make-process' implementation for Tramp files. +It does not support `:stderr'." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let ((name (plist-get args :name)) (buffer (plist-get args :buffer)) (command (plist-get args :command)) + ;; FIXME: `:coding' shall be used. (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) + ;; FIXME: `:connection-type' shall be used. (connection-type (plist-get args :connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) @@ -3667,11 +3678,12 @@ User is always nil." (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" stderr))) + (when stderr + (signal + 'user-error + (list + "Stderr not supported for direct remote asynchronous processes" + stderr))) (let* ((buffer (if buffer @@ -3698,9 +3710,12 @@ User is always nil." (tramp-set-connection-property v "process-name" name) (tramp-set-connection-property v "process-buffer" buffer) + ;; Check for `tramp-sh-file-name-handler', because something + ;; is different between tramp-adb.el and tramp-sh.el. (with-current-buffer (tramp-get-connection-buffer v) (unwind-protect - (let* ((login-program + (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) + (login-program (tramp-get-method-parameter v 'tramp-login-program)) (login-args (tramp-get-method-parameter v 'tramp-login-args)) @@ -3716,12 +3731,12 @@ User is always nil." ;; in the main connection process, therefore ;; we cannot use `tramp-get-connection-process'. (tmpfile - (when (tramp-sh-file-name-handler-p v) + (when sh-file-name-handler-p (with-tramp-connection-property (tramp-get-process v) "temp-file" (tramp-compat-make-temp-name)))) (options - (when (tramp-sh-file-name-handler-p v) + (when sh-file-name-handler-p (tramp-compat-funcall 'tramp-ssh-controlmaster-options v))) spec) @@ -3814,9 +3829,12 @@ support symbolic links." (setq current-buffer-p t) (current-buffer)) (t (get-buffer-create + ;; These variables have been introduced with Emacs 28.1. (if asynchronous - shell-command-buffer-name-async - shell-command-buffer-name))))) + (or (bound-and-true-p shell-command-buffer-name-async) + "*Async Shell Command*") + (or (bound-and-true-p shell-command-buffer-name) + "*Shell Command Output*")))))) (error-buffer (cond ((bufferp error-buffer) error-buffer) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index 2fba49f402d..cbe453aa6bf 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -37,6 +37,7 @@ ;; Special thanks to Rod Smith for many useful bug reports. ;;; Code: +;;; Options (defgroup longlines nil "Automatic wrapping of long lines when loading files." @@ -76,7 +77,7 @@ This is used when `longlines-show-hard-newlines' is on." :group 'longlines :type 'string) -;; Internal variables +;;; Internal variables (defvar longlines-wrap-beg nil) (defvar longlines-wrap-end nil) @@ -90,7 +91,7 @@ This is used when `longlines-show-hard-newlines' is on." (make-variable-buffer-local 'longlines-showing) (make-variable-buffer-local 'longlines-decoded) -;; Mode +;;; Mode (defvar message-indent-citation-function) @@ -210,7 +211,7 @@ This function exists to be called by `change-major-mode-hook' when the major mode changes." (longlines-mode 0)) -;; Showing the effect of hard newlines in the buffer +;;; Showing the effect of hard newlines in the buffer (defun longlines-show-hard-newlines (&optional arg) "Make hard newlines visible by adding a face. @@ -252,7 +253,7 @@ With optional argument ARG, make the hard newlines invisible again." (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil))) (restore-buffer-modified-p mod))) -;; Wrapping the paragraphs. +;;; Wrapping the paragraphs (defun longlines-wrap-region (beg end) "Wrap each successive line, starting with the line before BEG. @@ -402,7 +403,7 @@ Hard newlines are left intact." (setq pos (string-match "\n" str (1+ pos)))) str)) -;; Auto wrap +;;; Auto wrap (defun longlines-auto-wrap (&optional arg) "Toggle automatic line wrapping. @@ -457,7 +458,7 @@ This is called by `window-configuration-change-hook'." (setq fill-column (- (window-width) dw)) (longlines-wrap-region (point-min) (point-max))))) -;; Isearch +;;; Isearch (defun longlines-search-function () (cond @@ -477,7 +478,7 @@ This is called by `window-configuration-change-hook'." (let ((search-spaces-regexp " *[ \n]")) (re-search-forward string bound noerror count))) -;; Loading and saving +;;; Loading and saving (defun longlines-before-revert-hook () (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t) @@ -492,7 +493,7 @@ This is called by `window-configuration-change-hook'." (list 'longlines "Automatically wrap long lines." nil nil 'longlines-encode-region t nil)) -;; Unloading +;;; Unloading (defun longlines-unload-function () "Unload the longlines library." diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index e5982573792..903c0686063 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -976,16 +976,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (* image-vert-size (bubbles--grid-height))) 2))))) -(defun bubbles--remove-overlays () - "Remove all overlays." - (if (fboundp 'remove-overlays) - (remove-overlays))) +(define-obsolete-function-alias 'bubbles--remove-overlays + 'remove-overlays "28.1") (defun bubbles--initialize () "Initialize Bubbles game." (bubbles--initialize-faces) (bubbles--initialize-images) - (bubbles--remove-overlays) + (remove-overlays) (switch-to-buffer (get-buffer-create "*bubbles*")) (bubbles--compute-offsets) @@ -1409,7 +1407,7 @@ Return t if new char is non-empty." (defun bubbles--show-images () "Update images in the bubbles buffer." - (bubbles--remove-overlays) + (remove-overlays) (if (and (display-images-p) bubbles--images-ok (not (eq bubbles-graphics-theme 'ascii))) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index a76a3c44a35..0b9f417845f 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2373,12 +2373,10 @@ and runs `compilation-filter-hook'." (set-marker min nil) (set-marker max nil)))))) -;;; test if a buffer is a compilation buffer, assuming we're in the buffer (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." (local-variable-p 'compilation-locs)) -;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p (defsubst compilation-buffer-p (buffer) "Test if BUFFER is a compilation buffer." (with-current-buffer buffer diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 6770fbe8abc..f875915ca8e 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -2745,7 +2745,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command." ;; event. mouse-drag-track does so. (if drag-track 'mouse-drag-track 'mouse-drag-region))) (funcall tracker event) - (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil) + (idlwave-shell-print (if (region-active-p) '(4) nil) ,help ,ev)))) ;; Begin terrible hack section -- XEmacs tests for button2 explicitly @@ -2830,7 +2830,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." (cond ((equal arg '(16)) (setq expr (read-string "Expression: "))) - ((and (or arg (idlwave-region-active-p)) + ((and (or arg (region-active-p)) (< (- (region-end) (region-beginning)) 2000)) (setq beg (region-beginning) end (region-end))) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 3092d4c45b0..f7e53ec02d6 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -154,21 +154,6 @@ (eval-when-compile (require 'cl-lib)) (require 'idlw-help) -;; For XEmacs -(unless (fboundp 'line-beginning-position) - (defalias 'line-beginning-position 'point-at-bol)) -(unless (fboundp 'line-end-position) - (defalias 'line-end-position 'point-at-eol)) -(unless (fboundp 'char-valid-p) - (defalias 'char-valid-p 'characterp)) -(unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) - -(if (not (fboundp 'cancel-timer)) - (condition-case nil - (require 'timer) - (error nil))) - (declare-function idlwave-shell-get-path-info "idlw-shell") (declare-function idlwave-shell-temp-file "idlw-shell") (declare-function idlwave-shell-is-running "idlw-shell") @@ -2092,11 +2077,7 @@ Returns point if comment found and nil otherwise." (backward-char 1) (point))))) -(defun idlwave-region-active-p () - "Should we operate on an active region?" - (if (fboundp 'use-region-p) - (use-region-p) - (region-active-p))) +(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1") (defun idlwave-show-matching-quote () "Insert quote and show matching quote if this is end of a string." diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 99b57354e25..a209d21807f 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -271,10 +271,6 @@ (require 'easymenu) (require 'align) -(eval-when-compile - (or (fboundp 'use-region-p) - (defsubst use-region-p () (region-exists-p)))) - (defgroup prolog nil "Editing and running Prolog and Mercury files." :group 'languages) @@ -2752,20 +2748,6 @@ When called with prefix argument ARG, disable zipping instead." (nth 1 state))) )))) -;; For backward compatibility. Stolen from custom.el. -(or (fboundp 'match-string) - ;; Introduced in Emacs 19.29. - (defun match-string (num &optional string) - "Return string of text matched by last search. -NUM specifies which parenthesized expression in the last regexp. - Value is nil if NUMth pair didn't match, or there were less than NUM pairs. -Zero means the entire text matched by the whole regexp or whole string. -STRING should be given if the last search was by `string-match' on STRING." - (if (match-beginning num) - (if string - (substring string (match-beginning num) (match-end num)) - (buffer-substring (match-beginning num) (match-end num)))))) - (defun prolog-pred-start () "Return the starting point of the first clause of the current predicate." ;; FIXME: Use SMIE. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index a70b5ed60d6..e554b2b8b0b 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -455,7 +455,7 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-regexp "^mysql> " :prompt-length 6 :prompt-cont-regexp "^ -> " - :syntax-alist ((?# . "< b")) + :syntax-alist ((?# . "< b") (?\\ . "\\")) :input-filter sql-remove-tabs-filter) (oracle @@ -1508,22 +1508,6 @@ Based on `comint-mode-map'.") table) "Syntax table used in `sql-mode' and `sql-interactive-mode'.") -;;; Syntax Properties - -;; `sql--syntax-propertize-escaped-apostrophe', as follows, was -;; (analysed and) adapted from `pascal--syntax-propertize' in -;; pascal.el because basic syntax parsing cannot handle the SQL '' -;; construct within strings. - -(defconst sql--syntax-propertize-escaped-apostrophe - (syntax-propertize-rules - ("''" - (0 - (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) - (string-to-syntax ".") - (forward-char -1) - nil))))) - ;; Font lock support (defvar sql-mode-font-lock-object-name @@ -4203,7 +4187,7 @@ must tell Emacs. Here's how to do that in your init file: \(add-hook \\='sql-mode-hook (lambda () - (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" + (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table (if sql-mode-menu @@ -4226,10 +4210,18 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) - ;; Activate punctuation syntax table property for - ;; escaped apostrophes within strings: (setq-local syntax-propertize-function - sql--syntax-propertize-escaped-apostrophe) + (syntax-propertize-rules + ;; Handle escaped apostrophes within strings. + ("''" + (0 + (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (forward-char -1) + nil))) + ;; Propertize rules to not have /- and -* start comments. + ("\\(/-\\)" (1 ".")) + ("\\(-\\*\\)" (1 ".")))) ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 49d72d3be50..f532511b977 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -55,7 +55,7 @@ (face-background face nil t)) -(defalias 'ps-frame-parameter 'frame-parameter) +(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1") ;; Return t if the device (which can be changed during an emacs session) can ;; handle colors. This function is not yet implemented for GNU emacs. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index ace30017814..17b486bca11 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -5761,7 +5761,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-bg 'frame-parameter) - (ps-frame-parameter nil 'background-color)) + (frame-parameter nil 'background-color)) ((eq ps-default-bg t) (ps-face-background-name 'default)) (t @@ -5775,7 +5775,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-fg 'frame-parameter) - (ps-frame-parameter nil 'foreground-color)) + (frame-parameter nil 'foreground-color)) ((eq ps-default-fg t) (ps-face-foreground-name 'default)) (t diff --git a/lisp/server.el b/lisp/server.el index 18612181477..9934e1c1be9 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -274,10 +274,11 @@ the \"-f\" switch otherwise." (if internal--daemon-sockname (file-name-directory internal--daemon-sockname) (and (featurep 'make-network-process '(:family local)) - (let ((xdg_runtime_dir (getenv "XDG_RUNTIME_DIR"))) - (if xdg_runtime_dir - (format "%s/emacs" xdg_runtime_dir) - (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))))) + (let ((runtime-dir (getenv "XDG_RUNTIME_DIR"))) + (if runtime-dir + (expand-file-name "emacs" runtime-dir) + (expand-file-name (format "emacs%d" (user-uid)) + (or (getenv "TMPDIR") "/tmp")))))) "The directory in which to place the server socket. If local sockets are not supported, this is nil.") diff --git a/lisp/shell.el b/lisp/shell.el index dc528412a62..f5e18bbc728 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -619,7 +619,12 @@ buffer." ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") (add-hook 'comint-preoutput-filter-functions - #'shell-filter-ctrl-a-ctrl-b nil t))) + #'shell-filter-ctrl-a-ctrl-b nil t)) + + ;; Skip extended history for zsh. + (when (string-equal shell "zsh") + (setq-local comint-input-ring-file-prefix + ": [[:digit:]]+:[[:digit:]]+;"))) (comint-read-input-ring t))) (defun shell-apply-ansi-color (beg end face) diff --git a/lisp/simple.el b/lisp/simple.el index 6c9584aaa39..6f72c3b81b9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1366,28 +1366,47 @@ END, without printing any message." (message "line %d (narrowed line %d)" (+ n (line-number-at-pos start) -1) n)))))) -(defun count-lines (start end) +(defun count-lines (start end &optional ignore-invisible-lines) "Return number of lines between START and END. -This is usually the number of newlines between them, -but can be one more if START is not equal to END -and the greater of them is not at the start of a line." +This is usually the number of newlines between them, but can be +one more if START is not equal to END and the greater of them is +not at the start of a line. + +When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not +included in the count." (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (if (eq selective-display t) - (save-match-data - (let ((done 0)) - (while (re-search-forward "[\n\C-m]" nil t 40) - (setq done (+ 40 done))) - (while (re-search-forward "[\n\C-m]" nil t 1) - (setq done (+ 1 done))) - (goto-char (point-max)) - (if (and (/= start end) - (not (bolp))) - (1+ done) - done))) - (- (buffer-size) (forward-line (buffer-size))))))) + (cond ((and (not ignore-invisible-lines) + (eq selective-display t)) + (save-match-data + (let ((done 0)) + (while (re-search-forward "\n\\|\r[^\n]" nil t 40) + (setq done (+ 40 done))) + (while (re-search-forward "\n\\|\r[^\n]" nil t 1) + (setq done (+ 1 done))) + (goto-char (point-max)) + (if (and (/= start end) + (not (bolp))) + (1+ done) + done)))) + (ignore-invisible-lines + (save-match-data + (- (buffer-size) + (forward-line (buffer-size)) + (let ((invisible-count 0) + prop) + (goto-char (point-min)) + (while (re-search-forward "\n\\|\r[^\n]" nil t) + (setq prop (get-char-property (1- (point)) 'invisible)) + (if (if (eq buffer-invisibility-spec t) + prop + (or (memq prop buffer-invisibility-spec) + (assq prop buffer-invisibility-spec))) + (setq invisible-count (1+ invisible-count)))) + invisible-count)))) + (t (- (buffer-size) (forward-line (buffer-size)))))))) (defun line-number-at-pos (&optional pos absolute) "Return buffer line number at position POS. @@ -1619,6 +1638,10 @@ display the result of expression evaluation." "Hook run by `eval-expression' when entering the minibuffer.") (defun read--expression (prompt &optional initial-contents) + "Read an Emacs Lisp expression from the minibuffer. + +PROMPT and optional argument INITIAL-CONTENTS do the same as in +function `read-from-minibuffer'." (let ((minibuffer-completing-symbol t)) (minibuffer-with-setup-hook (lambda () @@ -1629,11 +1652,52 @@ display the result of expression evaluation." (set-syntax-table emacs-lisp-mode-syntax-table) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil t) + (local-set-key "\r" 'read--expression-try-read) + (local-set-key "\n" 'read--expression-try-read) (run-hooks 'eval-expression-minibuffer-setup-hook)) (read-from-minibuffer prompt initial-contents read-expression-map t 'read-expression-history)))) +(defun read--expression-try-read () + "Try to read an Emacs Lisp expression in the minibuffer. + +Exit the minibuffer if successful, else report the error to the +user and move point to the location of the error. If point is +not already at the location of the error, push a mark before +moving point." + (interactive) + (unless (> (minibuffer-depth) 0) + (error "Minibuffer must be active")) + (if (let* ((contents (minibuffer-contents)) + (error-point nil)) + (with-temp-buffer + (condition-case err + (progn + (insert contents) + (goto-char (point-min)) + ;; `read' will signal errors like "End of file during + ;; parsing" and "Invalid read syntax". + (read (current-buffer)) + ;; Since `read' does not signal the "Trailing garbage + ;; following expression" error, we check for trailing + ;; garbage ourselves. + (or (progn + ;; This check is similar to what `string_to_object' + ;; does in minibuf.c. + (skip-chars-forward " \t\n") + (= (point) (point-max))) + (error "Trailing garbage following expression"))) + (error + (setq error-point (+ (length (minibuffer-prompt)) (point))) + (with-current-buffer (window-buffer (minibuffer-window)) + (unless (= (point) error-point) + (push-mark)) + (goto-char error-point) + (minibuffer-message (error-message-string err))) + nil)))) + (exit-minibuffer))) + (defun eval-expression-get-print-arguments (prefix-argument) "Get arguments for commands that print an expression result. Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT) @@ -3441,8 +3505,9 @@ to `shell-command-history'." (defcustom async-shell-command-buffer 'confirm-new-buffer "What to do when the output buffer is used by another shell command. This option specifies how to resolve the conflict where a new command -wants to direct its output to the buffer `shell-command-buffer-name-async', -but this buffer is already taken by another running shell command. +wants to direct its output to the buffer whose name is stored +in `shell-command-buffer-name-async', but that buffer is already +taken by another running shell command. The value `confirm-kill-process' is used to ask for confirmation before killing the already running process and running a new process @@ -3593,14 +3658,18 @@ whose `car' is BUFFER." Like `shell-command', but adds `&' at the end of COMMAND to execute it asynchronously. -The output appears in the buffer `shell-command-buffer-name-async'. -That buffer is in shell mode. +The output appears in the buffer whose name is stored in the +variable `shell-command-buffer-name-async'. That buffer is in +shell mode. You can configure `async-shell-command-buffer' to specify what to do -when the `shell-command-buffer-name-async' buffer is already taken by another -running shell command. To run COMMAND without displaying the output -in a window you can configure `display-buffer-alist' to use the action -`display-buffer-no-window' for the buffer `shell-command-buffer-name-async'. +when the buffer specified by `shell-command-buffer-name-async' is +already taken by another running shell command. + +To run COMMAND without displaying the output in a window you can +configure `display-buffer-alist' to use the action +`display-buffer-no-window' for the buffer given by +`shell-command-buffer-name-async'. In Elisp, you will often be better served by calling `start-process' directly, since it offers more control and does not impose the use of @@ -3636,16 +3705,18 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current directory in the prompt. If COMMAND ends in `&', execute it asynchronously. -The output appears in the buffer `shell-command-buffer-name-async'. -That buffer is in shell mode. You can also use -`async-shell-command' that automatically adds `&'. +The output appears in the buffer whose name is specified +by `shell-command-buffer-name-async'. That buffer is in shell +mode. You can also use `async-shell-command' that automatically +adds `&'. Otherwise, COMMAND is executed synchronously. The output appears in -the buffer `shell-command-buffer-name'. If the output is short enough to -display in the echo area (which is determined by the variables -`resize-mini-windows' and `max-mini-window-height'), it is shown -there, but it is nonetheless available in buffer `*Shell Command -Output*' even though that buffer is not automatically displayed. +the buffer named by `shell-command-buffer-name'. If the output is +short enough to display in the echo area (which is determined by the +variables `resize-mini-windows' and `max-mini-window-height'), it is +shown there, but it is nonetheless available in buffer named by +`shell-command-buffer-name' even though that buffer is not +automatically displayed. To specify a coding system for converting non-ASCII characters in the shell command output, use \\[universal-coding-system-argument] \ @@ -3916,9 +3987,9 @@ and are used only if a pop-up buffer is displayed." error-buffer display-error-buffer region-noncontiguous-p) "Execute string COMMAND in inferior shell with region as input. -Normally display output (if any) in temp buffer `shell-command-buffer-name'; -Prefix arg means replace the region with it. Return the exit code of -COMMAND. +Normally display output (if any) in temp buffer specified +by `shell-command-buffer-name'; prefix arg means replace the region +with it. Return the exit code of COMMAND. To specify a coding system for converting non-ASCII characters in the input and output to the shell command, use \\[universal-coding-system-argument] @@ -3935,7 +4006,7 @@ in the echo area or in a buffer. If the output is short enough to display in the echo area \(determined by the variable `max-mini-window-height' if `resize-mini-windows' is non-nil), it is shown there. -Otherwise it is displayed in the buffer `shell-command-buffer-name'. +Otherwise it is displayed in the buffer named by `shell-command-buffer-name'. The output is available in that buffer in both cases. If there is output and an error, a message about the error @@ -3945,7 +4016,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, erase that buffer and insert the output there; a non-nil value of `shell-command-dont-erase-buffer' prevent to erase the buffer. -If the value is nil, use the buffer `shell-command-buffer-name'. +If the value is nil, use the buffer specified by `shell-command-buffer-name'. Any other non-nil value means to insert the output in the current buffer after START. diff --git a/lisp/term/st.el b/lisp/term/st.el new file mode 100644 index 00000000000..617664bb263 --- /dev/null +++ b/lisp/term/st.el @@ -0,0 +1,20 @@ +;;; st.el --- terminal initialization for st -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;;; Commentary: + +;; Support for the st terminal emulator. +;; https://st.suckless.org/ + +;;; Code: + +(require 'term/xterm) + +(defun terminal-init-st () + "Terminal initialization function for st." + (tty-run-terminal-initialization (selected-frame) "xterm")) + +(provide 'term/st) + +;; st.el ends here diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index e22e3f48994..b0975291428 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -371,33 +371,50 @@ See `forward-paragraph' for more information." (defun mark-paragraph (&optional arg allow-extend) "Put point at beginning of this paragraph, mark at end. -The paragraph marked is the one that contains point or follows point. +The paragraph marked is the one that contains point or follows +point. -With argument ARG, puts mark at end of a following paragraph, so that -the number of paragraphs marked equals ARG. +With argument ARG, puts mark at the end of this or a following +paragraph, so that the number of paragraphs marked equals ARG. -If ARG is negative, point is put at end of this paragraph, mark is put -at beginning of this or a previous paragraph. +If ARG is negative, point is put at the end of this paragraph, +mark is put at the beginning of this or a previous paragraph. Interactively (or if ALLOW-EXTEND is non-nil), if this command is -repeated or (in Transient Mark mode) if the mark is active, -it marks the next ARG paragraphs after the ones already marked." - (interactive "p\np") - (unless arg (setq arg 1)) - (when (zerop arg) - (error "Cannot mark zero paragraphs")) - (cond ((and allow-extend - (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active))) - (set-mark - (save-excursion - (goto-char (mark)) - (forward-paragraph arg) - (point)))) - (t - (forward-paragraph arg) - (push-mark nil t t) - (backward-paragraph arg)))) +repeated or (in Transient Mark mode) if the mark is active, it +marks the next ARG paragraphs after the region already marked. +This also means when activating the mark immediately before using +this command, the current paragraph is only marked from point." + (interactive "P\np") + (let ((numeric-arg (prefix-numeric-value arg))) + (cond ((zerop numeric-arg)) + ((and allow-extend + (or (and (eq last-command this-command) mark-active) + (region-active-p))) + (if arg + (setq arg numeric-arg) + (if (< (mark) (point)) + (setq arg -1) + (setq arg 1))) + (set-mark + (save-excursion + (goto-char (mark)) + (forward-paragraph arg) + (point)))) + ;; don't activate the mark when at eob + ((and (eobp) (> numeric-arg 0))) + (t + (unless (save-excursion + (forward-line 0) + (looking-at paragraph-start)) + (backward-paragraph (cond ((> numeric-arg 0) 1) + ((< numeric-arg 0) -1) + (t 0)))) + (push-mark + (save-excursion + (forward-paragraph numeric-arg) + (point)) + t t))))) (defun kill-paragraph (arg) "Kill forward to end of paragraph. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index e3d5759579a..a905d148009 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -593,7 +593,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; Miscellany. (slash "\\\\") (opt " *\\(\\[[^]]*\\] *\\)*") - (args "\\(\\(?:[^{}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)") + (args "\\(\\(?:[^${}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)") (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")) (list ;; diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 66378cb3468..b3bc634de9b 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -482,6 +482,13 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (define-key map "\C-c\C-ce" 'texinfo-insert-@end) (define-key map "\C-c\C-cd" 'texinfo-insert-@dfn) (define-key map "\C-c\C-cc" 'texinfo-insert-@code) + + ;; bindings for environment movement + (define-key map "\C-c." 'texinfo-to-environment-bounds) + (define-key map "\C-c\C-c\C-f" 'texinfo-next-environment-end) + (define-key map "\C-c\C-c\C-b" 'texinfo-previous-environment-end) + (define-key map "\C-c\C-c\C-n" 'texinfo-next-environment-start) + (define-key map "\C-c\C-c\C-p" 'texinfo-previous-environment-start) map)) (easy-menu-define texinfo-mode-menu @@ -1072,6 +1079,70 @@ You are prompted for the job number (use a number shown by a previous ;; job-number"\n")) (tex-recenter-output-buffer nil)) +(defun texinfo-to-environment-bounds () + "Move point alternately to the start and end of a Texinfo environment. +Do nothing when outside of an environment. This command does not +handle nested environments." + (interactive) + (cond ((save-excursion + (forward-line 0) + (looking-at texinfo-environment-regexp)) + (if (save-excursion + (forward-line 0) + (looking-at "^@end")) + (texinfo-previous-environment-start) + (texinfo-next-environment-end))) + ((save-excursion + (and (re-search-backward texinfo-environment-regexp nil t) + (not (looking-at "^@end")))) + (texinfo-previous-environment-start)) + ;; Otherwise, point is outside of an environment, so do nothing. + )) + +(defun texinfo-next-environment-start () + "Move forward to the beginning of a Texinfo environment." + (interactive) + (if (looking-at texinfo-environment-regexp) + (forward-line 1)) + (while (and (re-search-forward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "@end")))) + (if (save-excursion + (forward-line 0) + (looking-at texinfo-environment-regexp)) + (forward-line 0))) + +(defun texinfo-previous-environment-start () + "Move back to the beginning of the previous Texinfo environment." + (interactive) + (while (and (re-search-backward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "@end"))))) + +(defun texinfo-next-environment-end () + "Move forward to the beginning of the next @end line of an environment." + (interactive) + (if (looking-at "^@end") + (forward-line 1)) + (while (and (re-search-forward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (not (looking-at "^@end"))))) + (if (save-excursion + (forward-line 0) + (looking-at "^@end")) + (forward-line 0))) + +(defun texinfo-previous-environment-end () + "Move backward to the beginning of the next @end line of an environment." + (interactive) + (while (and (re-search-backward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (not (looking-at "@end")))))) + (provide 'texinfo) ;;; texinfo.el ends here diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 331152808fd..1c3607bb661 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -339,8 +339,7 @@ if it had been inserted from a file named URL." (decode-coding-inserted-region (point-min) (point) url visit beg end replace)) (let ((inserted (car size-and-charset))) - (list url (or (and (fboundp 'after-insert-file-set-coding) - (after-insert-file-set-coding inserted visit)) + (list url (or (after-insert-file-set-coding inserted visit) inserted)))))) ;;;###autoload diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index da6509b7cbe..f5177bca112 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -1513,21 +1513,6 @@ This default should work without changes." (defsubst ediff-nonempty-string-p (string) (and (stringp string) (not (string= string "")))) -(unless (fboundp 'subst-char-in-string) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. -Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) - -(unless (fboundp 'format-message) - (defalias 'format-message 'format)) - (defun ediff-abbrev-jobname (jobname) (cond ((eq jobname 'ediff-directories) "Compare two directories") diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e0cf9e79595..78a2fa08795 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -243,7 +243,7 @@ toggle display of the entire list." ;; path specs. ;; See also: http://marc.info/?l=git&m=125787684318129&w=2 (name (file-relative-name file dir)) - (str (ignore-errors + (str (with-demoted-errors "Error: %S" (cd dir) (vc-git--out-ok "ls-files" "-c" "-z" "--" name) ;; If result is empty, use ls-tree to check for deleted diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index db127ee726d..4eb638978a9 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -146,6 +146,20 @@ For a description of possible values, see `vc-check-master-templates'." (progn (defun vc-src-registered (f) (vc-default-registered 'src f))) +(defun vc-src--parse-state (out) + (when (null (string-match "does not exist or is unreadable" out)) + (let ((state (aref out 0))) + (cond + ;; FIXME: What to do about L code? + ((eq state ?.) 'up-to-date) + ((eq state ?A) 'added) + ((eq state ?M) 'edited) + ((eq state ?I) 'ignored) + ((eq state ?R) 'removed) + ((eq state ?!) 'missing) + ((eq state ??) 'unregistered) + (t 'up-to-date))))) + (defun vc-src-state (file) "SRC-specific version of `vc-state'." (let* @@ -163,32 +177,41 @@ For a description of possible values, see `vc-check-master-templates'." "status" "-a" (file-relative-name file)) (error nil))))))) (when (eq 0 status) - (when (null (string-match "does not exist or is unreadable" out)) - (let ((state (aref out 0))) - (cond - ;; FIXME: What to do about A and L codes? - ((eq state ?.) 'up-to-date) - ((eq state ?A) 'added) - ((eq state ?M) 'edited) - ((eq state ?I) 'ignored) - ((eq state ?R) 'removed) - ((eq state ?!) 'missing) - ((eq state ??) 'unregistered) - (t 'up-to-date))))))) + (vc-src--parse-state out)))) (autoload 'vc-expand-dirs "vc") (defun vc-src-dir-status-files (dir files update-function) - ;; FIXME: Use one src status -a call for this - (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC))) - (let ((result nil)) - (dolist (file files) - (let ((state (vc-state file)) - (frel (file-relative-name file))) - (when (and (eq (vc-backend file) 'SRC) - (not (eq state 'up-to-date))) - (push (list frel state) result)))) - (funcall update-function result))) + (let* ((result nil) + (status nil) + (default-directory (or dir default-directory)) + (out + (with-output-to-string + (with-current-buffer standard-output + (setq status + (ignore-errors + (apply + #'process-file vc-src-program nil t nil + "status" "-a" + (mapcar #'file-relative-name files))))))) + dlist) + (when (eq 0 status) + (dolist (line (split-string out "[\n\r]" t)) + (let* ((pair (split-string line "[\t]" t)) + (state (vc-src--parse-state (car pair))) + (frel (cadr pair))) + (if (file-directory-p frel) + (push frel dlist) + (when (not (eq state 'up-to-date)) + (push (list frel state) result))))) + (dolist (drel dlist) + (let ((dresult (vc-src-dir-status-files + (expand-file-name drel) nil #'identity))) + (dolist (dres dresult) + (push (list (concat (file-name-as-directory drel) (car dres)) + (cadr dres)) + result)))) + (funcall update-function result)))) (defun vc-src-command (buffer file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-src.el. diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el index 7552fbb99c1..1e81dd241f1 100644 --- a/lisp/vt100-led.el +++ b/lisp/vt100-led.el @@ -1,4 +1,4 @@ -;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones +;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -*- lexical-binding:t -*- ;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 42c4b61daff..8a1bb8ade87 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -262,7 +262,7 @@ ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; code: +;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/xwidget.el b/lisp/xwidget.el index aed6c09122c..074320855c5 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -41,7 +41,10 @@ (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height)) (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script &optional callback)) +(declare-function xwidget-webkit-uri "xwidget.c" (xwidget)) +(declare-function xwidget-webkit-title "xwidget.c" (xwidget)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) +(declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos)) (declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) @@ -51,6 +54,10 @@ (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) +(defgroup xwidget nil + "Displaying native widgets in Emacs buffers." + :group 'widgets) + (defun xwidget-insert (pos type title width height &optional args) "Insert an xwidget at position POS. Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT. @@ -78,6 +85,8 @@ This returns the result of `make-xwidget'." ;;; webkit support (require 'browse-url) (require 'image-mode);;for some image-mode alike functionality +(require 'seq) +(require 'url-handlers) ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) @@ -99,6 +108,24 @@ Interactively, URL defaults to the string looking like a url around point." (xwidget-webkit-new-session url) (xwidget-webkit-goto-url url)))) +(defun xwidget-webkit-clone-and-split-below () + "Clone current URL into a new widget place in new window below. +Get the URL of current session, then browse to the URL +in `split-window-below' with a new xwidget webkit session." + (interactive) + (let ((url (xwidget-webkit-current-url))) + (with-selected-window (split-window-below) + (xwidget-webkit-new-session url)))) + +(defun xwidget-webkit-clone-and-split-right () + "Clone current URL into a new widget place in new window right. +Get the URL of current session, then browse to the URL +in `split-window-right' with a new xwidget webkit session." + (interactive) + (let ((url (xwidget-webkit-current-url))) + (with-selected-window (split-window-right) + (xwidget-webkit-new-session url)))) + ;;todo. ;; - check that the webkit support is compiled in (defvar xwidget-webkit-mode-map @@ -106,6 +133,7 @@ Interactively, URL defaults to the string looking like a url around point." (define-key map "g" 'xwidget-webkit-browse-url) (define-key map "a" 'xwidget-webkit-adjust-size-dispatch) (define-key map "b" 'xwidget-webkit-back) + (define-key map "f" 'xwidget-webkit-forward) (define-key map "r" 'xwidget-webkit-reload) (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? (define-key map "\C-m" 'xwidget-webkit-insert-string) @@ -115,20 +143,21 @@ Interactively, URL defaults to the string looking like a url around point." ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) + (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down) (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down) - (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up) + (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line) (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up) - (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down) + (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down-line) (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down) (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward) (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward) (define-key map [remap right-char] 'xwidget-webkit-scroll-forward) (define-key map [remap left-char] 'xwidget-webkit-scroll-backward) - (define-key map [remap previous-line] 'xwidget-webkit-scroll-down) - (define-key map [remap next-line] 'xwidget-webkit-scroll-up) + (define-key map [remap previous-line] 'xwidget-webkit-scroll-down-line) + (define-key map [remap next-line] 'xwidget-webkit-scroll-up-line) ;; (define-key map [remap move-beginning-of-line] 'image-bol) ;; (define-key map [remap move-end-of-line] 'image-eol) @@ -147,33 +176,63 @@ Interactively, URL defaults to the string looking like a url around point." (interactive) (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1)) -(defun xwidget-webkit-scroll-up () - "Scroll webkit up." - (interactive) +(defun xwidget-webkit-scroll-up (&optional arg) + "Scroll webkit up by ARG pixels; or full window height if no ARG. +Stop if bottom of page is reached. +Interactively, ARG is the prefix numeric argument. +Negative ARG scrolls down." + (interactive "P") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(0, 50);")) - -(defun xwidget-webkit-scroll-down () - "Scroll webkit down." - (interactive) + (format "window.scrollBy(0, %d);" + (or arg (xwidget-window-inside-pixel-height (selected-window)))))) + +(defun xwidget-webkit-scroll-down (&optional arg) + "Scroll webkit down by ARG pixels; or full window height if no ARG. +Stop if top of page is reached. +Interactively, ARG is the prefix numeric argument. +Negative ARG scrolls up." + (interactive "P") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(0, -50);")) - -(defun xwidget-webkit-scroll-forward () - "Scroll webkit forwards." - (interactive) + (format "window.scrollBy(0, -%d);" + (or arg (xwidget-window-inside-pixel-height (selected-window)))))) + +(defun xwidget-webkit-scroll-up-line (&optional n) + "Scroll webkit up by N lines. +The height of line is calculated with `window-font-height'. +Stop if the bottom edge of the page is reached. +If N is omitted or nil, scroll up by one line." + (interactive "p") + (xwidget-webkit-scroll-up (* n (window-font-height)))) + +(defun xwidget-webkit-scroll-down-line (&optional n) + "Scroll webkit down by N lines. +The height of line is calculated with `window-font-height'. +Stop if the top edge of the page is reached. +If N is omitted or nil, scroll down by one line." + (interactive "p") + (xwidget-webkit-scroll-down (* n (window-font-height)))) + +(defun xwidget-webkit-scroll-forward (&optional n) + "Scroll webkit horizontally by N chars. +The width of char is calculated with `window-font-width'. +If N is ommited or nil, scroll forwards by one char." + (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(50, 0);")) - -(defun xwidget-webkit-scroll-backward () - "Scroll webkit backwards." - (interactive) + (format "window.scrollBy(%d, 0);" + (* n (window-font-width))))) + +(defun xwidget-webkit-scroll-backward (&optional n) + "Scroll webkit back by N chars. +The width of char is calculated with `window-font-width'. +If N is ommited or nil, scroll backwards by one char." + (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(-50, 0);")) + (format "window.scrollBy(-%d, 0);" + (* n (window-font-width))))) (defun xwidget-webkit-scroll-top () "Scroll webkit to the very top." @@ -187,7 +246,7 @@ Interactively, URL defaults to the string looking like a url around point." (interactive) (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollTo(pageXOffset, window.document.body.clientHeight);")) + "window.scrollTo(pageXOffset, window.document.body.scrollHeight);")) ;; The xwidget event needs to go into a higher level handler ;; since the xwidget can generate an event even if it's offscreen. @@ -207,12 +266,8 @@ Interactively, URL defaults to the string looking like a url around point." (let* ((xwidget-event-type (nth 1 last-input-event)) (xwidget (nth 2 last-input-event)) - ;;(xwidget-callback (xwidget-get xwidget 'callback)) - ;;TODO stopped working for some reason - ) - ;;(funcall xwidget-callback xwidget xwidget-event-type) - (message "xw callback %s" xwidget) - (funcall 'xwidget-webkit-callback xwidget xwidget-event-type))) + (xwidget-callback (xwidget-get xwidget 'callback))) + (funcall xwidget-callback xwidget xwidget-event-type))) (defun xwidget-webkit-callback (xwidget xwidget-event-type) "Callback for xwidgets. @@ -222,21 +277,23 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) (cond ((eq xwidget-event-type 'load-changed) - (xwidget-webkit-execute-script - xwidget "document.title" - (lambda (title) - (xwidget-log "webkit finished loading: '%s'" title) - ;;TODO - check the native/internal scroll - ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-to-window xwidget) - (rename-buffer (format "*xwidget webkit: %s *" title)))) - (pop-to-buffer (current-buffer))) + (let ((title (xwidget-webkit-title xwidget))) + (xwidget-log "webkit finished loading: %s" title) + ;; Do not adjust webkit size to window here, the selected window + ;; can be the mini-buffer window unwantedly. + (rename-buffer (format "*xwidget webkit: %s *" title) t))) ((eq xwidget-event-type 'decide-policy) (let ((strarg (nth 3 last-input-event))) (if (string-match ".*#\\(.*\\)" strarg) (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))) + ;; TODO: Response handling other than download. + ((eq xwidget-event-type 'download-callback) + (let ((url (nth 3 last-input-event)) + (mime-type (nth 4 last-input-event)) + (file-name (nth 5 last-input-event))) + (xwidget-webkit-save-as-file url mime-type file-name))) ((eq xwidget-event-type 'javascript-callback) (let ((proc (nth 3 last-input-event)) (arg (nth 4 last-input-event))) @@ -244,21 +301,66 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))) (defvar bookmark-make-record-function) +(when (memq window-system '(mac ns)) + (defvar xwidget-webkit-enable-plugins nil + "Enable plugins for xwidget webkit. +If non-nil, plugins are enabled. Otherwise, disabled.")) + (define-derived-mode xwidget-webkit-mode - special-mode "xwidget-webkit" "Xwidget webkit view mode." - (setq buffer-read-only t) - (setq-local bookmark-make-record-function - #'xwidget-webkit-bookmark-make-record) - ;; Keep track of [vh]scroll when switching buffers - (image-mode-setup-winprops)) + special-mode "xwidget-webkit" "Xwidget webkit view mode." + (setq buffer-read-only t) + (setq-local bookmark-make-record-function + #'xwidget-webkit-bookmark-make-record) + ;; Keep track of [vh]scroll when switching buffers + (image-mode-setup-winprops)) + +;;; Download, save as file. + +(defcustom xwidget-webkit-download-dir "~/Downloads/" + "Directory where download file saved." + :version "27.1" + :type 'file) + +(defun xwidget-webkit-save-as-file (url mime-type file-name) + "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user. +FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name +of the prompt when reading. When the file name the user specified is a +directory, URL is saved at the specified directory as FILE-NAME." + (let ((save-name (read-file-name + (format "Save URL `%s' of type `%s' in file/directory: " + url mime-type) + xwidget-webkit-download-dir + (when file-name + (expand-file-name + file-name + xwidget-webkit-download-dir))))) + (if (file-directory-p save-name) + (setq save-name + (expand-file-name (file-name-nondirectory file-name) save-name))) + (setq xwidget-webkit-download-dir (file-name-directory save-name)) + (url-copy-file url save-name t))) + +;;; Bookmarks integration + +(defcustom xwidget-webkit-bookmark-jump-new-session nil + "Control bookmark jump to use new session or not. +If non-nil, use a new xwidget webkit session after bookmark jump. +Otherwise, it will use `xwidget-webkit-last-session'. +When you set this variable to nil, consider further customization with +`xwidget-webkit-last-session-buffer'." + :version "27.1" + :type 'boolean) (defun xwidget-webkit-bookmark-make-record () - "Integrate Emacs bookmarks with the webkit xwidget." + "Create bookmark record in webkit xwidget." (nconc (bookmark-make-record-default t t) - `((page . ,(xwidget-webkit-current-url)) - (handler . (lambda (bmk) (browse-url - (bookmark-prop-get bmk 'page))))))) + `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session))) + (handler . (lambda (bmk) + (xwidget-webkit-browse-url + (bookmark-prop-get bmk 'page) + xwidget-webkit-bookmark-jump-new-session)))))) +;;; xwidget webkit session (defvar xwidget-webkit-last-session-buffer nil) @@ -306,7 +408,7 @@ function findactiveelement(doc){ " - "javascript that finds the active element." + "Javascript that finds the active element." ;; Yes it's ugly, because: ;; - there is apparently no way to find the active frame other than recursion ;; - the js "for each" construct misbehaved on the "frames" collection @@ -316,19 +418,22 @@ function findactiveelement(doc){ ) (defun xwidget-webkit-insert-string () - "Prompt for a string and insert it in the active field in the -current webkit widget." + "Insert string into the active field in the current webkit widget." ;; Read out the string in the field first and provide for edit. (interactive) + ;; As the prompt differs on JavaScript execution results, + ;; the function must handle the prompt itself. (let ((xww (xwidget-webkit-current-session))) (xwidget-webkit-execute-script xww (concat xwidget-webkit-activeelement-js " (function () { var res = findactiveelement(document); - return [res.value, res.type]; + if (res) + return [res.value, res.type]; })();") (lambda (field) + "Prompt a string for the FIELD and insert in the active input." (let ((str (pcase field (`[,val "text"] (read-string "Text: " val)) @@ -447,11 +552,23 @@ For example, use this to display an anchor." (ignore-errors (recenter-top-bottom))) +;; Utility functions + +(defun xwidget-window-inside-pixel-width (window) + "Return Emacs WINDOW body width in pixel." + (let ((edges (window-inside-pixel-edges window))) + (- (nth 2 edges) (nth 0 edges)))) + +(defun xwidget-window-inside-pixel-height (window) + "Return Emacs WINDOW body height in pixel." + (let ((edges (window-inside-pixel-edges window))) + (- (nth 3 edges) (nth 1 edges)))) + (defun xwidget-webkit-adjust-size-to-window (xwidget &optional window) "Adjust the size of the webkit XWIDGET to fit the WINDOW." (xwidget-resize xwidget - (window-pixel-width window) - (window-pixel-height window))) + (xwidget-window-inside-pixel-width window) + (xwidget-window-inside-pixel-height window))) (defun xwidget-webkit-adjust-size (w h) "Manually set webkit size to width W, height H." @@ -481,51 +598,56 @@ For example, use this to display an anchor." (add-to-list 'window-size-change-functions 'xwidget-webkit-adjust-size-in-frame)) -(defun xwidget-webkit-new-session (url) +(defun xwidget-webkit-new-session (url &optional callback) "Create a new webkit session buffer with URL." (let* ((bufname (generate-new-buffer-name "*xwidget-webkit*")) + (callback (or callback #'xwidget-webkit-callback)) xw) (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname))) ;; The xwidget id is stored in a text property, so we need to have ;; at least character in this buffer. - (insert " ") - (setq xw (xwidget-insert 1 'webkit bufname - (window-pixel-width) - (window-pixel-height))) - (xwidget-put xw 'callback 'xwidget-webkit-callback) + ;; Insert invisible url, good default for next `g' to browse url. + (let ((start (point))) + (insert url) + (put-text-property start (+ start (length url)) 'invisible t) + (setq xw (xwidget-insert + start 'webkit bufname + (xwidget-window-inside-pixel-width (selected-window)) + (xwidget-window-inside-pixel-height (selected-window))))) + (xwidget-put xw 'callback callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) (defun xwidget-webkit-goto-url (url) - "Goto URL." + "Goto URL with xwidget webkit." (if (xwidget-webkit-current-session) (progn (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url)) (xwidget-webkit-new-session url))) (defun xwidget-webkit-back () - "Go back in history." + "Go back to previous URL in xwidget webkit buffer." (interactive) - (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "history.go(-1);")) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1)) + +(defun xwidget-webkit-forward () + "Go forward in history." + (interactive) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1)) (defun xwidget-webkit-reload () - "Reload current url." + "Reload current URL." (interactive) - (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "history.go(0);")) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0)) (defun xwidget-webkit-current-url () - "Get the webkit url and place it on the kill-ring." + "Display the current xwidget webkit URL and place it on the `kill-ring'." (interactive) - (xwidget-webkit-execute-script - (xwidget-webkit-current-session) - "document.URL" (lambda (rv) - (let ((url (kill-new (or rv "")))) - (message "url: %s" url))))) + (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) + (message "URL: %s" (kill-new (or url ""))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xwidget-webkit-get-selection (proc) @@ -536,10 +658,9 @@ For example, use this to display an anchor." proc)) (defun xwidget-webkit-copy-selection-as-kill () - "Get the webkit selection and put it on the kill-ring." + "Get the webkit selection and put it on the `kill-ring'." (interactive) - (xwidget-webkit-get-selection (lambda (selection) (kill-new selection)))) - + (xwidget-webkit-get-selection #'kill-new)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Xwidget plist management (similar to the process plist functions) |