"^X-Received:" "^Content-length:" "X-precedence:"
"^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:"
"^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:"
- "^X-Abuse-Info:")
+ "^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:")
"*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."
;; Fixme: This isn't the right thing for mixed graphical and and
;; non-graphical frames in a session.
-;; gnus-xmas.el overrides this for XEmacs.
(defcustom gnus-article-x-face-command
(cond
+ ((featurep 'xemacs)
+ (if (or (featurep 'xface)
+ (featurep 'xpm))
+ 'gnus-xmas-article-display-xface
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -"))
((and (fboundp 'image-type-available-p)
(module-installed-p 'x-face-e21))
'x-face-decode-message-header)
((and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm))
'gnus-article-display-xface)
- ((and (not (featurep 'xemacs))
- window-system
+ ((and window-system
(module-installed-p 'x-face-mule))
'x-face-mule-gnus-article-display-x-face)
(gnus-article-compface-xbm
"*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."
- :type '(choice string
- (function-item
- :tag "x-face-decode-message-header (x-face-e21)"
- x-face-decode-message-header)
- (function-item gnus-article-display-xface)
- (function-item x-face-mule-gnus-article-display-x-face)
- function)
+ :type `(choice
+ ,@(let (x-face-e21 x-face-mule)
+ (if (featurep 'xemacs)
+ nil
+ (setq x-face-e21 (module-installed-p 'x-face-e21)
+ x-face-mule (module-installed-p 'x-face-mule)))
+ (delq nil
+ (list
+ 'string
+ (if (and (featurep 'xemacs)
+ (or (featurep 'xface)
+ (featurep 'xpm)))
+ '(function-item gnus-xmas-article-display-xface))
+ (if (and x-face-e21
+ (fboundp 'image-type-available-p))
+ '(function-item
+ :tag "x-face-decode-message-header (x-face-e21)"
+ x-face-decode-message-header))
+ (if x-face-mule
+ '(function-item
+ x-face-mule-gnus-article-display-x-face))
+ 'function))))
;;:version "21.1"
:group 'gnus-article-washing)
:type '(repeat regexp))
(defcustom gnus-unbuttonized-mime-types '(".*/.*")
- "List of MIME types that should not be given buttons when rendered inline."
+ "List of MIME types that should not be given buttons when rendered inline.
+See also `gnus-buttonized-mime-types' which may override this variable."
+ :version "21.1"
+ :group 'gnus-article-mime
+ :type '(repeat regexp))
+
+(defcustom gnus-buttonized-mime-types nil
+ "List of MIME types that should be given buttons when rendered inline.
+If set, this variable overrides `gnus-unbuttonized-mime-types'.
+To see e.g. security buttons you could set this to
+`(\"multipart/signed\")'."
:version "21.1"
:group 'gnus-article-mime
:type '(repeat regexp))
:group 'gnus-article-treat
:type gnus-article-treat-custom)
-(defcustom gnus-treat-hide-citation-maybe nil
- "Hide cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
- :group 'gnus-article-treat
- :type gnus-article-treat-custom)
-
(defcustom gnus-treat-strip-list-identifiers 'head
"Strip list identifiers from `gnus-list-identifiers`.
Valid values are nil, t, `head', `last', an integer or a predicate.
(let ((charset (save-excursion
(set-buffer gnus-summary-buffer)
default-mime-charset)))
- (mime-decode-header-in-buffer charset)
- )))
+ (mime-decode-header-in-buffer charset))))
+
+(defun article-decode-group-name ()
+ "Decode group names in `Newsgroups:'."
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only
+ (method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (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")
+ (nnheader-replace-header "Newsgroups"
+ (gnus-decode-newsgroups
+ (with-current-buffer
+ gnus-original-article-buffer
+ (mail-fetch-field "Newsgroups"))
+ gnus-newsgroup-name method)))
+ (when (mail-fetch-field "Followup-To")
+ (nnheader-replace-header "Followup-To"
+ (gnus-decode-newsgroups
+ (with-current-buffer
+ gnus-original-article-buffer
+ (mail-fetch-field "Followup-To"))
+ gnus-newsgroup-name method))))))
(defun article-de-quoted-unreadable (&optional force read-charset)
"Translate a quoted-printable-encoded article.
face (nth 3 elem))
(while (re-search-forward regexp nil t)
(when (and (match-beginning visible) (match-beginning invisible))
- (push 'emphasis gnus-article-wash-types)
(gnus-article-hide-text
(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
(match-beginning visible) (match-end visible) 'face face)
+ (push 'emphasis gnus-article-wash-types)
(goto-char (match-end invisible)))))))))
(defun gnus-article-setup-highlight-words (&optional highlight-words)
(interactive)
(gnus-article-check-buffer)
(let* ((data (get-text-property (point) 'gnus-data))
- file param)
+ file param
+ (handles gnus-article-mime-handles))
(if (mm-multiple-handles gnus-article-mime-handles)
(error "This function is not implemented"))
(setq file (and data (mm-save-part data)))
(mbl mml-buffer-list))
(setq mml-buffer-list nil)
(insert-buffer gnus-original-article-buffer)
- (mime-to-mml gnus-article-mime-handles)
+ (mime-to-mml ',handles)
(setq gnus-article-mime-handles nil)
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
(let ((gnus-tmp-name
- (or (mail-content-type-get (mm-handle-type handle)
- 'name)
- (mail-content-type-get (mm-handle-disposition handle)
- 'filename)
- (mail-content-type-get (mm-handle-type handle)
- 'url)
+ (or (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get (mm-handle-type handle) 'url)
""))
(gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description
(setq gnus-tmp-type-long (concat gnus-tmp-type
(and (not (equal gnus-tmp-name ""))
(concat "; " gnus-tmp-name))))
- (or (equal gnus-tmp-description "")
- (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
+ (unless (equal gnus-tmp-description "")
+ (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
(unless (bolp)
(insert "\n"))
(setq b (point))
(defun gnus-unbuttonized-mime-type-p (type)
"Say whether TYPE is to be unbuttonized."
(unless gnus-inhibit-mime-unbuttonizing
- (catch 'found
- (let ((types gnus-unbuttonized-mime-types))
- (while types
- (when (string-match (pop types) type)
- (throw 'found t)))))))
+ (when (catch 'found
+ (let ((types gnus-unbuttonized-mime-types))
+ (while types
+ (when (string-match (pop types) type)
+ (throw 'found t)))))
+ (not (catch 'found
+ (let ((types gnus-buttonized-mime-types))
+ (while types
+ (when (string-match (pop types) type)
+ (throw 'found t)))))))))
(defun gnus-article-insert-newline ()
"Insert a newline, but mark it as undeletable."
;; save it to file.
(goto-char (point-max))
(insert "\n")
- (write-region-as-binary (point-min) (point-max) file-name 'append)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system))
+ (write-region-as-binary (point-min) (point-max) file-name 'append))
t)))
(defun gnus-narrow-to-page (&optional arg)
(gnus-request-group gnus-newsgroup-name t)))
(defun gnus-request-article-this-buffer (article group)
- "Get an article and insert it into this buffer."
+ "Get an article and insert it into this buffer.
+T-gnus change: Insert an article into `gnus-original-article-buffer'."
(let (do-update-line sparse-header)
+ ;; The current buffer is `gnus-article-buffer'.
(prog1
(save-excursion
(erase-buffer)
(when (file-directory-p dir)
(setq article 'nneething)
(gnus-group-enter-directory dir))))))))
+ (setq gnus-original-article (cons group article))
+
+ ;; The current buffer is `gnus-original-article-buffer'.
+ (if (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+ (set-buffer-multibyte nil)
+ (buffer-disable-undo)
+ (setq major-mode 'gnus-original-article-mode)
+ (setq buffer-read-only nil))
(cond
;; Refuse to select canceled articles.
(setq gnus-override-method (pop methods)))
(while (not result)
(when (eq gnus-override-method 'current)
- (setq gnus-override-method gnus-current-select-method))
+ (setq gnus-override-method
+ (with-current-buffer gnus-summary-buffer
+ gnus-current-select-method)))
(erase-buffer)
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
;; Associate this article with the current summary buffer.
(setq gnus-article-current-summary gnus-summary-buffer)
- ;; Take the article from the original article buffer
- ;; and place it in the buffer it's supposed to be in.
- (when (and (get-buffer gnus-article-buffer)
- (equal (buffer-name (current-buffer))
- (buffer-name (get-buffer gnus-article-buffer))))
- (save-excursion
- (if (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
- (set-buffer-multibyte nil)
- (buffer-disable-undo)
- (setq major-mode 'gnus-original-article-mode)
- (setq buffer-read-only t))
- (let (buffer-read-only)
- (erase-buffer)
- (insert-buffer-substring gnus-article-buffer))
- (setq gnus-original-article (cons group article)))
+ ;; Copy the requested article from `gnus-original-article-buffer'.
+ (unless (equal (buffer-name (current-buffer))
+ (buffer-name (get-buffer gnus-original-article-buffer)))
+ (insert-buffer gnus-original-article-buffer))
- ;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook)
- ;; Mark article as decoded or not.
- (setq gnus-article-decoded-p gnus-article-decode-hook))
+ ;; Decode charsets.
+ (run-hooks 'gnus-article-decode-hook)
+ ;; Mark article as decoded or not.
+ (setq gnus-article-decoded-p gnus-article-decode-hook)
;; Update sparse articles.
(when (and do-update-line
;;; Internal Variables:
-(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
+(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
("mailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
+ ;; This is info
+ ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t
+ gnus-button-handle-info 2)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
;; Raw URLs.
(integer :tag "Regexp group")))))
(defcustom gnus-header-button-alist
- `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
+ `(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
0 t gnus-button-message-id 0)
("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
(limit (next-single-property-change end 'mime-view-entity
nil (point-max))))
(if (text-property-any end limit 'article-type 'signature)
- (gnus-remove-text-properties-when
- 'article-type 'signature end limit
- (cons 'article-type (cons 'signature
- gnus-hidden-properties)))
+ (progn
+ (setq gnus-article-wash-types
+ (delq 'signature gnus-article-wash-types))
+ (gnus-remove-text-properties-when
+ 'article-type 'signature end limit
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties))))
+ (or (memq 'signature gnus-article-wash-types)
+ (push 'signature gnus-article-wash-types))
(gnus-add-text-properties-when
'article-type nil end limit
(cons 'article-type (cons 'signature
- gnus-hidden-properties)))))))
+ gnus-hidden-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.
(group
(gnus-button-fetch-group url)))))
+(defun gnus-button-handle-info (url)
+ "Fetch an info URL."
+ (if (string-match
+ "^\\([^:/]+\\)?/\\(.*\\)"
+ url)
+ (gnus-info-find-node
+ (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
+ "Gnus")
+ ")"
+ (gnus-url-unhex-string (match-string 2 url))))
+ (error "Can't parse %s" url)))
+
(defun gnus-button-message-id (message-id)
"Fetch MESSAGE-ID."
(save-excursion
(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 "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$"
- address))
+ (if (not
+ (string-match
+ "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?"
+ address))
(error "Can't parse %s" address)
(gnus-group-read-ephemeral-group
(match-string 4 address)
(nntp-address ,(match-string 1 address))
(nntp-port-number ,(if (match-end 3)
(match-string 3 address)
- "nntp")))))))
+ "nntp")))
+ nil nil nil
+ (and (match-end 6) (list (string-to-int (match-string 6 address))))))))
(defun gnus-url-parse-query-string (query &optional downcase)
(let (retval pairs cur key val)
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 str ""))
+ (setq str (or (nnheader-replace-chars-in-string str ?+ ? ) ""))
(let ((tmp "")
(case-fold-search t))
(while (string-match "%[0-9a-f][0-9a-f]" str)
(defun gnus-mime-security-verify-or-decrypt (handle)
(mm-remove-parts (cdr handle))
(let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
- buffer-read-only)
+ point buffer-read-only)
+ (if region
+ (goto-char (car region)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (with-current-buffer (mm-handle-multipart-original-buffer handle)
+ (let* ((mm-verify-option 'known)
+ (mm-decrypt-option 'known)
+ (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+ (unless (eq nparts (cdr handle))
+ (mm-destroy-parts (cdr handle))
+ (setcdr handle nparts))))
+ (setq point (point))
+ (gnus-mime-display-security handle)
+ (goto-char (point-max)))
(when region
- (delete-region (car region) (cdr region))
+ (delete-region (point) (cdr region))
(set-marker (car region) nil)
- (set-marker (cdr region) nil)))
- (with-current-buffer (mm-handle-multipart-original-buffer handle)
- (let* ((mm-verify-option 'known)
- (mm-decrypt-option 'known)
- (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
- (unless (eq nparts (cdr handle))
- (mm-destroy-parts (cdr handle))
- (setcdr handle nparts))))
- (let ((point (point))
- buffer-read-only)
- (gnus-mime-display-security handle)
+ (set-marker (cdr region) nil))
(goto-char point)))
(defun gnus-mime-security-show-details (handle)
gnus-mime-security-button-line-format)
(forward-char -1))
(forward-char)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (gnus-insert-mime-security-button handle))
(delete-region (point)
(or (text-property-not-all
(point) (point-max)
'gnus-line-format
gnus-mime-security-button-line-format)
- (point-max)))
- (gnus-insert-mime-security-button handle))
+ (point-max))))
(if (gnus-buffer-live-p gnus-mime-security-details-buffer)
(with-current-buffer gnus-mime-security-details-buffer
(erase-buffer)
(defun gnus-mime-display-security (handle)
(save-restriction
(narrow-to-region (point) (point))
- (gnus-insert-mime-security-button handle)
+ (unless (gnus-unbuttonized-mime-type-p (car handle))
+ (gnus-insert-mime-security-button handle))
(gnus-mime-display-mixed (cdr handle))
(unless (bolp)
(insert "\n"))
- (let ((gnus-mime-security-button-line-format
- gnus-mime-security-button-end-line-format))
- (gnus-insert-mime-security-button handle))
+ (unless (gnus-unbuttonized-mime-type-p (car handle))
+ (let ((gnus-mime-security-button-line-format
+ gnus-mime-security-button-end-line-format))
+ (gnus-insert-mime-security-button handle)))
(mm-set-handle-multipart-parameter
handle 'gnus-region
(cons (set-marker (make-marker) (point-min))
(defun gnus-article-header-presentation-method (entity situation)
(mime-insert-header entity)
- )
+ (article-decode-group-name))
(set-alist 'mime-header-presentation-method-alist
'gnus-original-article-mode
projects / elisp / gnus.git- / blobdiff