;;; 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 <larsi@gnus.org>
;; Keywords: news
(autoload 'ansi-color-apply-on-region "ansi-color")
(autoload 'mm-url-insert-file-contents-external "mm-url")
(autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'url-expand-file-name "url-expand")
(defgroup gnus-article nil
"Article display."
"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)
:group 'gnus-article-signature)
(defcustom gnus-hidden-properties
- (if (featurep 'xemacs)
- ;; `intangible' is evil, but I keep it here in case it's useful.
- '(invisible t intangible t)
- ;; Emacs's command loop moves point out of invisible text anyway, so
- ;; `intangible' is clearly not needed there.
- '(invisible t))
+ ;; We use to have `intangible' here as well, but Emacs's command loop moves
+ ;; point out of invisible text anyway, so `intangible' is clearly not
+ ;; 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."
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
"*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
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)
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
: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
(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)))
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-list-identifiers 'head
- "Strip list identifiers from `gnus-list-identifiers`.
+ "Strip list identifiers from `gnus-list-identifiers'.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:version "21.1"
(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'.
(defvar idna-program)
-(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
- (mm-coding-system-p 'utf-8)
+(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8)
+ (condition-case nil
+ (require 'idna)
+ (file-error)
+ (invalid-operation))
idna-program
(executable-find idna-program))
"Whether IDNA decoding of headers is used when viewing messages.
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
(modify-syntax-entry ?` " " table)
table)
"Syntax table used in article mode buffers.
-Initialized from `text-mode-syntax-table.")
+Initialized from `text-mode-syntax-table'.")
(defvar gnus-save-article-buffer nil)
(re-search-forward (concat "^\\(" header "\\):") nil t))
(defsubst gnus-article-hide-text (b e props)
- "Set text PROPS on the B to E region, extending `intangible' 1 past B."
- (gnus-add-text-properties-when 'article-type nil b e props)
- (when (memq 'intangible props)
- (put-text-property
- (max (1- b) (point-min))
- b 'intangible (cddr (memq 'intangible props)))))
+ "Set text PROPS on the B to E region."
+ (gnus-add-text-properties-when 'article-type nil b e props))
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
- (remove-text-properties b e gnus-hidden-properties)
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ (remove-text-properties b e gnus-hidden-properties))
(defun gnus-article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
"Unhide text of TYPE between B and E."
(gnus-delete-wash-type type)
(remove-text-properties
- b e (cons 'article-type (cons type gnus-hidden-properties)))
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
"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)))
(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
(goto-char (point-max))
(let ((start (point)))
(insert "X-Boundary: ")
- (gnus-add-text-properties start (point) '(invisible t intangible t))
+ (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))
(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
(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 ()
(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)))
(setq gnus-article-browse-html-temp-list nil))
gnus-article-browse-html-temp-list)
-(defun gnus-article-browse-html-save-cid-content (cid handles directory abs)
+(defun gnus-article-browse-html-save-cid-content (cid handles directory)
"Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return absolute file name if ABS is non-nil, otherwise relative to
-the parent of DIRECTORY."
+Return file name relative to the parent of DIRECTORY."
(save-match-data
(let (file afile)
(catch 'found
((not (or (bufferp (car handle)) (stringp (car handle)))))
((equal (mm-handle-media-supertype handle) "multipart")
(when (setq file (gnus-article-browse-html-save-cid-content
- cid handle directory abs))
+ cid handle directory))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
(setq file (or (mm-handle-filename handle)
mailcap-mime-extensions))))
afile (expand-file-name file directory))
(mm-save-part-to-file handle afile)
- (throw 'found (if abs
- afile
- (concat (file-name-nondirectory
- (directory-file-name directory))
- "/" file))))))))))
+ (throw 'found (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
(insert content)
;; resolve cid contents
(let ((case-fold-search t)
- abs st cid-file)
+ st base regexp cid-file)
(goto-char (point-min))
- (when (re-search-forward "<head[\t\n >]" nil t)
- (setq st (match-end 0)
- abs (or
- (not (re-search-forward "</head[\t\n >]" nil t))
- (re-search-backward "<base[\t\n >]" st t))))
+ (when (and (re-search-forward "<head[\t\n >]" nil t)
+ (progn
+ (setq st (match-end 0))
+ (re-search-forward "</head[\t\n >]" nil t))
+ (re-search-backward "<base\
+\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
+ (setq base (match-string 1))
+ (replace-match "<!--\\&-->")
+ (setq st (point))
+ (dolist (tag '(("a" . "href") ("form" . "action")
+ ("img" . "src")))
+ (setq regexp (concat "<" (car tag)
+ "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
+ (cdr tag) "=\"\\([^\"]+\\)"))
+ (while (re-search-forward regexp nil t)
+ (insert (prog1
+ (condition-case nil
+ (save-match-data
+ (url-expand-file-name (match-string 1)
+ base))
+ (error (match-string 1)))
+ (delete-region (match-beginning 1)
+ (match-end 1)))))
+ (goto-char st)))
(while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(match-string 2)
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
- cid-dir abs))
- (when abs
- (setq cid-file
- (if (eq system-type 'cygwin)
- (concat "file:///"
- (substring
- (with-output-to-string
- (call-process "cygpath" nil
- standard-output
- nil "-m" cid-file))
- 0 -1))
- (concat "file://" cid-file))))
+ cid-dir))
(replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(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)
'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)
(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))
(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)
(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."
'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
(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)
(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))))))
'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
(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
: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))
"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
(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))
(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
(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
(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
(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))))
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.
"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)
(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
(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 "")
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))))
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)))
(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)))
(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)))
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
-(eval-when-compile
- (autoload 'nneething-get-file-name "nneething"))
+(declare-function nneething-get-file-name "nneething" (id))
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
+ "Allows images in newsgroups to be shown, blocks images in all
+other groups."
(if (or (gnus-news-group-p group)
(gnus-member-of-valid 'global group))
;; Block nothing in news 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)
(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].*@")
;;
(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."
(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
(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'."
(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)))
"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.
(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)
(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))))
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
;; Exclude [.?] for URLs in gmane.emacs.cvs
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][-a-z0-9]+\\.el\\)'"
+ ("['`‘]\\([a-z][-a-z0-9]+\\.el\\)['’]"
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+ ("['`‘]\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)['’]"
0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
- ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
+ ("['`‘]\\([a-z][a-z0-9]+-[a-z]+\\)['’]"
0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
- ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
+ ("['`‘]\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^'’]+\\)\\)['’]"
;; Unlike the other regexps we really have to require quoting
;; here to determine where it ends.
1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
(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))
(< (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)
'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))))
(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."
"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))
")" (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))))
(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)))
(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))
(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
(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
(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))
(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
: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
(interactive)
(gnus-mime-security-run-function 'mm-pipe-part))
-(gnus-ems-redefine)
-
(provide 'gnus-art)
(run-hooks 'gnus-art-load-hook)