diff options
Diffstat (limited to 'lisp/gnus')
| -rw-r--r-- | lisp/gnus/gnus-art.el | 206 | ||||
| -rw-r--r-- | lisp/gnus/gnus-cite.el | 22 | ||||
| -rw-r--r-- | lisp/gnus/gnus-gravatar.el | 1 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 1 | ||||
| -rw-r--r-- | lisp/gnus/gnus-rfc1843.el | 3 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 1 | ||||
| -rw-r--r-- | lisp/gnus/gnus-util.el | 5 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 6 |
8 files changed, 103 insertions, 142 deletions
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index fbcf8013138..3bea1a4c1d6 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1765,7 +1765,6 @@ Initialized from `text-mode-syntax-table'.") `(with-current-buffer gnus-article-buffer (save-restriction (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) (case-fold-search t)) (article-narrow-to-head) ,@forms)))) @@ -1852,7 +1851,6 @@ Initialized from `text-mode-syntax-table'.") (let ((inhibit-read-only t) (case-fold-search t) (max (1+ (length gnus-sorted-header-list))) - (inhibit-point-motion-hooks t) (cur (current-buffer)) ignored visible beg) (save-excursion @@ -1919,8 +1917,7 @@ always hide." (not gnus-show-all-headers)) (save-excursion (save-restriction - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (let ((inhibit-read-only t)) (article-narrow-to-head) (dolist (elem gnus-boring-article-headers) (goto-char (point-min)) @@ -2567,8 +2564,7 @@ fill width." "Decode all MIME-encoded words in the article." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t) - (mail-parse-charset gnus-newsgroup-charset) + (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) @@ -2578,7 +2574,7 @@ fill width." "Decode charset-encoded text in the article. If PROMPT (the prefix), prompt for a coding system to use." (interactive "P" gnus-article-mode) - (let ((inhibit-point-motion-hooks t) (case-fold-search t) + (let ((case-fold-search t) (inhibit-read-only t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets @@ -2620,8 +2616,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." - (let ((inhibit-point-motion-hooks t) - (mail-parse-charset gnus-newsgroup-charset) + (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) @@ -2668,8 +2663,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (defun article-decode-group-name () "Decode group names in Newsgroups, Followup-To and Xref headers." - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t) + (let ((inhibit-read-only t) (method (gnus-find-method-for-group gnus-newsgroup-name)) regexp) (when (and (or gnus-group-name-charset-method-alist @@ -2699,8 +2693,7 @@ The following headers are decoded: From:, To:, Cc:, Reply-To:, Mail-Reply-To: and Mail-Followup-To:." (when gnus-use-idna (save-restriction - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-narrow-to-head) (goto-char (point-min)) (while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) @@ -3171,8 +3164,7 @@ images if any to the browser, and deletes them when exiting the group "Remove list identifiers from the Subject header. The `gnus-list-identifiers' variable specifies what to do." (interactive nil gnus-article-mode) - (let ((inhibit-point-motion-hooks t) - (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) + (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) (inhibit-read-only t)) (when regexp (save-excursion @@ -3221,34 +3213,32 @@ always hide." (interactive nil gnus-article-mode) (save-excursion (save-restriction - (let ((inhibit-point-motion-hooks t)) - (when (gnus-parameter-banner gnus-newsgroup-name) - (article-really-strip-banner - (gnus-parameter-banner gnus-newsgroup-name))) - (when gnus-article-address-banner-alist - ;; Note that the From header is decoded here, so it is - ;; required that the *-extract-address-components function - ;; supports non-ASCII text. - (let ((from (save-restriction - (widen) - (article-narrow-to-head) - (mail-fetch-field "from")))) - (when (and from - (setq from - (cadr (funcall gnus-extract-address-components - from)))) - (catch 'found - (dolist (pair gnus-article-address-banner-alist) - (when (string-match (car pair) from) - (throw 'found - (article-really-strip-banner (cdr pair))))))))))))) + (when (gnus-parameter-banner gnus-newsgroup-name) + (article-really-strip-banner + (gnus-parameter-banner gnus-newsgroup-name))) + (when gnus-article-address-banner-alist + ;; Note that the From header is decoded here, so it is + ;; required that the *-extract-address-components function + ;; supports non-ASCII text. + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (cadr (funcall gnus-extract-address-components + from)))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found + (article-really-strip-banner (cdr pair)))))))))))) (defun article-really-strip-banner (banner) "Strip the banner specified by the argument." (save-excursion (save-restriction - (let ((inhibit-point-motion-hooks t) - (gnus-signature-limit nil) + (let ((gnus-signature-limit nil) (inhibit-read-only t)) (article-goto-body) (cond @@ -3307,8 +3297,7 @@ always hide." "Remove all blank lines from the beginning of the article." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (when (article-goto-body) (while (and (not (eobp)) (looking-at "[ \t]*$")) @@ -3349,8 +3338,7 @@ Point is left at the beginning of the narrowed-to region." "Replace consecutive blank lines with one empty line." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) ;; First make all blank lines empty. (article-goto-body) (while (re-search-forward "^[ \t]+$" nil t) @@ -3368,8 +3356,7 @@ Point is left at the beginning of the narrowed-to region." "Remove all white space from the beginning of the lines in the article." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-goto-body) (while (re-search-forward "^[ \t]+" nil t) (replace-match "" t t))))) @@ -3378,8 +3365,7 @@ Point is left at the beginning of the narrowed-to region." "Remove all white space from the end of the lines in the article." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-goto-body) (while (re-search-forward "[ \t]+$" nil t) (replace-match "" t t))))) @@ -3395,37 +3381,35 @@ Point is left at the beginning of the narrowed-to region." "Strip all blank lines." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-goto-body) (while (re-search-forward "^[ \t]*\n" nil t) (replace-match "" t t))))) (defun gnus-article-narrow-to-signature () "Narrow to the signature; return t if a signature is found, else nil." - (let ((inhibit-point-motion-hooks t)) - (when (gnus-article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t))))) + (when (gnus-article-search-signature) + (forward-line 1) + ;; Check whether we have some limits to what we consider + ;; to be a signature. + (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit + (list gnus-signature-limit))) + limit limited) + (while (setq limit (pop limits)) + (if (or (and (integerp limit) + (< (- (point-max) (point)) limit)) + (and (floatp limit) + (< (count-lines (point) (point-max)) limit)) + (and (functionp limit) + (funcall limit)) + (and (stringp limit) + (not (re-search-forward limit nil t)))) + () ; This limit did not succeed. + (setq limited t + limits nil))) + (unless limited + (narrow-to-region (point) (point-max)) + t)))) (defun gnus-article-search-signature () "Search the current buffer for the signature separator. @@ -3485,8 +3469,7 @@ means show, 0 means toggle." (defun gnus-article-show-hidden-text (type &optional _dummy) "Show all hidden text of type TYPE. Originally it is hide instead of DUMMY." - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (let ((inhibit-read-only t)) (gnus-remove-text-properties-when 'article-type type (point-min) (point-max) @@ -3528,7 +3511,6 @@ possible values." (interactive (list 'ut t) gnus-article-mode) (let* ((case-fold-search t) (inhibit-read-only t) - (inhibit-point-motion-hooks t) (visible-date (mail-fetch-field "Date")) pos date bface eface) (save-excursion @@ -4351,8 +4333,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (insert-buffer-substring gnus-original-article-buffer) (setq items (split-string sig)) (message-narrow-to-head) - (let ((inhibit-point-motion-hooks t) - (case-fold-search t)) + (let ((case-fold-search t)) ;; Don't verify multiple headers. (setq headers (mapconcat (lambda (header) (concat header ": " @@ -6811,16 +6792,15 @@ not have a face in `gnus-article-boring-faces'." (boundp 'gnus-article-boring-faces) (symbol-value 'gnus-article-boring-faces)) (save-excursion - (let ((inhibit-point-motion-hooks t)) - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (seq-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces) - #'eq)) - (throw 'only-boring nil))) - (throw 'only-boring t)))))) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (seq-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces) + #'eq)) + (throw 'only-boring nil))) + (throw 'only-boring t))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." @@ -8112,18 +8092,17 @@ It does this by highlighting everything after `gnus-signature-separator' using the face `gnus-signature'." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t)) - (save-restriction - (when (and gnus-signature-face - (gnus-article-narrow-to-signature)) - (overlay-put (make-overlay (point-min) (point-max) nil t) - 'face gnus-signature-face) - (widen) - (gnus-article-search-signature) - (let ((start (match-beginning 0)) - (end (set-marker (make-marker) (1+ (match-end 0))))) - (gnus-article-add-button start (1- end) 'gnus-signature-toggle - end))))))) + (save-restriction + (when (and gnus-signature-face + (gnus-article-narrow-to-signature)) + (overlay-put (make-overlay (point-min) (point-max) nil t) + 'face gnus-signature-face) + (widen) + (gnus-article-search-signature) + (let ((start (match-beginning 0)) + (end (set-marker (make-marker) (1+ (match-end 0))))) + (gnus-article-add-button start (1- end) 'gnus-signature-toggle + end)))))) (defun gnus-button-in-region-p (b e prop) "Say whether PROP exists in the region." @@ -8135,8 +8114,7 @@ It does this by highlighting everything after specified by `gnus-button-alist'." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t) - (case-fold-search t) + (let ((case-fold-search t) (alist gnus-button-alist) beg entry regexp) ;; We skip the headers. @@ -8292,19 +8270,18 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-signature-toggle (end) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t)) - (if (text-property-any end (point-max) 'article-type 'signature) - (progn - (gnus-delete-wash-type 'signature) - (gnus-remove-text-properties-when - 'article-type 'signature end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties)))) - (gnus-add-wash-type 'signature) - (gnus-add-text-properties-when - 'article-type nil end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties))))) + (if (text-property-any end (point-max) 'article-type 'signature) + (progn + (gnus-delete-wash-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) + (gnus-add-wash-type 'signature) + (gnus-add-text-properties-when + 'article-type nil end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)))) @@ -8313,8 +8290,7 @@ url is put as the `gnus-button-url' overlay property on the button." (save-excursion (let* ((marker (car marker-and-entry)) (entry (cadr marker-and-entry)) - (regexp (car entry)) - (inhibit-point-motion-hooks t)) + (regexp (car entry))) (goto-char marker) ;; This is obviously true, or something bad is happening :) ;; But we need it to have the match-data diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index b4d7661d742..e344b071bfd 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -341,7 +341,6 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) (faces gnus-cite-face-list) - (inhibit-point-motion-hooks t) face entry prefix skip numbers number face-alist) ;; Loop through citation prefixes. (while alist @@ -462,7 +461,6 @@ text (i.e., computer code and the like) will not be folded." (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) (marks (gnus-dissect-cited-text)) (adaptive-fill-mode nil) (fill-column (if width (prefix-numeric-value width) fill-column))) @@ -536,7 +534,6 @@ always hide." (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) marks - (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) (point (point-min)) @@ -613,7 +610,6 @@ means show, nil means toggle." (start (cadr args)) (hidden (text-property-any beg (1- end) 'article-type 'cite)) - (inhibit-point-motion-hooks t) buffer-read-only) (when (or (null arg) (zerop arg) @@ -673,7 +669,6 @@ See also the documentation for `gnus-article-highlight-citation'." (let ((start (point)) (atts gnus-cite-attribution-alist) (buffer-read-only nil) - (inhibit-point-motion-hooks t) (hidden 0) total) (goto-char (point-max)) @@ -731,13 +726,12 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-parse-wrapper () ;; Wrap chopped gnus-cite-parse. (article-goto-body) - (let ((inhibit-point-motion-hooks t)) - (save-excursion - (gnus-cite-parse-attributions)) - (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions)))) + (save-excursion + (gnus-cite-parse-attributions)) + (save-excursion + (gnus-cite-parse)) + (save-excursion + (gnus-cite-connect-attributions))) (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. @@ -1020,8 +1014,7 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. (when face - (let ((inhibit-point-motion-hooks t) - from to overlay) + (let (from to overlay) (goto-char (point-min)) (when (zerop (forward-line (1- number))) (forward-char (length prefix)) @@ -1041,7 +1034,6 @@ See also the documentation for `gnus-article-highlight-citation'." (gnus-cite-parse-maybe nil t) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) - (inhibit-point-motion-hooks t) number) (while numbers (setq number (car numbers) diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index d64e000d70f..93b18f95555 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -87,7 +87,6 @@ callback for `gravatar-retrieve'." (let ((real-name (car address)) (mail-address (cadr address)) (mark (point-marker)) - (inhibit-point-motion-hooks t) (case-fold-search t)) (save-restriction (article-narrow-to-head) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 35103e9c4f4..e69f0857e77 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2651,6 +2651,7 @@ If EXCLUDE-GROUP, do not go to that group." (and best-point (gnus-group-group-name)))) ;; Is there something like an after-point-motion-hook? +;; FIXME: There's `cursor-sensor-mode's `cursor-sensor-functions' property. ;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function? ;; (defun gnus-group-menu-bar-update () diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index 9872f7b9942..da1afb672ae 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -40,8 +40,7 @@ (save-excursion (save-restriction (message-narrow-to-head) - (let* ((inhibit-point-motion-hooks t) - (case-fold-search t) + (let* ((case-fold-search t) (ct (message-fetch-field "Content-Type" t)) (ctl (and ct (mail-header-parse-content-type ct)))) (if (and ctl (not (string-search "/" (car ctl)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 107ad8fd4a8..18ba55a4391 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9856,7 +9856,6 @@ If ARG is a negative number, hide the unwanted header lines." (widen) (article-narrow-to-head) (let* ((inhibit-read-only t) - (inhibit-point-motion-hooks t) (hidden (if (numberp arg) (>= arg 0) (or diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index fe556b155a8..95c9539593c 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -166,9 +166,8 @@ is slower." (require 'message) (save-excursion (save-restriction - (let ((inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-fetch-field field))))) + (nnheader-narrow-to-headers) + (message-fetch-field field)))) (defun gnus-fetch-original-field (field) "Fetch FIELD from the original version of the current article." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index beccef6f5f4..67ec0531fa4 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2172,8 +2172,7 @@ If FIRST is non-nil, only the first value is returned. The buffer is expected to be narrowed to just the header of the message; see `message-narrow-to-headers-or-head'." - (let* ((inhibit-point-motion-hooks t) - (value (mail-fetch-field header nil (not first)))) + (let* ((value (mail-fetch-field header nil (not first)))) (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) @@ -7309,7 +7308,6 @@ specified by FUNCTIONS, if non-nil, or by the variable (let ((cur (current-buffer)) from subject date references message-id follow-to - (inhibit-point-motion-hooks t) (message-this-is-mail t) gnus-warning) (save-restriction @@ -7370,7 +7368,6 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (let ((cur (current-buffer)) from subject date reply-to mrt mct references message-id follow-to - (inhibit-point-motion-hooks t) (message-this-is-news t) followup-to distribution newsgroups gnus-warning posted-to) (save-restriction @@ -8609,7 +8606,6 @@ From headers in the original article." (let ((regexps (if (stringp message-hidden-headers) (list message-hidden-headers) message-hidden-headers)) - (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) end-of-headers) (when regexps |