From: ichikawa Date: Sat, 14 Nov 1998 08:58:21 +0000 (+0000) Subject: Importing pgnus-0.44 X-Git-Tag: pgnus-0_44~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=67ebfaaccdebf3a32fdcb37d3a06faf620b4f651;p=elisp%2Fgnus.git- Importing pgnus-0.44 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 36c3242..7329efd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,92 @@ +Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.44 is released. + +1998-11-14 03:59:14 Lars Magne Ingebrigtsen + + * message.el (message-format-mime): New function. + + * nndraft.el (nndraft-save-mime-part): New function. + (nndraft-get-mime-part): New function. + + * mm-encode.el (mm-default-file-encoding): New function. + (mm-content-transfer-encoding): New function. + (mm-encode-buffer): New function. + + * message.el: New command. + (message-mime-part): New variable. + (message-insert-mime-part): New command. + + * mm-encode.el (mm-encode-content-transfer-encoding): New + function. + + * mm-util.el (mm-content-transfer-encoding-defaults): New + variable. + (mm-mime-file-types): Taken from TM. + +Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.43 is released. + +1998-11-07 Karl Kleinpaste + + * gnus-cus.el (gnus-score-customize): Add "Extra" element. + * gnus-score.el (gnus-score-default-header): Ditto. + (gnus-header-index): Ditto. + (gnus-summary-increase-score): Ditto, & process "extra" requests. + (gnus-summary-header): Handle extra headers. + (gnus-summary-score-entry): Ditto, & provide new score element. + (gnus-summary-score-effect): Ditto. + (gnus-score-string): Avoid "extra" string sort, & modify match in + "extra" case. + * gnus-sum.el (gnus-make-score-map): Add "extra" element. + +1998-11-13 20:30:40 Lars Magne Ingebrigtsen + + * message.el (message-resend): Bind message-required-mail-headers + to nil. + + * mm-view.el (mm-inline-text): Bind w3-strict-width. + + * nngateway.el (require): Require cl. + + * gnus-art.el (gnus-button-alist): Exclude more chars from news: + things. + +Wed Nov 11 02:15:06 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-headers): Create directory even + when no articles. + +1998-11-13 19:25:10 Lars Magne Ingebrigtsen + + * message.el (message-ignored-resent-headers): Remove X-Gnus. + +1998-11-10 Colin Rafferty + + * gnus-sum.el (gnus-ignored-from-addresses): Only quote + user-mail-address if non-nil. + +1998-11-13 18:50:18 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-make-sort-function): Do `reverse'. + (gnus-make-sort-function-1): Ditto. + + * gnus-art.el (gnus-mm-display-part): Switch to mm in right + window. + +1998-11-12 22:31:58 Lars Magne Ingebrigtsen + + * mm-util.el (mm-with-unibyte-buffer): Ditto. + + * binhex.el (binhex-decode-region): Quote. + +1998-11-10 05:32:28 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-charset): Don't downcase charset. + + * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's. + Sun Nov 8 23:17:24 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.42 is released. diff --git a/lisp/binhex.el b/lisp/binhex.el index e4e3aa2..a8f37a2 100644 --- a/lisp/binhex.el +++ b/lisp/binhex.el @@ -3,7 +3,7 @@ ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 -;; $Revision: 1.1.1.1 $ +;; $Revision: 1.1.1.2 $ ;; Time-stamp: ;; Keywords: binhex @@ -206,7 +206,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (when (re-search-forward binhex-begin-line end t) (if (boundp 'enable-multibyte-characters) (let ((multibyte - (default-value enable-multibyte-characters))) + (default-value 'enable-multibyte-characters))) (setq-default enable-multibyte-characters nil) (setq work-buffer (generate-new-buffer " *binhex-work*")) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index c518414..5f80f82 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -558,7 +558,8 @@ the actual number of articles toggled is returned." (gnus-delete-line)) (insert group " " (number-to-string (cdr active)) " " (number-to-string (car active)) " y\n")) - (when (re-search-forward (concat (regexp-quote group) "\\($\\| \\)") nil t) + (when (re-search-forward + (concat (regexp-quote group) "\\($\\| \\)") nil t) (gnus-delete-line)) (insert-buffer-substring nntp-server-buffer)))))) @@ -771,8 +772,11 @@ the actual number of articles toggled is returned." (cons (1+ (caar (last gnus-agent-article-alist))) (cdr (gnus-active group))))) (gnus-list-of-unread-articles group))) - (gnus-decode-encoded-word-function 'identity)) + (gnus-decode-encoded-word-function 'identity) + (file (gnus-agent-article-name ".overview" group))) ;; Fetch them. + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file))) (when articles (gnus-message 7 "Fetching headers for %s..." group) (save-excursion @@ -781,21 +785,17 @@ the actual number of articles toggled is returned." (nnvirtual-convert-headers)) ;; Save these headers for later processing. (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - (let (file) - (when (file-exists-p - (setq file (gnus-agent-article-name ".overview" group))) - (gnus-agent-braid-nov group articles file)) - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file))) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent)) - (gnus-agent-save-alist group articles nil) - (gnus-agent-enter-history - "last-header-fetched-for-session" - (list (cons group (nth (- (length articles) 1) articles))) - (time-to-days (current-time))) - articles))))) + (when (file-exists-p file) + (gnus-agent-braid-nov group articles file)) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)) + (gnus-agent-save-alist group articles nil) + (gnus-agent-enter-history + "last-header-fetched-for-session" + (list (cons group (nth (- (length articles) 1) articles))) + (time-to-days (current-time))) + articles)))) (defsubst gnus-agent-copy-nov-line (article) (let (b e) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 660b086..cedbec9 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1037,8 +1037,6 @@ If PROMPT (the prefix), prompt for a coding system to use." (gnus-group-find-parameter gnus-newsgroup-name 'charset)))) buffer-read-only) - (when charset - (setq charset (downcase charset))) (goto-char (point-max)) (widen) (forward-line 1) @@ -2334,7 +2332,13 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-insert-mime-button handle id (list (not (mm-handle-displayed-p handle)))) (prog1 - (mm-display-part handle) + (let ((window (selected-window))) + (save-excursion + (unwind-protect + (progn + (select-window (get-buffer-window (current-buffer) t)) + (mm-display-part handle)) + (select-window window)))) (goto-char point)))) (defun gnus-article-goto-part (n) @@ -3110,9 +3114,9 @@ groups." :type 'regexp) (defcustom gnus-button-alist - `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t - gnus-button-message-id 2) - ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1) + `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^)!;:,>\n\t ]*\\)>" + 0 t gnus-button-message-id 2) + ("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t gnus-button-fetch-group 4) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 7474f37..b71e2a9 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -601,6 +601,7 @@ if you do all your changes will be lost. ") (gnus-score-string :tag "Subject") (gnus-score-string :tag "References") (gnus-score-string :tag "Xref") + (gnus-score-string :tag "Extra") (gnus-score-string :tag "Message-ID") (gnus-score-integer :tag "Lines") (gnus-score-integer :tag "Chars") diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index f5505be..64824b2 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -308,6 +308,7 @@ Should be one of the following symbols. i: message-id t: references x: xref + e: `extra' (non-standard overview) l: lines d: date f: followup @@ -321,6 +322,7 @@ If nil, the user will be asked for a header." (const :tag "message-id" i) (const :tag "references" t) (const :tag "xref" x) + (const :tag "extra" e) (const :tag "lines" l) (const :tag "date" d) (const :tag "followup" f) @@ -444,6 +446,7 @@ of the last successful match.") ("chars" 6 gnus-score-integer) ("lines" 7 gnus-score-integer) ("xref" 8 gnus-score-string) + ("extra" 9 gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) @@ -502,6 +505,7 @@ used as score." (?i "message-id" nil t string) (?r "references" "message-id" nil string) (?x "xref" nil nil string) + (?e "extra" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) (?f "followup" nil nil string) @@ -530,7 +534,7 @@ used as score." (aref (symbol-name gnus-score-default-type) 0))) (pchar (and gnus-score-default-duration (aref (symbol-name gnus-score-default-duration) 0))) - entry temporary type match) + entry temporary type match extra) (unwind-protect (progn @@ -622,9 +626,26 @@ used as score." ;; Always kill the score help buffer. (gnus-score-kill-help-buffer)) + ;; If scoring an extra (non-standard overview) header, + ;; we must find out which header is in question. + (setq extra + (and gnus-extra-headers + (equal (nth 1 entry) "extra") + (intern ; need symbol + (gnus-completing-read + (symbol-name (car gnus-extra-headers)) ; default response + "Score extra header:" ; prompt + (mapcar (lambda (x) ; completion list + (cons (symbol-name x) x)) + gnus-extra-headers) + nil ; no completion limit + t)))) ; require match + ;; extra is now nil or a symbol. + ;; We have all the data, so we enter this score. (setq match (if (string= (nth 2 entry) "") "" - (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) + (gnus-summary-header (or (nth 2 entry) (nth 1 entry)) + nil extra))) ;; Modify the match, perhaps. (cond @@ -660,7 +681,9 @@ used as score." (if (eq temporary 'perm) ; Temp nil temporary) - (not (nth 3 entry))) ; Prompt + (not (nth 3 entry)) ; Prompt + nil ; not silent + extra) ; non-standard overview. (when (eq symp 'a) ;; We change the score file back to the previous one. @@ -709,14 +732,16 @@ used as score." (shrink-window-if-larger-than-buffer)) (select-window (get-buffer-window gnus-summary-buffer)))) -(defun gnus-summary-header (header &optional no-err) +(defun gnus-summary-header (header &optional no-err extra) ;; Return HEADER for current articles, or error. (let ((article (gnus-summary-article-number)) headers) (if article (if (and (setq headers (gnus-summary-article-header article)) (vectorp headers)) - (aref headers (nth 1 (assoc header gnus-header-index))) + (if extra ; `header' must be "extra" + (or (cdr (assq extra (mail-header-extra headers))) "") + (aref headers (nth 1 (assoc header gnus-header-index)))) (if no-err nil (error "Pseudo-articles can't be scored"))) @@ -742,7 +767,7 @@ used as score." (gnus-newsgroup-score-alist))))) (defun gnus-summary-score-entry (header match type score date - &optional prompt silent) + &optional prompt silent extra) (interactive) "Enter score file entry. HEADER is the header being scored. @@ -751,7 +776,8 @@ TYPE is the match type: substring, regexp, exact, fuzzy. SCORE is the score to add. DATE is the expire date, or nil for no expire, or 'now for immediate expire. If optional argument `PROMPT' is non-nil, allow user to edit match. -If optional argument `SILENT' is nil, show effect of score entry." +If optional argument `SILENT' is nil, show effect of score entry. +If optional argument `EXTRA' is non-nil, it's a non-standard overview header." ;; Regexp is the default type. (when (eq type t) (setq type 'r)) @@ -792,6 +818,11 @@ If optional argument `SILENT' is nil, show effect of score entry." elem) (setq new (cond + (extra + (list match score + (and date (if (numberp date) date + (date-to-day date))) + type (symbol-name extra))) (type (list match score (and date (if (numberp date) date @@ -822,18 +853,19 @@ If optional argument `SILENT' is nil, show effect of score entry." (if (and (>= (nth 1 (assoc header gnus-header-index)) 0) (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-string)) - (gnus-summary-score-effect header match type score) + (gnus-summary-score-effect header match type score extra) (gnus-summary-rescore))) ;; Return the new scoring rule. new)) -(defun gnus-summary-score-effect (header match type score) +(defun gnus-summary-score-effect (header match type score extra) "Simulate the effect of a score file entry. HEADER is the header being scored. MATCH is the string we are looking for. TYPE is the score type. -SCORE is the score to add." +SCORE is the score to add. +EXTRA is the possible non-standard header." (interactive (list (completing-read "Header: " gnus-header-index (lambda (x) (fboundp (nth 2 x))) @@ -854,7 +886,7 @@ SCORE is the score to add." (t (regexp-quote match))))) (while (not (eobp)) - (let ((content (gnus-summary-header header 'noerr)) + (let ((content (gnus-summary-header header 'noerr extra)) (case-fold-search t)) (and content (when (if (eq type 'f) @@ -1866,12 +1898,23 @@ SCORE is the score to add." ;; and U is the number of unique headers. It is assumed (but ;; untested) this will be a net win because of the large constant ;; factor involved with string matching. - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) + (setq gnus-scores-articles + ;; We cannot string-sort the extra headers list. *sigh* + (if (= gnus-score-index 9) + gnus-scores-articles + (sort gnus-scores-articles 'gnus-score-string<)) articles gnus-scores-articles) (erase-buffer) (while (setq art (pop articles)) (setq this (aref (car art) gnus-score-index)) + + ;; If we're working with non-standard headers, we are stuck + ;; with working on them as a group. What a hassle. + ;; Just wait 'til you see what horrors we commit against `match'... + (if (= gnus-score-index 9) + (setq this (prin1-to-string this))) ; ick. + (if simplify (setq this (gnus-map-function gnus-simplify-subject-functions this))) (if (equal last this) @@ -1902,6 +1945,7 @@ SCORE is the score to add." (type (or (nth 3 kill) 's)) (score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) + (extra (nth 4 kill)) ; non-standard header; string. (found nil) (mt (aref (symbol-name type) 0)) (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) @@ -1917,6 +1961,12 @@ SCORE is the score to add." ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ((= dmt ?w) nil) (t (error "Illegal match type: %s" type))))) + + ;; Evil hackery to make match usable in non-standard headers. + (when extra + (setq match (concat "[ (](" extra " \\. \"[^)]*" match "[^(]*\")[ )]") + search-func 're-search-forward)) ; XXX danger?!? + (cond ;; Fuzzy matches. We save these for later. ((= dmt ?f) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 2fba73e..06c6cdf 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -778,7 +778,8 @@ which it may alter in any way.") :group 'gnus-summary :type '(repeat symbol)) -(defcustom gnus-ignored-from-addresses (regexp-quote user-mail-address) +(defcustom gnus-ignored-from-addresses + (and user-mail-address (regexp-quote user-mail-address)) "*Regexp of From headers that may be suppressed in favor of To headers." :group 'gnus-summary :type 'regexp) @@ -1822,6 +1823,7 @@ increase the score of each group you read." ("article body" "body" string) ("article head" "head" string) ("xref" "xref" string) + ("extra header" "extra" string) ("lines" "lines" number) ("followups to author" "followup" string))) (types '((number ("less than" <) @@ -2389,7 +2391,7 @@ marks of articles." (defun gnus-summary-last-article-p (&optional article) "Return whether ARTICLE is the last article in the buffer." (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existent numbers are the last article. :-) + t ; All non-existent numbers are the last article. :-) (not (cdr (gnus-data-find-list article))))) (defun gnus-make-thread-indent-array () @@ -2613,7 +2615,7 @@ If NO-DISPLAY, don't generate a summary buffer." kill-buffer no-display select-articles) (setq show-all nil - select-articles nil))))) + select-articles nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) ;; The entry function called above goes to the next @@ -4209,7 +4211,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) - type list newmarked symbol delta-marks) + type list newmarked symbol delta-marks) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) @@ -4631,6 +4633,9 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." number headers header) (save-excursion (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (replace-match " " t t)) ;; Allow the user to mangle the headers before parsing them. (gnus-run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) @@ -4699,14 +4704,14 @@ the subject line on." (let* ((line (and (numberp old-header) old-header)) (old-header (and (vectorp old-header) old-header)) (header (cond ((and old-header use-old-header) - old-header) - ((and (numberp id) - (gnus-number-to-header id)) - (gnus-number-to-header id)) - (t - (gnus-read-header id)))) - (number (and (numberp id) id)) - d) + old-header) + ((and (numberp id) + (gnus-number-to-header id)) + (gnus-number-to-header id)) + (t + (gnus-read-header id)))) + (number (and (numberp id) id)) + d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. @@ -5943,9 +5948,9 @@ Return nil if there are no articles." (interactive) (prog1 (when (gnus-summary-first-subject) - (gnus-summary-show-thread) - (gnus-summary-first-subject) - (gnus-summary-display-article (gnus-summary-article-number))) + (gnus-summary-show-thread) + (gnus-summary-first-subject) + (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) (defun gnus-summary-best-unread-article () @@ -6729,6 +6734,7 @@ Optional argument BACKWARD means do search for backward. ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) + (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-article-display-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. @@ -6736,8 +6742,9 @@ Optional argument BACKWARD means do search for backward. (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) + (gnus-display-mime-function nil) (found nil) - point gnus-display-mime-function) + point) (gnus-save-hidden-threads (gnus-summary-select-article) (set-buffer gnus-article-buffer) @@ -9047,7 +9054,7 @@ save those articles instead." (push (cons prev (cdr active)) read)) (setq read (if (> (length read) 1) (nreverse read) read)) (if compute - read + read (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register @@ -9057,7 +9064,7 @@ save those articles instead." (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. - (gnus-info-set-read info read) + (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 678aba1..29052c6 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -478,21 +478,35 @@ If N, return the Nth ancestor instead." (defun gnus-make-sort-function (funs) "Return a composite sort condition based on the functions in FUNC." (cond - ((not (listp funs)) funs) + ;; Just a simple function. + ((gnus-functionp funs) funs) + ;; No functions at all. ((null funs) funs) - ((cdr funs) + ;; A list of functions. + ((or (cdr funs) + (listp (car funs))) `(lambda (t1 t2) ,(gnus-make-sort-function-1 (reverse funs)))) + ;; A list containing just one function. (t (car funs)))) (defun gnus-make-sort-function-1 (funs) "Return a composite sort condition based on the functions in FUNC." - (if (cdr funs) - `(or (,(car funs) t1 t2) - (and (not (,(car funs) t2 t1)) - ,(gnus-make-sort-function-1 (cdr funs)))) - `(,(car funs) t1 t2))) + (let ((function (car funs)) + (first 't1) + (last 't2)) + (when (consp function) + (if (eq (car function) 'not) + (setq function (cadr function) + first 't2 + last 't1) + (error "Invalid sort spec: %s" function))) + (if (cdr funs) + `(or (,function ,first ,last) + (and (not (,function ,last ,first)) + ,(gnus-make-sort-function-1 (cdr funs)))) + `(,function ,first ,last)))) (defun gnus-turn-off-edit-menu (type) "Turn off edit menu in `gnus-TYPE-mode-map'." diff --git a/lisp/gnus.el b/lisp/gnus.el index e05b3c3..a2ca37b 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -254,7 +254,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.42" +(defconst gnus-version-number "0.44" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) diff --git a/lisp/message.el b/lisp/message.el index 0f746c6..3696495 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -321,7 +321,7 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-receipt" +(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) @@ -863,6 +863,7 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-this-is-news nil) (defvar message-this-is-mail nil) (defvar message-draft-article nil) +(defvar message-mime-part nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) @@ -1273,6 +1274,8 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) + (define-key message-mode-map "\C-c\C-a" 'message-insert-mime-part) + (define-key message-mode-map "\t" 'message-tab)) (easy-menu-define @@ -1341,8 +1344,7 @@ C-c C-z message-kill-to-signature (kill the text up to the signature). C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) - (make-local-variable 'message-reply-buffer) - (setq message-reply-buffer nil) + (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) (make-local-variable 'message-kill-actions) @@ -1384,10 +1386,9 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (make-local-variable 'message-newsreader) (make-local-variable 'message-mailer) (make-local-variable 'message-post-method) - (make-local-variable 'message-sent-message-via) - (setq message-sent-message-via nil) - (make-local-variable 'message-checksum) - (setq message-checksum nil) + (set (make-local-variable 'message-sent-message-via) nil) + (set (make-local-variable 'message-checksum) nil) + (set (make-local-variable 'message-mime-part) 0) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) (when (string-match "XEmacs\\|Lucid" emacs-version) @@ -3798,7 +3799,8 @@ Optional NEWS will use news to forward instead of mail." (when (looking-at "From ") (replace-match "X-From-Line: ")) ;; Send it. - (message-send-mail) + (let (message-required-mail-headers) + (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) @@ -4074,6 +4076,7 @@ regexp varstr." (defun message-encode-message-body () "Examine the message body, encode it, and add the requisite headers." + (message-format-mime) (when (featurep 'mule) (let (old-headers) (save-excursion @@ -4081,7 +4084,8 @@ regexp varstr." (message-narrow-to-headers-or-head) (unless (setq old-headers (message-fetch-field "mime-version")) (message-remove-header - "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t)) + "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" + t)) (goto-char (point-max)) (widen) (narrow-to-region (point) (point-max)) @@ -4101,6 +4105,50 @@ regexp varstr." (mm-insert-rfc822-headers charset encoding)) (mm-encode-body))))))) +(defun message-insert-mime-part (file type) + "Insert a multipart/alternative part into the buffer." + (interactive + (let* ((file (read-file-name "Insert file: " nil nil t)) + (type (mm-default-file-encoding file))) + (setq mime-type + (read-string (format "MIME type for %s: " file) (car type))) + (unless (equal mime-type (car type)) + (setq type (list mime-type))) + (list file type))) + + (insert (format "-*[%s %d]*-\n" (car type) (incf message-mime-part))) + (let ((current buffer-file-name) + (part message-mime-part)) + (mm-with-unibyte-buffer + (insert-file file) + (mm-insert-headers type (mm-encode-buffer type) file) + (nndraft-save-mime-part current part)))) + +(defun message-format-mime () + "Insert all the MIME parts." + (when (not (zerop message-mime-part)) + (message-narrow-to-headers) + (goto-char (point-max)) + (let ((boundary (mm-insert-multipart-headers)) + (current buffer-file-name)) + (widen) + (forward-line 1) + (insert "This is a MIME message. If you are reading this -- *phphthth*.\n\n") + (insert "--" boundary "\n\n") + (while (re-search-forward + "-\\*\\[\\([-a-z/A-Z0-9]+\\) \\([0-9]+\\)\\]\\*-" nil t) + (let ((part (string-to-number (match-string 2)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert "\n--" boundary "\n") + (narrow-to-region (point) (point)) + (nndraft-get-mime-part current part) + (goto-char (point-max)) + (widen) + (insert "\n--" boundary "\n\n") + )) + (goto-char (point-max)) + (insert "\n--" boundary "--\n")))) + (run-hooks 'message-load-hook) (provide 'message) diff --git a/lisp/mm-encode.el b/lisp/mm-encode.el index 44ab492..e3bd0af 100644 --- a/lisp/mm-encode.el +++ b/lisp/mm-encode.el @@ -26,6 +26,55 @@ (require 'mail-parse) +(defvar mm-mime-file-types + '(("\\.rtf$" "text/richtext") + ("\\.\\(html\\|htm\\)$" "text/html") + ("\\.ps$" "application/postscript" + (encoding quoted-printable) + (disposition "attachment")) + ("\\.\\(jpeg\\|jpg\\)$" "image/jpeg") + ("\\.gif$" "image/gif") + ("\\.png$" "image/png") + ("\\.\\(tiff\\|tif\\)$" "image/tiff") + ("\\.pic$" "image/x-pic") + ("\\.mag$" "image/x-mag") + ("\\.xbm$" "image/x-xbm") + ("\\.xwd$" "image/x-xwd") + ("\\.au$" "audio/basic") + ("\\.mpg$" "video/mpeg") + ("\\.txt$" "text/plain") + ("\\.el$" "application/octet-stream" + ("type" ."emacs-lisp")) + ("\\.lsp$" "application/octet-stream" + ("type" "common-lisp")) + ("\\.tar\\.gz$" "application/octet-stream" + ("type" "tar+gzip")) + ("\\.tgz$" "application/octet-stream" + ("type" "tar+gzip")) + ("\\.tar\\.Z$" "application/octet-stream" + ("type" "tar+compress")) + ("\\.taz$" "application/octet-stream" + ("type" "tar+compress")) + ("\\.gz$" "application/octet-stream" + ("type" "gzip")) + ("\\.Z$" "application/octet-stream" + ("type" "compress")) + ("\\.lzh$" "application/octet-stream" + ("type" . "lha")) + ("\\.zip$" "application/zip") + ("\\.diffs?$" "text/plain" + ("type" . "patch")) + ("\\.patch$" "application/octet-stream" + ("type" "patch")) + ("\\.signature" "text/plain") + (".*" "application/octet-stream")) + "*Alist of regexps and MIME types.") + +(defvar mm-content-transfer-encoding-defaults + '(("text/.*" quoted-printable) + (".*" base64)) + "Alist of regexps that match MIME types and their encodings.") + (defun mm-insert-rfc822-headers (charset encoding) "Insert text/plain headers with CHARSET and ENCODING." (insert "MIME-Version: 1.0\n") @@ -34,6 +83,84 @@ (insert "Content-Transfer-Encoding: " (downcase (symbol-name encoding)) "\n")) +(defun mm-insert-multipart-headers () + "Insert multipart/mixed headers." + (let ((boundary "=-=-=")) + (insert "MIME-Version: 1.0\n") + (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" + boundary)) + boundary)) + +(defun mm-default-file-encoding (file) + "Return a default encoding for FILE." + (let ((types mm-mime-file-types) + type) + (catch 'found + (while (setq type (pop types)) + (when (string-match (car type) file) + (throw 'found (cdr type))) + (pop types))))) + +(defun mm-encode-content-transfer-encoding (encoding &optional type) + (cond + ((eq encoding 'quoted-printable) + (quoted-printable-encode-region (point-min) (point-max))) + ((eq encoding 'base64) + (when (equal type "text/plain") + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match "\r\n" t t))) + (condition-case () + (base64-encode-region (point-min) (point-max)) + (error nil))) + ((memq encoding '(7bit 8bit binary)) + ) + ((null encoding) + ) + ((eq encoding 'x-uuencode) + (condition-case () + (uudecode-encode-region (point-min) (point-max)) + (error nil))) + ((functionp encoding) + (condition-case () + (funcall encoding (point-min) (point-max)) + (error nil))) + (t + (message "Unknown encoding %s; defaulting to 8bit" encoding)))) + +(defun mm-encode-buffer (type) + "Encode the buffer which contains data of TYPE. +The encoding used is returned." + (let* ((mime-type (if (stringp type) type (car type))) + (encoding + (or (and (listp type) + (cadr (assq 'encoding type))) + (mm-content-transfer-encoding mime-type)))) + (mm-encode-content-transfer-encoding encoding mime-type) + encoding)) + +(defun mm-insert-headers (type encoding &optional file) + "Insert headers for TYPE." + (insert "Content-Type: " (car type)) + (when file + (insert ";\n\tname=\"" (file-name-nondirectory file) "\"")) + (insert "\n") + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + (insert "Content-Disposition: inline") + (when file + (insert ";\n\tfilename=\"" (file-name-nondirectory file) "\"")) + (insert "\n") + (insert "\n")) + +(defun mm-content-transfer-encoding (type) + "Return a CTE suitable for TYPE." + (let ((rules mm-content-transfer-encoding-defaults)) + (catch 'found + (while rules + (when (string-match (caar rules) type) + (throw 'found (cadar rules))) + (pop rules))))) + (provide 'mm-encode) ;;; mm-encode.el ends here diff --git a/lisp/mm-util.el b/lisp/mm-util.el index eeff82f..699e183 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -169,7 +169,7 @@ used as the line break code type of the coding system." (defsubst mm-enable-multibyte () "Enable multibyte in the current buffer." (when (and (fboundp 'set-buffer-multibyte) - (default-value enable-multibyte-characters)) + (default-value 'enable-multibyte-characters)) (set-buffer-multibyte t))) (defsubst mm-disable-multibyte () @@ -205,7 +205,7 @@ See also `with-temp-file' and `with-output-to-string'." (multibyte (make-symbol "multibyte"))) `(if (not (boundp 'enable-multibyte-characters)) (with-temp-buffer ,@forms) - (let ((,multibyte (default-value enable-multibyte-characters)) + (let ((,multibyte (default-value 'enable-multibyte-characters)) ,temp-buffer) (unwind-protect (progn @@ -231,7 +231,8 @@ See also `with-temp-file' and `with-output-to-string'." (save-restriction (narrow-to-region b e) (goto-char (point-min)) - (let ((entry (assoc current-language-environment language-info-alist))) + (let ((entry (assoc (capitalize current-language-environment) + language-info-alist))) (skip-chars-forward "\0-\177") (if (eobp) '(ascii) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 0335cdb..069858e 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -75,17 +75,19 @@ ,(set-marker (make-marker) (point-min)) ,(set-marker (make-marker) (point-max))))))))) ((equal type "html") - (save-excursion - (w3-do-setup) - (mm-with-unibyte-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (car (mm-handle-type handle))) - (require 'url) - (save-window-excursion - (w3-region (point-min) (point-max)) - (setq text (buffer-string))))) + (let ((width (window-width))) + (save-excursion + (w3-do-setup) + (mm-with-unibyte-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (car (mm-handle-type handle))) + (require 'url) + (save-window-excursion + (let ((w3-strict-width width)) + (w3-region (point-min) (point-max))) + (setq text (buffer-string)))))) (mm-insert-inline handle text)) ((or (equal type "enriched") (equal type "richtext")) diff --git a/lisp/nndraft.el b/lisp/nndraft.el index 52e2a01..1c10613 100644 --- a/lisp/nndraft.el +++ b/lisp/nndraft.el @@ -153,13 +153,22 @@ (with-temp-buffer (insert-buffer buf) (setq article (nndraft-request-accept-article - group (nnoo-current-server 'nndraft) t 'noinsert)) - (setq file (nndraft-article-filename article))) - (setq buffer-file-name (expand-file-name file)) - (setq buffer-auto-save-file-name (make-auto-save-file-name)) + group (nnoo-current-server 'nndraft) t 'noinsert) + file (nndraft-article-filename article))) + (setq buffer-file-name (expand-file-name file) + buffer-auto-save-file-name (make-auto-save-file-name)) (clear-visited-file-modtime) article)) +(defun nndraft-save-mime-part (file part) + "Save MIME PART belonging to the FILE." + (write-region (point-min) (point-max) + (format "%s.%d" file part))) + +(defun nndraft-get-mime-part (file part) + "Save MIME PART belonging to the FILE." + (insert-file-contents (format "%s.%d" file part))) + (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) diff --git a/lisp/nngateway.el b/lisp/nngateway.el index 41dc00a..51e20ad 100644 --- a/lisp/nngateway.el +++ b/lisp/nngateway.el @@ -25,6 +25,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'nnoo) (require 'message) diff --git a/lisp/nnoo.el b/lisp/nnoo.el index 9c27786..d676f0c 100644 --- a/lisp/nnoo.el +++ b/lisp/nnoo.el @@ -105,11 +105,11 @@ (cdr (assq pbackend (nnoo-parents backend)))) (prog1 (apply function args) - ;; Copy the changed variables back into the child. - (let ((vars (cdr (assq pbackend (nnoo-parents backend))))) - (while vars - (set (cadar vars) (symbol-value (caar vars))) - (setq vars (cdr vars))))))) + ;; Copy the changed variables back into the child. + (let ((vars (cdr (assq pbackend (nnoo-parents backend))))) + (while vars + (set (cadar vars) (symbol-value (caar vars))) + (setq vars (cdr vars))))))) (defun nnoo-execute (backend function &rest args) "Execute FUNCTION on behalf of BACKEND." diff --git a/make.bat b/make.bat index 4a6b8a0..d183af9 100755 --- a/make.bat +++ b/make.bat @@ -1,57 +1,57 @@ -@echo off - -rem Written by David Charlap - -rem There are two catches, however. The emacs.bat batch file may not exist -rem in all distributions. It is part of the Voelker build of Emacs 19.34 -rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user -rem installs Gnus with some other build, he may have to replace calls to -rem %1\emacs.bat with something else. -rem -rem Also, the emacs.bat file that Voelker ships does not accept more than 9 -rem parameters, so the attempts to compile the .texi files will fail. To -rem fix that (at least on NT. I don't know about Win95), the following -rem change should be made to emacs.bat: -rem -rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 -rem -rem should become -rem -rem %emacs_dir%\bin\emacs.exe %* -rem -rem which will allow the batch file to accept an unlimited number of -rem parameters. - -if "%1" == "" goto usage - -cd lisp -call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile -if not "%2" == "copy" goto info -copy *.el* %1\lisp - -:info -cd ..\texi -call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -if not "%2" == "copy" goto done -copy gnus %1\info -copy gnus-?? %1\info -copy message %1\info - -:etc -cd ..\etc -copy gnus-tut.txt %1\etc - -:done -cd .. -goto end - -:usage -echo Usage: make ^ [copy] -echo. -echo where: ^ is the directory you installed emacs in -echo eg. d:\emacs\19.34 -echo copy indicates that the compiled files should be copied to your -echo emacs lisp, info, and etc directories - -:end +@echo off + +rem Written by David Charlap + +rem There are two catches, however. The emacs.bat batch file may not exist +rem in all distributions. It is part of the Voelker build of Emacs 19.34 +rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user +rem installs Gnus with some other build, he may have to replace calls to +rem %1\emacs.bat with something else. +rem +rem Also, the emacs.bat file that Voelker ships does not accept more than 9 +rem parameters, so the attempts to compile the .texi files will fail. To +rem fix that (at least on NT. I don't know about Win95), the following +rem change should be made to emacs.bat: +rem +rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 +rem +rem should become +rem +rem %emacs_dir%\bin\emacs.exe %* +rem +rem which will allow the batch file to accept an unlimited number of +rem parameters. + +if "%1" == "" goto usage + +cd lisp +call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile +if not "%2" == "copy" goto info +copy *.el* %1\lisp + +:info +cd ..\texi +call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +if not "%2" == "copy" goto done +copy gnus %1\info +copy gnus-?? %1\info +copy message %1\info + +:etc +cd ..\etc +copy gnus-tut.txt %1\etc + +:done +cd .. +goto end + +:usage +echo Usage: make ^ [copy] +echo. +echo where: ^ is the directory you installed emacs in +echo eg. d:\emacs\19.34 +echo copy indicates that the compiled files should be copied to your +echo emacs lisp, info, and etc directories + +:end diff --git a/texi/gnus.texi b/texi/gnus.texi index 1499f1d..b368047 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.42 Manual +@settitle Pterodactyl Gnus 0.44 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.42 Manual +@title Pterodactyl Gnus 0.44 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.42. +This manual corresponds to Pterodactyl Gnus 0.44. @end ifinfo @@ -5188,7 +5188,10 @@ Matching}). @findex gnus-thread-sort-by-number @vindex gnus-thread-sort-functions If you are using a threaded summary display, you can sort the threads by -setting @code{gnus-thread-sort-functions}, which is a list of functions. +setting @code{gnus-thread-sort-functions}, which can be either a single +function, a list of functions, or a list containing functions and +@code{(not some-function)} elements. + By default, sorting is done on article numbers. Ready-made sorting predicate functions include @code{gnus-thread-sort-by-number}, @code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, @@ -5197,22 +5200,23 @@ predicate functions include @code{gnus-thread-sort-by-number}, Each function takes two threads and returns non-@code{nil} if the first thread should be sorted before the other. Note that sorting really is -normally done by looking only at the roots of each thread. If you use -more than one function, the primary sort key should be the last function -in the list. You should probably always include +normally done by looking only at the roots of each thread. + +If you use more than one function, the primary sort key should be the +last function in the list. You should probably always include @code{gnus-thread-sort-by-number} in the list of sorting functions---preferably first. This will ensure that threads that are equal with respect to the other sort criteria will be displayed in ascending article order. -If you would like to sort by score, then by subject, and finally by -number, you could do something like: +If you would like to sort by reverse score, then by subject, and finally +by number, you could do something like: @lisp (setq gnus-thread-sort-functions '(gnus-thread-sort-by-number gnus-thread-sort-by-subject - gnus-thread-sort-by-total-score)) + (reverse gnus-thread-sort-by-total-score))) @end lisp The threads that have highest score will be displayed first in the diff --git a/texi/message.texi b/texi/message.texi index a7c4d91..7ea85d5 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.42 Manual +@settitle Pterodactyl Message 0.44 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.42 Manual +@title Pterodactyl Message 0.44 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.42. Message is +This manual corresponds to Pterodactyl Message 0.44. Message is distributed with the Gnus distribution bearing the same version number as this manual.