(require 'gnus-sum)
(require 'gnus-spec)
(require 'gnus-int)
+(require 'gnus-win)
(require 'mm-bodies)
(require 'mail-parse)
(require 'mm-decode)
"^X-Abuse-Info:" "^X-From_:" "^X-Accept-Language:" "^Errors-To:"
"^X-BeenThere:" "^X-Mailman-Version:" "^List-Help:" "^List-Post:"
"^List-Subscribe:" "^List-Id:" "^List-Unsubscribe:" "^List-Archive:"
- "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:")
+ "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:"
+ "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:"
+ "^X-Virus-Scanned:" "^X-Delivery-Agent:")
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type `(choice string
- (function-item
+ (function-item
,(if (featurep 'xemacs)
'gnus-xmas-article-display-xface
'gnus-article-display-xface))
* gnus-summary-save-in-mail (Unix mail format)
* gnus-summary-save-in-folder (MH folder)
* gnus-summary-save-in-file (article format)
+* gnus-summary-save-body-in-file (article body)
* gnus-summary-save-in-vm (use VM's folder format)
* gnus-summary-write-to-file (article format -- overwrite)."
:group 'gnus-article-saving
(function-item gnus-summary-save-in-mail)
(function-item gnus-summary-save-in-folder)
(function-item gnus-summary-save-in-file)
+ (function-item gnus-summary-save-body-in-file)
(function-item gnus-summary-save-in-vm)
(function-item gnus-summary-write-to-file)))
(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
"Highlight the signature.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
:type gnus-article-treat-custom)
(put 'gnus-treat-display-smileys 'highlight t)
-(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil)
+(defcustom gnus-treat-display-picons
+ (if (or (and (featurep 'xemacs)
+ (featurep 'xpm))
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'pbm)))
+ 'head nil)
"Display picons.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
(gnus-treat-fill-article gnus-article-fill-cited-article)
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
- (gnus-treat-emphasize gnus-article-emphasize)
(gnus-treat-display-xface gnus-article-display-x-face)
(gnus-treat-date-ut gnus-article-date-ut)
(gnus-treat-date-local gnus-article-date-local)
(gnus-treat-display-smileys gnus-smiley-display)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
(gnus-treat-display-picons gnus-article-display-picons)
+ (gnus-treat-emphasize gnus-article-emphasize)
(gnus-treat-play-sounds gnus-earcon-display)))
(defvar gnus-article-mime-handle-alist nil)
;; We now have the area of the buffer where the X-Face is stored.
(save-excursion
(let ((beg (point))
- (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
+ (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))
+ buffer-read-only)
;; We display the face.
(if (symbolp gnus-article-x-face-command)
;; The command is a lisp function, so we call it.
(when (and (or gnus-group-name-charset-method-alist
gnus-group-name-charset-group-alist)
(gnus-buffer-live-p gnus-original-article-buffer))
- (when (mail-fetch-field "Newsgroups")
+ (when (nnmail-fetch-field "Newsgroups")
(nnheader-replace-header "Newsgroups"
(gnus-decode-newsgroups
(with-current-buffer
gnus-original-article-buffer
- (mail-fetch-field "Newsgroups"))
+ (nnmail-fetch-field "Newsgroups"))
gnus-newsgroup-name method)))
- (when (mail-fetch-field "Followup-To")
+ (when (nnmail-fetch-field "Followup-To")
(nnheader-replace-header "Followup-To"
(gnus-decode-newsgroups
(with-current-buffer
gnus-original-article-buffer
- (mail-fetch-field "Followup-To"))
+ (nnmail-fetch-field "Followup-To"))
gnus-newsgroup-name method))))))
(defun article-de-quoted-unreadable (&optional force read-charset)
(narrow-to-region (point) (point-max))
(mm-setup-w3)
(let ((w3-strict-width (window-width))
- (url-standalone-mode t))
+ (url-standalone-mode t)
+ (w3-honor-stylesheets nil)
+ (w3-delay-image-loads t))
(condition-case var
(w3-region (point-min) (point-max))
(error))))))))
(let ((buffer-read-only nil))
(when (gnus-article-narrow-to-signature)
(gnus-article-hide-text-type
- (point-min) (point-max) 'signature)))))))
+ (point-min) (point-max) 'signature))))))
+ (gnus-set-mode-line 'article))
(defun article-strip-headers-in-body ()
"Strip offensive headers from bodies."
(defun gnus-article-check-hidden-text (type arg)
"Return nil if hiding is necessary.
-Arg can be nil or a number. Nil and positive means hide, negative
+Arg can be nil or a number. nil and positive means hide, negative
means show, 0 means toggle."
(save-excursion
(save-restriction
'article-type type
(point-min) (point-max)
(cons 'article-type (cons type
- gnus-hidden-properties)))))
+ gnus-hidden-properties)))
+ (setq gnus-article-wash-types (delq type gnus-article-wash-types))))
(defconst article-time-units
`((year . ,(* 365.25 24 60 60))
(match-beginning invisible) (match-end invisible) props)
(gnus-article-unhide-text-type
(match-beginning visible) (match-end visible) 'emphasis)
- (gnus-put-text-property-excluding-newlines
+ (gnus-put-overlay-excluding-newlines
(match-beginning visible) (match-end visible) 'face face)
(push 'emphasis gnus-article-wash-types)
(goto-char (match-end invisible)))))))))
filename)
(defun gnus-summary-write-to-file (&optional filename)
- "Write this article to a file.
+ "Write this article to a file, overwriting it if the file exists.
Optional argument FILENAME specifies file name.
The directory to save in defaults to `gnus-article-save-directory'."
(gnus-summary-save-in-file nil t))
(shell-command-on-region (point-min) (point-max) command nil)))
(setq gnus-last-shell-command command))
+(defun gnus-summary-pipe-to-muttprint (&optional command)
+ "Pipe this article to muttprint."
+ (setq command (read-string
+ "Print using command: " gnus-summary-muttprint-program
+ nil gnus-summary-muttprint-program))
+ (gnus-summary-save-in-pipe command))
+
;;; Article file names when saving.
(defun gnus-capitalize-newsgroup (newsgroup)
(put-text-property (match-end 0) (point-max)
'face eface)))))))))
+(defun article-verify-cancel-lock ()
+ "Verify Cancel-Lock header."
+ (interactive)
+ (if (gnus-buffer-live-p gnus-original-article-buffer)
+ (canlock-verify gnus-original-article-buffer)))
+
(eval-and-compile
(mapcar
(lambda (func)
(apply ',afunc args))))))))
'(article-hide-headers
article-verify-x-pgp-sig
+ article-verify-cancel-lock
article-hide-boring-headers
article-treat-overstrike
article-fill-long-lines
;; from the head of the article.
(defun gnus-article-set-window-start (&optional line)
(set-window-start
- (get-buffer-window gnus-article-buffer t)
+ (gnus-get-buffer-window gnus-article-buffer t)
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-min))
gnus-newsgroup-ignored-charsets)))
(save-excursion
(unwind-protect
- (let ((win (get-buffer-window (current-buffer) t))
+ (let ((win (gnus-get-buffer-window (current-buffer) t))
(beg (point)))
(when win
(select-window win))
;; This will remove the part.
(mm-display-part handle)
(save-restriction
- (narrow-to-region (point)
+ (narrow-to-region (point)
(if (eobp) (point) (1+ (point))))
(mm-display-part handle)
;; We narrow to the part itself and
(when ibegend
(goto-char point))))
+(defconst gnus-article-wash-status-strings
+ (let ((alist '((cite "c" "Possible hidden citation text"
+ " " "All citation text visible")
+ (headers "h" "Hidden headers"
+ " " "All headers visible.")
+ (pgp "p" "Encrypted or signed message status hidden"
+ " " "No hidden encryption nor digital signature status")
+ (signature "s" "Signature has been hidden"
+ " " "Signature is visible")
+ (overstrike "o" "Overstrike (^H) characters applied"
+ " " "No overstrike characters applied")
+ (emphasis "e" "/*_Emphasis_*/ characters applied"
+ " " "No /*_emphasis_*/ characters applied")))
+ result)
+ (dolist (entry alist result)
+ (let ((key (nth 0 entry))
+ (on (copy-sequence (nth 1 entry)))
+ (on-help (nth 2 entry))
+ (off (copy-sequence (nth 3 entry)))
+ (off-help (nth 4 entry)))
+ (put-text-property 0 1 'help-echo on-help on)
+ (put-text-property 0 1 'help-echo off-help off)
+ (push (list key on off) result))))
+ "Alist of strings describing wash status in the mode line.
+Each entry has the form (KEY ON OF), where the KEY is a symbol
+representing the particular washing function, ON is the string to use
+in the article mode line when the washing function is active, and OFF
+is the string to use when it is inactive.")
+
+(defun gnus-gnus-article-wash-status-entry (key value)
+ (let ((entry (assoc key gnus-article-wash-status-strings)))
+ (if value (nth 1 entry) (nth 2 entry))))
+
(defun gnus-article-wash-status ()
"Return a string which display status of article washing."
(save-excursion
(signature (memq 'signature gnus-article-wash-types))
(overstrike (memq 'overstrike gnus-article-wash-types))
(emphasis (memq 'emphasis gnus-article-wash-types)))
- (format "%c%c%c%c%c%c"
- (if cite ?c ? )
- (if (or headers boring) ?h ? )
- (if (or pgp pem signed encrypted) ?p ? )
- (if signature ?s ? )
- (if overstrike ?o ? )
- (if emphasis ?e ? )))))
+ (concat (gnus-gnus-article-wash-status-entry 'cite cite)
+ (gnus-gnus-article-wash-status-entry 'headers
+ (or headers boring))
+ (gnus-gnus-article-wash-status-entry
+ 'pgp (or pgp pem signed encrypted))
+ (gnus-gnus-article-wash-status-entry 'signature signature)
+ (gnus-gnus-article-wash-status-entry 'overstrike overstrike)
+ (gnus-gnus-article-wash-status-entry 'emphasis emphasis)))))
(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
(set-buffer gnus-summary-buffer)
(gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
- (set-window-point (get-buffer-window (current-buffer) t)
+ (set-window-point (gnus-get-buffer-window (current-buffer) t)
(point))
(set-buffer buf))))))
(defun gnus-button-handle-info (url)
"Fetch an info URL."
- (if (string-match
+ (if (string-match
"^\\([^:/]+\\)?/\\(.*\\)"
url)
(gnus-info-find-node
(concat "(" (or (gnus-url-unhex-string (match-string 1 url))
- "Gnus")
- ")"
+ "Gnus")
+ ")"
(gnus-url-unhex-string (match-string 2 url))))
(error "Can't parse %s" url)))
(if (not (string-match "[:/]" address))
;; This is just a simple group url.
(gnus-group-read-ephemeral-group address gnus-select-method)
- (if (not
- (string-match
+ (if (not
+ (string-match
"^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?"
address))
(error "Can't parse %s" address)
(setq retval (cons (list key val) retval)))))
retval))
-(defun gnus-url-unhex (x)
- (if (> x ?9)
- (if (>= x ?a)
- (+ 10 (- x ?a))
- (+ 10 (- x ?A)))
- (- x ?0)))
-
-(defun gnus-url-unhex-string (str &optional allow-newlines)
- "Remove %XXX embedded spaces, etc in a url.
-If optional second argument ALLOW-NEWLINES is non-nil, then allow the
-decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
- (setq str (or (mm-subst-char-in-string ?+ ? str) ""))
- (let ((tmp "")
- (case-fold-search t))
- (while (string-match "%[0-9a-f][0-9a-f]" str)
- (let* ((start (match-beginning 0))
- (ch1 (gnus-url-unhex (elt str (+ start 1))))
- (code (+ (* 16 ch1)
- (gnus-url-unhex (elt str (+ start 2))))))
- (setq tmp (concat
- tmp (substring str 0 start)
- (cond
- (allow-newlines
- (char-to-string code))
- ((or (= code ?\n) (= code ?\r))
- " ")
- (t (char-to-string code))))
- str (substring str (match-end 0)))))
- (setq tmp (concat tmp str))
- tmp))
-
(defun gnus-url-mailto (url)
;; Send mail to someone
(when (string-match "mailto:/*\\(.*\\)" url)
"Go to the next page."
(interactive)
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
(select-window win)))
"Go to the prev page."
(interactive)
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
(select-window win)))
"Go to the next page."
(interactive "P")
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
(select-window win)))
"Go to the prev page."
(interactive "P")
(let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
+ (select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
(select-window win)))
projects / gnus / blobdiff