diff options
Diffstat (limited to 'lisp')
49 files changed, 608 insertions, 303 deletions
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index ba8efd43b8e..37e10e8dfac 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1097,7 +1097,7 @@ Redefine the corresponding command." (or func (setq func (and cmd (symbolp cmd) (fboundp cmd) cmd))) (if (get func 'math-compose-forms) (let ((pt (point))) - (insert "(put '" (symbol-name cmd) + (insert "(put '" (symbol-name func) " 'math-compose-forms '" (prin1-to-string (get func 'math-compose-forms)) ")\n") diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 8a8bad91137..24969633373 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2212,7 +2212,12 @@ and `face'." (unless (eq state 'modified) (unless (memq state '(nil unknown hidden)) (widget-put widget :custom-state 'modified)) - (custom-magic-reset widget) + ;; Update the status text (usually from "STANDARD" to "EDITED + ;; bla bla" in the buffer after the command has run. Otherwise + ;; commands like `M-u' (that work on a region in the buffer) + ;; will upcase the wrong part of the buffer, since more text has + ;; been inserted before point. + (run-with-idle-timer 0.0 nil #'custom-magic-reset widget) (apply 'widget-default-notify widget args)))) (defun custom-redraw (widget) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index a2dbd402c52..ce2827162b9 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -398,9 +398,8 @@ FILE's name." ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, ;; which was designed to handle CVSREAD=1 and equivalent. (and autoload-ensure-writable - (file-exists-p file) (let ((modes (file-modes file))) - (if (zerop (logand modes #o0200)) + (if (and modes (zerop (logand modes #o0200))) ;; Ignore any errors here, and let subsequent attempts ;; to write the file raise any real error. (ignore-errors (set-file-modes file (logior modes #o0200)))))) diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 60d146e24a8..0c4c7987c3c 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -175,7 +175,8 @@ This should be a list of `backtrace-frame' objects.") (defvar-local backtrace-view nil "A plist describing how to render backtrace frames. -Possible entries are :show-flags, :show-locals and :print-circle.") +Possible entries are :show-flags, :show-locals, :print-circle +and :print-gensym.") (defvar-local backtrace-insert-header-function nil "Function for inserting a header for the current Backtrace buffer. @@ -205,6 +206,7 @@ frames where the source code location is known.") (define-key map "p" 'backtrace-backward-frame) (define-key map "v" 'backtrace-toggle-locals) (define-key map "#" 'backtrace-toggle-print-circle) + (define-key map ":" 'backtrace-toggle-print-gensym) (define-key map "s" 'backtrace-goto-source) (define-key map "\C-m" 'backtrace-help-follow-symbol) (define-key map "+" 'backtrace-multi-line) @@ -224,6 +226,18 @@ frames where the source code location is known.") :active (backtrace-get-index) :selected (plist-get (backtrace-get-view) :show-locals) :help "Show or hide the local variables for the frame at point"] + ["Show Circular Structures" backtrace-toggle-print-circle + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :print-circle) + :help + "Condense or expand shared or circular structures in the frame at point"] + ["Show Uninterned Symbols" backtrace-toggle-print-gensym + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :print-gensym) + :help + "Toggle unique printing of uninterned symbols in the frame at point"] ["Expand \"...\"s" backtrace-expand-ellipses :help "Expand all the abbreviated forms in the current frame"] ["Show on Multiple Lines" backtrace-multi-line @@ -339,6 +353,7 @@ It runs `backtrace-revert-hook', then calls `backtrace-print'." `(let ((print-escape-control-characters t) (print-escape-newlines t) (print-circle (plist-get ,view :print-circle)) + (print-gensym (plist-get ,view :print-gensym)) (standard-output (current-buffer))) ,@body)) @@ -420,12 +435,18 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button." (defun backtrace-toggle-print-circle (&optional all) "Toggle `print-circle' for the backtrace frame at point. -With prefix argument ALL, toggle the value of :print-circle in -`backtrace-view', which affects all of the backtrace frames in -the buffer." +With prefix argument ALL, toggle the default value bound to +`print-circle' for all the frames in the buffer." (interactive "P") (backtrace--toggle-feature :print-circle all)) +(defun backtrace-toggle-print-gensym (&optional all) + "Toggle `print-gensym' for the backtrace frame at point. +With prefix argument ALL, toggle the default value bound to +`print-gensym' for all the frames in the buffer." + (interactive "P") + (backtrace--toggle-feature :print-gensym all)) + (defun backtrace--toggle-feature (feature all) "Toggle FEATURE for the current backtrace frame or for the buffer. FEATURE should be one of the options in `backtrace-view'. If ALL @@ -450,12 +471,15 @@ position point at the start of the frame it was in before." (goto-char (point-min)) (while (and (not (eql index (backtrace-get-index))) (< (point) (point-max))) - (goto-char (backtrace-get-frame-end))))) - (let ((index (backtrace-get-index))) - (unless index - (user-error "Not in a stack frame")) - (backtrace--set-feature feature - (not (plist-get (backtrace-get-view) feature)))))) + (goto-char (backtrace-get-frame-end)))) + (message "%s is now %s for all frames" + (substring (symbol-name feature) 1) value)) + (unless (backtrace-get-index) + (user-error "Not in a stack frame")) + (let ((value (not (plist-get (backtrace-get-view) feature)))) + (backtrace--set-feature feature value) + (message "%s is now %s for this frame" + (substring (symbol-name feature) 1) value)))) (defun backtrace--set-feature (feature value) "Set FEATURE in the view plist of the frame at point to VALUE. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 5fe3dd1b912..530770128e6 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -548,21 +548,22 @@ limit." ;; call_debugger (bug#31919). (let* ((print-length (when limit (min limit 50))) (print-level (when limit (min 8 (truncate (log limit))))) - (delta (when limit - (max 1 (truncate (/ print-length print-level)))))) + (delta-length (when limit + (max 1 (truncate (/ print-length print-level)))))) (with-temp-buffer (catch 'done (while t (erase-buffer) (funcall print-function value (current-buffer)) - ;; Stop when either print-level is too low or the value is - ;; successfully printed in the space allowed. - (when (or (not limit) - (< (- (point-max) (point-min)) limit) - (= print-level 2)) - (throw 'done (buffer-string))) - (cl-decf print-level) - (cl-decf print-length delta)))))) + (let ((result (- (point-max) (point-min)))) + ;; Stop when either print-level is too low or the value is + ;; successfully printed in the space allowed. + (when (or (not limit) (< result limit) (<= print-level 2)) + (throw 'done (buffer-string))) + (let* ((ratio (/ result limit)) + (delta-level (max 1 (min (- print-level 2) ratio)))) + (cl-decf print-level delta-level) + (cl-decf print-length (* delta-length delta-level))))))))) (provide 'cl-print) ;;; cl-print.el ends here diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 521edbe6048..0f5c92c2c9e 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1,4 +1,4 @@ -;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs, -*-lexical-binding:t -*- +;;; viper.el --- A full-featured Vi emulator for Emacs -*- lexical-binding:t -*- ;; a VI Plan for Emacs Rescue, ;; and a venomous VI PERil. ;; Viper Is also a Package for Emacs Rebels. @@ -34,7 +34,7 @@ ;;; Commentary: -;; Viper is a full-featured Vi emulator for Emacs and XEmacs. It emulates and +;; Viper is a full-featured Vi emulator for Emacs. It emulates and ;; improves upon the standard features of Vi and, at the same time, allows ;; full access to all Emacs facilities. Viper supports multiple undo, ;; file name completion, command, file, and search history and it extends @@ -541,7 +541,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on." "Viper Is a Package for Emacs Rebels, a VI Plan for Emacs Rescue, and a venomous VI PERil. -Incidentally, Viper emulates Vi under Emacs/XEmacs 20. +Incidentally, Viper emulates Vi under Emacs. It supports all of what is good in Vi and Ex, while extending and improving upon much of it. diff --git a/lisp/files.el b/lisp/files.el index ce4dd99bd53..5ceaacd744e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2554,13 +2554,13 @@ unless NOMODES is non-nil." (auto-save-mode 1))) ;; Make people do a little extra work (C-x C-q) ;; before altering a backup file. - (when (backup-file-name-p buffer-file-name) - (setq buffer-read-only t)) ;; When a file is marked read-only, ;; make the buffer read-only even if root is looking at it. - (when (and (file-modes (buffer-file-name)) - (zerop (logand (file-modes (buffer-file-name)) #o222))) - (setq buffer-read-only t)) + (unless buffer-read-only + (when (or (backup-file-name-p buffer-file-name) + (let ((modes (file-modes (buffer-file-name)))) + (and modes (zerop (logand modes #o222))))) + (setq buffer-read-only t))) (unless nomodes (when (and view-read-only view-mode) (view-mode -1)) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index e8775c66673..cb369f07b92 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -897,9 +897,8 @@ If REGEXP is given, lines that match it will be deleted." (set-buffer-modified-p t)) ;; Set the file modes to reflect the .newsrc file modes. (save-buffer) - (when (and (file-exists-p gnus-current-startup-file) - (file-exists-p dribble-file) - (setq modes (file-modes gnus-current-startup-file))) + (when (and (setq modes (file-modes gnus-current-startup-file)) + (file-exists-p dribble-file)) (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) (when (search-forward "Gnus was exited on purpose" nil t) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index cba9633b539..5636b8eca47 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -381,9 +381,11 @@ enables you to choose manually one of two types those mails include." :type 'directory :group 'mime-display) -(defcustom mm-inline-large-images nil - "If t, then all images fit in the buffer. -If `resize', try to resize the images so they fit." +(defcustom mm-inline-large-images 'resize + "If nil, images larger than the window aren't displayed in the buffer. +If `resize', try to resize the images so they fit in the buffer. +If t, show the images as they are without resizing." + :version "27.1" :type '(radio (const :tag "Inline large images as they are." t) (const :tag "Resize large images." resize) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 6ffa1fc168d..02d99200a35 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -65,8 +65,9 @@ :group 'mime-display) (defcustom mm-inline-large-images-proportion 0.9 - "Maximum proportion of large image resized when -`mm-inline-large-images' is set to resize." + "Maximum proportion large images can occupy in the buffer. +This is only used if `mm-inline-large-images' is set to +`resize'." :type 'float :version "24.1" :group 'mime-display) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index fb29bd2be4f..efc0b8ffa9e 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -59,7 +59,7 @@ ["Next Topic" help-go-forward :help "Go back to next topic in this help buffer"] ["Move to Previous Button" backward-button - :help "Move to the Next Button in the help buffer"] + :help "Move to the Previous Button in the help buffer"] ["Move to Next Button" forward-button :help "Move to the Next Button in the help buffer"])) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index b8442be1e89..c1aaab5e211 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1938,9 +1938,9 @@ adding an extension of `hfy-extn'. Fontification is actually done by (set-buffer html) (write-file (concat target hfy-extn)) (kill-buffer html)) - ;; #o0200 == 128, but emacs20 doesn't know that - (if (and (file-exists-p target) (not (file-writable-p target))) - (set-file-modes target (logior (file-modes target) 128))) + (let ((modes (file-modes target))) + (if (and modes (not (file-writable-p target))) + (set-file-modes target (logior modes #o0200)))) (copy-file (buffer-file-name source) target 'overwrite)) (kill-buffer source)) )) diff --git a/lisp/imenu.el b/lisp/imenu.el index 5084fe61eff..9df597b4d63 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -510,8 +510,9 @@ See `imenu--index-alist' for the format of the index alist." "No items suitable for an index found in this buffer")) (or imenu--index-alist (setq imenu--index-alist (list nil))) - ;; Add a rescan option to the index. - (cons imenu--rescan-item imenu--index-alist)) + (unless imenu-auto-rescan + ;; Add a rescan option to the index. + (cons imenu--rescan-item imenu--index-alist))) (defvar imenu--cleanup-seen nil) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index f3ab81633dc..1debec7f469 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -719,6 +719,7 @@ symbol braille yi + tai-viet aegean-number ancient-greek-number ancient-symbol @@ -731,18 +732,26 @@ deseret shavian osmanya + osage cypriot-syllabary phoenician lydian kharoshthi + manichaean + elymaic + makasar cuneiform-numbers-and-punctuation cuneiform egyptian + bassa-vah + pahawh-hmong + medefaidrin byzantine-musical-symbol musical-symbol ancient-greek-musical-notation tai-xuan-jing-symbol counting-rod-numeral + adlam mahjong-tile domino-tile)) (set-fontset-font "fontset-default" diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index b573e1e47c5..3530e6f2538 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -177,6 +177,8 @@ ("c" . [?¢]) ("*o" . [?°]) ("o" . [?°]) + ("Oe" . [?œ]) + ("OE" . [?Œ]) ("*u" . [?µ]) ("u" . [?µ]) ("*m" . [?µ]) diff --git a/lisp/isearch.el b/lisp/isearch.el index 30f7fc7254c..9401e8c06d3 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -514,6 +514,9 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map [isearch-yank-kill] '(menu-item "Current kill" isearch-yank-kill :help "Append current kill to search string")) + (define-key map [isearch-yank-until-char] + '(menu-item "Until char..." isearch-yank-until-char + :help "Yank from point to specified character into search string")) (define-key map [isearch-yank-line] '(menu-item "Rest of line" isearch-yank-line :help "Yank the rest of the current line on search string")) @@ -705,6 +708,7 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-\C-d" 'isearch-del-char) (define-key map "\M-\C-y" 'isearch-yank-char) (define-key map "\C-y" 'isearch-yank-kill) + (define-key map "\M-\C-z" 'isearch-yank-until-char) (define-key map "\M-s\C-e" 'isearch-yank-line) (define-key map "\M-s\M-<" 'isearch-beginning-of-buffer) @@ -998,6 +1002,8 @@ Type \\[isearch-yank-word-or-char] to yank next word or character in buffer Type \\[isearch-del-char] to delete character from end of search string. Type \\[isearch-yank-char] to yank char from buffer onto end of search\ string and search for it. +Type \\[isearch-yank-until-char] to yank from point until the next instance of a + specified character onto end of search string and search for it. Type \\[isearch-yank-line] to yank rest of line onto end of search string\ and search for it. Type \\[isearch-yank-kill] to yank the last string of killed text. @@ -2562,6 +2568,23 @@ If optional ARG is non-nil, pull in the next ARG words." (interactive "p") (isearch-yank-internal (lambda () (forward-word arg) (point)))) +(defun isearch-yank-until-char (char) + "Pull everything until next instance of CHAR from buffer into search string. +Interactively, prompt for CHAR. +This is often useful for keyboard macros, for example in programming +languages or markup languages in which CHAR marks a token boundary." + (interactive "cYank until character: ") + (isearch-yank-internal + (lambda () (let ((inhibit-field-text-motion t)) + (condition-case nil + (progn + (search-forward (char-to-string char)) + (forward-char -1)) + (search-failed + (message "`%c' not found" char) + (sit-for 2))) + (point))))) + (defun isearch-yank-line (&optional arg) "Pull rest of line from buffer into search string. If optional ARG is non-nil, yank the next ARG lines." diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index b202abf029c..086483da813 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -39,21 +39,20 @@ (input-method . "tai-sonla") (sample-text . "TaiViet (ꪁꪫꪱꪣ ꪼꪕ)\t\tꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ") (documentation . "\ -TaiViet refers to the Tai language used by Tai people in -Vietnam, and also refers to the script used for this language. -Both the script and language have the same origin as that of Thai +TaiViet refers to the Tai script, which is used to write several +Tai languages of northwestern Vietnam and surrounding areas. These +languages are Tai Dam (also known as Black Tai or Tai Noir), +Tai Dón (also known as White Tai or Tai Blanc), Tày Tac, +Tai Daeng (also known as Red Tai or Tai Rouge), +and Thai Song (also known as Lao Song). However, some people +consider Tai Dam, Tai Dón and Tai Daeng to be dialects of the +same language, and call them collectively \"Tai Viet\". + +Both the script and languages have the same origin as that of Thai language/script used in Thailand, but now they differ from each other in a significant way (especially the scripts are). The language name is spelled as \"ꪁꪫꪱꪣ ꪼꪕ\", and the script name is -spelled as \"ꪎ ꪼꪕ\" in the modern form, \"ꪎꪳ ꪼꪕ\" in the traditional -form. - -As the proposal for TaiViet script to the Unicode is still on -the progress, we use the Private Use Area for TaiViet -characters (U+F000..U+F07E). A TaiViet font encoded accordingly -is available at this web page: - http://www.m17n.org/viettai/ -"))) +spelled as \"ꪎꪳ ꪼꪕ\"."))) (provide 'tai-viet) diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el index 74a2dccc060..169dbcf0e22 100644 --- a/lisp/leim/quail/ipa-praat.el +++ b/lisp/leim/quail/ipa-praat.el @@ -148,7 +148,14 @@ input | example | description \\'1 | ˈ | primary stress \\'2 | ˌ | secondary stress \\cn | t̚ | unreleased plosive -\\rh | ɜ˞ | rhotacized vowel +\\hr | ɜ˞ | rhotacized vowel +\\^h | ʰ | aspiration +\\^H | ʱ | voiced aspiration +\\^w | ʷ | labialized, rounded +\\^j | ʲ | palatalized +\\^g | ˠ | velarized +\\^9 | ˤ | pharyngealized + - Understrikes @@ -168,7 +175,7 @@ input | example | description \\Uv | d̺ | apical \\Dv | d̻ | laminal \\nv | u̯ | nonsyllabic -\\e3v | e̹ | slightly rounded +\\3v | e̹ | slightly rounded \\cv | u̜ | slightly unrounded - Overstrikes @@ -176,14 +183,14 @@ input | example | description input | example | description ------+---------+-------------------------------------------- \\0^ | ɣ̊ | voiceless -\\'^ | | high tone -\\`^ | | low tone -\\-^ | | mid tone -\\~^ | | nasalized -\\v^ | | rising tone -\\^^ | | falling tone -\\:^ | | centralized -\\N^ | | short +\\'^ | é | high tone +\\`^ | è | low tone +\\-^ | ē | mid tone +\\~^ | ẽ | nasalized +\\v^ | ě | rising tone +\\^^ | ê | falling tone +\\:^ | ë | centralized +\\N^ | ĕ | short \\li | k͡p | simultaneous articulation or single segment " nil t nil nil nil nil nil nil nil nil t) @@ -308,7 +315,13 @@ input | example | description ("\\'1" ?ˈ) ; primary stress ("\\'2" ?ˌ) ; secondary stress ("\\cn" #x031A) ; t̚ unreleased plosive - ("\\rh" #x02DE) ; ɜ˞ rhotacized vowel + ("\\hr" #x02DE) ; ɜ˞ rhotacized vowel + ("\\^h" ?ʰ) ; ʰ aspiration (usually following a plosive) + ("\\^H" ?ʱ) ; ʱ voiced aspiration (usually following a plosive) + ("\\^w" ?ʷ) ; labialized + ("\\^j" ?ʲ) ; palatalized + ("\\^g" ?ˠ) ; velarized + ("\\^9" ?ˤ) ; pharyngealized ("\\|v" #x0329) ; n̩ syllabic consonant ("\\0v" #x0325) ; b̥ voiceless @@ -324,7 +337,7 @@ input | example | description ("\\Uv" #x033A) ; d̺ apical ("\\Dv" #x033B) ; d̻ laminal ("\\nv" #x032F) ; u̯ nonsyllabic - ("\\e3v" #x0339) ; e̹ slightly rounded + ("\\3v" #x0339) ; e̹ slightly rounded ("\\cv" #x031C) ; u̜ slightly unrounded ("\\0^" #x030A) ; ɣ̊ voiceless diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index babc3fc212a..b362614d3a0 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -17,15 +17,6 @@ ;; ability to queue messages for later sending. This replaces ;; the standalone fakemail program that used to be distributed with Emacs. -;; feedmail works with recent versions of Emacs (20.x series) and -;; XEmacs (tested with 20.4 and later betas). It probably no longer -;; works with Emacs v18, though I haven't tried that in a long -;; time. Makoto.Nakagawa@jp.compaq.com reports: "I have a report -;; that with a help of APEL library, feedmail works fine under emacs -;; 19.28. You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/. -;; you need apel-10.2 or later to make feedmail work under emacs -;; 19.28." - ;; Sorry, no manual yet in this release. Look for one with the next ;; release. Or the one after that. Or maybe later. @@ -437,9 +428,7 @@ shuttled robotically onward." (defcustom feedmail-confirm-outgoing-timeout nil "If non-nil, a timeout in seconds at the send confirmation prompt. If a positive number, it's a timeout before sending. If a negative -number, it's a timeout before not sending. This will not work if your -version of Emacs doesn't include the function `y-or-n-p-with-timeout' -\(e.g., some versions of XEmacs)." +number, it's a timeout before not sending." :version "24.1" :group 'feedmail-misc :type '(choice (const nil) integer) @@ -2004,9 +1993,7 @@ backup file names and the like)." ((feedmail-fqm-p blobby) (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby))) (setq already-buffer - (if (fboundp 'find-buffer-visiting) ; missing from XEmacs - (find-buffer-visiting maybe-file) - (get-file-buffer maybe-file))) + (find-buffer-visiting maybe-file)) (if (and already-buffer (buffer-modified-p already-buffer)) (save-window-excursion (display-buffer (set-buffer already-buffer)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f6fd1cd65eb..802c9ba788d 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -165,6 +165,13 @@ attempt." :type '(choice regexp (const :tag "None" nil)) :version "27.1") +(defcustom smtpmail-retries 10 + "The number of times smtpmail will retry sending when getting transient errors. +These are errors with a code of 4xx from the SMTP server, which +mean \"try again\"." + :type 'integer + :version "27.1") + ;; End of customizable variables. @@ -654,10 +661,12 @@ Returns an error if the server cannot be contacted." user-mail-address)))) (defun smtpmail-via-smtp (recipient smtpmail-text-buffer - &optional ask-for-password) + &optional ask-for-password + send-attempts) (unless smtpmail-smtp-server (smtpmail-query-smtp-server)) (let ((process nil) + (send-attempts (or send-attempts 1)) (host (or smtpmail-smtp-server (error "`smtpmail-smtp-server' not defined"))) (port smtpmail-smtp-service) @@ -819,6 +828,23 @@ Returns an error if the server cannot be contacted." ((smtpmail-ok-p (setq result (smtpmail-read-response process))) ;; Success. ) + ((and (numberp (car result)) + (<= 400 (car result) 499) + (< send-attempts smtpmail-retries)) + (message "Got transient error code %s when sending; retrying attempt %d..." + (car result) send-attempts) + ;; Retry on getting a transient 4xx code; see + ;; https://tools.ietf.org/html/rfc5321#section-4.2.1 + (ignore-errors + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process)) + (delete-process process) + (sleep-for 1) + (setq process nil) + (throw 'done + (smtpmail-via-smtp recipient smtpmail-text-buffer + ask-for-password + (1+ send-attempts)))) ((and auth-mechanisms (not ask-for-password) (eq (car result) 530)) diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index c017419df2e..0f15d3eb71b 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -270,10 +270,16 @@ MH-E functions." (declare (debug let) (indent 1)) ;; Works in both lexical and non-lexical mode. `(progn - ,@(mapcar (lambda (binder) - `(defvar ,(if (consp binder) (car binder) binder))) - binders) - (let* ,binders ,@body))) + (with-suppressed-warnings ((lexical + ,@(mapcar (lambda (binder) + (if (consp binder) + (car binder) + binder)) + binders))) + ,@(mapcar (lambda (binder) + `(defvar ,(if (consp binder) (car binder) binder))) + binders) + (let* ,binders ,@body)))) (provide 'mh-acros) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 77e6cec9b04..fb495a98582 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -326,6 +326,18 @@ the default EWW buffer." #'url-hexify-string (split-string url) "+")))))) url) +(defun eww--preprocess-html (start end) + "Translate all < characters that do not look like start of tags into <." + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let ((case-fold-search t)) + (while (re-search-forward "<[^0-9a-z!/]" nil t) + (goto-char (match-beginning 0)) + (delete-region (point) (1+ (point))) + (insert "<")))))) + ;;;###autoload (defalias 'browse-web 'eww) ;;;###autoload @@ -479,6 +491,7 @@ Currently this means either text/html or application/xhtml+xml." ;; Remove CRLF and replace NUL with � before parsing. (while (re-search-forward "\\(\r$\\)\\|\0" nil t) (replace-match (if (match-beginning 1) "" "�") t t))) + (eww--preprocess-html (point) (point-max)) (libxml-parse-html-region (point) (point-max)))))) (source (and (null document) (buffer-substring (point) (point-max))))) @@ -716,6 +729,7 @@ the like." (condition-case nil (decode-coding-region (point-min) (point-max) 'utf-8) (coding-system-error nil)) + (eww--preprocess-html (point-min) (point-max)) (libxml-parse-html-region (point-min) (point-max)))) (base (plist-get eww-data :url))) (eww-score-readability dom) @@ -1433,15 +1447,15 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (push (cons name (plist-get input :value)) values))) ((equal (plist-get input :type) "file") - (push (cons "file" - (list (cons "filedata" - (with-temp-buffer - (insert-file-contents - (plist-get input :filename)) - (buffer-string))) - (cons "name" (plist-get input :name)) - (cons "filename" (plist-get input :filename)))) - values)) + (when-let ((file (plist-get input :filename))) + (push (list "file" + (cons "filedata" + (with-temp-buffer + (insert-file-contents file) + (buffer-string))) + (cons "name" name) + (cons "filename" file)) + values))) ((equal (plist-get input :type) "submit") ;; We want the values from buttons if we hit a button if ;; we hit enter on it, or if it's the first button after diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 4f68e5db61d..03ed4a59575 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -563,7 +563,7 @@ This command uses `nslookup-program' to look up DNS records." (apply #'vector (mapcar #'string-to-number (split-string ip "\\.")))) (t (error "Invalid format: %s" format))))) -(defun ipv6-expand (ipv6-vector) +(defun nslookup--ipv6-expand (ipv6-vector) (let ((len (length ipv6-vector))) (if (< len 8) (let* ((pivot (cl-position 0 ipv6-vector)) @@ -598,9 +598,10 @@ This command uses `nslookup-program' to look up DNS records." (cond ((memq format '(string nil)) ip) ((eq format 'vector) - (ipv6-expand (apply #'vector - (cl-loop for hextet in (split-string ip "[:]") - collect (string-to-number hextet 16))))) + (nslookup--ipv6-expand + (apply #'vector + (cl-loop for hextet in (split-string ip "[:]") + collect (string-to-number hextet 16))))) (t (error "Invalid format: %s" format))))) ;;;###autoload diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el index 5de8401d5b6..fadc979bc15 100644 --- a/lisp/net/rfc2104.el +++ b/lisp/net/rfc2104.el @@ -37,8 +37,6 @@ ;; 64 is block length of hash function (64 for MD5 and SHA), 16 is ;; resulting hash length (16 for MD5, 20 for SHA). ;; -;; Tested with Emacs 20.2 and XEmacs 20.3. -;; ;; Test case reference: RFC 2202. ;;; History: diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 81c3fb4aa52..1dff129b9dc 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1180,8 +1180,24 @@ Return a string with image data." ;; so glitches may occur during this transformation. (shr-dom-to-xml (libxml-parse-xml-region (point) (point-max))))) + ;; SVG images often do not have a specified foreground/background + ;; color, so wrap them in styles. + (when (eq content-type 'image/svg+xml) + (setq data (svg--wrap-svg data))) (list data content-type))) +(defun svg--wrap-svg (data) + "Add a default foreground colour to SVG images." + (with-temp-buffer + (insert "<svg xmlns:xlink=\"http://www.w3.org/1999/xlink\" " + "xmlns:xi=\"http://www.w3.org/2001/XInclude\" " + "style=\"color: " + (face-foreground 'default) ";\">" + "<xi:include href=\"data:image/svg+xml;base64," + (base64-encode-string data t) + "\"></xi:include></svg>") + (buffer-string))) + (defun shr-image-displayer (content-function) "Return a function to display an image. CONTENT-FUNCTION is a function to retrieve an image for a cid url that diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index df4778c9c96..982522bdaf4 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1191,6 +1191,10 @@ FMT and ARGS are passed to `error'." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let* ((buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf)) (host (tramp-file-name-host vec)) @@ -1204,14 +1208,6 @@ connection if a previous connection has died for some reason." (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) (unless (process-live-p p) - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; - ;; otherwise `start-file-process' wouldn't run ever when - ;; `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (save-match-data (when (and p (processp p)) (delete-process p)) (if (zerop (length device)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index b9b6b4b6d18..1036865e4ec 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1787,6 +1787,10 @@ This is relevant for GNOME Online Accounts." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + ;; We set the file name, in case there are incoming D-Bus signals or ;; D-Bus errors. (setq tramp-gvfs-dbus-event-vector vec) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 866e7791bf8..1f0c7eadbc5 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -520,19 +520,14 @@ file names." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let ((host (tramp-file-name-host vec))) (when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) (if (zerop (length host)) (tramp-error vec 'file-error "Storage %s not connected" host)) - - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; - ;; otherwise `start-file-process' wouldn't run ever when - ;; `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - ;; We need a process bound to the connection buffer. Therefore, ;; we create a dummy process. Maybe there is a better solution? (unless (get-buffer-process (tramp-get-connection-buffer vec)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bcfac78ee65..8092f6a5cf1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -525,7 +525,9 @@ based on the Tramp and Emacs versions, and should not be set here." :type '(repeat string)) ;;;###tramp-autoload -(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) +(defcustom tramp-sh-extra-args + '(("/bash\\'" . "-norc -noprofile") + ("/zsh\\'" . "-f +Z")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the @@ -1198,18 +1200,22 @@ component is used as the target of the symlink." (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-exists-p" - (or (not (null (tramp-get-file-property - v localname "file-attributes-integer" nil))) - (not (null (tramp-get-file-property - v localname "file-attributes-string" nil))) - (tramp-send-command-and-check - v - (format - "%s %s" - (tramp-get-file-exists-command v) - (tramp-shell-quote-argument localname))))))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-exists-p" + (or (not (null (tramp-get-file-property + v localname "file-attributes-integer" nil))) + (not (null (tramp-get-file-property + v localname "file-attributes-string" nil))) + (tramp-send-command-and-check + v + (format + "%s %s" + (tramp-get-file-exists-command v) + (tramp-shell-quote-argument localname)))))))) (defun tramp-sh-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -4762,6 +4768,10 @@ If there is just some editing, retry it after 5 seconds." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let ((p (tramp-get-connection-process vec)) (process-name (tramp-get-connection-property vec "process-name" nil)) (process-environment (copy-sequence process-environment)) @@ -4806,15 +4816,6 @@ connection if a previous connection has died for some reason." ;; New connection must be opened. (condition-case err (unless (process-live-p p) - - ;; During completion, don't reopen a new connection. We - ;; check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5df26a1e33e..b008e6b25eb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -832,12 +832,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Implement `file-attributes' for Tramp files using stat command." (tramp-message vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) - (with-current-buffer (tramp-get-connection-buffer vec) - (let* (size id link uid gid atime mtime ctime mode inode) - (when (tramp-smb-send-command - vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) + (let* (size id link uid gid atime mtime ctime mode inode) + (when (tramp-smb-send-command + vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) - ;; Loop the listing. + ;; Loop the listing. + (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) (unless (re-search-forward tramp-smb-errors nil t) (while (not (eobp)) @@ -1628,40 +1628,40 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) (with-tramp-file-property v localname "file-entries" - (with-current-buffer (tramp-get-connection-buffer v) - (let* ((share (tramp-smb-get-share v)) - (cache (tramp-get-connection-property v "share-cache" nil)) - res entry) - - (if (and (not share) cache) - ;; Return cached shares. - (setq res cache) - - ;; Read entries. - (if share - (tramp-smb-send-command - v (format "dir \"%s*\"" (tramp-smb-get-localname v))) - ;; `tramp-smb-maybe-open-connection' lists also the share names. - (tramp-smb-maybe-open-connection v)) - - ;; Loop the listing. + (let* ((share (tramp-smb-get-share v)) + (cache (tramp-get-connection-property v "share-cache" nil)) + res entry) + + (if (and (not share) cache) + ;; Return cached shares. + (setq res cache) + + ;; Read entries. + (if share + (tramp-smb-send-command + v (format "dir \"%s*\"" (tramp-smb-get-localname v))) + ;; `tramp-smb-maybe-open-connection' lists also the share names. + (tramp-smb-maybe-open-connection v)) + + ;; Loop the listing. + (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (if (re-search-forward tramp-smb-errors nil t) (tramp-error v 'file-error "%s `%s'" (match-string 0) directory) (while (not (eobp)) (setq entry (tramp-smb-read-file-entry share)) (forward-line) - (when entry (push entry res)))) + (when entry (push entry res))))) - ;; Cache share entries. - (unless share - (tramp-set-connection-property v "share-cache" res))) + ;; Cache share entries. + (unless share + (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself. - (push '("" "drwxrwxrwx" 0 (0 0)) res) + ;; Add directory itself. + (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; Return entries. - (delq nil res)))))) + ;; Return entries. + (delq nil res))))) ;; Return either a share name (if SHARE is nil), or a file name. ;; @@ -1855,6 +1855,10 @@ Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason. If ARGUMENT is non-nil, use it as argument for `tramp-smb-winexe-program', and suppress any checks." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let* ((share (tramp-smb-get-share vec)) (buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf))) @@ -1909,15 +1913,6 @@ If ARGUMENT is non-nil, use it as argument for (string-equal share (tramp-get-connection-property p "smb-share" "")))) - - ;; During completion, don't reopen a new connection. We - ;; check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (save-match-data ;; There might be unread output from checking for share names. (when buf (with-current-buffer buf (erase-buffer))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 80ce8f78747..bfc9b3bdc3a 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -424,10 +424,14 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-exists-p" - (tramp-sudoedit-send-command - v "test" "-e" (tramp-compat-file-name-unquote localname))))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-exists-p" + (tramp-sudoedit-send-command + v "test" "-e" (tramp-compat-file-name-unquote localname)))))) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -760,18 +764,13 @@ Remove unneeded output." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + ;; We need a process bound to the connection buffer. Therefore, we ;; create a dummy process. Maybe there is a better solution? (unless (tramp-get-connection-process vec) - - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; otherwise - ;; `start-file-process' wouldn't run ever when `non-essential' is - ;; non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (let ((p (make-network-process :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ed0f1def181..aefb84bb4e4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1566,25 +1566,27 @@ necessary only. This function will be used in file name completion." tramp-postfix-host-format)) (when localname localname))) -(defun tramp-get-buffer (vec) +(defun tramp-get-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC." (or (get-buffer (tramp-buffer-name vec)) - (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) - ;; We use the existence of connection property "process-buffer" - ;; as indication, whether a connection is active. - (tramp-set-connection-property - vec "process-buffer" - (tramp-get-connection-property vec "process-buffer" nil)) - (setq buffer-undo-list t - default-directory (tramp-make-tramp-file-name vec 'noloc 'nohop)) - (current-buffer)))) - -(defun tramp-get-connection-buffer (vec) + (unless dont-create + (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) + ;; We use the existence of connection property "process-buffer" + ;; as indication, whether a connection is active. + (tramp-set-connection-property + vec "process-buffer" + (tramp-get-connection-property vec "process-buffer" nil)) + (setq buffer-undo-list t + default-directory + (tramp-make-tramp-file-name vec 'noloc 'nohop)) + (current-buffer))))) + +(defun tramp-get-connection-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC. In case a second asynchronous communication has been started, it is different from `tramp-get-buffer'." (or (tramp-get-connection-property vec "process-buffer" nil) - (tramp-get-buffer vec))) + (tramp-get-buffer vec dont-create))) (defun tramp-get-connection-name (vec) "Get the connection name to be used for VEC. @@ -1770,14 +1772,15 @@ applicable)." ;; Log only when there is a minimum level. (when (>= tramp-verbose 4) (let ((tramp-verbose 0)) - ;; Append connection buffer for error messages. + ;; Append connection buffer for error messages, if exists. (when (= level 1) - (with-current-buffer - (if (processp vec-or-proc) - (process-buffer vec-or-proc) - (tramp-get-connection-buffer vec-or-proc)) - (setq fmt-string (concat fmt-string "\n%s") - arguments (append arguments (list (buffer-string)))))) + (ignore-errors + (with-current-buffer + (if (processp vec-or-proc) + (process-buffer vec-or-proc) + (tramp-get-connection-buffer vec-or-proc 'dont-create)) + (setq fmt-string (concat fmt-string "\n%s") + arguments (append arguments (list (buffer-string))))))) ;; Translate proc to vec. (when (processp vec-or-proc) (setq vec-or-proc (process-get vec-or-proc 'vector)))) @@ -2517,16 +2520,21 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;; This variable has been obsoleted in Emacs 26. tramp-completion-mode)) -(defun tramp-connectable-p (filename) +(defun tramp-connectable-p (vec-or-filename) "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are not in completion mode." - (let (tramp-verbose) - (and (tramp-tramp-file-p filename) - (or (not (tramp-completion-mode-p)) - (process-live-p - (tramp-get-connection-process - (tramp-dissect-file-name filename))))))) + (let (tramp-verbose + (vec + (cond + ((tramp-file-name-p vec-or-filename) vec-or-filename) + ((tramp-tramp-file-p vec-or-filename) + (tramp-dissect-file-name vec-or-filename))))) + (or ;; We check this for the process related to + ;; `tramp-buffer-name'; otherwise `start-file-process' + ;; wouldn't run ever when `non-essential' is non-nil. + (and vec (process-live-p (get-process (tramp-buffer-name vec)))) + (not (tramp-completion-mode-p))))) ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of @@ -2606,8 +2614,7 @@ not in completion mode." (try-completion filename (mapcar #'list (file-name-all-completions filename directory)) - (when (and predicate - (tramp-connectable-p (expand-file-name filename directory))) + (when (and predicate (tramp-connectable-p directory)) (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) ;; I misuse a little bit the `tramp-file-name' structure in order to @@ -3096,7 +3103,11 @@ User is always nil." (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (not (null (file-attributes filename)))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (not (null (file-attributes filename))))) (defun tramp-handle-file-in-directory-p (filename directory) "Like `file-in-directory-p' for Tramp files." diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index be09a73a1f1..df9b1352480 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -505,9 +505,12 @@ format." ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun gamegrid-add-score (file score) +(defun gamegrid-add-score (file score &optional reverse) "Add the current score to the high score file. +If REVERSE is non-nil, treat lower scores as better than higher +scores. This is useful for games where lower scores are better. + On POSIX systems there may be a shared game directory for all users in which the scorefiles are kept. On such systems Emacs doesn't create the score file FILE in this directory, if it doesn't already exist. @@ -525,9 +528,9 @@ specified by the variable `temporary-file-directory'. If necessary, FILE is created there." (pcase system-type ((or 'ms-dos 'windows-nt) - (gamegrid-add-score-insecure file score)) + (gamegrid-add-score-insecure file score reverse)) (_ - (gamegrid-add-score-with-update-game-score file score)))) + (gamegrid-add-score-with-update-game-score file score reverse)))) ;; On POSIX systems there are four cases to distinguish: @@ -556,20 +559,21 @@ FILE is created there." (defvar gamegrid-shared-game-dir) -(defun gamegrid-add-score-with-update-game-score (file score) +(defun gamegrid-add-score-with-update-game-score (file score &optional reverse) (let* ((update-game-score-modes (file-modes (expand-file-name "update-game-score" exec-directory))) (gamegrid-shared-game-dir (not (zerop (logand #o6000 (or update-game-score-modes 0)))))) (cond ((or (not update-game-score-modes) (file-name-absolute-p file)) (gamegrid-add-score-insecure file score - gamegrid-user-score-file-directory)) + gamegrid-user-score-file-directory + reverse)) ((and gamegrid-shared-game-dir (file-exists-p (expand-file-name file shared-game-score-directory))) ;; Use the setgid (or setuid) "update-game-score" program ;; to update a system-wide score file. (gamegrid-add-score-with-update-game-score-1 file - (expand-file-name file shared-game-score-directory) score)) + (expand-file-name file shared-game-score-directory) score reverse)) ;; Else: Add the score to a score file in the user's home ;; directory. (gamegrid-shared-game-dir @@ -579,7 +583,8 @@ FILE is created there." (directory-file-name gamegrid-user-score-file-directory)) (make-directory gamegrid-user-score-file-directory t)) (gamegrid-add-score-insecure file score - gamegrid-user-score-file-directory)) + gamegrid-user-score-file-directory + reverse)) (t (unless (file-exists-p (directory-file-name gamegrid-user-score-file-directory)) @@ -588,9 +593,9 @@ FILE is created there." gamegrid-user-score-file-directory))) (unless (file-exists-p f) (write-region "" nil f nil 'silent nil 'excl)) - (gamegrid-add-score-with-update-game-score-1 file f score)))))) + (gamegrid-add-score-with-update-game-score-1 file f score reverse)))))) -(defun gamegrid-add-score-with-update-game-score-1 (file target score) +(defun gamegrid-add-score-with-update-game-score-1 (file target score &optional reverse) (let ((default-directory "/") (errbuf (generate-new-buffer " *update-game-score loss*")) (marker-string (concat @@ -601,17 +606,16 @@ FILE is created there." (with-local-quit (apply 'call-process - (append - (list - (expand-file-name "update-game-score" exec-directory) - nil errbuf nil - "-m" (int-to-string gamegrid-score-file-length) - "-d" (if gamegrid-shared-game-dir - (expand-file-name shared-game-score-directory) - (file-name-directory target)) - file - (int-to-string score) - marker-string)))) + `(,(expand-file-name "update-game-score" exec-directory) + nil ,errbuf nil + "-m" ,(int-to-string gamegrid-score-file-length) + "-d" ,(if gamegrid-shared-game-dir + (expand-file-name shared-game-score-directory) + (file-name-directory target)) + ,@(if reverse '("-r")) + ,file + ,(int-to-string score) + ,marker-string))) (if (buffer-modified-p errbuf) (progn (display-buffer errbuf) @@ -632,7 +636,7 @@ FILE is created there." marker-string) nil t) (beginning-of-line))))) -(defun gamegrid-add-score-insecure (file score &optional directory) +(defun gamegrid-add-score-insecure (file score &optional directory reverse) (save-excursion (setq file (expand-file-name file (or directory temporary-file-directory))) @@ -645,7 +649,8 @@ FILE is created there." (user-full-name) user-mail-address)) (sort-fields 1 (point-min) (point-max)) - (reverse-region (point-min) (point-max)) + (unless reverse + (reverse-region (point-min) (point-max))) (goto-char (point-min)) (forward-line gamegrid-score-file-length) (delete-region (point) (point-max)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 14b65669c4b..ec5d8c55512 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4084,6 +4084,12 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (goto-char (line-end-position)))) t) +(defun python-do-auto-fill () + "Like `do-auto-fill', but bind `fill-indent-according-to-mode'." + ;; See Bug#36056. + (let ((fill-indent-according-to-mode t)) + (do-auto-fill))) + ;;; Skeletons @@ -5379,7 +5385,7 @@ REPORT-FN is Flymake's callback function." (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) #'python-fill-paragraph) - (set (make-local-variable 'fill-indent-according-to-mode) t) ; Bug#36056. + (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill) (set (make-local-variable 'beginning-of-defun-function) #'python-nav-beginning-of-defun) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index aad38b94d76..cbc0ac74f09 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -112,7 +112,7 @@ ;; would make this unnecessary; simply learn the values when you visit ;; the buffer. ;; You can do this automatically like this: -;; (add-hook 'sh-set-shell-hook 'sh-learn-buffer-indent) +;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent) ;; ;; However... `sh-learn-buffer-indent' is extremely slow, ;; especially on large-ish buffer. Also, if there are conflicts the @@ -480,7 +480,6 @@ This is buffer-local in every such buffer.") (define-key map "\C-c>" 'sh-learn-buffer-indent) (define-key map "\C-c\C-\\" 'sh-backslash-region) - (define-key map "=" 'sh-assignment) (define-key map "\C-c+" 'sh-add) (define-key map "\C-\M-x" 'sh-execute-region) (define-key map "\C-c\C-x" 'executable-interpret) @@ -1059,7 +1058,7 @@ subshells can nest." (when (< startpos (line-beginning-position)) (put-text-property startpos (point) 'syntax-multiline t) (add-hook 'syntax-propertize-extend-region-functions - 'syntax-propertize-multiline nil t)) + #'syntax-propertize-multiline nil t)) ))) @@ -1603,25 +1602,25 @@ with your script for an edit-interpret-debug cycle." (setq-local local-abbrev-table sh-mode-abbrev-table) (setq-local comint-dynamic-complete-functions sh-dynamic-complete-functions) - (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) + (add-hook 'completion-at-point-functions #'comint-completion-at-point nil t) ;; we can't look if previous line ended with `\' (setq-local comint-prompt-regexp "^[ \t]*") (setq-local imenu-case-fold-search nil) (setq font-lock-defaults - '((sh-font-lock-keywords + `((sh-font-lock-keywords sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil (font-lock-syntactic-face-function - . sh-font-lock-syntactic-face-function))) + . ,#'sh-font-lock-syntactic-face-function))) (setq-local syntax-propertize-function #'sh-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) (setq-local skeleton-pair-alist '((?` _ ?`))) - (setq-local skeleton-pair-filter-function 'sh-quoted-p) + (setq-local skeleton-pair-filter-function #'sh-quoted-p) (setq-local skeleton-further-elements '((< '(- (min sh-basic-offset (current-column)))))) - (setq-local skeleton-filter-function 'sh-feature) + (setq-local skeleton-filter-function #'sh-feature) (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp (concat @@ -2408,12 +2407,12 @@ whose value is the shell name (don't quote it)." (message "setting up indent stuff") ;; sh-mode has already made indent-line-function local ;; but do it in case this is called before that. - (setq-local indent-line-function 'sh-indent-line)) + (setq-local indent-line-function #'sh-indent-line)) (if sh-make-vars-local (sh-make-vars-local)) (message "Indentation setup for shell type %s" sh-shell)) (message "No indentation for this shell type.") - (setq-local indent-line-function 'sh-basic-indent-line)) + (setq-local indent-line-function #'sh-basic-indent-line)) (when font-lock-mode (setq font-lock-set-defaults nil) (font-lock-set-defaults) @@ -3586,7 +3585,7 @@ so that `occur-next' and `occur-prev' will work." ;; (insert ")\n") ;; ))) ;; -;; (add-hook 'sh-learned-buffer-hook 'what-i-learned) +;; (add-hook 'sh-learned-buffer-hook #'what-i-learned) ;; Originally this was sh-learn-region-indent (beg end) @@ -4055,7 +4054,8 @@ Add these variables to `sh-shell-variables'." (goto-char (point-min)) (setq sh-shell-variables-initialized t) (while (search-forward "=" nil t) - (sh-assignment 0))) + (sh--assignment-collect))) + (add-hook 'post-self-insert-hook #'sh--assignment-collect nil t) (message "Scanning buffer `%s' for variable assignments...done" (buffer-name))) @@ -4328,20 +4328,24 @@ option followed by a colon `:' if the option accepts an argument." +(put 'sh-assignment 'delete-selection t) (defun sh-assignment (arg) "Remember preceding identifier for future completion and do self-insert." (interactive "p") + (declare (obsolete nil "27.1")) (self-insert-command arg) - (if (<= arg 1) - (sh-remember-variable - (save-excursion - (if (re-search-forward (sh-feature sh-assignment-regexp) - (prog1 (point) - (beginning-of-line 1)) - t) - (match-string 1)))))) + (sh--assignment-collect)) + +(defun sh--assignment-collect () + (sh-remember-variable + (when (eq ?= (char-before)) + (save-excursion + (if (re-search-forward (sh-feature sh-assignment-regexp) + (prog1 (point) + (beginning-of-line 1)) + t) + (match-string 1)))))) -(put 'sh-assignment 'delete-selection t) (defun sh-maybe-here-document (arg) "Insert self. Without prefix, following unquoted `<' inserts here document. diff --git a/lisp/replace.el b/lisp/replace.el index ad9be77a79b..5c0616e25f0 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2698,7 +2698,7 @@ characters." (num-replacements 0) (nocasify t) ; Undo must preserve case (Bug#31073). search-string - next-replacement) + last-replacement) (while (and (< stack-idx stack-len) stack (or (null replaced) last-was-act-and-show)) @@ -2709,9 +2709,9 @@ characters." ;; Bind swapped values ;; (search-string <--> replacement) search-string (nth (if replaced 4 3) elt) - next-replacement (nth (if replaced 3 4) elt) + last-replacement (nth (if replaced 3 4) elt) search-string-replaced search-string - next-replacement-replaced next-replacement + next-replacement-replaced last-replacement last-was-act-and-show nil) (when (and (= stack-idx stack-len) @@ -2733,16 +2733,18 @@ characters." (match-data t (nth 2 elt))) noedit (replace-match-maybe-edit - next-replacement nocasify literal + last-replacement nocasify literal noedit real-match-data backward) replace-count (1- replace-count) real-match-data (save-excursion (goto-char (match-beginning 0)) (if regexp-flag - (looking-at next-replacement) - (looking-at (regexp-quote next-replacement))) + (looking-at last-replacement) + (looking-at (regexp-quote last-replacement))) (match-data t (nth 2 elt)))) + (when regexp-flag + (setq next-replacement (nth 4 elt))) ;; Set replaced nil to keep in loop (when (eq def 'undo-all) (setq replaced nil diff --git a/lisp/select.el b/lisp/select.el index 59bcf7da664..334e10f41ba 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -160,12 +160,11 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." (const TEXT))) :group 'killing) -;; Get a selection value of type TYPE by calling gui-get-selection with -;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. -;; The return value is already decoded. If gui-get-selection causes an -;; error, this function return nil. - (defun gui--selection-value-internal (type) + "Get a selection value of type TYPE. +Call `gui-get-selection' with an appropriate DATA-TYPE argument +decided by `x-select-request-type'. The return value is already +decoded. If `gui-get-selection' signals an error, return nil." (let ((request-type (if (eq window-system 'x) (or x-select-request-type '(UTF8_STRING COMPOUND_TEXT STRING)) diff --git a/lisp/server.el b/lisp/server.el index ac81cdbd483..45fa55ad6b0 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -563,9 +563,9 @@ See variable `server-auth-dir' for details." (format "it is not owned by you (owner = %s (%d))" (user-full-name uid) uid)) (w32 nil) ; on NTFS? - ((/= 0 (logand ?\077 (file-modes dir))) - (format "it is accessible by others (%03o)" - (file-modes dir))) + ((let ((modes (file-modes dir))) + (unless (zerop (logand (or modes 0) #o077)) + (format "it is accessible by others (%03o)" modes)))) (t nil)))) (when unsafe (error "`%s' is not a safe directory because %s" diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 2778e583674..72491b99807 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -207,7 +207,7 @@ PREFIX." ;;; I use the term `site' to refer to a string which may be the ;;; cluster identification "/name:", a remote identification -;;; "/method:user@host:", or "/system-name:' (the value of +;;; "/method:user@host:", or "/system-name:" (the value of ;;; `shadow-system-name') for the location of local files. All ;;; user-level commands should accept either. @@ -607,6 +607,11 @@ and to are absolute file names." canonical-file shadow-literal-groups nil) (shadow-shadows-of-1 canonical-file shadow-regexp-groups t))))) + (when shadow-debug + (message + "shadow-shadows-of: %s %s %s %s %s" + file (shadow-local-file file) shadow-homedir + absolute-file canonical-file)) (set (intern file shadow-hashtable) shadows)))) (defun shadow-shadows-of-1 (file groups regexp) @@ -621,6 +626,10 @@ Consider them as regular expressions if third arg REGEXP is true." (let ((realname (tramp-file-name-localname (shadow-parse-name file)))) + (when shadow-debug + (message + "shadow-shadows-of-1: %s %s %s" + file (shadow-parse-name file) realname)) (mapcar (function (lambda (x) @@ -631,6 +640,11 @@ Consider them as regular expressions if third arg REGEXP is true." (defun shadow-add-to-todo () "If current buffer has shadows, add them to the list needing to be copied." + (when shadow-debug + (message + "shadow-add-to-todo: %s %s" + (buffer-file-name (current-buffer)) + (shadow-expand-file-name (buffer-file-name (current-buffer))))) (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) diff --git a/lisp/subr.el b/lisp/subr.el index 0d7bffb35f3..0b47da884b7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2045,7 +2045,7 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards." (put 'major-mode--suspended 'permanent-local t) (defun major-mode-suspend () - "Exit current major, remembering it." + "Exit current major mode, remembering it." (let* ((prev-major-mode (or major-mode--suspended (unless (eq major-mode 'fundamental-mode) major-mode)))) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 198182fca72..e2c019fc548 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -485,6 +485,136 @@ numbers, and the build number." That includes all Windows systems except for 9X/Me." (getenv "SystemRoot")) +;; The value of the following variable was calculated using the table in +;; https://docs.microsoft.com/windows/desktop/Intl/unicode-subset-bitfields, +;; by looking for Unicode subranges for which no USB bits are defined. +(defconst w32-no-usb-subranges + '((#x000800 . #x0008ff) + (#x0018b0 . #x0018ff) + (#x001a20 . #x001aff) + (#x001bc0 . #x001bff) + (#x001c80 . #x001cff) + (#x002fe0 . #x002fef) + (#x00a4d0 . #x00a4ff) + (#x00a6a0 . #x00a6ff) + (#x00a830 . #x00a83f) + (#x00a8e0 . #x00a8ff) + (#x00a960 . #x00a9ff) + (#x00aa60 . #x00abff) + (#x00d7b0 . #x00d7ff) + (#x010200 . #x01027f) + (#x0102e0 . #x0102ff) + (#x010350 . #x01037f) + (#x0103e0 . #x0103ff) + (#x0104b0 . #x0107ff) + (#x010840 . #x0108ff) + (#x010940 . #x0109ff) + (#x010a60 . #x011fff) + (#x012480 . #x01cfff) + (#x01d250 . #x01d2ff) + (#x01d380 . #x01d3ff) + (#x01d800 . #x01efff) + (#x01f0a0 . #x01ffff) + (#x02a6e0 . #x02f7ff) + (#x02fa20 . #x0dffff) + (#x0e0080 . #x0e00ff) + (#x0e01f0 . #x0fefff)) + "List of Unicode subranges whose support cannot be announced by a font. +The FONTSIGNATURE structure reported by MS-Windows for a font +includes 123 Unicode Subset bits (USBs) to identify subranges of +the Unicode codepoint space supported by the font. Since the +number of bits is fixed, not every Unicode block can have a +corresponding USB bit; fonts that support characters from blocks +that have no USBs cannot communicate their support to Emacs, +unless the font is opened and physically tested for glyphs for +characters from these blocks.") + +(defun w32--filter-USB-scripts () + "Filter USB scripts out of `script-representative-chars'." + (let (val) + (dolist (elt script-representative-chars) + (let ((subranges w32-no-usb-subranges) + (chars (cdr elt)) + ch found subrange) + (while (and (consp chars) (not found)) + (setq ch (car chars) + chars (cdr chars)) + (while (and (consp subranges) (not found)) + (setq subrange (car subranges) + subranges (cdr subranges)) + (when (and (>= ch (car subrange)) (<= ch (cdr subrange))) + (setq found t) + (push elt val)))))) + (nreverse val))) + +(defvar w32-non-USB-fonts nil + "Alist of script symbols and corresponding fonts. +Each element of the alist has the form (SCRIPT FONTS...), where +SCRIPT is a symbol of a script and FONTS are one or more fonts installed +on the system that can display SCRIPT's characters. FONTS are +specified as symbols. +Only scripts that have no corresponding Unicode Subset Bits (USBs) can +be found in this alist. +This alist is used by w32font.c when it looks for fonts that can display +characters from scripts for which no USBs are defined.") + +(defun w32-find-non-USB-fonts (&optional frame size) + "Compute the value of `w32-non-USB-fonts' for specified SIZE and FRAME. +FRAME defaults to the selected frame. +SIZE is the required font size and defaults to the nominal size of the +default font on FRAME, or its best approximation." + (let* ((inhibit-compacting-font-caches t) + (all-fonts + (delete-dups + (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1" + 'default frame))) + val) + (mapc (function + (lambda (script-desc) + (let* ((script (car script-desc)) + (script-chars (vconcat (cdr script-desc))) + (nchars (length script-chars)) + (fntlist all-fonts) + (entry (list script)) + fspec ffont font-obj glyphs idx) + ;; For each font in FNTLIST, determine whether it + ;; supports the representative character(s) of any + ;; scripts that have no USBs defined for it. + (dolist (fnt fntlist) + (setq fspec (ignore-errors (font-spec :name fnt))) + (if fspec + (setq ffont (find-font fspec frame))) + (when ffont + (setq font-obj + (open-font ffont size frame)) + ;; Ignore fonts for which open-font returns nil: + ;; they are buggy fonts that we cannot use anyway. + (setq glyphs + (if font-obj + (font-get-glyphs font-obj + 0 nchars script-chars) + '[nil])) + ;; Does this font support ALL of the script's + ;; representative characters? + (setq idx 0) + (while (and (< idx nchars) (not (null (aref glyphs idx)))) + (setq idx (1+ idx))) + (if (= idx nchars) + ;; It does; add this font to the script's entry in alist. + (let ((font-family (font-get font-obj :family))) + ;; Unifont is an ugly font, and it is already + ;; present in the default fontset. + (unless (string= (downcase (symbol-name font-family)) + "unifont") + (push font-family entry)))))) + (if (> (length entry) 1) + (push (nreverse entry) val))))) + (w32--filter-USB-scripts)) + ;; We've opened a lot of fonts, so clear the font caches to free + ;; some memory. + (clear-font-cache) + (and val (setq w32-non-USB-fonts val)))) + (provide 'w32-win) (provide 'term/w32-win) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 1f185e0f216..f684f4e4ca9 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -567,10 +567,6 @@ ;; Consider the use of `:box' face attribute under Emacs 21 ;; Consider the use of `modification-hooks' text property instead of ;; rebinding the keymap -;; Maybe provide complete XEmacs support in the future however the -;; "extent" is the single largest obstacle lying ahead, read the -;; document in Emacs info. -;; (progn (require 'info) (Info-find-node "elisp" "Not Intervals")) ;; ;; ;; --------------- diff --git a/lisp/tooltip.el b/lisp/tooltip.el index b1c69ae7368..eac510ba7ba 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -365,7 +365,10 @@ It is also called if Tooltip mode is on, for text-only displays." (let ((message-log-max nil)) (message "%s" tooltip-previous-message) (setq tooltip-previous-message nil))) - (t + ;; Only stop displaying the message when the current message is our own. + ;; This has the advantage of not clearing the echo area when + ;; running after an error message was displayed (Bug#3192). + ((equal-including-properties tooltip-help-message (current-message)) (message nil))))) (defun tooltip-show-help (msg) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index d84700fc176..a9e79d7956c 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -440,7 +440,7 @@ REV is the revision to check out." (if vc-cvs-use-edit (vc-cvs-command nil 0 file "unedit") ;; Make the file read-only by switching off all w-bits - (set-file-modes file (logand (file-modes file) 3950))))) + (set-file-modes file (logand (file-modes file) #o7555))))) (defun vc-cvs-merge-file (file) "Accept a file merge request, prompting for revisions." diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9a6f6bb6874..e2259785923 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -864,10 +864,18 @@ with the command \\[tags-loop-continue]." delimited) (fileloop-continue)) -(defun vc-dir-ignore () - "Ignore the current file." - (interactive) - (vc-ignore (vc-dir-current-file))) +(defun vc-dir-ignore (&optional arg) + "Ignore the current file. +If a prefix argument is given, ignore all marked files." + (interactive "P") + (if arg + (ewoc-map + (lambda (filearg) + (when (vc-dir-fileinfo->marked filearg) + (vc-ignore (vc-dir-fileinfo->name filearg)) + t)) + vc-ewoc) + (vc-ignore (vc-dir-current-file)))) (defun vc-dir-current-file () (let ((node (ewoc-locate vc-ewoc))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 4d7b4c4055d..db09aa4bc06 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -366,8 +366,9 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY." (defun vc-svn-ignore-completion-table (directory) "Return the list of ignored files in DIRECTORY." (with-temp-buffer - (vc-svn-command t t nil "propget" "svn:ignore" (expand-file-name directory)) - (split-string (buffer-string)))) + (when (zerop (vc-svn-command + t t nil "propget" "svn:ignore" (expand-file-name directory))) + (split-string (buffer-string) "\n")))) (defun vc-svn-find-admin-dir (file) "Return the administrative directory of FILE." diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 90899d27e38..9d2eadad873 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1417,17 +1417,22 @@ remove from the list of ignored files." (defun vc-default-ignore (backend file &optional directory remove) "Ignore FILE under the VCS of DIRECTORY (default is `default-directory'). -FILE is a file wildcard, relative to the root directory of DIRECTORY. +FILE is a wildcard specification, either relative to +DIRECTORY or absolute. When called from Lisp code, if DIRECTORY is non-nil, the repository to use will be deduced by DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files. Argument BACKEND is the backend you are using." (let ((ignore (vc-call-backend backend 'find-ignore-file (or directory default-directory))) - (pattern (file-relative-name - (expand-file-name file) (file-name-directory file)))) + file-path root-dir pattern) + (setq file-path (expand-file-name file directory)) + (setq root-dir (file-name-directory ignore)) + (when (not (string= (substring file-path 0 (length root-dir)) root-dir)) + (error "Ignore spec %s is not below project root %s" file-path root-dir)) + (setq pattern (substring file-path (length root-dir))) (if remove - (vc--remove-regexp pattern ignore) + (vc--remove-regexp (concat "^" (regexp-quote pattern ) "\\(\n\\|$\\)") ignore) (vc--add-line pattern ignore)))) (defun vc-default-ignore-completion-table (backend file) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index dbc41009c77..3124a9c01e5 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -89,7 +89,11 @@ if that value is non-nil." (defun widget-browse-at (pos) "Browse the widget under point." (interactive "d") - (let* ((field (get-char-property pos 'field)) + (let* ((field (or + ;; See comments in `widget-specify-field' to know why we + ;; need this. + (get-char-property pos 'real-field) + (get-char-property pos 'field))) (button (get-char-property pos 'button)) (doc (get-char-property pos 'widget-doc)) (text (cond (field "This is an editable text area.") diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 9bc7a076eec..7ed7b81280b 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -414,6 +414,7 @@ the :notify function can't know the new value.") (defmacro widget-specify-insert (&rest form) "Execute FORM without inheriting any text properties." + (declare (debug body)) `(save-restriction (let ((inhibit-read-only t) (inhibit-modification-hooks t)) |