X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f1baa156503f089d6627171e0e9ad73bbdbb7268..21cfd14d54370cddc1160d30bc47e17c5ac3a162:/lisp/gnus/gnus-art.el diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d83eaddf16..f16a4c66ab 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1,6 +1,6 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996-2015 Free Software Foundation, Inc. +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -195,16 +195,16 @@ this list." "Headers that are only to be displayed if they have interesting data. Possible values in this list are: - 'empty Headers with no content. - 'newsgroups Newsgroup identical to Gnus group. - 'to-address To identical to To-address. - 'to-list To identical to To-list. - 'cc-list CC identical to To-list. - 'followup-to Followup-to identical to Newsgroups. - 'reply-to Reply-to identical to From. - 'date Date less than four days old. - 'long-to To and/or Cc longer than 1024 characters. - 'many-to Multiple To and/or Cc." + `empty' Headers with no content. + `newsgroups' Newsgroup identical to Gnus group. + `to-address' To identical to To-address. + `to-list' To identical to To-list. + `cc-list' CC identical to To-list. + `followup-to' Followup-to identical to Newsgroups. + `reply-to' Reply-to identical to From. + `date' Date less than four days old. + `long-to' To and/or Cc longer than 1024 characters. + `many-to' Multiple To and/or Cc." :type '(set (const :tag "Headers with no content." empty) (const :tag "Newsgroups identical to Gnus group." newsgroups) (const :tag "To identical to To-address." to-address) @@ -260,24 +260,17 @@ This can also be a list of the above values." ;; needed there. And XEmacs doesn't handle `intangible' anyway. '(invisible t) "Property list to use for hiding text." - :type 'sexp + :type 'plist :group 'gnus-article-hiding) ;; Fixme: This isn't the right thing for mixed graphical and non-graphical ;; frames in a session. (defcustom gnus-article-x-face-command - (if (featurep 'xemacs) - (if (or (gnus-image-type-available-p 'xface) - (gnus-image-type-available-p 'pbm)) - 'gnus-display-x-face-in-from - "{ echo \ + (if (gnus-image-type-available-p 'pbm) + 'gnus-display-x-face-in-from + "{ echo \ '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\ -; uncompface; } | icontopbm | ee -") - (if (gnus-image-type-available-p 'pbm) - 'gnus-display-x-face-in-from - "{ echo \ -'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\ -; uncompface; } | icontopbm | display -")) +; uncompface; } | icontopbm | display -") "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." @@ -330,7 +323,7 @@ to match a mail address in the From: header, BANNER is one of a symbol If ADDRESS matches author's mail address, it will remove things like advertisements. For example: -\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\")) +\((\"@yoo-hoo\\\\.co\\\\.jp\\\\\\='\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\")) " :type '(repeat (cons @@ -399,7 +392,7 @@ advertisements. For example: "*Alist that says how to fontify certain phrases. Each item looks like this: - (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) + (\"_\\\\(\\\\w+\\\\)_\" 0 1 \\='underline) The first element is a regular expression to be matched. The second is a number that says what regular expression grouping used to find @@ -484,9 +477,7 @@ and the latter avoids underlining any whitespace at all." Example: (_/*word*/_)." :group 'gnus-article-emphasis) -(defface gnus-emphasis-strikethru (if (featurep 'xemacs) - '((t (:strikethru t))) - '((t (:strike-through t)))) +(defface gnus-emphasis-strikethru '((t (:strike-through t))) "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) @@ -661,7 +652,7 @@ For instance, if you would like to save articles related to Gnus in the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", you could set this variable to something like: - '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") + ((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) This variable is an alist where the key is the match and the @@ -705,13 +696,6 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) -(when (featurep 'xemacs) - ;; Extracted from gnus-xmas-define in order to preserve user settings - (when (fboundp 'turn-off-scroll-in-place) - (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) - ;; Extracted from gnus-xmas-redefine in order to preserve user settings - (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) - (defcustom gnus-article-menu-hook nil "*Hook run after the creation of the article mode menu." :type 'hook @@ -877,27 +861,24 @@ be displayed by the first non-nil matching CONTENT face." (item :tag "skip" nil) (face :value default))))) -(defcustom gnus-face-properties-alist (if (featurep 'xemacs) - '((xface . (:face gnus-x-face))) - '((pbm . (:face gnus-x-face)) - (png . nil))) +(defcustom gnus-face-properties-alist '((pbm . (:face gnus-x-face)) + (png . nil)) "Alist of image types and properties applied to Face and X-Face images. Here are examples: ;; Specify the altitude of Face images in the From header. \(setq gnus-face-properties-alist - '((pbm . (:face gnus-x-face :ascent 80)) + \\='((pbm . (:face gnus-x-face :ascent 80)) (png . (:ascent 80)))) ;; Show Face images as pressed buttons. \(setq gnus-face-properties-alist - '((pbm . (:face gnus-x-face :relief -2)) + \\='((pbm . (:face gnus-x-face :relief -2)) (png . (:relief -2)))) See the manual for the valid properties for various image types. Currently, `pbm' is used for X-Face images and `png' is used for Face -images in Emacs. Only the `:face' property is effective on the `xface' -image type in XEmacs if it is built with the libcompface library." +images in Emacs." :version "23.1" ;; No Gnus :group 'gnus-article-headers :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist))) @@ -1420,14 +1401,12 @@ predicate. See Info node `(gnus)Customizing Articles'." (defcustom gnus-treat-display-x-face (and (not noninteractive) (gnus-image-type-available-p 'xbm) - (if (featurep 'xemacs) - (featurep 'xface) - (condition-case nil - (and (string-match "^0x" (shell-command-to-string "uncompface")) - (executable-find "icontopbm")) - ;; shell-command-to-string may signal an error, e.g. if - ;; shell-file-name is not found. - (error nil))) + (condition-case nil + (and (string-match "^0x" (shell-command-to-string "uncompface")) + (executable-find "icontopbm")) + ;; shell-command-to-string may signal an error, e.g. if + ;; shell-file-name is not found. + (error nil)) 'head) "Display X-Face headers. Valid values are nil and `head'. @@ -1659,7 +1638,9 @@ called with the group name as the parameter, and should return a regexp." :version "24.1" :group 'gnus-art - :type '(choice regexp function)) + :type '(choice (const :tag "Allow all" nil) + (regexp :tag "Regular expression") + (function :tag "Use a function"))) ;;; Internal variables @@ -2109,21 +2090,17 @@ try this wash." "Translate many Unicode characters into their ASCII equivalents." (interactive) (require 'org-entities) - (let ((table (make-char-table (if (featurep 'xemacs) 'generic)))) + (let ((table (make-char-table nil))) (dolist (elem org-entities) (when (and (listp elem) (= (length (nth 6 elem)) 1)) - (if (featurep 'xemacs) - (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table) - (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem))))) + (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))) (save-excursion (when (article-goto-body) (let ((inhibit-read-only t) replace props) (while (not (eobp)) - (if (not (setq replace (if (featurep 'xemacs) - (get-char-table (following-char) table) - (aref table (following-char))))) + (if (not (setq replace (aref table (following-char)))) (forward-char 1) (if (prog1 (setq props (text-properties-at (point))) @@ -2256,8 +2233,7 @@ This only works if the article in question is HTML." (save-restriction (widen) (if (eq mm-text-html-renderer 'w3m) - (let ((mm-inline-text-html-with-images nil)) - (w3m-toggle-inline-images)) + (w3m-toggle-inline-images) (dolist (region (gnus-find-text-property-region (point-min) (point-max) 'image-displayer)) (destructuring-bind (start end function) region @@ -2322,8 +2298,6 @@ long lines if and only if arg is positive." (insert "X-Boundary: ") (gnus-add-text-properties start (point) gnus-hidden-properties) (insert (let (str (max (window-width))) - (if (featurep 'xemacs) - (setq max (1- max))) (while (>= max (length str)) (setq str (concat str gnus-body-boundary-delimiter))) (substring str 0 max)) @@ -2428,7 +2402,7 @@ long lines if and only if arg is positive." (unless (setq from (gnus-article-goto-header "from")) (insert "From:") (setq from (point)) - (insert " [no `from' set]\n")) + (insert " [no 'from' set]\n")) (while faces (when (setq png (gnus-convert-face-to-png (pop faces))) (setq image @@ -2717,7 +2691,7 @@ If READ-CHARSET, ask for a coding system." (while (re-search-forward "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) - (when (gmm-called-interactively-p 'any) + (when (called-interactively-p 'any) (gnus-treat-article nil)))) (defun article-wash-html () @@ -2770,7 +2744,7 @@ summary buffer." (cond ((file-directory-p file) (when (or (not (eq how 'file)) (gnus-y-or-n-p - (format + (gnus-format-message "Delete temporary HTML file(s) in directory `%s'? " (file-name-as-directory file)))) (gnus-delete-directory file))) @@ -4319,8 +4293,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (put-text-property (match-end 0) (point-max) 'face eface))))))))) -(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs. - (defun article-verify-cancel-lock () "Verify Cancel-Lock header." (interactive) @@ -4433,13 +4405,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) (defvar gnus-article-send-map) - (gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) - "W" gnus-article-wide-reply-with-original) -(if (featurep 'xemacs) - (set-keymap-default-binding gnus-article-send-map - 'gnus-article-read-summary-send-keys) - (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys)) + "W" gnus-article-wide-reply-with-original + [t] 'gnus-article-read-summary-send-keys) (defun gnus-article-make-menu-bar () (unless (boundp 'gnus-article-commands-menu) @@ -4898,8 +4866,8 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) + (define-key map [mouse-2] 'gnus-article-push-button) + (define-key map [down-mouse-3] 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) (define-key map (cadr c) (car c))) map)) @@ -4927,25 +4895,30 @@ General format specifiers can also be used. See Info node (vector (caddr c) (car c) :active t)) gnus-url-button-commands))) -(defmacro gnus-bind-safe-url-regexp (&rest body) - "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'." - `(let ((mm-w3m-safe-url-regexp - (let ((group (if (and (derived-mode-p 'gnus-article-mode) - (gnus-buffer-live-p - gnus-article-current-summary)) - (with-current-buffer gnus-article-current-summary - gnus-newsgroup-name) - gnus-newsgroup-name))) - (if (cond ((not group) - ;; Maybe we're in a mml-preview buffer - ;; and no group is selected. - t) - ((stringp gnus-safe-html-newsgroups) - (string-match gnus-safe-html-newsgroups group)) - ((consp gnus-safe-html-newsgroups) - (member group gnus-safe-html-newsgroups))) - nil - mm-w3m-safe-url-regexp)))) +(defmacro gnus-bind-mm-vars (&rest body) + "Bind some mm-* variables and execute BODY." + `(let (mm-html-inhibit-images + mm-html-blocked-images + (mm-w3m-safe-url-regexp mm-w3m-safe-url-regexp)) + (with-current-buffer + (cond ((derived-mode-p 'gnus-article-mode) + (if (gnus-buffer-live-p gnus-article-current-summary) + gnus-article-current-summary + ;; Maybe we're in a mml-preview buffer + ;; and no group is selected. + (current-buffer))) + ((gnus-buffer-live-p gnus-summary-buffer) + gnus-summary-buffer) + (t (current-buffer))) + (setq mm-html-inhibit-images gnus-inhibit-images + mm-html-blocked-images (gnus-blocked-images)) + (when (or (not gnus-newsgroup-name) + (and (stringp gnus-safe-html-newsgroups) + (string-match gnus-safe-html-newsgroups + gnus-newsgroup-name)) + (and (consp gnus-safe-html-newsgroups) + (member gnus-newsgroup-name gnus-safe-html-newsgroups))) + (setq mm-w3m-safe-url-regexp nil))) ,@body)) (defun gnus-mime-button-menu (event prefix) @@ -4973,7 +4946,7 @@ General format specifiers can also be used. See Info node (or (search-forward "\n\n") (goto-char (point-max))) (let ((inhibit-read-only t)) (delete-region (point) (point-max)) - (gnus-bind-safe-url-regexp (mm-display-parts handles))))))) + (gnus-bind-mm-vars (mm-display-parts handles))))))) (defun gnus-article-jump-to-part (n) "Jump to MIME part N." @@ -5403,9 +5376,9 @@ Compressed files like .gz and .bz2 are decompressed." 'gnus-undeletable t)))) ;; We're in the article header. (delete-char -1) - (dolist (ovl (gnus-overlays-in btn (point))) - (gnus-overlay-put ovl 'gnus-button-attachment-extra t) - (gnus-overlay-put ovl 'face nil)) + (dolist (ovl (overlays-in btn (point))) + (overlay-put ovl 'gnus-button-attachment-extra t) + (overlay-put ovl 'face nil)) (save-restriction (message-narrow-to-field) (let ((gnus-treatment-function-alist @@ -5512,11 +5485,10 @@ If no internal viewer is available, use an external viewer." (gnus-mime-view-part-as-type nil (lambda (type) (mm-inlinable-p handle type))) (when handle - (gnus-bind-safe-url-regexp - (mm-display-part handle nil t)))))) + (gnus-bind-mm-vars (mm-display-part handle nil t)))))) (defun gnus-mime-action-on-part (&optional action) - "Do something with the MIME attachment at \(point\)." + "Do something with the MIME attachment at (point)." (interactive (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t))) (gnus-article-check-buffer) @@ -5743,7 +5715,7 @@ all parts." (mm-inlined-p handle) t) (with-temp-buffer - (gnus-bind-safe-url-regexp + (gnus-bind-mm-vars (setq retval (mm-display-part handle))) (unless (zerop (buffer-size)) (buffer-string)))))) @@ -5798,9 +5770,9 @@ all parts." 'gnus-undeletable t)))) ;; We're in the article header. (delete-char -1) - (dolist (ovl (gnus-overlays-in point (point))) - (gnus-overlay-put ovl 'gnus-button-attachment-extra t) - (gnus-overlay-put ovl 'face nil)) + (dolist (ovl (overlays-in point (point))) + (overlay-put ovl 'gnus-button-attachment-extra t) + (overlay-put ovl 'face nil)) (save-restriction (message-narrow-to-field) (let ((gnus-treatment-function-alist @@ -5889,8 +5861,8 @@ all parts." (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -5898,16 +5870,12 @@ all parts." :button-keymap gnus-mime-button-map :help-echo (lambda (widget) - ;; Needed to properly clear the message due to a bug in - ;; wid-edit (XEmacs only). - (if (boundp 'help-echo-owns-message) - (setq help-echo-owns-message t)) (format "%S: %s the MIME part; %S: more options" - (aref gnus-mouse-2 0) + 'mouse-2 (if (mm-handle-displayed-p (widget-get widget :mime-handle)) "hide" "show") - (aref gnus-down-mouse-3 0)))))) + 'down-mouse-3))))) (defun gnus-widget-press-button (elems _el) (goto-char (widget-get elems :from)) @@ -5992,7 +5960,7 @@ If t, it overrides nil values of "Display \"multipart/related\" parts as \"multipart/mixed\". If displaying \"text/html\" is discouraged \(see -`mm-discouraged-alternatives'\) images or other material inside a +`mm-discouraged-alternatives') images or other material inside a \"multipart/related\" part might be overlooked when this variable is nil." :version "22.1" :group 'gnus-article-mime @@ -6104,7 +6072,7 @@ If nil, don't show those extra buttons." (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets))) - (gnus-bind-safe-url-regexp (mm-display-part handle t)))) + (gnus-bind-mm-vars (mm-display-part handle t)))) ((and text not-attachment) (mm-display-inline handle))) (goto-char (point-max)) @@ -6192,14 +6160,13 @@ If nil, don't show those extra buttons." (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) keymap ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face + mouse-face ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id article-type multipart rear-nonsticky t)) (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) + :action 'gnus-widget-press-button) ;; Do the handles (while (setq handle (pop handles)) (gnus-add-text-properties @@ -6217,14 +6184,13 @@ If nil, don't show those extra buttons." (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) keymap ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face + mouse-face ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id gnus-data ,handle rear-nonsticky t)) (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) + :action 'gnus-widget-press-button) (insert " ")) (insert "\n\n")) (when preferred @@ -6234,7 +6200,7 @@ If nil, don't show those extra buttons." (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) - (gnus-bind-safe-url-regexp (mm-display-part preferred)) + (gnus-bind-mm-vars (mm-display-part preferred)) ;; Do highlighting. (save-excursion (save-restriction @@ -6452,9 +6418,9 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." (insert "\n") (end-of-line))) (insert "\n") - (dolist (ovl (gnus-overlays-in (point-min) (point))) - (gnus-overlay-put ovl 'gnus-button-attachment-extra t) - (gnus-overlay-put ovl 'face nil)) + (dolist (ovl (overlays-in (point-min) (point))) + (overlay-put ovl 'gnus-button-attachment-extra t) + (overlay-put ovl 'face nil)) (let ((gnus-treatment-function-alist '((gnus-treat-highlight-headers gnus-article-highlight-headers)))) @@ -6601,12 +6567,10 @@ If given a numerical ARG, move forward ARG pages." If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." (interactive "p") - (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin))) + (move-to-window-line (- -1 scroll-margin)) (if (and (not (and gnus-article-over-scroll (> (count-lines (window-start) (point-max)) - (if (featurep 'xemacs) - (or lines (1- (window-height))) - (+ (or lines (1- (window-height))) scroll-margin))))) + (+ (or lines (1- (window-height))) scroll-margin)))) (save-excursion (end-of-line) (and (pos-visible-in-window-p) ;Not continuation line. @@ -6632,18 +6596,16 @@ Argument LINES specifies lines to be scrolled up." "Move point to the beginning of the window. In Emacs, the point is placed at the line number which `scroll-margin' specifies." - (if (featurep 'xemacs) - (move-to-window-line 0) - ;; There is an obscure bug in Emacs that makes it impossible to - ;; scroll past big pictures in the article buffer. Try to fix - ;; this by adding a sanity check by counting the lines visible. - (when (> (count-lines (window-start) (window-end)) 30) - (move-to-window-line - (min (max 0 scroll-margin) - (max 1 (- (window-height) - (if mode-line-format 1 0) - (if header-line-format 1 0) - 2))))))) + ;; There is an obscure bug in Emacs that makes it impossible to + ;; scroll past big pictures in the article buffer. Try to fix + ;; this by adding a sanity check by counting the lines visible. + (when (> (count-lines (window-start) (window-end)) 30) + (move-to-window-line + (min (max 0 scroll-margin) + (max 1 (- (window-height) + (if mode-line-format 1 0) + (if header-line-format 1 0) + 2)))))) (defvar scroll-in-place) @@ -6670,10 +6632,7 @@ Argument LINES specifies lines to be scrolled down." (goto-char (point-max)) (recenter (if gnus-article-over-scroll (if lines - (max (if (featurep 'xemacs) - lines - (+ lines scroll-margin)) - 3) + (max (+ lines scroll-margin) 3) (- (window-height) 2)) -1))) (prog1 @@ -6754,9 +6713,7 @@ not have a face in `gnus-article-boring-faces'." (let (gnus-pick-mode) (setq unread-command-events (nconc unread-command-events (list (or key last-command-event))) - keys (if (featurep 'xemacs) - (events-to-keys (read-key-sequence nil t)) - (read-key-sequence nil t))))) + keys (read-key-sequence nil t)))) (message "") @@ -6870,12 +6827,12 @@ KEY is a string or a vector." gnus-article-read-summary-send-keys)) (with-current-buffer gnus-article-current-summary (setq unread-command-events - (if (featurep 'xemacs) - (append key nil) - (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) - (list 'meta (- x 128)) - x)) - key))) + (nconc + (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) + (list 'meta (- x 128)) + x)) + key) + unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) (describe-key (read-key-sequence nil t)))) @@ -6892,12 +6849,12 @@ KEY is a string or a vector." gnus-article-read-summary-send-keys)) (with-current-buffer gnus-article-current-summary (setq unread-command-events - (if (featurep 'xemacs) - (append key nil) - (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) - (list 'meta (- x 128)) - x)) - key))) + (nconc + (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) + (list 'meta (- x 128)) + x)) + key) + unread-command-events)) (let ((cursor-in-echo-area t) gnus-pick-mode) (describe-key-briefly (read-key-sequence nil t) insert))) @@ -6971,7 +6928,7 @@ the entire article will be yanked." (interactive) (let ((article (cdr gnus-article-current)) contents) - (if (not (gnus-region-active-p)) + (if (not (and transient-mark-mode mark-active)) (with-current-buffer gnus-summary-buffer (gnus-summary-reply (list (list article)) wide)) (setq contents (buffer-substring (point) (mark t))) @@ -6997,7 +6954,7 @@ the entire article will be yanked." (interactive) (let ((article (cdr gnus-article-current)) contents) - (if (not (gnus-region-active-p)) + (if (not (and transient-mark-mode mark-active)) (with-current-buffer gnus-summary-buffer (gnus-summary-followup (list (list article)))) (setq contents (buffer-substring (point) (mark t))) @@ -7446,10 +7403,9 @@ groups." :group 'gnus-article-buttons :type 'regexp) -(defcustom gnus-button-valid-fqdn-regexp - message-valid-fqdn-regexp +(defcustom gnus-button-valid-fqdn-regexp "\\([-A-Za-z0-9]+\\.\\)+[A-Za-z]+" "Regular expression that matches a valid FQDN." - :version "22.1" + :version "25.2" :group 'gnus-article-buttons :type 'regexp) @@ -7541,7 +7497,7 @@ must return `mid', `mail', `invalid' or `ask'." (10.0 . "^[^0-9]+@") (3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@") ;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part - (3.0 . "\@stud") + (3.0 . "@stud") ;; (2.0 . "[a-z][a-z][._-][A-Z][a-z].*@") ;; @@ -7549,7 +7505,7 @@ must return `mid', `mail', `invalid' or `ask'." (0.5 . "^[A-Z][a-z][a-z]") (1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3} (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4} - "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. + "An alist of (RATE . REGEXP) pairs for `gnus-button-mid-or-mail-heuristic'. A negative RATE indicates a message IDs, whereas a positive indicates a mail address. The REGEXP is processed with `case-fold-search' set to nil." @@ -7566,7 +7522,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." (list gnus-button-mid-or-mail-heuristic-alist) (result 0) rate regexp lpartlen elem) (setq lpartlen - (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) + (length (replace-regexp-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) ;; Certain special cases... (when (string-match @@ -7608,9 +7564,9 @@ address, `ask' if unsure and `invalid' if the string is invalid." (gnus-message 9 "Many digits in `%s', rate `%s', result `%s'." mid-or-mail rate result)) - ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@" + ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*@" mid-or-mail) - ;; Too few vowels [^aeiouy]{4,}.*\@ + ;; Too few vowels [^aeiouy]{4,}.*@ (setq result (+ result -5.0)) (gnus-message 9 "Few vowels in `%s', rate `%s', result `%s'." @@ -7637,7 +7593,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." (setq guessed ;; get rid of surrounding angles... (funcall pref - (gnus-replace-in-string mid-or-mail "^<\\|>$" ""))) + (replace-regexp-in-string mid-or-mail "^<\\|>$" ""))) (if (or (eq 'mid guessed) (eq 'mail guessed)) (setq pref guessed) (setq pref 'ask))) @@ -7669,13 +7625,13 @@ as a symbol to FUN." "Call `describe-function' when pushing the corresponding URL button." (describe-function (intern - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + (replace-regexp-in-string url gnus-button-handle-describe-prefix "")))) (defun gnus-button-handle-describe-variable (url) "Call `describe-variable' when pushing the corresponding URL button." (describe-variable (intern - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + (replace-regexp-in-string url gnus-button-handle-describe-prefix "")))) (defun gnus-button-handle-symbol (url) "Display help on variable or function. @@ -7689,7 +7645,7 @@ Calls `describe-variable' or `describe-function'." (defun gnus-button-handle-describe-key (url) "Call `describe-key' when pushing the corresponding URL button." (let* ((key-string - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")) + (replace-regexp-in-string url gnus-button-handle-describe-prefix "")) (keys (ignore-errors (eval `(kbd ,key-string))))) (if keys (describe-key keys) @@ -7697,30 +7653,31 @@ Calls `describe-variable' or `describe-function'." (defun gnus-button-handle-apropos (url) "Call `apropos' when pushing the corresponding URL button." - (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (apropos (replace-regexp-in-string + url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-command (url) "Call `apropos' when pushing the corresponding URL button." (apropos-command - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-variable (url) "Call `apropos' when pushing the corresponding URL button." (funcall (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-documentation (url) "Call `apropos' when pushing the corresponding URL button." (funcall (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + (replace-regexp-in-string url gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-library (url) "Call `locate-library' when pushing the corresponding URL button." (gnus-message 9 "url=`%s'" url) (let* ((lib (locate-library url)) - (file (gnus-replace-in-string (or lib "") "\.elc" ".el"))) + (file (replace-regexp-in-string (or lib "") "\\.elc" ".el"))) (if (not lib) (gnus-message 1 "Cannot locale library `%s'." url) (find-file-read-only file)))) @@ -8033,8 +7990,8 @@ It does this by highlighting everything after (save-restriction (when (and gnus-signature-face (gnus-article-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t) - 'face gnus-signature-face) + (overlay-put (make-overlay (point-min) (point-max) nil t) + 'face gnus-signature-face) (widen) (gnus-article-search-signature) (let ((start (match-beginning 0)) @@ -8109,7 +8066,7 @@ url is put as the `gnus-button-url' overlay property on the button." (< (match-end 0) start)) (regexp-quote (match-string 0))) "\ -\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*" +[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*" delim "\\)")) (while (progn (forward-line 1) @@ -8132,12 +8089,12 @@ url is put as the `gnus-button-url' overlay property on the button." 'gnus-button-push (list beg (assq 'gnus-button-url-regexp gnus-button-alist))))) - (let ((overlay (gnus-make-overlay start end))) - (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'gnus-button-url - (list (mapconcat 'identity (nreverse url) ""))) + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'gnus-button-url + (list (mapconcat 'identity (nreverse url) ""))) (when gnus-article-mouse-face - (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))) + (overlay-put overlay 'mouse-face gnus-article-mouse-face))) t) (goto-char opoint)))) @@ -8176,18 +8133,17 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-add-button (from to fun &optional data text) "Create a button between FROM and TO with callback FUN and data DATA." (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay from to nil t) + 'face gnus-article-button-face)) (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) + (list 'mouse-face gnus-article-mouse-face)) (list 'gnus-callback fun) (and data (list 'gnus-data data)))) (widget-convert-button 'link from to :action 'gnus-widget-press-button :help-echo (or text "Follow the link") - :keymap gnus-url-button-map - :button-keymap gnus-widget-button-keymap)) + :keymap gnus-url-button-map)) (defun gnus-article-copy-string () "Copy the string in the button to the kill ring." @@ -8319,7 +8275,7 @@ url is put as the `gnus-button-url' overlay property on the button." "Fetch a man page." (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (when (eq gnus-button-man-handler 'woman) - (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" ""))) + (setq url (replace-regexp-in-string url "([1-9][X1a-z]*).*\\'" ""))) (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) (funcall gnus-button-man-handler url)) @@ -8334,8 +8290,8 @@ url is put as the `gnus-button-url' overlay property on the button." ")" (gnus-url-unhex-string (match-string 2 url))))) ((string-match "([^)\"]+)[^\"]+" url) (setq url - (gnus-replace-in-string - (gnus-replace-in-string url "[\n\t ]+" " ") "\"" "")) + (replace-regexp-in-string + (replace-regexp-in-string url "[\n\t ]+" " ") "\"" "")) (gnus-info-find-node url)) (t (error "Can't parse %s" url)))) @@ -8473,7 +8429,7 @@ url is put as the `gnus-button-url' overlay property on the button." (if (fboundp func) (funcall func) (message-position-on-field (caar args))) - (insert (gnus-replace-in-string + (insert (replace-regexp-in-string (mapconcat 'identity (reverse (cdar args)) ", ") "\r\n" "\n" t)) (setq args (cdr args))) @@ -8492,13 +8448,13 @@ url is put as the `gnus-button-url' overlay property on the button." (defvar gnus-prev-page-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-button-prev-page) + (define-key map [mouse-2] 'gnus-button-prev-page) (define-key map "\r" 'gnus-button-prev-page) map)) (defvar gnus-next-page-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map [mouse-2] 'gnus-button-next-page) (define-key map "\r" 'gnus-button-next-page) map)) @@ -8516,8 +8472,8 @@ url is put as the `gnus-button-url' overlay property on the button." (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :action 'gnus-button-prev-page @@ -8552,8 +8508,8 @@ url is put as the `gnus-button-url' overlay property on the button." (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :action 'gnus-button-next-page @@ -8812,8 +8768,8 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu) + (define-key map [mouse-2] 'gnus-article-push-button) + (define-key map [down-mouse-3] 'gnus-mime-security-button-menu) (dolist (c gnus-mime-security-button-commands) (define-key map (cadr c) (car c))) map)) @@ -8948,8 +8904,8 @@ For example: (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -8957,14 +8913,10 @@ For example: :button-keymap gnus-mime-security-button-map :help-echo (lambda (_widget) - ;; Needed to properly clear the message due to a bug in - ;; wid-edit (XEmacs only). - (when (boundp 'help-echo-owns-message) - (setq help-echo-owns-message t)) (format "%S: show detail; %S: more options" - (aref gnus-mouse-2 0) - (aref gnus-down-mouse-3 0)))))) + 'mouse-2 + 'down-mouse-3))))) (defun gnus-mime-display-security (handle) (save-restriction @@ -9010,8 +8962,6 @@ For example: (interactive) (gnus-mime-security-run-function 'mm-pipe-part)) -(gnus-ems-redefine) - (provide 'gnus-art) (run-hooks 'gnus-art-load-hook)