(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
-(defcustom gnus-unread-mark ? ;Whitespace
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ? ;Whitespace
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
(gnus-tmp-replied
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
;; using some other form will lead to serious barfage.
(or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (list 'byte-code "\10\211:\203\17\0\211@ ;\203\16\0A@@\207" ;
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
(vector thread) 2))
(defsubst gnus-article-sort-by-number (h1 h2)
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
rmail-summary-exists rmail-select-summary
rmail-update-summary url-retrieve
temp-directory babel-fetch babel-wash
- find-coding-systems-for-charsets sc-cite-regexp
- pop3-get-message-count))
+ find-coding-systems-for-charsets sc-cite-regexp))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
w3-meta-charset-content-type-regexp
babel-translations babel-history
display-time-mail-function))
- (maybe-fbind '(color-instance-rgb-components temp-directory
- glyph-width annotation-glyph window-pixel-width glyph-height
- window-pixel-height map-extents
- make-color-instance color-instance-name specifier-instance
- device-type device-class get-popup-menu-response event-object
- x-defined-colors read-color add-submenu set-font-family
- font-create-object set-font-size frame-device find-face
- set-extent-property make-extent characterp display-error
- set-face-doc-string frame-property face-doc-string
- button-press-event-p next-command-event
- widget-make-intangible glyphp make-glyph set-glyph-image
- set-glyph-property event-glyph glyph-property event-point
- device-on-window-system-p make-gui-button Info-goto-node
- pp-to-string color-name
- gnus-mule-get-coding-system decode-coding-string
- mail-aliases-setup
- mm-copy-tree url-view-url w3-prepare-buffer
- mule-write-region-no-coding-system char-int
- annotationp delete-annotation make-image-specifier
- make-annotation events-to-keys
- w3-do-setup w3-region
- w3-coding-system-for-mime-charset
- rmail-summary-exists rmail-select-summary rmail-update-summary
- url-generic-parse-url valid-image-instantiator-format-p
- babel-fetch babel-wash babel-as-string sc-cite-regexp
- pop3-get-message-count)))
+ (maybe-fbind '(color-instance-rgb-components
+ temp-directory
+ glyph-width annotation-glyph window-pixel-width glyph-height
+ window-pixel-height map-extents
+ make-color-instance color-instance-name specifier-instance
+ device-type device-class get-popup-menu-response event-object
+ x-defined-colors read-color add-submenu set-font-family
+ font-create-object set-font-size frame-device find-face
+ set-extent-property make-extent characterp display-error
+ set-face-doc-string frame-property face-doc-string
+ button-press-event-p next-command-event
+ widget-make-intangible glyphp make-glyph set-glyph-image
+ set-glyph-property event-glyph glyph-property event-point
+ device-on-window-system-p make-gui-button Info-goto-node
+ pp-to-string color-name
+ gnus-mule-get-coding-system decode-coding-string
+ mail-aliases-setup
+ mm-copy-tree url-view-url w3-prepare-buffer
+ mule-write-region-no-coding-system char-int
+ annotationp delete-annotation make-image-specifier
+ make-annotation events-to-keys
+ w3-do-setup w3-region
+ w3-coding-system-for-mime-charset
+ rmail-summary-exists rmail-select-summary rmail-update-summary
+ url-generic-parse-url valid-image-instantiator-format-p
+ babel-fetch babel-wash babel-as-string sc-cite-regexp)))
(setq load-path (cons "." load-path))
(require 'custom)
+++ /dev/null
-;;; mail-header.el --- Mail header parsing, merging, formatting
-
-;; Copyright (C) 1996 by Free Software Foundation, Inc.
-
-;; Author: Erik Naggum <erik@arcana.naggum.no>
-;; Keywords: tools, mail, news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package provides an abstraction to RFC822-style messages, used in
-;; mail news, and some other systems. The simple syntactic rules for such
-;; headers, such as quoting and line folding, are routinely reimplemented
-;; in many individual packages. This package removes the need for this
-;; redundancy by representing message headers as association lists,
-;; offering functions to extract the set of headers from a message, to
-;; parse individual headers, to merge sets of headers, and to format a set
-;; of headers.
-
-;; The car of each element in the message-header alist is a symbol whose
-;; print name is the name of the header, in all lower-case. The cdr of an
-;; element depends on the operation. After extracting headers from a
-;; message, it is a string, the value of the header. An extracted set of
-;; headers may be parsed further, which may turn it into a list, whose car
-;; is the original value and whose subsequent elements depend on the
-;; header. For formatting, it is evaluated to obtain the strings to be
-;; inserted. For merging, one set of headers consists of strings, while
-;; the other set will be evaluated with the symbols in the first set of
-;; headers bound to their respective values.
-
-;;; Code:
-
-(require 'cl)
-
-;; Make the byte-compiler shut up.
-(defvar headers)
-
-(defun mail-header-extract ()
- "Extract headers from current buffer after point.
-Returns a header alist, where each element is a cons cell (name . value),
-where NAME is a symbol, and VALUE is the string value of the header having
-that name."
- (let ((message-headers ()) (top (point))
- start end)
- (while (and (setq start (point))
- (> (skip-chars-forward "^\0- :") 0)
- (eq (char-after) ?:)
- (setq end (point))
- (progn (forward-char)
- (> (skip-chars-forward " \t") 0)))
- (let ((header (intern (downcase (buffer-substring start end))))
- (value (list (buffer-substring
- (point) (progn (end-of-line) (point))))))
- (while (progn (forward-char) (> (skip-chars-forward " \t") 0))
- (push (buffer-substring (point) (progn (end-of-line) (point)))
- value))
- (push (if (cdr value)
- (cons header (mapconcat #'identity (nreverse value) " "))
- (cons header (car value)))
- message-headers)))
- (goto-char top)
- (nreverse message-headers)))
-
-(defun mail-header-extract-no-properties ()
- "Extract headers from current buffer after point, without properties.
-Returns a header alist, where each element is a cons cell (name . value),
-where NAME is a symbol, and VALUE is the string value of the header having
-that name."
- (mapcar
- (lambda (elt)
- (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
- elt)
- (mail-header-extract)))
-
-(defun mail-header-parse (parsing-rules headers)
- "Apply PARSING-RULES to HEADERS.
-PARSING-RULES is an alist whose keys are header names (symbols) and whose
-value is a parsing function. The function takes one argument, a string,
-and return a list of values, which will destructively replace the value
-associated with the key in HEADERS, after being prepended with the original
-value."
- (dolist (rule parsing-rules)
- (let ((header (assq (car rule) headers)))
- (when header
- (if (consp (cdr header))
- (setf (cddr header) (funcall (cdr rule) (cadr header)))
- (setf (cdr header)
- (cons (cdr header) (funcall (cdr rule) (cdr header))))))))
- headers)
-
-(defsubst mail-header (header &optional header-alist)
- "Return the value associated with header HEADER in HEADER-ALIST.
-If the value is a string, it is the original value of the header. If the
-value is a list, its first element is the original value of the header,
-with any subsequent elements being the result of parsing the value.
-If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
- (cdr (assq header (or header-alist headers))))
-
-(defun mail-header-set (header value &optional header-alist)
- "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
-HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
-See `mail-header' for the semantics of VALUE."
- (let* ((alist (or header-alist headers))
- (entry (assq header alist)))
- (if entry
- (setf (cdr entry) value)
- (nconc alist (list (cons header value)))))
- value)
-
-(defsetf mail-header (header &optional header-alist) (value)
- `(mail-header-set ,header ,value ,header-alist))
-
-(defun mail-header-merge (merge-rules headers)
- "Return a new header alist with MERGE-RULES applied to HEADERS.
-MERGE-RULES is an alist whose keys are header names (symbols) and whose
-values are forms to evaluate, the results of which are the new headers. It
-should be a string or a list of string. The first element may be nil to
-denote that the formatting functions must use the remaining elements, or
-skip the header altogether if there are no other elements.
- The macro `mail-header' can be used to access headers in HEADERS."
- (mapcar
- (lambda (rule)
- (cons (car rule) (eval (cdr rule))))
- merge-rules))
-
-(defvar mail-header-format-function
- (lambda (header value)
- "Function to format headers without a specified formatting function."
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")))
-
-(defun mail-header-format (format-rules headers)
- "Use FORMAT-RULES to format HEADERS and insert into current buffer.
-FORMAT-RULES is an alist whose keys are header names (symbols), and whose
-values are functions that format the header, the results of which are
-inserted, unless it is nil. The function takes two arguments, the header
-symbol, and the value of that header. If the function itself is nil, the
-default action is to insert the value of the header, unless it is nil.
-The headers are inserted in the order of the FORMAT-RULES.
-A key of t represents any otherwise unmentioned headers.
-A key of nil has as its value a list of defaulted headers to ignore."
- (let ((ignore (append (cdr (assq nil format-rules))
- (mapcar #'car format-rules))))
- (dolist (rule format-rules)
- (let* ((header (car rule))
- (value (mail-header header)))
- (cond ((null header) 'ignore)
- ((eq header t)
- (dolist (defaulted headers)
- (unless (memq (car defaulted) ignore)
- (let* ((header (car defaulted))
- (value (cdr defaulted)))
- (if (cdr rule)
- (funcall (cdr rule) header value)
- (funcall mail-header-format-function header value))))))
- (value
- (if (cdr rule)
- (funcall (cdr rule) header value)
- (funcall mail-header-format-function header value))))))
- (insert "\n")))
-
-(provide 'mailheader)
-
-;;; mail-header.el ends here
projects / gnus / commitdiff