From: yamaoka Date: Tue, 8 Sep 1998 05:00:23 +0000 (+0000) Subject: Sync up with Pterodactyl Gnus 0.18. X-Git-Tag: pgnus-ichikawa-199811302358~225 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=96b0a2e74314b6edb32cb2e54562adfc9acce90b;p=elisp%2Fgnus.git- Sync up with Pterodactyl Gnus 0.18. A snapshot is available from ftp://ftp.jpl.org/pub/tmp/semi-gnus-pgnus-ichikawa-19980908-1.tar.gz --- diff --git a/ChangeLog b/ChangeLog index 2fbdeaf..0afc405 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +1998-09-08 Katsumi Yamaoka + + * lisp/gnus.el (gnus-version-number): Update to 6.10.012. + + * Sync up with Pterodactyl Gnus 0.18. + 1998-09-07 Tatsuya Ichikawa * lisp/gnus-draft.el (gnus-draft-setup): Do not use message mode. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 93fb80e..06e1752 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,50 @@ +Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.18 is released. + +1998-09-08 02:21:36 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 + + * 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 + + * message.el (message-make-date): Use symbolic zone. + +1998-09-06 23:23:06 Lars Magne Ingebrigtsen + + * 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 * gnus.el: Pterodactyl Gnus v0.17 is released. @@ -83,6 +130,11 @@ Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen * message.el (message-caesar-region): Bugged out. +1998-09-06 Mike McEwan + + * 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 * gnus.el: Pterodactyl Gnus v0.16 is released. diff --git a/lisp/drums.el b/lisp/drums.el index 1f45a89..0344956 100644 --- a/lisp/drums.el +++ b/lisp/drums.el @@ -56,6 +56,8 @@ (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) @@ -110,8 +112,7 @@ (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))) @@ -119,7 +120,7 @@ (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)) @@ -133,8 +134,8 @@ (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 @@ -146,9 +147,14 @@ (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) @@ -179,7 +185,7 @@ (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) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 3c2df6e..cf6b1bd 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -912,7 +912,7 @@ the actual number of articles toggled is returned." (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) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 817b224..45227b1 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1282,80 +1282,83 @@ how much time has lapsed since DATE." (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." diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 7cef406..d4995b2 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -132,13 +132,16 @@ ;; (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*") diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index 58dfb09..2c5517a 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -164,9 +164,9 @@ (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)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 8a034cf..8cadcfc 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2041,21 +2041,6 @@ The following commands are available: (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))))) @@ -2223,6 +2208,21 @@ marks of articles." ,@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 diff --git a/lisp/gnus.el b/lisp/gnus.el index 67d581f..bbf0cc5 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -253,10 +253,10 @@ is restarted, and sometimes reloaded." (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" diff --git a/lisp/message.el b/lisp/message.el index 855adf2..be70d14 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2031,7 +2031,8 @@ The text will also be indented the normal way." (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." @@ -2833,7 +2834,17 @@ to find out how to use this." (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." diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 23ee6f6..c74994e 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -51,7 +51,14 @@ If no encoding was done, nil is returned." 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. diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 39c6e28..d2489ee 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -130,8 +130,6 @@ (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) diff --git a/lisp/nnspool.el b/lisp/nnspool.el index dd0b28a..b2075be 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -279,7 +279,7 @@ there.") (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]+ ") diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 96784c2..4ab9ec4 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -34,11 +34,17 @@ (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) diff --git a/lisp/parse-time.el b/lisp/parse-time.el index e25abbb..2871623 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -38,10 +38,8 @@ (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) @@ -49,18 +47,18 @@ (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) @@ -89,7 +87,8 @@ (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) @@ -114,17 +113,17 @@ 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 @@ -150,11 +149,14 @@ (* 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...)") @@ -163,7 +165,7 @@ 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) @@ -173,25 +175,27 @@ unknown are returned as nil." (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) diff --git a/lisp/qp.el b/lisp/qp.el index 58dfb36..ea88dbd 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -65,21 +65,23 @@ matched by that regexp." (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." diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 0fe7328..907a084 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -55,7 +55,7 @@ The values can be: (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) @@ -73,13 +73,13 @@ Valid encodings are nil, `Q' and `B'.") (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.") ;;; @@ -140,36 +140,36 @@ Should be called narrowed to the head of the message." (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." @@ -180,9 +180,15 @@ Should be called narrowed to the head of the message." (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)) "?"))) @@ -204,6 +210,10 @@ Should be called narrowed to the head of the message." (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 diff --git a/lisp/time-date.el b/lisp/time-date.el index cd6f9e9..4f07bbc 100644 --- a/lisp/time-date.el +++ b/lisp/time-date.el @@ -24,42 +24,25 @@ ;;; 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." diff --git a/texi/ChangeLog b/texi/ChangeLog index cac38a8..ef1680a 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +1998-09-06 Mike McEwan + + * gnus.texi (Category Syntax): Added doc about agent categories + and download scoring. + 1998-09-05 17:36:14 Lars Magne Ingebrigtsen * gnus.texi (Sorting Groups): Change. diff --git a/texi/gnus.texi b/texi/gnus.texi index 24cb4bc..1f06379 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \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 @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.011 Manual +@title Semi-gnus 6.10.012 Manual @author by Lars Magne Ingebrigtsen @page @@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE 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 @@ -11568,11 +11568,21 @@ are eligible for downloading; and @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. @@ -11640,14 +11650,186 @@ to know: The functions are called with no parameters, but the @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 @@ -17926,6 +18108,9 @@ gnus-fetch-group and friends should exit Gnus when the user exits the group. @item +The jingle is only played on the second invocation of Gnus. + +@item Solve the halting problem. @c TODO diff --git a/texi/message.texi b/texi/message.texi index d0539bc..34966cf 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \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 @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.17 Manual +@title Pterodactyl Message 0.18 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * 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.