From 62bb349be72fcd9f3547abc0db9cda65f1b68fcf Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 11 Sep 1998 11:11:10 +0000 Subject: [PATCH] Importing pgnus-0.26. --- lisp/ChangeLog | 46 ++++++++++++++++++++++++++ lisp/gnus-art.el | 91 ++++++++++++++++++++++++++++++++++++++++------------ lisp/gnus-cache.el | 3 +- lisp/gnus-int.el | 1 + lisp/gnus-sum.el | 8 ++--- lisp/gnus-util.el | 2 +- lisp/gnus.el | 2 +- lisp/mailcap.el | 10 +++--- lisp/message.el | 14 ++++---- lisp/mm-decode.el | 69 +++++++++++++++++++++++++++++++++------ lisp/mm-util.el | 3 ++ lisp/nnagent.el | 2 +- lisp/parse-time.el | 2 +- texi/ChangeLog | 6 ++++ texi/gnus.texi | 20 ++++++------ texi/message.texi | 8 +++-- 16 files changed, 223 insertions(+), 64 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f088f06..5c71c81 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,49 @@ +Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.26 is released. + +1998-09-11 08:25:33 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-interactively-view-part): New function. + + * gnus-art.el (gnus-mime-view-part): New command. + + * mm-decode.el (mm-last-shell-command): New variable. + + * mailcap.el (mailcap-mime-info): Allow returning all matches. + + * mm-decode.el (mm-save-part): New function. + + * gnus-art.el (article-decode-charset): Protect against buggy + content-types. + (gnus-mime-pipe-part): New command. + (gnus-mime-save-part): New command. + (gnus-mime-button-map): New keymap. + (gnus-mime-button-line-format): New variable. + (gnus-insert-mime-button): New function. + (gnus-display-mime): Use it. + + * gnus-util.el (gnus-dd-mmm): Removed length spec. + + * mm-decode.el (mm-inline-text): Decode charsets. + + * gnus-art.el (gnus-article-save): Comment fix. + + * gnus-int.el (gnus-start-news-server): When in batch, don't + prompt. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Don't + decode. + + * mm-decode.el (mm-inline-media-tests): Add audio. + (mm-inline-audio): New function. + +1998-09-11 08:19:22 Katsumi Yamaoka + + * gnus-art.el (article-make-date-line): Didn't work. + + * parse-time.el (parse-time-string): One too many nils. + Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.25 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index e99e8c4..d9a828a 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -543,7 +543,6 @@ displayed by the first non-nil matching CONTENT face." ;;; Internal variables -(defvar gnus-article-mime-handles nil) (defvar article-lapsed-timer nil) (defvar gnus-article-current-summary nil) @@ -963,11 +962,12 @@ If PROMPT (the prefix), prompt for a coding system to use." (let* ((inhibit-point-motion-hooks t) (ct (message-fetch-field "Content-Type" t)) (cte (message-fetch-field "Content-Transfer-Encoding" t)) - (ctl (and ct (drums-parse-content-type ct))) + (ctl (and ct (condition-case () (drums-parse-content-type ct) + (error nil)))) (charset (cond (prompt (mm-read-coding-system "Charset to decode: ")) - (ct + (ctl (drums-content-type-get ctl 'charset)) (gnus-newsgroup-name (gnus-group-find-parameter @@ -1350,17 +1350,26 @@ how much time has lapsed since DATE." ;; functions since they aren't particularly resistant to ;; buggy dates. ((eq type 'local) - (concat "Date: " (current-time-string time))) + (let ((tz (car (current-time-zone)))) + (format "Date: %s %s%04d" (current-time-string time) + (if (> tz 0) "+" "-") (abs (/ tz 36))))) ;; 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))))) + (let* ((e (parse-time-string date)) + (tm (apply 'encode-time e)) + (ms (car tm)) + (ls (- (cadr tm) (car (current-time-zone))))) + (cond ((< ls 0) (list (1- ms) (+ ls 65536))) + ((> ls 65535) (list (1+ ms) (- ls 65536))) + (t (list ms ls))))) + " UT")) ;; Get the original date from the article. ((eq type 'original) - (concat "Date: " date)) + (concat "Date: " (if (string-match "\n+$" date) + (substring date 0 (match-beginning 0)) + date))) ;; Let the user define the format. ((eq type 'user) (if (gnus-functionp gnus-article-time-format) @@ -1531,7 +1540,7 @@ This format is defined by the `gnus-article-time-format' variable." (if (not gnus-default-article-saver) (error "No default saver is defined") ;; !!! Magic! The saving functions all save - ;; `gnus-original-article-buffer' (or so they think), but we + ;; `gnus-save-article-buffer' (or so they think), but we ;; bind that variable to our save-buffer. (set-buffer gnus-article-buffer) (let* ((gnus-save-article-buffer save-buffer) @@ -2116,9 +2125,57 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) +;;; +;;; Gnus MIME viewing functions +;;; + +(defvar gnus-mime-button-line-format "%{%([%t%n]%)%}\n") +(defvar gnus-mime-button-line-format-alist + '((?t gnus-tmp-type ?s) + (?n gnus-tmp-name ?s))) + +(defvar gnus-mime-button-map nil) +(unless gnus-mime-button-map + (setq gnus-mime-button-map (make-sparse-keymap)) + (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) + (define-key gnus-mime-button-map "\r" 'gnus-article-press-button) + (define-key gnus-mime-button-map "\M-\r" 'gnus-mime-view-part) + (define-key gnus-mime-button-map "o" 'gnus-mime-save-part) + (define-key gnus-mime-button-map "|" 'gnus-mime-pipe-part)) + +(defun gnus-mime-save-part () + "Save the MIME part under point." + (interactive) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-save-part data))) + +(defun gnus-mime-pipe-part () + "Pipe the MIME part under point to a process." + (interactive) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-pipe-part data))) + +(defun gnus-mime-view-part () + "Interactively choose a view method for the MIME part under point." + (interactive) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-interactively-view-part data))) + +(defun gnus-insert-mime-button (handle) + (let ((gnus-tmp-name (drums-content-type-get (cadr handle) 'name)) + (gnus-tmp-type (caadr handle))) + (when gnus-tmp-name + (setq gnus-tmp-name (concat " (" gnus-tmp-name ")"))) + (gnus-eval-format + gnus-mime-button-line-format gnus-mime-button-line-format-alist + `(local-map ,gnus-mime-button-map + keymap ,gnus-mime-button-map + gnus-callback mm-display-part + gnus-data ,handle)))) + (defun gnus-display-mime () (let ((handles (mm-dissect-buffer)) - handle name type) + handle name type b e) (mapcar 'mm-destroy-part gnus-article-mime-handles) (setq gnus-article-mime-handles nil) (setq gnus-article-mime-handles (nconc gnus-article-mime-handles handles)) @@ -2127,17 +2184,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (search-forward "\n\n" nil t) (delete-region (point) (point-max)) (while (setq handle (pop handles)) - (setq name (drums-content-type-get (cadr handle) 'name) - type (caadr handle)) - (gnus-article-add-button - (point) - (progn - (insert - (format "[%s%s]" type (if name (concat " (" name ")") ""))) - (point)) - 'mm-display-part handle) - (insert "\n\n\n") - (when (mm-automatic-display-p type) + (gnus-insert-mime-button handle) + (insert "\n\n") + (when (mm-automatic-display-p (caadr handle)) (forward-line -2) (mm-display-part handle) (goto-char (point-max))))))) diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index bce2f54..c73de86 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -175,7 +175,8 @@ it's not cached." t ; The article already is saved. (save-excursion (set-buffer nntp-server-buffer) - (let ((gnus-use-cache nil)) + (let ((gnus-use-cache nil) + (gnus-article-decode-hook nil)) (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) (gnus-write-buffer file) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 0c4ff6f..d7970ff 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -91,6 +91,7 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." ;; gnus-open-server-hook might have opened it (gnus-server-opened gnus-select-method) (gnus-open-server gnus-select-method) + gnus-batch-mode (gnus-y-or-n-p (format "%s (%s) open error: '%s'. Continue? " diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index ebc08c0..146c5c0 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -763,6 +763,7 @@ which it may alter in any way.") ;;; Internal variables +(defvar gnus-article-mime-handles nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) @@ -4521,10 +4522,9 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." number dependencies force-new)))) (push header headers)) (forward-line 1)) - ;(error - ; (gnus-error 4 "Strange nov line (%d)" - ; (count-lines (point-min) (point)))) - ) + (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 -- diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 0c63370..5b1ca77 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -291,7 +291,7 @@ (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string." - (format-time-string "%2d-%b" (safe-date-to-time messy-date))) + (format-time-string "%d-%b" (safe-date-to-time messy-date))) (defmacro gnus-date-get-time (date) "Convert DATE string to Emacs time. diff --git a/lisp/gnus.el b/lisp/gnus.el index b3823cd..3d4e699 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,7 +250,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.25" +(defconst gnus-version-number "0.26" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/mailcap.el b/lisp/mailcap.el index d401499..a38bee3 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -602,16 +602,16 @@ If FORCE, re-parse even if already parsed." (t nil)))) (defun mailcap-mime-info (string &optional request) - "Get the mime viewer command for HEADERLINE, return nil if none found. -Expects a complete content-type header line as its argument. This can -be simple like text/html, or complex like text/plain; charset=blah; foo=bar + "Get the MIME viewer command for STRING, return nil if none found. +Expects a complete content-type header line as its argument. Second argument REQUEST specifies what information to return. If it is nil or the empty string, the viewer (second field of the mailcap entry) will be returned. If it is a string, then the mailcap field corresponding to that string will be returned (print, description, whatever). If a number, then all the information for this specific -viewer is returned." +viewer is returned. If `all', then all possible viewers for +this type is returned." (let ( major ; Major encoding (text, etc) minor ; Minor encoding (html, etc) @@ -652,6 +652,8 @@ viewer is returned." (if (or (string= request "test") (string= request "viewer")) (mailcap-unescape-mime-test (cdr-safe (assoc request viewer)) info))) + ((eq request 'all) + passed) (t ;; MUST make a copy *sigh*, else we modify mailcap-mime-data (setq viewer (copy-tree viewer)) diff --git a/lisp/message.el b/lisp/message.el index 8812edb..8d427c4 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,4 +1,3 @@ - ;;; message.el --- composing mail and news messages ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. @@ -1984,10 +1983,11 @@ the user from the mailer." (unless (bolp) (insert "\n")) ;; Delete all invisible text. - (when (text-property-any (point-min) (point-max) 'invisible t) - (put-text-property (point-min) (point-max) 'invisible nil) - (unless (yes-or-no-p "Invisible text found and made visible; continue posting?") - (error "Invisible text found and made visible")))) + (message-check 'invisible-text + (when (text-property-any (point-min) (point-max) 'invisible t) + (put-text-property (point-min) (point-max) 'invisible nil) + (unless (yes-or-no-p "Invisible text found and made visible; continue posting?") + (error "Invisible text found and made visible"))))) (defun message-add-action (action &rest types) "Add ACTION to be performed when doing an exit of type TYPES." @@ -2200,9 +2200,7 @@ to find out how to use this." (message-encode-message-body) (message-cleanup-headers) (if (not (message-check-news-syntax)) - (progn - ;;(message "Posting not performed") - nil) + nil (unwind-protect (save-excursion (set-buffer tembuf) diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 48b0496..4c4d23f 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -35,9 +35,15 @@ ("image/tiff" mm-inline-image (featurep 'tiff)) ("image/xbm" mm-inline-image (eq (device-type) 'x)) ("image/xpm" mm-inline-image (featurep 'xpm)) + ("image/bmp" mm-inline-image (featurep 'bmp)) ("text/plain" mm-inline-text t) ("text/html" mm-inline-text (featurep 'w3)) - ) + ("audio/wav" mm-inline-audio + (and (or (featurep 'nas-sound) (featurep 'native-sound)) + (device-sound-enabled-p))) + ("audio/au" mm-inline-audio + (and (or (featurep 'nas-sound) (featurep 'native-sound)) + (device-sound-enabled-p)))) "Alist of media types/test that say whether the media types can be displayed inline.") (defvar mm-user-display-methods @@ -53,6 +59,7 @@ ;;; Internal variables. (defvar mm-dissection-list nil) +(defvar mm-last-shell-command "") (defun mm-dissect-buffer (&optional no-strict-mime) "Dissect the current buffer and return a list of MIME handles." @@ -267,14 +274,58 @@ This overrides entries in the mailcap file." ((equal type "plain") (let ((b (point))) (insert text) - (setcar - (nthcdr 3 handle) - `(lambda () - (let (buffer-read-only) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point))))))))))) - - + (save-restriction + (narrow-to-region b (point)) + (let ((charset (drums-content-type-get (nth 1 handle) 'charset))) + (when charset + (mm-decode-body charset nil))) + (setcar + (nthcdr 3 handle) + `(lambda () + (let (buffer-read-only) + (delete-region ,(set-marker (make-marker) (point-min)) + ,(set-marker (make-marker) (point-max))))))))) + ))) + +(defun mm-inline-audio (handle) + (message "Not implemented")) + +;;; +;;; Functions for outputting parts +;;; + +(defun mm-save-part (handle) + "Write HANDLE to a file." + (let* ((name (drums-content-type-get (cadr handle) 'name)) + (file (read-file-name "Save MIME part to: " + (expand-file-name + (or name "") default-directory)))) + (mm-with-unibyte-buffer + (insert-buffer-substring (car handle)) + (mm-decode-content-transfer-encoding (nth 2 handle)) + (when (or (not (file-exists-p file)) + (yes-or-no-p (format "File %s already exists; overwrite? "))) + (write-region (point-min) (point-max) file))))) + +(defun mm-pipe-part (handle) + "Pipe HANDLE to a process." + (let* ((name (drums-content-type-get (cadr handle) 'name)) + (command + (read-string "Shell command on MIME part: " mm-last-shell-command))) + (mm-with-unibyte-buffer + (insert-buffer-substring (car handle)) + (mm-decode-content-transfer-encoding (nth 2 handle)) + (shell-command-on-region (point-min) (point-max) command nil)))) + +(defun mm-interactively-view-part (handle) + "Display HANDLE using METHOD." + (let* ((type (caadr handle)) + (methods + (mapcar (lambda (i) (list (cdr (assoc "viewer" i)))) + (mailcap-mime-info type 'all))) + (method (completing-read "Viewer: " methods))) + (mm-display-external (copy-sequence handle) method))) + (provide 'mm-decode) ;; mm-decode.el ends here diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 01ef03c..bcba15b 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -201,6 +201,9 @@ See also `with-temp-file' and `with-output-to-string'." (and (buffer-name ,temp-buffer) (kill-buffer ,temp-buffer)) (setq-default enable-multibyte-characters ,multibyte)))))) +(put 'mm-with-unibyte-buffer 'lisp-indent-function 0) +(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) + (provide 'mm-util) diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 714a07a..e77eb72 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -110,7 +110,7 @@ (deffoo nnagent-request-post (&optional server) (gnus-agent-insert-meta-information 'news gnus-command-method) - (gnus-request-accept-article "nndraft:queue")) + (gnus-request-accept-article "nndraft:queue" nil t t)) ;; Use nnml functions for just about everything. (nnoo-import nnagent diff --git a/lisp/parse-time.el b/lisp/parse-time.el index 4ade7b2..038541c 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -174,7 +174,7 @@ "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). 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)) + (let ((time (list nil nil nil nil nil nil nil nil nil)) (temp (parse-time-tokenize (downcase string)))) (while temp (let ((elt (pop temp)) diff --git a/texi/ChangeLog b/texi/ChangeLog index e627fea..7aee1f4 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,9 @@ +1998-09-11 08:52:50 Lars Magne Ingebrigtsen + + * gnus.texi (Group Score Commands): Fix. + (Saving Articles): Fix. + (Agent Expiry): Fix. + 1998-09-10 03:19:14 Lars Magne Ingebrigtsen * gnus.texi (Windows Configuration): Addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index ea0121e..4d94fc5 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.25 Manual +@settitle Pterodactyl Gnus 0.26 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 Pterodactyl Gnus 0.25 Manual +@title Pterodactyl Gnus 0.26 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.25. +This manual corresponds to Pterodactyl Gnus 0.26. @end ifinfo @@ -5501,7 +5501,7 @@ files. @vindex gnus-default-article-saver You can customize the @code{gnus-default-article-saver} variable to make -Gnus do what you want it to. You can use any of the four ready-made +Gnus do what you want it to. You can use any of the six ready-made functions below, or you can create your own. @table @code @@ -12037,16 +12037,16 @@ Agent (@code{gnus-agent-remove-server}). @node Agent Expiry @subsection Agent Expiry -@vindex gnus-agent-expiry-days -@findex gnus-agent-expiry -@kindex M-x gnus-agent-expiry +@vindex gnus-agent-expire-days +@findex gnus-agent-expire +@kindex M-x gnus-agent-expire @cindex Agent expiry @cindex Gnus Agent expiry @cindex expiry @code{nnagent} doesn't handle expiry. Instead, there's a special -@code{gnus-agent-expiry} command that will expire all read articles that -are older than @code{gnus-agent-expiry-days} days. It can be run +@code{gnus-agent-expire} command that will expire all read articles that +are older than @code{gnus-agent-expire-days} days. It can be run whenever you feel that you're running out of space. It's not particularly fast or efficient, and it's not a particularly good idea to interrupt it (with @kbd{C-g} or anything else) once you've started it. @@ -12464,7 +12464,7 @@ You can do scoring from the command line by saying something like: @findex gnus-batch-score @cindex batch scoring @example -$ emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score +$ emacs -batch -l ~/.emacs -l ~/.gnus.el -f gnus-batch-score @end example diff --git a/texi/message.texi b/texi/message.texi index 8a0d0fb..e5dbdeb 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.25 Manual +@settitle Pterodactyl Message 0.26 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.25 Manual +@title Pterodactyl Message 0.26 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.25. Message is +This manual corresponds to Pterodactyl Message 0.26. Message is distributed with the Gnus distribution bearing the same version number as this manual. @@ -956,6 +956,8 @@ Check whether the article has an @code{Approved} header, which is something only moderators should include. @item empty Check whether the article is empty. +@item invisible-text +Check whether there is any invisible text in the buffer. @item empty-headers Check whether any of the headers are empty. @item existing-newsgroups -- 1.7.10.4