longer (in lines) than that number. If it is a function, the function
will be called without any parameters, and if it returns nil, there is
no signature in the buffer. If it is a string, it will be used as a
-regexp. If it matches, the text in question is not a signature."
+regexp. If it matches, the text in question is not a signature.
+
+This can also be a list of the above values."
:type '(choice (integer :value 200)
(number :value 4.0)
(function :value fun)
(format format (car spec) (car (cdr spec)))
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
types)
- ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
- 2 3 gnus-emphasis-strikethru)
("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
2 3 gnus-emphasis-underline)))
"*Alist that says how to fontify certain phrases.
"Face used for displaying highlighted words."
:group 'gnus-article-emphasis)
-(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
"Format for display of Date headers in article bodies.
See `format-time-string' for the possible values.
The variable can also be function, which should return a complete Date
header. The function is called with one argument, the time, which can
be fed to `format-time-string'."
- :type '(choice string symbol)
+ :type '(choice string function)
:link '(custom-manual "(gnus)Article Date")
:group 'gnus-article-washing)
:group 'gnus-article-mime
:type 'boolean)
-(defcustom gnus-mime-recompute-hierarchical-structure nil
- "Non-nil means recompute article's hierarchical MIME structure.
-The hierarchy numbers will be displayed in MIME buttons."
- :group 'gnus-article-mime
- :type 'boolean)
-
(defcustom gnus-body-boundary-delimiter "_"
"String used to delimit header and body.
This variable is used by `gnus-article-treat-body-boundary' which can
:type '(choice (item :tag "None" :value nil)
string))
-(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
+ "/usr/share/picons")
"Defines the location of the faces database.
For information on obtaining this database of pretty pictures, please
see http://www.cs.indiana.edu/picons/ftp/index.html"
:type 'function)
(defcustom gnus-mime-multipart-functions nil
- "An alist of MIME types to functions to display them.
-Consider using `gnus-mime-accumulate-hierarchy' for each MIME handle
-when defining your function. For example:
-
-\(setq gnus-mime-multipart-functions
- (list (cons \"multipart/examples\"
- (lambda (handles)
- (dolist (handle (cdr handles))
- (gnus-mime-accumulate-hierarchy handle)
- (function-to-display-an-example handle))))))"
+ "An alist of MIME types to functions to display them."
:version "21.1"
:group 'gnus-article-mime
:type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
(defvar gnus-article-mime-handle-alist nil)
(defvar article-lapsed-timer nil)
(defvar gnus-article-current-summary nil)
-(defvar gnus-article-mime-hierarchy nil)
-(defvar gnus-article-mime-hierarchy-next nil)
(defvar gnus-article-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(when (eq 1 (point-min))
(set-window-start (get-buffer-window (current-buffer)) 1)))
(unless gnus-inhibit-hiding
- (save-excursion
- (save-restriction
- (let ((inhibit-read-only t)
- (case-fold-search t)
- (max (1+ (length gnus-sorted-header-list)))
- (ignored (when (not gnus-visible-headers)
- (cond ((stringp gnus-ignored-headers)
- gnus-ignored-headers)
- ((listp gnus-ignored-headers)
- (mapconcat 'identity gnus-ignored-headers
- "\\|")))))
- (visible
- (cond ((stringp gnus-visible-headers)
- gnus-visible-headers)
- ((and gnus-visible-headers
- (listp gnus-visible-headers))
- (mapconcat 'identity gnus-visible-headers "\\|"))))
- (inhibit-point-motion-hooks t)
- beg)
+ (let ((inhibit-read-only t)
+ (case-fold-search t)
+ (max (1+ (length gnus-sorted-header-list)))
+ (inhibit-point-motion-hooks t)
+ (cur (current-buffer))
+ ignored visible beg)
+ (save-excursion
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
+ ;; group parameters, so we should go to the summary buffer.
+ (when (prog1
+ (condition-case nil
+ (progn (set-buffer gnus-summary-buffer) t)
+ (error nil))
+ (setq ignored (when (not gnus-visible-headers)
+ (cond ((stringp gnus-ignored-headers)
+ gnus-ignored-headers)
+ ((listp gnus-ignored-headers)
+ (mapconcat 'identity
+ gnus-ignored-headers
+ "\\|"))))
+ visible (cond ((stringp gnus-visible-headers)
+ gnus-visible-headers)
+ ((and gnus-visible-headers
+ (listp gnus-visible-headers))
+ (mapconcat 'identity
+ gnus-visible-headers
+ "\\|")))))
+ (set-buffer cur))
+ (save-restriction
;; First we narrow to just the headers.
(article-narrow-to-head)
;; Hide any "From " lines at the beginning of (mail) articles.
(save-restriction
(mail-narrow-to-head)
(while (gnus-article-goto-header "Face")
- (push (mail-header-field-value) faces))))
+ (setq faces (nconc faces (list (mail-header-field-value)))))))
(while (setq face (pop faces))
(let ((png (gnus-convert-face-to-png face))
image)
buffer-read-only)
(article-narrow-to-head)
(goto-char (point-min))
- (while (re-search-forward "\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
+ (while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
(let (ace unicode)
(when (save-match-data
(and (setq ace (match-string 1))
(save-excursion
(and (re-search-backward "^[^ \t]" nil t)
(looking-at "From\\|To\\|Cc")))
- (save-excursion (backward-char)
- (message-idna-inside-rhs-p))
(setq unicode (idna-to-unicode ace))))
(unless (string= ace unicode)
(replace-match unicode nil nil nil 1)))))))))
(article-really-strip-banner
(gnus-parameter-banner gnus-newsgroup-name)))
(when gnus-article-address-banner-alist
- (article-really-strip-banner
- (let ((from (save-restriction
- (widen)
- (article-narrow-to-head)
- (mail-fetch-field "from"))))
- (when (and from
- (setq from
- (caar (mail-header-parse-addresses from))))
- (catch 'found
- (dolist (pair gnus-article-address-banner-alist)
- (when (string-match (car pair) from)
- (throw 'found (cdr pair)))))))))))))
+ ;; It is necessary to encode from fields before checking,
+ ;; because `mail-header-parse-addresses' does not work
+ ;; (reliably) on decoded headers. And more, it is
+ ;; impossible to use `gnus-fetch-original-field' here,
+ ;; because `article-strip-banner' may be called in draft
+ ;; buffers to preview them.
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (mail-fetch-field "from"))))
+ (when (and from
+ (setq from
+ (caar (mail-header-parse-addresses
+ (mail-encode-encoded-word-string from)))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found
+ (article-really-strip-banner (cdr pair)))))))))))))
(defun article-really-strip-banner (banner)
"Strip the banner specified by the argument."
(forward-line -1)
;; Do highlighting.
(when (looking-at "\\([^:]+\\): *\\(.*\\)$")
- (put-text-property (match-beginning 1) (1+ (match-end 1))
- 'original-date date)
- (put-text-property (match-beginning 1) (1+ (match-end 1))
- 'face bface)
+ (add-text-properties (match-beginning 1) (1+ (match-end 1))
+ (list 'original-date date 'face bface))
(put-text-property (match-beginning 2) (match-end 2)
'face eface))))))))
(cond
;; Convert to the local timezone.
((eq type 'local)
- (let ((tz (car (current-time-zone time))))
- (format "Date: %s %s%02d%02d" (current-time-string time)
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
- (/ (% (abs tz) 3600) 60))))
+ (concat "Date: " (message-make-date time)))
;; Convert to Universal Time.
((eq type 'ut)
(concat "Date: "
- (current-time-string
- (let* ((e (parse-time-string date))
- (tm (apply 'encode-time e))
- (ms (car tm))
- (ls (- (cadr tm) (car (current-time-zone time)))))
- (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
- ((> ls 65535) (list (1+ ms) (- ls 65536)))
- (t (list ms ls)))))
- " UT"))
+ (substring
+ (message-make-date
+ (let* ((e (parse-time-string date))
+ (tm (apply 'encode-time e))
+ (ms (car tm))
+ (ls (- (cadr tm) (car (current-time-zone time)))))
+ (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+ ((> ls 65535) (list (1+ ms) (- ls 65536)))
+ (t (list ms ls)))))
+ 0 -5)
+ "UT"))
;; Get the original date from the article.
((eq type 'original)
(concat "Date: " (if (string-match "\n+$" date)
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
- (make-local-variable 'gnus-article-mime-hierarchy)
(gnus-set-default-directory)
(buffer-disable-undo)
- (setq buffer-read-only t)
+ (setq buffer-read-only t
+ show-trailing-whitespace nil)
(set-syntax-table gnus-article-mode-syntax-table)
(gnus-run-hooks 'gnus-article-mode-hook))
(setq gnus-article-buffer name)
(setq gnus-original-article-buffer original)
(setq gnus-article-mime-handle-alist nil)
- (setq gnus-article-mime-hierarchy nil
- gnus-article-mime-hierarchy-next nil)
;; This might be a variable local to the summary buffer.
(unless gnus-single-article-buffer
(save-excursion
(or (mail-content-type-get (mm-handle-disposition data) 'filename)
none))
(type (mm-handle-media-type data)))
+ (unless data
+ (error "No MIME part under point"))
(with-current-buffer (mm-handle-buffer data)
(let ((bsize (format "%s" (buffer-size))))
(erase-buffer)
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
- (prog1
- `(keymap ,gnus-mime-button-map
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle)
- (when gnus-mime-recompute-hierarchical-structure
- (setq gnus-tmp-id (mapconcat 'number-to-string
- (car (nth (1- gnus-tmp-id)
- gnus-article-mime-hierarchy))
- ".")))))
+ `(keymap ,gnus-mime-button-map
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ article-type annotation
+ gnus-data ,handle))
(setq e (if (bolp)
;; Exclude a newline.
(1- (point))
:group 'gnus-article-mime
:type 'boolean)
-(defun gnus-mime-accumulate-hierarchy (handle &optional single)
- "Accumulate the MIME hierarchy."
- (when gnus-mime-recompute-hierarchical-structure
- (prog1
- (setq gnus-article-mime-hierarchy
- (nconc
- gnus-article-mime-hierarchy
- (list
- (cons
- (or
- gnus-article-mime-hierarchy-next
- (if gnus-article-mime-hierarchy
- (let ((last (1- (length gnus-article-mime-hierarchy))))
- (prog1
- (setq last
- (copy-sequence
- (car (nth last
- gnus-article-mime-hierarchy))))
- (setq last (nthcdr (1- (length last)) last))
- (setcar last (1+ (car last)))))
- (list 1)))
- ;; A placeholder which may be replaced with `handle'.
- nil))))
- (if (and single
- (not (member (mm-handle-media-type handle)
- '("message/rfc822"))))
- (let ((last (copy-sequence
- (car (nth (1- (length gnus-article-mime-hierarchy))
- gnus-article-mime-hierarchy)))))
- (setq gnus-article-mime-hierarchy-next last
- last (nthcdr (1- (length last)) last))
- (setcar last (1+ (car last))))
- (setq gnus-article-mime-hierarchy-next nil)))))
-
-(defun gnus-mime-enter-multipart ()
- (when gnus-mime-recompute-hierarchical-structure
- (setq gnus-article-mime-hierarchy-next
- (cond (gnus-article-mime-hierarchy-next
- (nconc gnus-article-mime-hierarchy-next (list 1)))
- (gnus-article-mime-hierarchy
- (append (car (nth (1- (length gnus-article-mime-hierarchy))
- gnus-article-mime-hierarchy))
- (list 1)))
- (t
- (list 1))))))
-
-(defun gnus-mime-leave-multipart ()
- (when gnus-mime-recompute-hierarchical-structure
- (setq gnus-article-mime-hierarchy-next
- (when gnus-article-mime-hierarchy
- (let ((last (car (nth (1- (length gnus-article-mime-hierarchy))
- gnus-article-mime-hierarchy))))
- (when (cdr last)
- (prog1
- (setq last (butlast last))
- (setq last (nthcdr (1- (length last)) last))
- (setcar last (1+ (car last))))))))))
-
(defun gnus-mime-display-part (handle)
- (if (not (stringp (car handle)))
- ;; Single part.
- (progn
- (gnus-mime-accumulate-hierarchy handle t)
- (gnus-mime-display-single handle))
- (gnus-mime-enter-multipart)
- (prog1
- (cond
- ;; User-defined multipart
- ((cdr (assoc (car handle) gnus-mime-multipart-functions))
- (gnus-mime-accumulate-hierarchy handle)
- (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
- handle))
- ;; multipart/alternative
- ((and (equal (car handle) "multipart/alternative")
- (not (or gnus-mime-display-multipart-as-mixed
- gnus-mime-display-multipart-alternative-as-mixed)))
- (gnus-mime-accumulate-hierarchy handle)
- (let ((id (1+ (length gnus-article-mime-handle-alist))))
- (push (cons id handle) gnus-article-mime-handle-alist)
- (gnus-mime-display-alternative (cdr handle) nil nil id)))
- ;; multipart/related
- ((and (equal (car handle) "multipart/related")
- (not (or gnus-mime-display-multipart-as-mixed
- gnus-mime-display-multipart-related-as-mixed)))
- (gnus-mime-accumulate-hierarchy handle)
- ;;;!!!We should find the start part, but we just default
- ;;;!!!to the first part.
- ;;(gnus-mime-display-part (cadr handle))
- ;;;!!! Most multipart/related is an HTML message plus images.
- ;;;!!! Unfortunately we are unable to let W3 display those
- ;;;!!! included images, so we just display it as a mixed multipart.
- ;;(gnus-mime-display-mixed (cdr handle))
- ;;;!!! No, w3 can display everything just fine.
- (gnus-mime-display-part (cadr handle)))
- ((equal (car handle) "multipart/signed")
- (gnus-mime-accumulate-hierarchy handle)
- (gnus-add-wash-type 'signed)
- (gnus-mime-display-security handle))
- ((equal (car handle) "multipart/encrypted")
- (gnus-mime-accumulate-hierarchy handle)
- (gnus-add-wash-type 'encrypted)
- (gnus-mime-display-security handle))
- ;; Other multiparts are handled like multipart/mixed.
- (t
- (gnus-mime-display-mixed (cdr handle))))
- (gnus-mime-leave-multipart))))
+ (cond
+ ;; Single part.
+ ((not (stringp (car handle)))
+ (gnus-mime-display-single handle))
+ ;; User-defined multipart
+ ((cdr (assoc (car handle) gnus-mime-multipart-functions))
+ (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
+ handle))
+ ;; multipart/alternative
+ ((and (equal (car handle) "multipart/alternative")
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-alternative-as-mixed)))
+ (let ((id (1+ (length gnus-article-mime-handle-alist))))
+ (push (cons id handle) gnus-article-mime-handle-alist)
+ (gnus-mime-display-alternative (cdr handle) nil nil id)))
+ ;; multipart/related
+ ((and (equal (car handle) "multipart/related")
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-related-as-mixed)))
+ ;;;!!!We should find the start part, but we just default
+ ;;;!!!to the first part.
+ ;;(gnus-mime-display-part (cadr handle))
+ ;;;!!! Most multipart/related is an HTML message plus images.
+ ;;;!!! Unfortunately we are unable to let W3 display those
+ ;;;!!! included images, so we just display it as a mixed multipart.
+ ;;(gnus-mime-display-mixed (cdr handle))
+ ;;;!!! No, w3 can display everything just fine.
+ (gnus-mime-display-part (cadr handle)))
+ ((equal (car handle) "multipart/signed")
+ (gnus-add-wash-type 'signed)
+ (gnus-mime-display-security handle))
+ ((equal (car handle) "multipart/encrypted")
+ (gnus-add-wash-type 'encrypted)
+ (gnus-mime-display-security handle))
+ ;; Other multiparts are handled like multipart/mixed.
+ (t
+ (gnus-mime-display-mixed (cdr handle)))))
(defun gnus-mime-part-function (handles)
(if (stringp (car handles))
(gnus-add-text-properties
(setq from (point))
(progn
- (insert (format "%s. "
- (if gnus-mime-recompute-hierarchical-structure
- (mapconcat
- 'number-to-string
- (car (nth (1- id)
- gnus-article-mime-hierarchy))
- ".")
- id)))
+ (insert (format "%d. " id))
(point))
`(gnus-callback
(lambda (handles)
(save-excursion
(save-restriction
(widen)
+ (forward-line)
(eobp)))) ;Real end-of-buffer?
(progn
(when gnus-article-over-scroll
(interactive "P")
(let ((article (cdr gnus-article-current))
contents)
- (if (not (gnus-mark-active-p))
+ (if (not (gnus-region-active-p))
(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-mark-active-p))
+ (if (not (gnus-region-active-p))
(with-current-buffer gnus-summary-buffer
(gnus-summary-followup (list (list article))))
(setq contents (buffer-substring (point) (mark t)))
(gnus-button-url-regexp
0 (>= gnus-button-browse-level 0) browse-url 0)
;; man pages
- ("\\b\\([a-z][a-z]+\\)([1-9])\\W"
+ ("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
gnus-button-handle-man 1)
;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
- ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W"
+ ("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
gnus-button-handle-man 1)
;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
- ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
+ ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"
0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
;; MID or mail: To avoid too many false positives we don't try to catch
;; all kind of allowed MIDs or mail addresses. Domain part must contain
(defun gnus-button-handle-man (url)
"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]*).*\\'" "")))
+ (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
(funcall gnus-button-man-handler url))
(defun gnus-button-handle-info-url (url)
projects / elisp / gnus.git- / blobdiff