+Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.44 is released.
+
+1998-11-14 03:59:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.43 is released.
+
+1998-11-07 Karl Kleinpaste <karl@jprc.com>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-fetch-headers): Create directory even
+ when no articles.
+
+1998-11-13 19:25:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-ignored-resent-headers): Remove X-Gnus.
+
+1998-11-10 Colin Rafferty <colin@xemacs.org>
+
+ * gnus-sum.el (gnus-ignored-from-addresses): Only quote
+ user-mail-address if non-nil.
+
+1998-11-13 18:50:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * mm-util.el (mm-with-unibyte-buffer): Ditto.
+
+ * binhex.el (binhex-decode-region): Quote.
+
+1998-11-10 05:32:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.42 is released.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Create Date: Oct 1, 1998
-;; $Revision: 1.1.1.1 $
+;; $Revision: 1.1.1.2 $
;; Time-stamp: <Tue Oct 6 23:48:38 EDT 1998 zsh>
;; Keywords: binhex
(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*"))
(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))))))
(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
(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)
(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)
(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)
: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)
(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")
i: message-id
t: references
x: xref
+ e: `extra' (non-standard overview)
l: lines
d: date
f: followup
(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)
("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)
(?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)
(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
;; 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
(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.
(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")))
(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.
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))
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
(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)))
(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)
;; 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)
(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))))
((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)
: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)
("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" <)
(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 ()
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
(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))
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))
(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.
(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 ()
;; 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.
(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)
(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
(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))))
(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'."
: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)
: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)
(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)
(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
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)
(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)
(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)))
(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
(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))
(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)
(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")
(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
(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 ()
(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
(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)
,(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"))
(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)
;;; Code:
+(eval-when-compile (require 'cl))
(require 'nnoo)
(require 'message)
(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."
-@echo off\r
-\r
-rem Written by David Charlap <shamino@writeme.com>\r
-\r
-rem There are two catches, however. The emacs.bat batch file may not exist\r
-rem in all distributions. It is part of the Voelker build of Emacs 19.34\r
-rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user\r
-rem installs Gnus with some other build, he may have to replace calls to\r
-rem %1\emacs.bat with something else.\r
-rem \r
-rem Also, the emacs.bat file that Voelker ships does not accept more than 9\r
-rem parameters, so the attempts to compile the .texi files will fail. To\r
-rem fix that (at least on NT. I don't know about Win95), the following\r
-rem change should be made to emacs.bat:\r
-rem \r
-rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9\r
-rem \r
-rem should become\r
-rem \r
-rem %emacs_dir%\bin\emacs.exe %*\r
-rem \r
-rem which will allow the batch file to accept an unlimited number of\r
-rem parameters.\r
-\r
-if "%1" == "" goto usage\r
-\r
-cd lisp\r
-call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile\r
-if not "%2" == "copy" goto info\r
-copy *.el* %1\lisp\r
-\r
-:info\r
-cd ..\texi\r
-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\r
-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\r
-if not "%2" == "copy" goto done\r
-copy gnus %1\info\r
-copy gnus-?? %1\info\r
-copy message %1\info\r
-\r
-:etc\r
-cd ..\etc\r
-copy gnus-tut.txt %1\etc\r
-\r
-:done\r
-cd ..\r
-goto end\r
-\r
-:usage\r
-echo Usage: make ^<emacs-dir^> [copy]\r
-echo.\r
-echo where: ^<emacs-dir^> is the directory you installed emacs in\r
-echo eg. d:\emacs\19.34\r
-echo copy indicates that the compiled files should be copied to your\r
-echo emacs lisp, info, and etc directories\r
-\r
-:end\r
+@echo off
+
+rem Written by David Charlap <shamino@writeme.com>
+
+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 ^<emacs-dir^> [copy]
+echo.
+echo where: ^<emacs-dir^> 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
\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
@tex
@titlepage
-@title Pterodactyl Gnus 0.42 Manual
+@title Pterodactyl Gnus 0.44 Manual
@author by Lars Magne Ingebrigtsen
@page
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
@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},
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
\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
@tex
@titlepage
-@title Pterodactyl Message 0.42 Manual
+@title Pterodactyl Message 0.44 Manual
@author by Lars Magne Ingebrigtsen
@page
* 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.
projects / elisp / gnus.git- / commitdiff