;;; gnus-art.el --- article mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
"Fill long lines.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
+ :version "24.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
"Remove all images from the article buffer."
(interactive)
(gnus-with-article-buffer
- (dolist (elem gnus-article-image-alist)
- (gnus-delete-images (car elem)))))
+ (save-restriction
+ (widen)
+ (dolist (elem gnus-article-image-alist)
+ (gnus-delete-images (car elem))))))
(defun gnus-article-show-images ()
"Show any images that are in the HTML-rendered article buffer.
This only works if the article in question is HTML."
(interactive)
(gnus-with-article-buffer
- (dolist (region (gnus-find-text-property-region (point-min) (point-max)
- 'image-displayer))
- (destructuring-bind (start end function) region
- (funcall function (get-text-property start 'image-url)
- start end)))))
+ (save-restriction
+ (widen)
+ (dolist (region (gnus-find-text-property-region (point-min) (point-max)
+ 'image-displayer))
+ (destructuring-bind (start end function) region
+ (funcall function (get-text-property start 'image-url)
+ start end))))))
(defun gnus-article-treat-fold-newsgroups ()
"Unfold folded message headers.
(gnus-update-format-specifications nil 'article-mode)
(set (make-local-variable 'page-delimiter) gnus-page-delimiter)
(set (make-local-variable 'gnus-page-broken) nil)
- (make-local-variable 'gnus-button-marker-list)
(make-local-variable 'gnus-article-current-summary)
(make-local-variable 'gnus-article-mime-handles)
(make-local-variable 'gnus-article-decoded-p)
(mm-enable-multibyte)
(gnus-run-mode-hooks 'gnus-article-mode-hook))
-(defvar gnus-button-marker-list nil
- "Regexp matching any of the regexps from `gnus-button-alist'.
-Internal variable.")
-
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
(let* ((name (if gnus-single-article-buffer "*Article*"
(setq gnus-article-mime-handle-alist nil)
(buffer-disable-undo)
(setq buffer-read-only t)
- ;; This list just keeps growing if we don't reset it.
- (setq gnus-button-marker-list nil)
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(setq truncate-lines gnus-article-truncate-lines)
(if (mm-handle-undisplayer handle)
(mm-remove-part handle))))
(forward-line 2)
- (mm-insert-inline
- handle
- (if (or coding-system
- (and charset
- (setq coding-system
- (mm-charset-to-coding-system charset))
- (not (eq coding-system 'ascii))))
- (mm-decode-coding-string contents coding-system)
- (mm-string-to-multibyte contents)))
+ (mm-display-inline handle)
(goto-char b)))))
(defun gnus-mime-set-charset-parameters (handle charset)
(forward-line -1)
(setq beg (point)))
(gnus-article-insert-newline)
- (mm-insert-inline
- handle
- (let ((charset (or (mail-content-type-get (mm-handle-type handle)
- 'charset)
- (and (equal type "text/calendar") 'utf-8))))
- (cond ((not charset)
- (mm-string-as-multibyte (mm-get-part handle)))
- ((eq charset 'gnus-decoded)
- (with-current-buffer (mm-handle-buffer handle)
- (buffer-string)))
- (t
- (mm-decode-string (mm-get-part handle) charset)))))
+ (mm-display-inline handle)
(goto-char (point-max))))
;; Do highlighting.
(save-excursion
;; Info links like `C-h i d m Gnus RET' or `C-h i d m Gnus RET i partial RET'
0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 0)
;; This is custom
- ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
+ ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET\\>" 0
(>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2)
;; Emacs help commands
- ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
;; regexp doesn't match arguments containing ` '.
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
- ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1)
- ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
- ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
;; The following entries may lead to many false positives so don't enable
;; them by default (use a high button level).
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)
- ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1)
- ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
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"
+ ("\\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]+\\([^']+\\)\\)'"
;; Unlike the other regexps we really have to require quoting
(gnus-article-highlight-headers)
(gnus-article-highlight-citation force)
(gnus-article-highlight-signature)
- (gnus-article-add-buttons force)
+ (gnus-article-add-buttons)
(gnus-article-add-buttons-to-head))
(defun gnus-article-highlight-some (&optional force)
"Say whether PROP exists in the region."
(text-property-not-all b e prop nil))
-(defun gnus-article-add-buttons (&optional force)
+(defun gnus-article-add-buttons ()
"Find external references in the article and make buttons of them.
\"External references\" are things like Message-IDs and URLs, as
specified by `gnus-button-alist'."
- (interactive (list 'force))
+ (interactive)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t)
(case-fold-search t)
(alist gnus-button-alist)
beg entry regexp)
- ;; Remove all old markers.
- (let (marker entry new-list)
- (while (setq marker (pop gnus-button-marker-list))
- (if (or (< marker (point-min)) (>= marker (point-max)))
- (push marker new-list)
- (goto-char marker)
- (when (setq entry (gnus-button-entry))
- (put-text-property (match-beginning (nth 1 entry))
- (match-end (nth 1 entry))
- 'gnus-callback nil))
- (set-marker marker nil)))
- (setq gnus-button-marker-list new-list))
;; We skip the headers.
(article-goto-body)
(setq beg (point))
(let ((start (match-beginning (nth 1 entry)))
(end (match-end (nth 1 entry)))
(from (match-beginning 0)))
- (when (and (or (eq t (nth 2 entry))
- (eval (nth 2 entry)))
+ (when (and (eval (nth 2 entry))
(not (gnus-button-in-region-p
start end 'gnus-callback)))
;; That optional form returned non-nil, so we add the
;; button.
(setq from (set-marker (make-marker) from))
- (push from gnus-button-marker-list)
(unless (and (eq (car entry) 'gnus-button-url-regexp)
(gnus-article-extend-url-button from start end))
(gnus-article-add-button start end
- 'gnus-button-push from)
+ 'gnus-button-push (list from entry))
(gnus-put-text-property
start end
'gnus-string (buffer-substring-no-properties
(let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
(gnus-set-mode-line 'article))))
-(defun gnus-button-entry ()
- ;; Return the first entry in `gnus-button-alist' matching this place.
- (let ((alist gnus-button-alist)
- (entry nil))
- (while alist
- (setq entry (pop alist))
- (if (looking-at (eval (car entry)))
- (setq alist nil)
- (setq entry nil)))
- entry))
-
-(defun gnus-button-push (marker)
+(defun gnus-button-push (marker-and-entry)
;; Push button starting at MARKER.
(save-excursion
- (goto-char marker)
- (let* ((entry (gnus-button-entry))
- (inhibit-point-motion-hooks t)
- (fun (nth 3 entry))
- (args (or (and (eq (car entry) 'gnus-button-url-regexp)
- (get-char-property marker 'gnus-button-url))
- (mapcar (lambda (group)
- (let ((string (match-string group)))
- (set-text-properties
- 0 (length string) nil string)
- string))
- (nthcdr 4 entry)))))
- (cond
- ((fboundp fun)
- (apply fun args))
- ((and (boundp fun)
- (fboundp (symbol-value fun)))
- (apply (symbol-value fun) args))
- (t
- (gnus-message 1 "You must define `%S' to use this button"
- (cons fun args)))))))
+ (let* ((marker (car marker-and-entry))
+ (entry (cadr marker-and-entry))
+ (regexp (car entry))
+ (inhibit-point-motion-hooks t))
+ (goto-char marker)
+ ;; This is obviously true, or something bad is happening :)
+ ;; But we need it to have the match-data
+ (when (looking-at (or (if (symbolp regexp)
+ (symbol-value regexp)
+ regexp)))
+ (let ((fun (nth 3 entry))
+ (args (or (and (eq (car entry) 'gnus-button-url-regexp)
+ (get-char-property marker 'gnus-button-url))
+ (mapcar (lambda (group)
+ (let ((string (match-string group)))
+ (set-text-properties
+ 0 (length string) nil string)
+ string))
+ (nthcdr 4 entry)))))
+
+ (cond
+ ((fboundp fun)
+ (apply fun args))
+ ((and (boundp fun)
+ (fboundp (symbol-value fun)))
+ (apply (symbol-value fun) args))
+ (t
+ (gnus-message 1 "You must define `%S' to use this button"
+ (cons fun args)))))))))
(defun gnus-parse-news-url (url)
(let (scheme server port group message-id articles)
(if (string-match
(concat "\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+"
"\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
- "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET"
+ "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\>"
"\\(?:[ \t\n,]*\\)\\)?")
url)
(setq node (match-string 2 url)
(Info-directory)
(Info-menu node)
(when (> (length indx) 0)
- (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
+ (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET\\>"
"\\([ \t\n,]*\\)")
indx)
(setq comma (match-string 2 indx))
(Info-index-next 1)))
nil)))
+(autoload 'pgg-snarf-keys-region "pgg")
;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
(declare-function pgg-display-output-buffer "pgg" (start end status))
(defun gnus-url-mailto (url)
;; Send mail to someone
+ (setq url (replace-regexp-in-string "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
(let (to args subject func)
(if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
(concat "to=" (match-string 1 url) "&"
(match-string 2 url))
- (concat "to=" url)))
- t)
+ (concat "to=" url))))
subject (cdr-safe (assoc "subject" args)))
(gnus-msg-mail)
(while args
projects / gnus / blobdiff