*** pub/pgnus/lisp/base64.el Mon Aug 31 22:15:44 1998 --- pgnus/lisp/base64.el Sat Sep 5 01:46:08 1998 *************** *** 25,30 **** --- 25,32 ---- ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (require 'mm-util) + ;; For non-MULE (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) *** pub/pgnus/lisp/date.el Sat Sep 5 01:46:17 1998 --- pgnus/lisp/date.el Sat Sep 5 01:46:08 1998 *************** *** 0 **** --- 1,124 ---- + ;;; date.el --- Date and time handling functions + ;; Copyright (C) 1998 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Masanobu Umeda + ;; 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: + + ;;; Code: + + (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))))) + + (defun date-to-time (date) + "Convert DATE into time." + (apply 'encode-time (parse-time-string date))) + + (defun time-less (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + + (defun days-to-time (days) + "Convert DAYS into time." + (let* ((seconds (* 1.0 days 60 60 24)) + (rest (expt 2 16)) + (ms (condition-case nil (floor (/ seconds rest)) + (range-error (expt 2 16))))) + (list ms (condition-case nil (round (- seconds (* ms rest))) + (range-error (expt 2 16)))))) + + (defun time-since (time) + "Return the time since TIME, which is either an internal time or a date." + (when (stringp time) + ;; Convert date strings to internal time. + (setq time (date-to-time time))) + (let* ((current (current-time)) + (rest (when (< (nth 1 current) (nth 1 time)) + (expt 2 16)))) + (list (- (+ (car current) (if rest -1 0)) (car time)) + (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) + + (defun subtract-time (t1 t2) + "Subtract two internal times." + (let ((borrow (< (cadr t1) (cadr t2)))) + (list (- (car t1) (car t2) (if borrow 1 0)) + (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) + + (defun date-to-day (date) + "Return the number of days between year 1 and DATE." + (time-to-day (date-to-time date))) + + (defun days-between (date1 date2) + "Return the number of days between DATE1 and DATE2." + (- (date-to-day date1) (date-to-day date2))) + + (defun date-leap-year-p (year) + "Return t if YEAR is a leap year." + (or (and (zerop (% year 4)) + (not (zerop (% year 100)))) + (zerop (% year 400)))) + + (defun time-to-day-in-year (time) + "Return the day number within the year of the date month/day/year." + (let* ((tim (decode-time time)) + (month (nth 4 tim)) + (day (nth 3 tim)) + (year (nth 5 tim)) + (day-of-year (+ day (* 31 (1- month))))) + (when (> month 2) + (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) + (when (date-leap-year-p year) + (setq day-of-year (1+ day-of-year)))) + day-of-year)) + + (defun time-to-day (time) + "The number of days between the Gregorian date 0001-12-31bce and TIME. + The Gregorian date Sunday, December 31, 1bce is imaginary." + (let* ((tim (decode-time time)) + (month (nth 4 tim)) + (day (nth 3 tim)) + (year (nth 5 tim))) + (+ (time-to-day-in-year time) ; Days this year + (* 365 (1- year)) ; + Days in prior years + (/ (1- year) 4) ; + Julian leap years + (- (/ (1- year) 100)) ; - century years + (/ (1- year) 400)))) ; + Gregorian leap years + + (provide 'date) + + ;;; date.el ends here *** pub/pgnus/lisp/drums.el Sat Sep 5 01:46:17 1998 --- pgnus/lisp/drums.el Sat Sep 5 01:46:09 1998 *************** *** 0 **** --- 1,186 ---- + ;;; drums.el --- Functions for parsing RFC822bis headers + ;; Copyright (C) 1998 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; 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: + + ;; DRUMS is and IETF Working Group that works (or worked) on the + ;; successor to RFC822, "Standard For The Format Of Arpa Internet Text + ;; Messages". This library is based on + ;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05. + + ;;; Code: + + (require 'date) + + (defvar drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177" + "US-ASCII control characters excluding CR, LF and white space.") + (defvar drums-text-token "\001-\011\013\014\016-\177" + "US-ASCII characters exlcuding CR and LF.") + (defvar drums-specials-token "()<>[]:;@\\,.\"" + "Special characters.") + (defvar drums-quote-token "\\" + "Quote character.") + (defvar drums-wsp-token " \t" + "White space.") + (defvar drums-fws-regexp + (concat "[" drums-wsp-token "]*\n[" drums-wsp-token "]+") + "Folding white space.") + (defvar drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~" + "Textual token.") + (defvar drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~." + "Textual token including full stop.") + (defvar drums-qtext-token + (concat drums-no-ws-ctl-token "\041\043-\133\135-\177") + "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.") + + (defvar drums-syntax-table + (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) + (modify-syntax-entry ?\\ "/" table) + (modify-syntax-entry ?< "(" table) + (modify-syntax-entry ?> ")" table) + table)) + + (defsubst drums-init (string) + (set-syntax-table drums-syntax-table) + (insert string) + (drums-unfold-fws) + (goto-char (point-min))) + + (defun drums-remove-comments (string) + "Remove comments from STRING." + (with-temp-buffer + (let (c) + (drums-init string) + (while (not (eobp)) + (setq c (following-char)) + (cond + ((eq c ?\") + (forward-sexp 1)) + ((eq c ?\() + (delete-region (point) (progn (forward-sexp 1) (point)))) + (t + (forward-char 1)))) + (buffer-string)))) + + (defun drums-remove-whitespace (string) + "Remove comments from STRING." + (with-temp-buffer + (drums-init string) + (let (c) + (while (not (eobp)) + (setq c (following-char)) + (cond + ((eq c ?\") + (forward-sexp 1)) + ((memq c '(? ?\t)) + (delete-char 1)) + (t + (forward-char 1)))) + (buffer-string)))) + + (defun drums-get-comment (string) + "Return the first comment in STRING." + (with-temp-buffer + (drums-init string) + (let (result c) + (while (not (eobp)) + (setq c (following-char)) + (cond + ((eq c ?\") + (forward-sexp 1)) + ((eq c ?\() + (setq result + (buffer-substring + (1+ (point)) + (progn (forward-sexp 1) (1- (point))))) + (goto-char (point-max))) + (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) + (drums-init string) + (while (not (eobp)) + (setq c (following-char)) + (cond + ((or (eq c ? ) + (eq c ?\t)) + (forward-char 1)) + ((eq c ?\() + (forward-sexp 1)) + ((eq c ?\") + (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))) + display-name)) + ((eq c ?<) + (setq mailbox + (drums-remove-whitespace + (drums-remove-comments + (buffer-substring + (1+ (point)) + (progn (forward-sexp 1) (1- (point)))))))) + (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 + (cons mailbox display-name))))) + + (defun drums-parse-addresses (string) + "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." + (with-temp-buffer + (drums-init string) + (let ((beg (point)) + pairs c) + (while (not (eobp)) + (setq c (following-char)) + (cond + ((memq c '(?\" ?< ?\()) + (forward-sexp 1)) + ((eq c ?,) + (push (drums-parse-address (buffer-substring beg (1- (point)))) + pairs) + (setq beg (point))) + (t + (forward-char 1)))) + (nreverse pairs)))) + + (defun drums-unfold-fws () + "Unfold folding white space in the current buffer." + (goto-char (point-min)) + (while (re-search-forward drums-fws-regexp nil t) + (replace-match " " t t)) + (goto-char (point-min))) + + (defun drums-parse-date (string) + "Return an Emacs time spec from STRING." + (encode-time (parse-time-string string))) + + (provide 'drums) + + ;;; drums.el ends here *** pub/pgnus/lisp/gnus-agent.el Sat Aug 29 22:25:14 1998 --- pgnus/lisp/gnus-agent.el Sat Sep 5 01:46:09 1998 *************** *** 654,660 **** (let ((dir (concat (gnus-agent-directory) (gnus-agent-group-path group) "/")) ! (date (gnus-time-to-day (current-time))) (case-fold-search t) pos crosses id elem) (gnus-make-directory dir) --- 654,660 ---- (let ((dir (concat (gnus-agent-directory) (gnus-agent-group-path group) "/")) ! (date (time-to-day (current-time))) (case-fold-search t) pos crosses id elem) (gnus-make-directory dir) *************** *** 775,781 **** (gnus-agent-enter-history "last-header-fetched-for-session" (list (cons group (nth (- (length articles) 1) articles))) ! (gnus-time-to-day (current-time))) articles)))))) (defsubst gnus-agent-copy-nov-line (article) --- 775,781 ---- (gnus-agent-enter-history "last-header-fetched-for-session" (list (cons group (nth (- (length articles) 1) articles))) ! (time-to-day (current-time))) articles)))))) (defsubst gnus-agent-copy-nov-line (article) *************** *** 1258,1264 **** "Expire all old articles." (interactive) (let ((methods gnus-agent-covered-methods) ! (day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days)) gnus-command-method sym group articles history overview file histories elem art nov-file low info unreads marked article) --- 1258,1264 ---- "Expire all old articles." (interactive) (let ((methods gnus-agent-covered-methods) ! (day (- (time-to-day (current-time)) gnus-agent-expire-days)) gnus-command-method sym group articles history overview file histories elem art nov-file low info unreads marked article) *** pub/pgnus/lisp/gnus-art.el Tue Sep 1 10:28:25 1998 --- pgnus/lisp/gnus-art.el Sat Sep 5 01:46:09 1998 *************** *** 273,279 **** :group 'gnus-article-washing) (eval-and-compile - (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'mail-extract-address-components "mail-extr")) (defcustom gnus-save-all-headers t --- 273,278 ---- *************** *** 769,775 **** ((eq elem 'date) (let ((date (message-fetch-field "date"))) (when (and date ! (< (gnus-days-between (current-time-string) date) 4)) (gnus-article-hide-header "date")))) ((eq elem 'long-to) --- 768,774 ---- ((eq elem 'date) (let ((date (message-fetch-field "date"))) (when (and date ! (< (days-between (current-time-string) date) 4)) (gnus-article-hide-header "date")))) ((eq elem 'long-to) *************** *** 1343,1400 **** ;; functions since they aren't particularly resistant to ;; buggy dates. ((eq type 'local) ! (concat "Date: " (condition-case () ! (timezone-make-date-arpa-standard date) ! (error date)))) ;; Convert to Universal Time. ((eq type 'ut) (concat "Date: " ! (condition-case () ! (timezone-make-date-arpa-standard date nil "UT") ! (error date)))) ;; 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 ! (ignore-errors ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT")))) (concat "Date: " ! (format-time-string gnus-article-time-format ! (ignore-errors ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT"))))))) ;; ISO 8601. ((eq type 'iso8601) (concat "Date: " ! (format-time-string "%Y%M%DT%h%m%s" ! (ignore-errors ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT")))))) ;; 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 ! (ignore-errors ! (gnus-time-minus ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! (current-time-string now) ! (current-time-zone now) "UT")) ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT"))))) (real-sec (and real-time (+ (* (float (car real-time)) 65536) (cadr real-time)))) --- 1342,1376 ---- ;; 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)) (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)))) *************** *** 1664,1670 **** (save-excursion (save-restriction (widen) ! (gnus-output-to-rmail filename)))) filename) (defun gnus-summary-save-in-mail (&optional filename) --- 1640,1646 ---- (save-excursion (save-restriction (widen) ! (rmail-output-to-rmail-file filename)))) filename) (defun gnus-summary-save-in-mail (&optional filename) *************** *** 1681,1687 **** (widen) (if (and (file-readable-p filename) (mail-file-babyl-p filename)) ! (gnus-output-to-rmail filename t) (gnus-output-to-mail filename))))) filename) --- 1657,1663 ---- (widen) (if (and (file-readable-p filename) (mail-file-babyl-p filename)) ! (rmail-output-to-rmail-file filename t) (gnus-output-to-mail filename))))) filename) *** pub/pgnus/lisp/gnus-demon.el Sat Aug 29 19:53:56 1998 --- pgnus/lisp/gnus-demon.el Sat Sep 5 01:46:09 1998 *************** *** 268,275 **** (defun gnus-demon-nntp-close-connection () (save-window-excursion ! (when (nnmail-time-less '(0 300) ! (nnmail-time-since nntp-last-command-time)) (nntp-close-server)))) (defun gnus-demon-add-scanmail () --- 268,274 ---- (defun gnus-demon-nntp-close-connection () (save-window-excursion ! (when (subtract-time '(0 300) (time-since nntp-last-command-time)) (nntp-close-server)))) (defun gnus-demon-add-scanmail () *** pub/pgnus/lisp/gnus-group.el Sat Aug 29 22:25:16 1998 --- pgnus/lisp/gnus-group.el Sat Sep 5 01:46:10 1998 *************** *** 3373,3379 **** "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." (let* ((time (or (gnus-group-timestamp group) (list 0 0))) ! (delta (gnus-time-minus (current-time) time))) (+ (* (nth 0 delta) 65536.0) (nth 1 delta)))) --- 3373,3379 ---- "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." (let* ((time (or (gnus-group-timestamp group) (list 0 0))) ! (delta (subtract-time (current-time) time))) (+ (* (nth 0 delta) 65536.0) (nth 1 delta)))) *** pub/pgnus/lisp/gnus-kill.el Sat Aug 29 19:53:57 1998 --- pgnus/lisp/gnus-kill.el Sat Sep 5 01:46:10 1998 *************** *** 524,530 **** ;; It's on the form (regexp . date). (if (zerop (gnus-execute field (car kill-list) command nil (not all))) ! (when (> (gnus-days-between date (cdr kill-list)) gnus-kill-expiry-days) (setq regexp nil)) (setcdr kill-list date)) --- 524,530 ---- ;; It's on the form (regexp . date). (if (zerop (gnus-execute field (car kill-list) command nil (not all))) ! (when (> (days-between date (cdr kill-list)) gnus-kill-expiry-days) (setq regexp nil)) (setcdr kill-list date)) *************** *** 535,541 **** (setq kdate (cdr kill)) (if (zerop (gnus-execute field (car kill) command nil (not all))) ! (when (> (gnus-days-between date kdate) gnus-kill-expiry-days) ;; Time limit has been exceeded, so we ;; remove the match. --- 535,541 ---- (setq kdate (cdr kill)) (if (zerop (gnus-execute field (car kill) command nil (not all))) ! (when (> (days-between date kdate) gnus-kill-expiry-days) ;; Time limit has been exceeded, so we ;; remove the match. *** pub/pgnus/lisp/gnus-logic.el Sat Aug 29 19:53:57 1998 --- pgnus/lisp/gnus-logic.el Sat Sep 5 01:46:10 1998 *************** *** 171,179 **** ((eq type 'at) (equal date match)) ((eq type 'before) ! (gnus-time-less match date)) ((eq type 'after) ! (gnus-time-less date match)) (t (error "No such date score type: %s" type))))) --- 171,179 ---- ((eq type 'at) (equal date match)) ((eq type 'before) ! (time-less match date)) ((eq type 'after) ! (time-less date match)) (t (error "No such date score type: %s" type))))) *** pub/pgnus/lisp/gnus-msg.el Thu Sep 3 15:24:44 1998 --- pgnus/lisp/gnus-msg.el Sat Sep 5 01:46:10 1998 *************** *** 495,501 **** (list gnus-post-method))) gnus-secondary-select-methods (mapcar 'cdr gnus-server-alist) ! gnus-opened-servers (list gnus-select-method) (list group-method))) method-alist post-methods method) --- 495,501 ---- (list gnus-post-method))) gnus-secondary-select-methods (mapcar 'cdr gnus-server-alist) ! (mapcar 'car gnus-opened-servers) (list gnus-select-method) (list group-method))) method-alist post-methods method) *** pub/pgnus/lisp/gnus-nocem.el Sat Aug 29 22:25:16 1998 --- pgnus/lisp/gnus-nocem.el Sat Sep 5 01:46:10 1998 *************** *** 190,198 **** (let ((date (mail-header-date header)) issuer b e type) (when (or (not date) ! (nnmail-time-less ! (nnmail-time-since (nnmail-date-to-time date)) ! (nnmail-days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) (goto-char (point-min)) (when (re-search-forward "-----BEGIN PGP MESSAGE-----" nil t) --- 190,198 ---- (let ((date (mail-header-date header)) issuer b e type) (when (or (not date) ! (time-less ! (time-since (date-to-time date)) ! (days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) (goto-char (point-min)) (when (re-search-forward "-----BEGIN PGP MESSAGE-----" nil t) *************** *** 316,326 **** (let* ((alist gnus-nocem-alist) (pprev (cons nil alist)) (prev pprev) ! (expiry (nnmail-days-to-time gnus-nocem-expiry-wait)) entry) (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) (while (setq entry (car alist)) ! (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry)) ;; This entry has expired, so we remove it. (setcdr prev (cdr alist)) (setq prev alist) --- 316,326 ---- (let* ((alist gnus-nocem-alist) (pprev (cons nil alist)) (prev pprev) ! (expiry (days-to-time gnus-nocem-expiry-wait)) entry) (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) (while (setq entry (car alist)) ! (if (not (subtract-time (time-since (car entry)) expiry)) ;; This entry has expired, so we remove it. (setcdr prev (cdr alist)) (setq prev alist) *** pub/pgnus/lisp/gnus-score.el Sat Aug 29 22:25:16 1998 --- pgnus/lisp/gnus-score.el Sat Sep 5 01:46:11 1998 *************** *** 794,802 **** (type (list match score (and date (if (numberp date) date ! (gnus-day-number date))) type)) ! (date (list match score (gnus-day-number date))) (score (list match score)) (t (list match)))) ;; We see whether we can collapse some score entries. --- 794,802 ---- (type (list match score (and date (if (numberp date) date ! (date-to-day date))) type)) ! (date (list match score (date-to-day date))) (score (list match score)) (t (list match)))) ;; We see whether we can collapse some score entries. *************** *** 1121,1127 **** (or (not decay) (gnus-decay-scores alist decay))) (gnus-score-set 'touched '(t) alist) ! (gnus-score-set 'decay (list (gnus-time-to-day (current-time))) alist)) ;; We do not respect eval and files atoms from global score ;; files. (when (and files (not global)) --- 1121,1127 ---- (or (not decay) (gnus-decay-scores alist decay))) (gnus-score-set 'touched '(t) alist) ! (gnus-score-set 'decay (list (time-to-day (current-time))) alist)) ;; We do not respect eval and files atoms from global score ;; files. (when (and files (not global)) *************** *** 1290,1296 **** (setcar scor (list (caar scor) (nth 2 (car scor)) (and (nth 3 (car scor)) ! (gnus-day-number (nth 3 (car scor)))) (if (nth 1 (car scor)) 'r 's))) (setq scor (cdr scor)))) (push (if (not (listp (cdr entry))) --- 1290,1296 ---- (setcar scor (list (caar scor) (nth 2 (car scor)) (and (nth 3 (car scor)) ! (date-to-day (nth 3 (car scor)))) (if (nth 1 (car scor)) 'r 's))) (setq scor (cdr scor)))) (push (if (not (listp (cdr entry))) *************** *** 1385,1391 **** (when (and gnus-summary-default-score scores) (let* ((entries gnus-header-index) ! (now (gnus-day-number (current-time-string))) (expire (and gnus-score-expiry-days (- now gnus-score-expiry-days))) (headers gnus-newsgroup-headers) --- 1385,1391 ---- (when (and gnus-summary-default-score scores) (let* ((entries gnus-header-index) ! (now (date-to-day (current-time-string))) (expire (and gnus-score-expiry-days (- now gnus-score-expiry-days))) (headers gnus-newsgroup-headers) *************** *** 2211,2217 **** (memq 'word gnus-newsgroup-adaptive)) (with-temp-buffer (let* ((hashtb (gnus-make-hashtable 1000)) ! (date (gnus-day-number (current-time-string))) (data gnus-newsgroup-data) (syntab (syntax-table)) word d score val) --- 2211,2217 ---- (memq 'word gnus-newsgroup-adaptive)) (with-temp-buffer (let* ((hashtb (gnus-make-hashtable 1000)) ! (date (date-to-day (current-time-string))) (data gnus-newsgroup-data) (syntab (syntax-table)) word d score val) *************** *** 2837,2843 **** (defun gnus-decay-scores (alist day) "Decay non-permanent scores in ALIST." ! (let ((times (- (gnus-time-to-day (current-time)) day)) kill entry updated score n) (unless (zerop times) ;Done decays today already? (while (setq entry (pop alist)) --- 2837,2843 ---- (defun gnus-decay-scores (alist day) "Decay non-permanent scores in ALIST." ! (let ((times (- (time-to-day (current-time)) day)) kill entry updated score n) (unless (zerop times) ;Done decays today already? (while (setq entry (pop alist)) *** pub/pgnus/lisp/gnus-sum.el Tue Sep 1 10:28:27 1998 --- pgnus/lisp/gnus-sum.el Sat Sep 5 01:46:11 1998 *************** *** 3483,3489 **** (defsubst gnus-article-sort-by-date (h1 h2) "Sort articles by root article date." ! (gnus-time-less (gnus-date-get-time (mail-header-date h1)) (gnus-date-get-time (mail-header-date h2)))) --- 3483,3489 ---- (defsubst gnus-article-sort-by-date (h1 h2) "Sort articles by root article date." ! (time-less (gnus-date-get-time (mail-header-date h1)) (gnus-date-get-time (mail-header-date h2)))) *************** *** 4529,4537 **** number dependencies force-new)))) (push header headers)) (forward-line 1)) ! (error ! (gnus-error 4 "Strange nov line (%d)" ! (count-lines (point-min) (point))))) (forward-line 1)) ;; A common bug in inn is that if you have posted an article and ;; then retrieves the active file, it will answer correctly -- --- 4529,4538 ---- number dependencies force-new)))) (push header headers)) (forward-line 1)) ! ;(error ! ; (gnus-error 4 "Strange nov line (%d)" ! ; (count-lines (point-min) (point)))) ! ) (forward-line 1)) ;; A common bug in inn is that if you have posted an article and ;; then retrieves the active file, it will answer correctly -- *************** *** 5928,5940 **** (interactive "nTime in days: \nP") (prog1 (let ((data gnus-newsgroup-data) ! (cutoff (nnmail-days-to-time age)) articles d date is-younger) (while (setq d (pop data)) (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) ! (setq is-younger (nnmail-time-less ! (nnmail-time-since (nnmail-date-to-time date)) cutoff)) (when (if younger-p is-younger --- 5929,5941 ---- (interactive "nTime in days: \nP") (prog1 (let ((data gnus-newsgroup-data) ! (cutoff (days-to-time age)) articles d date is-younger) (while (setq d (pop data)) (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) ! (setq is-younger (subtract-time ! (time-since (date-to-time date)) cutoff)) (when (if younger-p is-younger *************** *** 8487,8493 **** If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") ! (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) --- 8488,8494 ---- If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") ! (let ((gnus-default-article-saver 'rmail-output-to-rmail-file)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) *** pub/pgnus/lisp/gnus-util.el Mon Aug 31 22:15:46 1998 --- pgnus/lisp/gnus-util.el Sat Sep 5 01:46:12 1998 *************** *** 33,43 **** (require 'custom) (eval-when-compile (require 'cl)) (require 'nnheader) - (require 'timezone) (require 'message) (eval-and-compile - (autoload 'nnmail-date-to-time "nnmail") (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail")) --- 33,42 ---- (require 'custom) (eval-when-compile (require 'cl)) (require 'nnheader) (require 'message) + (require 'date) (eval-and-compile (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail")) *************** *** 218,260 **** ;;; Time functions. - (defun gnus-days-between (date1 date2) - ;; Return the number of days between date1 and date2. - (- (gnus-day-number date1) (gnus-day-number date2))) - - (defun gnus-day-number (date) - (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) - (timezone-parse-date date)))) - (timezone-absolute-from-gregorian - (nth 1 dat) (nth 2 dat) (car dat)))) - - (defun gnus-time-to-day (time) - "Convert TIME to day number." - (let ((tim (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 tim) (nth 3 tim) (nth 5 tim)))) - - (defun gnus-encode-date (date) - "Convert DATE to internal time." - (let* ((parse (timezone-parse-date date)) - (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) - (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) - (encode-time (caddr time) (cadr time) (car time) - (caddr date) (cadr date) (car date) - (* 60 (timezone-zone-to-minute (nth 4 date)))))) - - (defun gnus-time-minus (t1 t2) - "Subtract two internal times." - (let ((borrow (< (cadr t1) (cadr t2)))) - (list (- (car t1) (car t2) (if borrow 1 0)) - (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) - - (defun gnus-time-less (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - (defun gnus-file-newer-than (file date) (let ((fdate (nth 5 (file-attributes file)))) (or (> (car fdate) (car date)) --- 217,222 ---- *************** *** 353,359 **** '(0 0) (or (get-text-property 0 'gnus-time d) ;; or compute the value... ! (let ((time (nnmail-date-to-time d))) ;; and store it back in the string. (put-text-property 0 1 'gnus-time time d) time))))) --- 315,321 ---- '(0 0) (or (get-text-property 0 'gnus-time d) ;; or compute the value... ! (let ((time (date-to-time d))) ;; and store it back in the string. (put-text-property 0 1 'gnus-time time d) time))))) *************** *** 701,758 **** ;;; Functions for saving to babyl/mail files. - - (defvar rmail-default-rmail-file) - (defun gnus-output-to-rmail (filename &optional ask) - "Append the current article to an Rmail file named FILENAME." - (require 'rmail) - ;; Most of these codes are borrowed from rmailout.el. - (setq filename (expand-file-name filename)) - (setq rmail-default-rmail-file filename) - (let ((artbuf (current-buffer)) - (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))) - (save-excursion - (or (get-file-buffer filename) - (file-exists-p filename) - (if (or (not ask) - (gnus-yes-or-no-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (rmail-insert-rmail-file-header) - (let ((require-final-newline nil)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (gnus-convert-article-to-rmail) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (append-to-file (point-min) (point-max) filename) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - (when msg - (widen) - (narrow-to-region (point-max) (point-max))) - (insert-buffer-substring tmpbuf) - (when msg - (goto-char (point-min)) - (widen) - (search-backward "\^_") - (narrow-to-region (point) (point-max)) - (goto-char (1+ (point-min))) - (rmail-count-new-messages t) - (rmail-show-message msg)) - (save-buffer))))) - (kill-buffer tmpbuf))) (defun gnus-output-to-mail (filename &optional ask) "Append the current article to a mail file named FILENAME." --- 663,668 ---- *** pub/pgnus/lisp/gnus.el Thu Sep 3 15:24:44 1998 --- pgnus/lisp/gnus.el Sat Sep 5 01:46:12 1998 *************** *** 250,256 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.14" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 250,256 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.15" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *************** *** 1581,1593 **** ("browse-url" browse-url) ("message" :interactive t message-send-and-exit message-yank-original) ! ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) ("timezone" timezone-make-date-arpa-standard timezone-fix-time timezone-make-sortable-date timezone-make-time-string) ("rmailout" rmail-output) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages ! rmail-show-message) ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t --- 1581,1593 ---- ("browse-url" browse-url) ("message" :interactive t message-send-and-exit message-yank-original) ! ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) ("timezone" timezone-make-date-arpa-standard timezone-fix-time timezone-make-sortable-date timezone-make-time-string) ("rmailout" rmail-output) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages ! rmail-show-message rmail-output-to-rmail-file) ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t *************** *** 2009,2016 **** "4.99" (+ 5 (* 0.02 (abs ! (- (char-int (aref (downcase alpha) 0)) ! (char-int ?t)))) -0.01)) minor least) (format "%d.%02d%02d" major minor least)))))) --- 2009,2016 ---- "4.99" (+ 5 (* 0.02 (abs ! (- (mm-char-int (aref (downcase alpha) 0)) ! (mm-char-int ?t)))) -0.01)) minor least) (format "%d.%02d%02d" major minor least)))))) *** pub/pgnus/lisp/lpath.el Thu Sep 3 15:24:44 1998 --- pgnus/lisp/lpath.el Sat Sep 5 01:46:12 1998 *************** *** 25,31 **** run-with-idle-timer mouse-minibuffer-check window-edges event-click-count track-mouse read-event mouse-movement-p event-end mouse-scroll-subr overlay-lists delete-overlay ! set-face-stipple mail-abbrevs-setup char-int make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string w3-form-encode-xwfu gnus-mule-get-coding-system --- 25,31 ---- run-with-idle-timer mouse-minibuffer-check window-edges event-click-count track-mouse read-event mouse-movement-p event-end mouse-scroll-subr overlay-lists delete-overlay ! set-face-stipple mail-abbrevs-setup make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string w3-form-encode-xwfu gnus-mule-get-coding-system *************** *** 34,40 **** set-buffer-multibyte find-non-ascii-charset-region char-charset mule-write-region-no-coding-system ! find-charset-region)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table --- 34,40 ---- set-buffer-multibyte find-non-ascii-charset-region char-charset mule-write-region-no-coding-system ! find-charset-region base64-decode-string)) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table *************** *** 62,68 **** gnus-mule-get-coding-system decode-coding-string mail-aliases-setup mm-copy-tree url-view-url w3-prepare-buffer ! char-int mule-write-region-no-coding-system))) (setq load-path (cons "." load-path)) (require 'custom) --- 62,68 ---- 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))) (setq load-path (cons "." load-path)) (require 'custom) *** pub/pgnus/lisp/message.el Thu Sep 3 15:24:45 1998 --- pgnus/lisp/message.el Sat Sep 5 01:46:12 1998 *************** *** 4050,4056 **** (goto-char (point-max)) (mm-insert-rfc822-headers (or charset (mm-mule-charset-to-mime-charset 'ascii)) ! encoding)))))) (run-hooks 'message-load-hook) --- 4050,4057 ---- (goto-char (point-max)) (mm-insert-rfc822-headers (or charset (mm-mule-charset-to-mime-charset 'ascii)) ! encoding) ! (mm-encode-body)))))) (run-hooks 'message-load-hook) *** pub/pgnus/lisp/messagexmas.el Sat Aug 29 19:54:00 1998 --- pgnus/lisp/messagexmas.el Sat Sep 5 01:46:12 1998 *************** *** 100,107 **** "Create a rot table with offset N." (let ((i -1) (table (make-string 256 0)) ! (a (char-int ?a)) ! (A (char-int ?A))) (while (< (incf i) 256) (aset table i i)) (concat --- 100,107 ---- "Create a rot table with offset N." (let ((i -1) (table (make-string 256 0)) ! (a (mm-char-int ?a)) ! (A (mm-char-int ?A))) (while (< (incf i) 256) (aset table i i)) (concat *** pub/pgnus/lisp/mm-bodies.el Thu Sep 3 15:24:45 1998 --- pgnus/lisp/mm-bodies.el Sat Sep 5 01:46:12 1998 *************** *** 53,60 **** (t (let ((mime-charset (mm-mule-charset-to-mime-charset (car charsets))) start) ! (when (not (mm-coding-system-equal ! mime-charset buffer-file-coding-system)) (while (not (eobp)) (if (eq (char-charset (following-char)) 'ascii) (when start --- 53,62 ---- (t (let ((mime-charset (mm-mule-charset-to-mime-charset (car charsets))) start) ! (when (or t ! ;; We always decode. ! (not (mm-coding-system-equal ! mime-charset buffer-file-coding-system))) (while (not (eobp)) (if (eq (char-charset (following-char)) 'ascii) (when start *************** *** 80,86 **** (goto-char (point-min)) (while (and (not found) (not (eobp))) ! (when (> (char-int (following-char)) 127) (setq found t)) (forward-char 1)) (not found)))) --- 82,88 ---- (goto-char (point-min)) (while (and (not found) (not (eobp))) ! (when (> (mm-char-int (following-char)) 127) (setq found t)) (forward-char 1)) (not found)))) *************** *** 94,99 **** --- 96,102 ---- (defun mm-decode-body (charset encoding) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." + (setq charset (or charset rfc2047-default-charset)) (save-excursion (when encoding (cond *************** *** 105,110 **** --- 108,115 ---- (error nil))) ((memq encoding '(7bit 8bit binary)) ) + ((null encoding) + ) (t (error "Can't decode encoding %s" encoding)))) (when (featurep 'mule) *************** *** 112,119 **** (when (and charset (setq mule-charset (mm-charset-to-coding-system charset)) buffer-file-coding-system ! (not (mm-coding-system-equal ! buffer-file-coding-system mule-charset))) (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) (provide 'mm-bodies) --- 117,125 ---- (when (and charset (setq mule-charset (mm-charset-to-coding-system charset)) buffer-file-coding-system ! ;;(not (mm-coding-system-equal ! ;; buffer-file-coding-system mule-charset)) ! ) (mm-decode-coding-region (point-min) (point-max) mule-charset)))))) (provide 'mm-bodies) *** pub/pgnus/lisp/mm-util.el Thu Sep 3 15:24:45 1998 --- pgnus/lisp/mm-util.el Sat Sep 5 01:46:13 1998 *************** *** 83,88 **** --- 83,92 ---- (fset 'mm-coding-system-list 'coding-system-list) (fset 'mm-coding-system-list 'ignore)) + (if (fboundp 'char-int) + (fset 'mm-char-int 'char-int) + (fset 'mm-char-int 'identity)) + (if (fboundp 'coding-system-equal) (fset 'mm-coding-system-equal 'coding-system-equal) (fset 'mm-coding-system-equal 'equal)) *** pub/pgnus/lisp/nndb.el Sat Aug 29 19:54:00 1998 --- pgnus/lisp/nndb.el Sat Sep 5 01:46:13 1998 *************** *** 181,188 **** msg)) (if (nnmail-expired-article-p group ! (gnus-encode-date ! (substring msg (match-beginning 1) (match-end 1))) force) (progn (setq delete-list (concat delete-list " " (int-to-string art))) --- 181,187 ---- msg)) (if (nnmail-expired-article-p group ! (date-to-time (substring msg (match-beginning 1) (match-end 1))) force) (progn (setq delete-list (concat delete-list " " (int-to-string art))) *** pub/pgnus/lisp/nnmail.el Mon Aug 31 22:15:47 1998 --- pgnus/lisp/nnmail.el Sat Sep 5 01:46:13 1998 *************** *** 482,488 **** (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) ! (defvar nnmail-file-coding-system 'raw-text "Coding system used in nnmail.") (defun nnmail-find-file (file) --- 482,488 ---- (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) ! (defvar nnmail-file-coding-system 'binary "Coding system used in nnmail.") (defun nnmail-find-file (file) *************** *** 493,499 **** (after-insert-file-functions nil)) (condition-case () (let ((coding-system-for-read nnmail-file-coding-system) ! (pathname-coding-system 'binary)) (insert-file-contents file) t) (file-error nil)))) --- 493,499 ---- (after-insert-file-functions nil)) (condition-case () (let ((coding-system-for-read nnmail-file-coding-system) ! (pathname-coding-system nnmail-file-coding-system)) (insert-file-contents file) t) (file-error nil)))) *************** *** 519,566 **** "/"))) (or file ""))) - (defun nnmail-date-to-time (date) - "Convert DATE into 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)))) - - (defun nnmail-time-less (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - - (defun nnmail-days-to-time (days) - "Convert DAYS into time." - (let* ((seconds (* 1.0 days 60 60 24)) - (rest (expt 2 16)) - (ms (condition-case nil (floor (/ seconds rest)) - (range-error (expt 2 16))))) - (list ms (condition-case nil (round (- seconds (* ms rest))) - (range-error (expt 2 16)))))) - - (defun nnmail-time-since (time) - "Return the time since TIME, which is either an internal time or a date." - (when (stringp time) - ;; Convert date strings to internal time. - (setq time (nnmail-date-to-time time))) - (let* ((current (current-time)) - (rest (when (< (nth 1 current) (nth 1 time)) - (expt 2 16)))) - (list (- (+ (car current) (if rest -1 0)) (car time)) - (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) - ;; Function rewritten from rmail.el. (defun nnmail-move-inbox (inbox) "Move INBOX to `nnmail-crash-box'." --- 519,524 ---- *************** *** 1671,1679 **** ;; This is an ange-ftp group, and we don't have any dates. nil) ((numberp days) ! (setq days (nnmail-days-to-time days)) ;; Compare the time with the current time. ! (nnmail-time-less days (nnmail-time-since time))))))) (defvar nnmail-read-passwd nil) (defun nnmail-read-passwd (prompt &rest args) --- 1629,1637 ---- ;; This is an ange-ftp group, and we don't have any dates. nil) ((numberp days) ! (setq days (days-to-time days)) ;; Compare the time with the current time. ! (subtract-time days (time-since time))))))) (defvar nnmail-read-passwd nil) (defun nnmail-read-passwd (prompt &rest args) *** pub/pgnus/lisp/nnml.el Sat Aug 29 22:25:19 1998 --- pgnus/lisp/nnml.el Sat Sep 5 01:46:13 1998 *************** *** 249,257 **** (deffoo nnml-request-list (&optional server) (save-excursion (let ((nnmail-file-coding-system nnmail-active-file-coding-system) ! (pathname-coding-system 'binary)) ; for XEmacs/mule ! (nnmail-find-file nnml-active-file) ! ) (setq nnml-group-alist (nnmail-get-active)) t)) --- 249,256 ---- (deffoo nnml-request-list (&optional server) (save-excursion (let ((nnmail-file-coding-system nnmail-active-file-coding-system) ! (pathname-coding-system 'binary)) ! (nnmail-find-file nnml-active-file)) (setq nnml-group-alist (nnmail-get-active)) t)) *** pub/pgnus/lisp/nntp.el Sat Aug 29 22:25:19 1998 --- pgnus/lisp/nntp.el Sat Sep 5 01:46:13 1998 *************** *** 728,734 **** (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" ! (format-time-string "%y%m%d %H%M%S" (nnmail-date-to-time date))) (nntp-decode-text)))) (deffoo nntp-request-post (&optional server) --- 728,734 ---- (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" ! (format-time-string "%y%m%d %H%M%S" (date-to-time date))) (nntp-decode-text)))) (deffoo nntp-request-post (&optional server) *** pub/pgnus/lisp/rfc2047.el Thu Sep 3 15:24:45 1998 --- pgnus/lisp/rfc2047.el Sat Sep 5 01:46:13 1998 *************** *** 30,37 **** (require 'qp) (require 'mm-util) ! (defvar rfc2047-unencoded-charsets '(ascii latin-iso8859-1) ! "List of MULE charsets not to encode.") (defvar rfc2047-header-encoding-alist '(("Newsgroups" . nil) --- 30,37 ---- (require 'qp) (require 'mm-util) ! (defvar rfc2047-default-charset 'iso-8859-1 ! "Default MIME charset -- does not need encoding.") (defvar rfc2047-header-encoding-alist '(("Newsgroups" . nil) *************** *** 130,137 **** (defun rfc2047-encodable-p () "Say whether the current (narrowed) buffer contains characters that need encoding." ! (let ((charsets (find-charset-region (point-min) (point-max))) ! (cs rfc2047-unencoded-charsets) found) (while charsets (unless (memq (pop charsets) cs) --- 130,139 ---- (defun rfc2047-encodable-p () "Say whether the current (narrowed) buffer contains characters that need encoding." ! (let ((charsets (mapcar ! 'mm-mule-charset-to-mime-charset ! (find-charset-region (point-min) (point-max)))) ! (cs (list 'us-ascii rfc2047-default-charset)) found) (while charsets (unless (memq (pop charsets) cs) *************** *** 225,248 **** (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." (interactive "r") ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (goto-char (point-min)) ! ;; Remove whitespace between encoded words. ! (while (re-search-forward ! (concat "\\(" rfc2047-encoded-word-regexp "\\)" ! "\\(\n?[ \t]\\)+" ! "\\(" rfc2047-encoded-word-regexp "\\)") ! nil t) ! (delete-region (goto-char (match-end 1)) (match-beginning 6))) ! ;; Decode the encoded words. ! (goto-char (point-min)) ! (while (re-search-forward rfc2047-encoded-word-regexp nil t) ! (insert (rfc2047-parse-and-decode ! (prog1 ! (match-string 0) ! (delete-region (match-beginning 0) (match-end 0))))))))) ;;;###autoload (defun rfc2047-decode-string (string) --- 227,256 ---- (defun rfc2047-decode-region (start end) "Decode MIME-encoded words in region between START and END." (interactive "r") ! (let ((case-fold-search t) ! b e) ! (save-excursion ! (save-restriction ! (narrow-to-region start end) ! (goto-char (point-min)) ! ;; Remove whitespace between encoded words. ! (while (re-search-forward ! (concat "\\(" rfc2047-encoded-word-regexp "\\)" ! "\\(\n?[ \t]\\)+" ! "\\(" rfc2047-encoded-word-regexp "\\)") ! nil t) ! (delete-region (goto-char (match-end 1)) (match-beginning 6))) ! ;; Decode the encoded words. ! (setq b (goto-char (point-min))) ! (while (re-search-forward rfc2047-encoded-word-regexp nil t) ! (setq e (match-beginning 0)) ! (insert (rfc2047-parse-and-decode ! (prog1 ! (match-string 0) ! (delete-region (match-beginning 0) (match-end 0))))) ! (decode-coding-region b e rfc2047-default-charset) ! (setq b (point))) ! (decode-coding-region b (point-max) rfc2047-default-charset))))) ;;;###autoload (defun rfc2047-decode-string (string) *************** *** 277,283 **** (mm-decode-coding-string (cond ((equal "B" encoding) ! (base64-decode string)) ((equal "Q" encoding) (quoted-printable-decode-string (mm-replace-chars-in-string string ?_ ? ))) --- 285,293 ---- (mm-decode-coding-string (cond ((equal "B" encoding) ! (if (fboundp 'base64-decode-string) ! (base64-decode-string string) ! (base64-decode string))) ((equal "Q" encoding) (quoted-printable-decode-string (mm-replace-chars-in-string string ?_ ? ))) *** pub/pgnus/lisp/ChangeLog Thu Sep 3 15:24:44 1998 --- pgnus/lisp/ChangeLog Sat Sep 5 01:46:08 1998 *************** *** 1,3 **** --- 1,46 ---- + Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.15 is released. + + 1998-09-05 00:21:22 Lars Magne Ingebrigtsen + + * date.el: New file. + + * gnus-util.el (gnus-encode-date): Removed. + (gnus-time-less): Ditto. + + * nnmail.el (nnmail-date-to-time): Removed. + (nnmail-time-less): Ditto. + (nnmail-days-to-time): Ditto. + (nnmail-time-since): Ditto. + + * drums.el: New file. + + 1998-09-04 00:25:52 Lars Magne Ingebrigtsen + + * message.el (message-encode-message-body): Encode headers with + body encoding. + + * rfc2047.el (rfc2047-default-charset): Renamed. + (rfc2047-encodable-p): Use it. + + * base64.el (mm-util): Required. + + 1998-09-03 16:28:30 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-post-method): Peel off real info from opened + servers. + + * gnus-util.el (gnus-output-to-rmail): Removed. + + * gnus-art.el (gnus-summary-save-in-rmail): Use + gnus-output-to-rmailrmail-output-to-rmail-file. + + * rfc2047.el (rfc2047-decode-region): Fold case. + (rfc2047-decode): Use decode-string. + + * mm-util.el: Provide mm-char-int. + Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.14 is released. *** pub/pgnus/texi/gnus.texi Thu Sep 3 15:24:47 1998 --- pgnus/texi/gnus.texi Sat Sep 5 01:46:15 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.14 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.15 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.14 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.15 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.14. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.15. @end ifinfo *************** *** 6295,6301 **** @vindex gnus-article-hide-pgp-hook Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). The @code{gnus-article-hide-pgp-hook} hook will be run after a @sc{pgp} ! signature has been hidden. @item W W P @kindex W W P (Summary) --- 6295,6316 ---- @vindex gnus-article-hide-pgp-hook Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). The @code{gnus-article-hide-pgp-hook} hook will be run after a @sc{pgp} ! signature has been hidden. For example, to automatically verify ! articles that have signatures in them do: ! @lisp ! ;;; Hide pgp cruft if any. ! ! (add-hook 'gnus-article-display-hook 'gnus-article-hide-pgp) ! ! ;;; After hiding pgp, verify the message; ! ;;; only happens if pgp signature is found. ! ! (add-hook 'gnus-article-hide-pgp-hook ! (lambda () ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (mc-verify)))) ! @end lisp @item W W P @kindex W W P (Summary) *** pub/pgnus/texi/message.texi Thu Sep 3 15:24:47 1998 --- pgnus/texi/message.texi Sat Sep 5 01:46:15 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.14 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.15 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.14 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.15 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.14. Message is distributed with the Gnus distribution bearing the same version number as this manual has. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.15. Message is distributed with the Gnus distribution bearing the same version number as this manual has. *** pub/pgnus/texi/ChangeLog Tue Sep 1 10:28:30 1998 --- pgnus/texi/ChangeLog Sat Sep 5 01:46:16 1998 *************** *** 1,3 **** --- 1,7 ---- + 1998-09-04 00:40:07 David S. Goldberg + + * gnus.texi (Article Hiding): Verify. + 1998-08-31 11:46:57 Lars Magne Ingebrigtsen * gnus.texi (Mail Folders): Addition.