+1998-09-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/gnus.el (gnus-version-number): Update to 6.10.012.
+
+ * Sync up with Pterodactyl Gnus 0.18.
+
1998-09-07 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
* lisp/gnus-draft.el (gnus-draft-setup): Do not use message mode.
+Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.18 is released.
+
+1998-09-08 02:21:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-send-and-exit): Return t on success.
+ (message-make-date): Make a proper time zone.
+
+ * gnus-draft.el (gnus-draft-send): Only remove article if the
+ sending is successful.
+
+ * drums.el (drums-get-comment): Return the last comment.
+ (drums-parse-address): Parse old-style From headers.
+
+1998-09-07 SL Baur <steve@altair.xemacs.org>
+
+ * gnus-sum.el (gnus-data-compute-positions): Move below
+ `gnus-save-hidden-threads' so the former is correctly detected as
+ a macro.
+
+1998-09-06 Dave Love <fx@gnu.org>
+
+ * gnus/nnweb.el (require): Wrap requirement of w3 and url in
+ ignore-errors too, eval'd when compile. Require w3 stuff at load
+ time for nicer failure if it's not available.
+
+1998-09-08 00:38:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * time-date.el (time-to-seconds): Renamed.
+
+ * parse-time.el (parse-time-string): Downcase before handling.
+ (parse-time-rules): Times without seconds have 0 seconds.
+
+ * rfc2047.el (rfc2047-encode-region): New version.
+ (rfc2047-dissect-region): New function.
+
+1998-09-07 01:08:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-make-date): Use symbolic zone.
+
+1998-09-06 23:23:06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * time-date.el (parse-time): Always use parse-time.
+
+ * parse-time.el (parse-time-syntax): Use vectors.
+
Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.17 is released.
* message.el (message-caesar-region): Bugged out.
+1998-09-06 Mike McEwan <mike@lotusland.demon.co.uk>
+
+ * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when
+ specifying `agent-predicate' in a group's parameters.
+
Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.16 is released.
(modify-syntax-entry ?\\ "/" table)
(modify-syntax-entry ?< "(" table)
(modify-syntax-entry ?> ")" table)
+ (modify-syntax-entry ?( "(" table)
+ (modify-syntax-entry ?) ")" table)
table))
(defsubst drums-init (string)
(setq result
(buffer-substring
(1+ (point))
- (progn (forward-sexp 1) (1- (point)))))
- (goto-char (point-max)))
+ (progn (forward-sexp 1) (1- (point))))))
(t
(forward-char 1))))
result)))
(defun drums-parse-address (string)
"Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
(with-temp-buffer
- (let (display-name mailbox c)
+ (let (display-name mailbox c display-string)
(drums-init string)
(while (not (eobp))
(setq c (following-char))
(push (buffer-substring
(1+ (point)) (progn (forward-sexp 1) (1- (point))))
display-name))
- ((looking-at (concat "[" drums-atext-token "]"))
- (push (buffer-substring (point) (progn (forward-word 1) (point)))
+ ((looking-at (concat "[" drums-atext-token "@" "]"))
+ (push (buffer-substring (point) (progn (forward-sexp 1) (point)))
display-name))
((eq c ?<)
(setq mailbox
(t (error "Unknown symbol: %c" c))))
;; If we found no display-name, then we look for comments.
(if display-name
- (setq display-name (mapconcat 'identity (nreverse display-name) " "))
- (setq display-name (drums-get-comment string)))
- (when mailbox
+ (setq display-string
+ (mapconcat 'identity (reverse display-name) " "))
+ (setq display-string (drums-get-comment string)))
+ (if (not mailbox)
+ (when (string-match "@" display-string)
+ (cons
+ (mapconcat 'identity (nreverse display-name) "")
+ (drums-get-comment string)))
(cons mailbox display-name)))))
(defun drums-parse-addresses (string)
(defun drums-parse-date (string)
"Return an Emacs time spec from STRING."
- (encode-time (parse-time-string string)))
+ (apply 'encode-time (parse-time-string string)))
(provide 'drums)
(setq category (gnus-group-category group))
(setq predicate
(gnus-get-predicate
- (or (gnus-group-get-parameter group 'agent-predicate)
+ (or (gnus-group-get-parameter group 'agent-predicate t)
(cadr category))))
;; Do we want to download everything, or nothing?
(if (or (eq (caaddr predicate) 'gnus-agent-true)
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
- (cond
- ;; Convert to the local timezone. We have to slap a
- ;; `condition-case' round the calls to the timezone
- ;; functions since they aren't particularly resistant to
- ;; buggy dates.
- ((eq type 'local)
- (concat "Date: " (current-time-string (date-to-time date))))
- ;; Convert to Universal Time.
- ((eq type 'ut)
- (concat "Date: "
- (current-time-string
- (let ((e (parse-time-string date)))
- (setcar (last e) 0)
- (encode-time e)))))
- ;; Get the original date from the article.
- ((eq type 'original)
- (concat "Date: " date))
- ;; Let the user define the format.
- ((eq type 'user)
- (if (gnus-functionp gnus-article-time-format)
- (funcall gnus-article-time-format (date-to-time date))
+ (let ((time (condition-case ()
+ (date-to-time date)
+ (error '(0 0)))))
+ (cond
+ ;; Convert to the local timezone. We have to slap a
+ ;; `condition-case' round the calls to the timezone
+ ;; functions since they aren't particularly resistant to
+ ;; buggy dates.
+ ((eq type 'local)
+ (concat "Date: " (current-time-string time)))
+ ;; Convert to Universal Time.
+ ((eq type 'ut)
+ (concat "Date: "
+ (current-time-string
+ (let ((e (parse-time-string date)))
+ (setcar (last e) 0)
+ (apply 'encode-time e)))))
+ ;; Get the original date from the article.
+ ((eq type 'original)
+ (concat "Date: " date))
+ ;; Let the user define the format.
+ ((eq type 'user)
+ (if (gnus-functionp gnus-article-time-format)
+ (funcall gnus-article-time-format time)
+ (concat
+ "Date: "
+ (format-time-string gnus-article-time-format time))))
+ ;; ISO 8601.
+ ((eq type 'iso8601)
(concat
"Date: "
- (format-time-string gnus-article-time-format (date-to-time date)))))
- ;; ISO 8601.
- ((eq type 'iso8601)
- (concat
- "Date: "
- (format-time-string "%Y%M%DT%h%m%s" (date-to-time date))))
- ;; Do an X-Sent lapsed format.
- ((eq type 'lapsed)
- ;; If the date is seriously mangled, the timezone functions are
- ;; liable to bug out, so we ignore all errors.
- (let* ((now (current-time))
- (real-time (subtract-time now (date-to-time date)))
- (real-sec (and real-time
- (+ (* (float (car real-time)) 65536)
- (cadr real-time))))
- (sec (and real-time (abs real-sec)))
- num prev)
- (cond
- ((null real-time)
- "X-Sent: Unknown")
- ((zerop sec)
- "X-Sent: Now")
- (t
- (concat
- "X-Sent: "
- ;; This is a bit convoluted, but basically we go
- ;; through the time units for years, weeks, etc,
- ;; and divide things to see whether that results
- ;; in positive answers.
- (mapconcat
- (lambda (unit)
- (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
- ;; The (remaining) seconds are too few to
- ;; be divided into this time unit.
- ""
- ;; It's big enough, so we output it.
- (setq sec (- sec (* num (cdr unit))))
- (prog1
- (concat (if prev ", " "") (int-to-string
- (floor num))
- " " (symbol-name (car unit))
- (if (> num 1) "s" ""))
- (setq prev t))))
- article-time-units "")
- ;; If dates are odd, then it might appear like the
- ;; article was sent in the future.
- (if (> real-sec 0)
- " ago"
- " in the future"))))))
- (t
- (error "Unknown conversion type: %s" type))))
+ (format-time-string "%Y%M%DT%h%m%s" time)))
+ ;; Do an X-Sent lapsed format.
+ ((eq type 'lapsed)
+ ;; If the date is seriously mangled, the timezone functions are
+ ;; liable to bug out, so we ignore all errors.
+ (let* ((now (current-time))
+ (real-time (subtract-time now time))
+ (real-sec (and real-time
+ (+ (* (float (car real-time)) 65536)
+ (cadr real-time))))
+ (sec (and real-time (abs real-sec)))
+ num prev)
+ (cond
+ ((null real-time)
+ "X-Sent: Unknown")
+ ((zerop sec)
+ "X-Sent: Now")
+ (t
+ (concat
+ "X-Sent: "
+ ;; This is a bit convoluted, but basically we go
+ ;; through the time units for years, weeks, etc,
+ ;; and divide things to see whether that results
+ ;; in positive answers.
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ;; The (remaining) seconds are too few to
+ ;; be divided into this time unit.
+ ""
+ ;; It's big enough, so we output it.
+ (setq sec (- sec (* num (cdr unit))))
+ (prog1
+ (concat (if prev ", " "") (int-to-string
+ (floor num))
+ " " (symbol-name (car unit))
+ (if (> num 1) "s" ""))
+ (setq prev t))))
+ article-time-units "")
+ ;; If dates are odd, then it might appear like the
+ ;; article was sent in the future.
+ (if (> real-sec 0)
+ " ago"
+ " in the future"))))))
+ (t
+ (error "Unknown conversion type: %s" type)))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
;; (message-remove-header gnus-agent-meta-information-header)))
;; ;; Then we send it. If we have no meta-information, we just send
;; ;; it and let Message figure out how.
-;; (if type
-;; (let ((message-this-is-news (eq type 'news))
-;; (message-this-is-mail (eq type 'mail))
-;; (gnus-post-method method)
-;; (message-post-method method))
-;; (message-send-and-exit))
-;; (message-send-and-exit))))
+;; (when (if type
+;; (let ((message-this-is-news (eq type 'news))
+;; (message-this-is-mail (eq type 'mail))
+;; (gnus-post-method method)
+;; (message-post-method method))
+;; (message-send-and-exit))
+;; (message-send-and-exit))
+;; (let ((gnus-verbose-backends nil))
+;; (gnus-request-expire-articles
+;; (list article) (or group "nndraft:queue") t)))))
;; For draft TEST
(defvar gnus-draft-send-draft-buffer " *send draft*")
(funcall type match (or (aref gnus-advanced-headers index) 0))))
(defun gnus-advanced-date (index match type)
- (let ((date (encode-time (parse-time-string
- (aref gnus-advanced-headers index))))
- (match (encode-time (parse-time-string match))))
+ (let ((date (apply 'encode-time (parse-time-string
+ (aref gnus-advanced-headers index))))
+ (match (apply 'encode-time (parse-time-string match))))
(cond
((eq type 'at)
(equal date match))
(setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
(setq data (cdr data))))
-(defun gnus-data-compute-positions ()
- "Compute the positions of all articles."
- (setq gnus-newsgroup-data-reverse nil)
- (let ((data gnus-newsgroup-data))
- (save-excursion
- (gnus-save-hidden-threads
- (gnus-summary-show-all-threads)
- (goto-char (point-min))
- (while data
- (while (get-text-property (point) 'gnus-intangible)
- (forward-line 1))
- (gnus-data-set-pos (car data) (+ (point) 3))
- (setq data (cdr data))
- (forward-line 1))))))
-
(defun gnus-summary-article-pseudo-p (article)
"Say whether this article is a pseudo article or not."
(not (vectorp (gnus-data-header (gnus-data-find article)))))
,@forms)
(gnus-restore-hidden-threads-configuration ,config)))))
+(defun gnus-data-compute-positions ()
+ "Compute the positions of all articles."
+ (setq gnus-newsgroup-data-reverse nil)
+ (let ((data gnus-newsgroup-data))
+ (save-excursion
+ (gnus-save-hidden-threads
+ (gnus-summary-show-all-threads)
+ (goto-char (point-min))
+ (while data
+ (while (get-text-property (point) 'gnus-intangible)
+ (forward-line 1))
+ (gnus-data-set-pos (car data) (+ (point) 3))
+ (setq data (cdr data))
+ (forward-line 1))))))
+
(defun gnus-hidden-threads-configuration ()
"Return the current hidden threads configuration."
(save-excursion
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.011"
+(defconst gnus-version-number "6.10.012"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.17"
+(defconst gnus-original-version-number "0.18"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
(when (eq buf (current-buffer))
(message-bury buf)))
(message-do-actions actions)
- (message-delete-frame frame org-frame))))
+ (message-delete-frame frame org-frame)
+ t)))
(defun message-dont-send ()
"Don't send the message you have been editing."
(defun message-make-date (&optional now)
"Make a valid data header.
If NOW, use that time instead."
- (format-time-string "%d %b %Y %H:%M:%S %z" (or now (current-time))))
+ (let* ((now (or now (current-time)))
+ (zone (nth 8 (decode-time now)))
+ (sign "+"))
+ ;; We do all of this because XEmacs doesn't have the %z spec.
+ (when (> (/ zone 3600) 12)
+ (setq sign "-"
+ zone (- zone (* 3600 12))))
+ (concat (format-time-string "%d %b %Y %H:%M:%S " (or now (current-time)))
+ (format "%s%02d%02d"
+ sign (/ zone 3600)
+ (% zone 3600)))))
(defun message-make-followup-subject (subject)
"Make a followup Subject."
charsets)
;; We encode.
(t
- (let ((mime-charset (mm-mule-charset-to-mime-charset (car charsets)))
+ (let ((mime-charset
+ (or
+ (coding-system-get
+ (get-charset-property (car charsets) 'prefered-coding-system)
+ 'mime-charset)
+ (car (memq (car charsets)
+ (find-coding-systems-region
+ (point-min) (point-max))))))
start)
(when (or t
;; We always decode.
(when (nndraft-request-article article group server (current-buffer))
(message-remove-header "xref")
(message-remove-header "lines")
- (let ((gnus-verbose-backends nil))
- (nndraft-request-expire-articles (list article) group server t))
t))
(deffoo nndraft-request-update-info (group info &optional server)
(while (and (not (looking-at
"\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
(zerop (forward-line -1))))
- (let ((seconds (time-to-float (date-to-time date)))
+ (let ((seconds (time-to-seconds (date-to-time date)))
groups)
;; Go through lines and add the latest groups to a list.
(while (and (looking-at "\\([^ ]+\\) +[0-9]+ ")
(require 'message)
(require 'gnus-util)
(require 'gnus)
-(require 'w3)
-(require 'url)
(require 'nnmail)
-(ignore-errors
- (require 'w3-forms))
+(eval-when-compile
+ (ignore-errors
+ (require 'w3)
+ (require 'url)
+ (require 'w3-forms)))
+;; Report failure to find w3 at load time if appropriate.
+(eval '(progn
+ (require 'w3)
+ (require 'url)
+ (require 'w3-forms)))
(nnoo-declare nnweb)
(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it
-(put 'parse-time-syntax 'char-table-extra-slots 0)
-
-(defvar parse-time-syntax (make-char-table 'parse-time-syntax))
-(defvar parse-time-digits (make-char-table 'parse-time-syntax))
+(defvar parse-time-syntax (make-vector 256 nil))
+(defvar parse-time-digits (make-vector 256 nil))
;; Byte-compiler warnings
(defvar elt)
(unless (aref parse-time-digits ?0)
(loop for i from ?0 to ?9
- do (set-char-table-range parse-time-digits i (- i ?0))))
+ do (aset parse-time-digits i (- i ?0))))
(unless (aref parse-time-syntax ?0)
(loop for i from ?0 to ?9
- do (set-char-table-range parse-time-syntax i ?0))
+ do (aset parse-time-syntax i ?0))
(loop for i from ?A to ?Z
- do (set-char-table-range parse-time-syntax i ?A))
+ do (aset parse-time-syntax i ?A))
(loop for i from ?a to ?z
- do (set-char-table-range parse-time-syntax i ?a))
- (set-char-table-range parse-time-syntax ?+ 1)
- (set-char-table-range parse-time-syntax ?- -1)
- (set-char-table-range parse-time-syntax ?: ?d)
+ do (aset parse-time-syntax i ?a))
+ (aset parse-time-syntax ?+ 1)
+ (aset parse-time-syntax ?- -1)
+ (aset parse-time-syntax ?: ?d)
)
(defsubst digit-char-p (char)
(setq integer (+ (* integer 10) digit)
index (1+ index)))
(if (/= index end)
- (signal 'parse-error `("not an integer" ,(substring string (or start 0) end)))
+ (signal 'parse-error `("not an integer"
+ ,(substring string (or start 0) end)))
(* sign integer))))))
(defun parse-time-tokenize (string)
list)))
(nreverse list)))
-(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3)
- ("Apr" . 4) ("May" . 5) ("Jun" . 6)
- ("Jul" . 7) ("Aug" . 8) ("Sep" . 9)
- ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))
-(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2)
- ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
-(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0)
- ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t)
- ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t)
- ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t)
- ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t))
+(defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
+ ("apr" . 4) ("may" . 5) ("jun" . 6)
+ ("jul" . 7) ("aug" . 8) ("sep" . 9)
+ ("oct" . 10) ("nov" . 11) ("dec" . 12)))
+(defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2)
+ ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6)))
+(defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0)
+ ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t)
+ ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t)
+ ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t)
+ ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t))
"(zoneinfo seconds-off daylight-savings-time-p)")
(defvar parse-time-rules
(* 60 (parse-integer elt 1 3)))
(if (= (aref elt 0) ?-) -1 1))))
((5 4 3)
- ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-)))
+ ,#'(lambda () (and (stringp elt)
+ (= (length elt) 10)
+ (= (aref elt 4) ?-)
+ (= (aref elt 7) ?-)))
[0 4] [5 7] [8 10])
- ((2 1)
+ ((2 1 0)
,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:)))
- [0 2] [3 5])
+ [0 2] [3 5] ,#'(lambda () 0))
((5) (70 99) ,#'(lambda () (+ 1900 elt))))
"(slots predicate extractor...)")
The values are identical to those of `decode-time', but any values that are
unknown are returned as nil."
(let ((time (list nil nil nil nil nil nil nil nil nil nil))
- (temp (parse-time-tokenize string)))
+ (temp (parse-time-tokenize (downcase string))))
(while temp
(let ((elt (pop temp))
(rules parse-time-rules)
(slots (pop rule))
(predicate (pop rule))
(val))
- (if (and (not (nth (car slots) time)) ;not already set
- (setq val (cond ((and (consp predicate)
- (not (eq (car predicate) 'lambda)))
- (and (numberp elt)
- (<= (car predicate) elt)
- (<= elt (cadr predicate))
- elt))
- ((symbolp predicate)
- (cdr (assoc elt (symbol-value predicate))))
- ((funcall predicate)))))
- (progn
- (setq exit t)
- (while slots
- (let ((new-val (and rule
- (let ((this (pop rule)))
- (if (vectorp this)
- (parse-integer elt (aref this 0) (aref this 1))
- (funcall this))))))
- (rplaca (nthcdr (pop slots) time) (or new-val val))))))))))
+ (when (and (not (nth (car slots) time)) ;not already set
+ (setq val (cond ((and (consp predicate)
+ (not (eq (car predicate)
+ 'lambda)))
+ (and (numberp elt)
+ (<= (car predicate) elt)
+ (<= elt (cadr predicate))
+ elt))
+ ((symbolp predicate)
+ (cdr (assoc elt
+ (symbol-value predicate))))
+ ((funcall predicate)))))
+ (setq exit t)
+ (while slots
+ (let ((new-val (and rule
+ (let ((this (pop rule)))
+ (if (vectorp this)
+ (parse-integer
+ elt (aref this 0) (aref this 1))
+ (funcall this))))))
+ (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))
time))
(provide 'parse-time)
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
- (while (re-search-forward
- (or class "[\000-\007\013\015-\037\200-\377=]") nil t)
+ (while (and (skip-chars-forward
+ (or class "^\000-\007\013\015-\037\200-\377="))
+ (not (eobp)))
(insert
(prog1
- (format "=%x" (char-after (1- (point))))
- (delete-char -1))))
- ;; Fold long lines.
- (goto-char (point-min))
- (end-of-line)
- (while (> (current-column) 72)
- (beginning-of-line)
- (forward-char 72)
- (search-backward "=" (- (point) 2) t)
- (insert "=\n")
- (end-of-line)))))
+ (upcase (format "=%x" (char-after (point))))
+ (delete-char 1))))
+ (when fold
+ ;; Fold long lines.
+ (goto-char (point-min))
+ (end-of-line)
+ (while (> (current-column) 72)
+ (beginning-of-line)
+ (forward-char 72)
+ (search-backward "=" (- (point) 2) t)
+ (insert "=\n")
+ (end-of-line))))))
(defun quoted-printable-encode-string (string)
"QP-encode STRING and return the results."
(iso-8859-2 . Q)
(iso-8859-3 . Q)
(iso-8859-4 . Q)
- (iso-8859-5 . Q)
+ (iso-8859-5 . B)
(koi8-r . Q)
(iso-8859-7 . Q)
(iso-8859-8 . Q)
(defvar rfc2047-encoding-function-alist
'((Q . rfc2047-q-encode-region)
- (B . base64-encode-region)
+ (B . rfc2047-b-encode-region)
(nil . ignore))
"Alist of RFC2047 encodings to encoding functions.")
(defvar rfc2047-q-encoding-alist
- '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "[^-A-Za-z0-9!*+/=_]")
- ("." . "[\000-\007\013\015-\037\200-\377=_?]"))
+ '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/=_")
+ ("." . "^\000-\007\013\015-\037\200-\377=_?"))
"Alist of header regexps and valid Q characters.")
;;;
(setq found t)))
found))
+(defun rfc2047-dissect-region (b e)
+ "Dissect the region between B and E."
+ (let (words)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char (point-min))
+ (while (re-search-forward "[^ \t\n]+" nil t)
+ (push
+ (list (match-beginning 0) (match-end 0)
+ (car
+ (delq 'ascii
+ (find-charset-region (match-beginning 0)
+ (match-end 0)))))
+ words))
+ words)))
+
(defun rfc2047-encode-region (b e)
"Encode all encodable words in REGION."
- (let (prev c start qstart qprev qend)
- (save-excursion
- (goto-char b)
- (while (re-search-forward "[^ \t\n]+" nil t)
- (save-restriction
- (narrow-to-region (match-beginning 0) (match-end 0))
- (goto-char (setq start (point-min)))
- (setq prev nil)
- (while (not (eobp))
- (unless (eq (setq c (char-charset (following-char))) 'ascii)
- (cond
- ((eq c prev)
- )
- ((null prev)
- (setq qstart (or qstart start)
- qend (point-max)
- qprev c)
- (setq prev c))
- (t
- ;(rfc2047-encode start (setq start (point)) prev)
- (setq prev c))))
- (forward-char 1)))
- (when (and (not prev) qstart)
- (rfc2047-encode qstart qend qprev)
- (setq qstart nil)))
- (when qstart
- (rfc2047-encode qstart qend qprev)
- (setq qstart nil)))))
+ (let ((words (rfc2047-dissect-region b e))
+ beg end current word)
+ (while (setq word (pop words))
+ (if (equal (nth 2 word) current)
+ (setq beg (nth 0 word))
+ (when current
+ (rfc2047-encode beg end current))
+ (setq current (nth 2 word)
+ beg (nth 0 word)
+ end (nth 1 word))))
+ (when current
+ (rfc2047-encode beg end current))))
(defun rfc2047-encode-string (string)
"Encode words in STRING."
(defun rfc2047-encode (b e charset)
"Encode the word in the region with CHARSET."
- (let* ((mime-charset (mm-mule-charset-to-mime-charset charset))
- (encoding (cdr (assq mime-charset
- rfc2047-charset-encoding-alist)))
+ (let* ((mime-charset
+ (or
+ (coding-system-get
+ (get-charset-property charset 'prefered-coding-system)
+ 'mime-charset)
+ (car (memq charset (find-coding-systems-region b e)))))
+ (encoding (or (cdr (assq mime-charset
+ rfc2047-charset-encoding-alist))
+ 'B))
(start (concat
"=?" (downcase (symbol-name mime-charset)) "?"
(downcase (symbol-name encoding)) "?")))
(insert "?=\n " start)
(end-of-line)))))
+(defun rfc2047-b-encode-region (b e)
+ "Encode the header contained in REGION with the B encoding."
+ (base64-encode-region b e t))
+
(defun rfc2047-q-encode-region (b e)
"Encode the header contained in REGION with the Q encoding."
(save-excursion
;;; Code:
-(eval-and-compile
- (eval
- '(if (not (string-match "XEmacs" emacs-version))
- (require 'parse-time)
-
- (require 'timezone)
- (defun parse-time-string (date)
- "Convert DATE into time."
- (decode-time
- (condition-case ()
- (let* ((d1 (timezone-parse-date date))
- (t1 (timezone-parse-time (aref d1 3))))
- (apply 'encode-time
- (mapcar (lambda (el)
- (and el (string-to-number el)))
- (list
- (aref t1 2) (aref t1 1) (aref t1 0)
- (aref d1 2) (aref d1 1) (aref d1 0)
- (number-to-string
- (* 60 (timezone-zone-to-minute (aref d1 4))))))))
- ;; If we get an error, then we just return a 0 time.
- (error (list 0 0))))))))
+(require 'parse-time)
(defun date-to-time (date)
"Convert DATE into time."
- (apply 'encode-time (parse-time-string date)))
+ (condition-case ()
+ (apply 'encode-time (parse-time-string date))
+ (error (error "Invalid date: %s" date))))
-(defun time-to-float (time)
+(defun time-to-seconds (time)
"Convert TIME to a floating point number."
(+ (* (car time) 65536.0)
- (cadr time)))
-
-(defun float-to-time (float)
- "Convert FLOAT (a floating point number) to an Emacs time structure."
- (list (floor float 65536)
- (floor (mod float 65536))))
+ (cadr time)
+ (/ (or (caddr time) 0) 1000000.0)))
+
+(defun seconds-to-time (seconds)
+ "Convert SECONDS (a floating point number) to an Emacs time structure."
+ (list (floor seconds 65536)
+ (floor (mod seconds 65536))
+ (floor (* (- seconds (ffloor seconds)) 1000000))))
(defun time-less-p (t1 t2)
"Say whether time T1 is less than time T2."
+1998-09-06 Mike McEwan <mike@lotusland.demon.co.uk>
+
+ * gnus.texi (Category Syntax): Added doc about agent categories
+ and download scoring.
+
1998-09-05 17:36:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Sorting Groups): Change.
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Semi-gnus 6.10.011 Manual
+@settitle Semi-gnus 6.10.012 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Semi-gnus 6.10.011 Manual
+@title Semi-gnus 6.10.012 Manual
@author by Lars Magne Ingebrigtsen
@page
API. So Semi-gnus does not discriminate various language communities.
Oh, if you are a Klingon, please wait Unicode Next Generation.
-This manual corresponds to Semi-gnus 6.10.011.
+This manual corresponds to Semi-gnus 6.10.012.
@end ifinfo
@item
a score rule which (generally) gives you a finer granularity when
deciding what articles to download. (Note that this @dfn{download
-score} is wholly unrelated to normal scores.)
+score} is not necessarily related to normal scores.)
@end enumerate
-A predicate consists of predicates with logical operators sprinkled in
-between.
+A predicate in its simplest form can be a single predicate such as
+@code{true} or @code{false}. These two will download every available
+article or nothing respectively. In the case of these two special
+predicates an additional score rule is superfluous.
+
+Predicates of @code{high} or @code{low} download articles in respect of
+their scores in relationship to @code{gnus-agent-high-score} and
+@code{gnus-agent-low-score} as descibed below.
+
+To gain even finer control of what is to be regarded eligible for
+download a predicate can consist of a number of predicates with logical
+operators sprinkled in between.
Perhaps some examples are in order.
@code{gnus-headers} and @code{gnus-score} dynamic variables are bound to
useful values.
+For example, you could decide that you don't want to download articles
+that were posted more than a certain number of days ago (e.g. posted
+more than @code{gnus-agent-expire-days} ago) you might write a function
+something along the lines of the following:
+
+@lisp
+(defun my-article-old-p ()
+ "Say whether an article is old."
+ (< (time-to-day (date-to-time (mail-header-date gnus-headers)))
+ (- (time-to-day (current-time)) gnus-agent-expire-days)))
+@end lisp
+
+with the predicate then defined as:
+
+@lisp
+(not my-article-old-p)
+@end lisp
+
+or you could append your predicate to the predefined
+@code{gnus-category-predicate-alist} in your @file{~/.gnus.el} or
+wherever. (Note: this would have to be at a point *after*
+@code{gnus-agent} has been loaded via @code{(gnus-agentize)})
+
+@lisp
+(defvar gnus-category-predicate-alist
+ (append gnus-category-predicate-alist
+ '((old . my-article-old-p))))
+@end lisp
+
+and simply specify your predicate as:
+
+@lisp
+(not old)
+@end lisp
+
+If/when using something like the above, be aware that there are many
+misconfigured systems/mailers out there and so an article's date is not
+always a reliable indication of when it was posted. Hell, some people
+just don't give a damm.
+
+
+The above predicates apply to *all* the groups which belong to the
+category. However, if you wish to have a specific predicate for an
+individual group within a category, or you're just too lazy to set up a
+new category, you can enter a group's individual predicate in it's group
+parameters like so:
+
+@lisp
+(agent-predicate . short)
+@end lisp
+
+This is the group parameter equivalent of the agent category
+default. Note that when specifying a single word predicate like this,
+the @code{agent-predicate} specification must be in dotted pair
+notation.
+
+The equivalent of the longer example from above would be:
+
+@lisp
+(agent-predicate or high (and (not low) (not long)))
+@end lisp
+
+The outer parenthesis required in the category specification are not
+entered here as, not being in dotted pair notation, the value of the
+predicate is assumed to be a list.
+
+
Now, the syntax of the download score is the same as the syntax of
normal score files, except that all elements that require actually
seeing the article itself are verboten. This means that only the
-following headers can be scored on: @code{From}, @code{Subject},
-@code{Date}, @code{Xref}, @code{Lines}, @code{Chars}, @code{Message-ID},
-and @code{References}.
+following headers can be scored on: @code{Subject}, @code{From},
+@code{Date}, @code{Message-ID}, @code{References}, @code{Chars},
+@code{Lines}, and @code{Xref}.
+
+As with predicates, the specification of the @code{download score rule}
+to use in respect of a group can be in either the category definition if
+it's to be applicable to all groups in therein, or a group's parameters
+if it's to be specific to that group.
+In both of these places the @code{download score rule} can take one of
+three forms:
+
+@table @code
+@enumerate
+@item
+Score rule
+
+This has the same syntax as a normal gnus score file except only a
+subset of scoring keywords are available as mentioned above.
+
+example:
+
+@itemize @bullet
+@item
+Category specification
+
+@lisp
+(("from"
+ ("Lars Ingebrigtsen" 1000000 nil s))
+("lines"
+ (500 -100 nil <)))
+@end lisp
+@item
+Group Parameter specification
+
+@lisp
+(agent-score ("from"
+ ("Lars Ingebrigtsen" 1000000 nil s))
+ ("lines"
+ (500 -100 nil <)))
+@end lisp
+
+Again, note the omission of the outermost parenthesis here.
+@end itemize
+
+@item
+Agent score file
+
+These score files must *only* contain the permitted scoring keywords
+stated above.
+
+example:
+
+@itemize @bullet
+@item
+Category specification
+
+@lisp
+("~/News/agent.SCORE")
+@end lisp
+
+or perhaps
+
+@lisp
+("~/News/agent.SCORE" "~/News/agent.group.SCORE")
+@end lisp
+
+@item
+Group Parameter specification
+
+@lisp
+(agent-score "~/News/agent.SCORE")
+@end lisp
+
+Additional score files can be specified as above. Need I say anything
+about parenthesis.
+@end itemize
+
+@item
+Use @code{normal} score files
+
+If you dont want to maintain two sets of scoring rules for a group, and
+your desired @code{downloading} criteria for a group are the same as your
+@code{reading} criteria then you can tell the agent to refer to your
+@code{normal} score files when deciding what to download.
+
+These directives in either the category definition or a group's
+parameters will cause the agent to read in all the applicable score
+files for a group, *filtering out* those those sections that do not
+relate to one of the permitted subset of scoring keywords.
+
+@itemize @bullet
+@item
+Category Specification
+
+@lisp
+file
+@end lisp
+
+@item
+Group Parameter specification
+
+@lisp
+(agent-score . file)
+@end lisp
+@end itemize
+@end enumerate
+@end table
+
@node The Category Buffer
@subsubsection The Category Buffer
exits the group.
@item
+The jingle is only played on the second invocation of Gnus.
+
+@item
Solve the halting problem.
@c TODO
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.17 Manual
+@settitle Pterodactyl Message 0.18 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.17 Manual
+@title Pterodactyl Message 0.18 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.17. Message is
+This manual corresponds to Pterodactyl Message 0.18. Message is
distributed with the Gnus distribution bearing the same version number
as this manual has.
projects / elisp / gnus.git- / commitdiff