+Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.93 is released.
+
+1999-07-07 10:41:11 Stainless Steel Rat <ratinox@peorth.gweep.net>
+
+ * pop3.el: New version.
+
+1999-07-05 Simon Josefsson
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Use read.
+
+1999-07-07 10:37:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-display-alternative): Do treatment.
+
+1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-util.el (gnus-write-active-file): Use real name.
+
+ * gnus-agent.el (gnus-agent-expire): Update active file
+ method by method.
+
+1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * nndraft.el (nndraft-request-article): Use difference
+ coding-systems for queue and drafts.
+
+ * gnus-sum.el (gnus-summary-setup-default-charset): Special-case
+ nndraft:drafts.
+
+ * mm-util.el (mm-auto-save-coding-system): New coding system.
+
+ * message.el (message-draft-coding-system): Use it.
+
+1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el: More customizable and less aggressive.
+
+1999-07-07 07:53:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active
+ when plugged.
+
+ * mml.el (mml-generate-mime-1): Don't insert nofile files.
+ (mml-insert-mml-markup): Accept a nofile.
+ (mml-insert-mime): Insert nofile.
+
+ * gnus-art.el (gnus-treat-strip-blank-lines): Removed.
+
+ * mm-decode.el (mm-handle-media-type): New function.
+ (mm-handle-media-supertype): New function.
+ (mm-handle-media-subtype): New function.
+ Use new functions throughout. "/"))
+
+1999-05-18 03:03:50 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-treat-predicate): Typo.
+
+1999-07-07 06:21:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-score.el (gnus-summary-score-entry): Made un-interactive.
+
+1999-07-06 17:57:16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (article-date-ut): UT! Default it!
+
Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.92 is released.
history overview file histories elem art nov-file low info
unreads marked article orig lowest highest)
(save-excursion
- (with-temp-buffer
- (insert-file-contents file)
- (gnus-active-to-gnus-format
- nil (setq orig (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))
(setq overview (gnus-get-buffer-create " *expire overview*"))
(while (setq gnus-command-method (pop methods))
+ (with-temp-buffer
+ (insert-file-contents (gnus-agent-lib-file "active"))
+ (gnus-active-to-gnus-format
+ gnus-command-method
+ (setq orig (gnus-make-hashtable
+ (count-lines (point-min) (point-max))))))
(let ((expiry-hashtb (gnus-make-hashtable 1023)))
(gnus-agent-open-history)
(set-buffer
:group 'gnus-article-treat
:type gnus-article-treat-custom)
-(defcustom gnus-treat-strip-blank-lines nil
- "Strip all blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
- :group 'gnus-article-treat
- :type gnus-article-treat-custom)
-
(defcustom gnus-treat-overstrike t
"Treat overstrike highlighting.
Valid values are nil, t, `head', `last', an integer or a predicate.
gnus-article-strip-leading-blank-lines)
(gnus-treat-strip-multiple-blank-lines
gnus-article-strip-multiple-blank-lines)
- (gnus-treat-strip-blank-lines gnus-article-strip-blank-lines)
(gnus-treat-overstrike gnus-article-treat-overstrike)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-smiley-display)
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))
(setq newline nil))
- (if (re-search-forward tdate-regexp nil t)
- (forward-line 1))
- (insert (article-make-date-line date type))
+ (when (re-search-forward tdate-regexp nil t)
+ (forward-line 1))
+ (insert (article-make-date-line date (or type 'ut)))
(when newline
(insert "\n")
(forward-line -1))
(gnus-treat-article
nil id
(1- (length gnus-article-mime-handles))
- (car (mm-handle-type handle))))))
+ (mm-handle-media-type handle)))))
(select-window window))))
(goto-char point)
(delete-region (gnus-point-at-bol) (progn (forward-line 1) (point)))
(mail-content-type-get (mm-handle-disposition handle)
'filename)
""))
- (gnus-tmp-type (car (mm-handle-type handle)))
+ (gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description
(mail-decode-encoded-word-string (or (mm-handle-description handle)
"")))
(mapcar 'gnus-mime-display-part handles))
(defun gnus-mime-display-single (handle)
- (let ((type (car (mm-handle-type handle)))
+ (let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
(not-attachment t)
(move nil)
(or (mm-inlined-p handle)
(mm-automatic-external-display-p type)))
(setq display t)
- (when (equal (car (split-string type "/"))
- "text")
+ (when (equal (mm-handle-media-supertype handle) "text")
(setq text t)))
(let ((id (1+ (length gnus-article-mime-handle-alist))))
(push (cons id handle) gnus-article-mime-handle-alist)
(gnus-treat-article
nil (length gnus-article-mime-handle-alist)
(1- (length gnus-article-mime-handles))
- (car (mm-handle-type handle))))))))))
+ (mm-handle-media-type handle)))))))))
(defun gnus-unbuttonized-mime-type-p (type)
"Say whether TYPE is to be unbuttonized."
(progn
(insert (format "(%c) %-18s"
(if (equal handle preferred) ?* ? )
- (if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))))
+ (mm-handle-media-type handle)))
(point))
`(gnus-callback
(lambda (handles)
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
- (mm-display-part preferred)))
+ (mm-display-part preferred)
+ ;; Do highlighting.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (car begend) (point-max))
+ (gnus-treat-article
+ nil (length gnus-article-mime-handle-alist)
+ (1- (length gnus-article-mime-handles))
+ (mm-handle-media-type handle))))))
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
(funcall start-func)
- ;;(gnus-article-delete-text-of-type 'annotation)
- ;;(gnus-set-text-properties (point-min) (point-max) nil)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(setq gnus-prev-winconf winconf)
((eq pred 'or)
(apply 'gnus-or (mapcar 'gnus-treat-predicate val)))
((eq pred 'and)
- (apply 'gnus-and (mapcar 'gnus-tread-predicate val)))
+ (apply 'gnus-and (mapcar 'gnus-treat-predicate val)))
((eq pred 'not)
(not (gnus-treat-predicate val)))
((eq pred 'typep)
-;;; gnus-mlsplt.el --- a group params-based mail splitting mechanism
+;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@dcc.unicamp.br>
(require 'gnus-group)
(require 'nnmail)
-(defvar gnus-mlsplt-updated-hook nil
+(defvar gnus-mlsplit-updated-hook nil
"Hook called just after nnmail-split-fancy is updated by
-gnus-mlsplt-update")
+gnus-mlsplit-update")
-(defvar gnus-mlsplt-default-catch-all-group "mail.misc"
- "Group used by gnus-mlsplt and
-gnus-mlsplt-update as default catch-all group")
+(defvar gnus-mlsplit-default-catch-all-group "mail.misc"
+ "Group used by gnus-mlsplit and
+gnus-mlsplit-update as default catch-all group")
-(defun gnus-mlsplt-setup (&optional auto-update catch-all)
+;;;###autoload
+(defun gnus-mlsplit-setup (&optional auto-update catch-all)
"Sets things up so that nnmail-split-fancy is used for mail splitting,
and defines the variable nnmail-split-fancy according with group parameters.
if AUTO-UPDATE is non-nil (prefix argument accepted, if called interactive),
makes sure nnmail-split-fancy is re-computed before getting new mail,
-by adding gnus-mlsplt-update to nnmail-pre-get-new-mail-hook."
+by adding gnus-mlsplit-update to nnmail-pre-get-new-mail-hook."
(interactive "P")
(setq nnmail-split-methods 'nnmail-split-fancy)
(when catch-all
- (setq gnus-mlsplt-default-catch-all-group catch-all))
- (gnus-mlsplt-update)
+ (setq gnus-mlsplit-default-catch-all-group catch-all))
+ (gnus-mlsplit-update)
(when auto-update
- (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-mlsplt-update)))
+ (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-mlsplit-update)))
-(defun gnus-mlsplt-update (&optional catch-all)
+;;;###autoload
+(defun gnus-mlsplit-update (&optional catch-all)
"Computes nnmail-split-fancy from group params, by calling
-\(gnus-mlsplt-fancy nil nil DEFAULTGROUP)"
+\(gnus-mlsplit-fancy nil nil DEFAULTGROUP)"
(interactive)
(setq nnmail-split-fancy
- (gnus-mlsplt-fancy
- nil nil (or catch-all gnus-mlsplt-default-catch-all-group)))
- (run-hooks 'gnus-mlsplt-updated-hook)
+ (gnus-mlsplit-fancy
+ nil nil (or catch-all gnus-mlsplit-default-catch-all-group)))
+ (run-hooks 'gnus-mlsplit-updated-hook)
)
-(defun gnus-mlsplt ()
+;;;###autoload
+(defun gnus-mlsplit ()
"Uses information from group parameters in order to split mail.
-See gnus-mlsplt-fancy for more information.
+See gnus-mlsplit-fancy for more information.
If no group is defined as catch-all, the value of
-gnus-mlsplt-default-catch-all-group is used.
+gnus-mlsplit-default-catch-all-group is used.
-gnus-mlsplt is a valid value for nnmail-split-methods."
+gnus-mlsplit is a valid value for nnmail-split-methods."
(let (nnmail-split-fancy)
- (gnus-mlsplt-update
- gnus-mlsplt-default-catch-all-group)
+ (gnus-mlsplit-update
+ gnus-mlsplit-default-catch-all-group)
(nnmail-split-fancy)))
-(defun gnus-mlsplt-fancy
+;;;###autoload
+(defun gnus-mlsplit-fancy
(&optional groups no-crosspost catch-all)
"Uses information from group parameters in order to split mail.
It can be embedded into nnmail-split-fancy lists with the SPLIT
-\(: gnus-mlsplt-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
+\(: gnus-mlsplit-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
GROUPS may be a regular expression or a list of group names, that will
be used to select candidate groups. If it is ommited or nil, all
nnml:mail.others:
\((split-spec . catch-all))
-Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
+Calling (gnus-mlsplit-fancy nil nil \"mail.misc\") returns:
\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
\"nnml:mail.bar\")
(setq split (list '| split catch-all)))
split))
-(provide 'gnus-mlsplt)
+(provide 'gnus-mlspl)
(defun gnus-summary-score-entry (header match type score date
&optional prompt silent extra)
- (interactive)
"Enter score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
(goto-char (point-min))
(unless (string= gnus-ignored-newsgroups "")
(delete-matching-lines gnus-ignored-newsgroups))
- (while (re-search-forward
- "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
- (goto-char (match-end 1))
+ (while (and (not (eobp)) (forward-line))
(ignore-errors
- (push (cons (match-string 1)
+ (push (cons (read cur)
(max 0 (- (1+ (read cur)) (read cur))))
groups)))))
(setq groups (sort groups
(defcustom gnus-after-getting-new-news-hook
(when (gnus-boundp 'display-time-timer)
'(display-time-event-handler))
- "*A hook run after Gnus checks for new news."
+ "*A hook run after Gnus checks for new news when Gnus is already running."
:group 'gnus-group-new
:type 'hook)
(gnus-group-prefixed-name "" method))))
;; Let the Gnus agent save the active file.
- (if (and gnus-agent real-active)
+ (if (and gnus-agent real-active gnus-plugged)
(progn
(gnus-agent-save-groups method)
(gnus-active-to-gnus-format method hashtb nil real-active))
(mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
(cdr handle))
(when (if reverse
- (not (string-match type (car (mm-handle-type handle))))
- (string-match type (car (mm-handle-type handle))))
+ (not (string-match type (mm-handle-media-type handle)))
+ (string-match type (mm-handle-media-type handle)))
(let ((file (expand-file-name
(file-name-nondirectory
(or
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
+ (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (setq gnus-newsgroup-charset nil)
(let* ((name (and gnus-newsgroup-name
(gnus-group-real-name gnus-newsgroup-name)))
(ignored-charsets
charset)))
gnus-default-charset))
(set (make-local-variable 'gnus-newsgroup-ignored-charsets)
- ignored-charsets)))
+ ignored-charsets))))
;;;
;;; Mime Commands
(boundp sym)
(symbol-value sym))
(insert (format "%s %d %d y\n"
- (symbol-name sym) (cdr (symbol-value sym))
+ (gnus-group-real-name (symbol-name sym))
+ (cdr (symbol-value sym))
(car (symbol-value sym))))))
hashtb)))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.92"
+(defconst gnus-version-number "0.93"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
gnus-unplugged gnus-agentize gnus-agent-batch)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm)
- ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts))))
+ ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-drafts)
+ ("gnus-mlspl" gnus-mlsplit gnus-mlsplit-fancy)
+ ("gnus-mlspl" :interactive t gnus-mlsplit-setup gnus-mlsplit-update))))
;;; gnus-sum.el thingies
"Coding system to encode outgoing mail.")
(defvar message-draft-coding-system
- (cond
- ((not (fboundp 'coding-system-p)) nil)
- ((coding-system-p 'emacs-mule)
- (if (string-match "nt\\|windows" system-configuration)
- 'emacs-mule-dos 'emacs-mule))
- ((memq 'escape-quoted (mm-get-coding-system-list)) 'escape-quoted)
- ((coding-system-p 'no-conversion) 'no-conversion)
- (t nil))
+ mm-auto-save-coding-system
"Coding system to compose mail.")
;;; Internal variables.
`(nth 0 ,handle))
(defmacro mm-handle-type (handle)
`(nth 1 ,handle))
+(defsubst mm-handle-media-type (handle)
+ (if (stringp (car handle))
+ (car handle)
+ (car (mm-handle-type handle))))
+(defsubst mm-handle-media-supertype (handle)
+ (car (split-string (mm-handle-media-type handle) "/")))
+(defsubst mm-handle-media-subtype (handle)
+ (cadr (split-string (mm-handle-media-type handle) "/")))
(defmacro mm-handle-encoding (handle)
`(nth 2 ,handle))
(defmacro mm-handle-undisplayer (handle)
(mailcap-parse-mailcaps)
(if (mm-handle-displayed-p handle)
(mm-remove-part handle)
- (let* ((type (car (mm-handle-type handle)))
+ (let* ((type (mm-handle-media-type handle))
(method (mailcap-mime-info type)))
(if (mm-inlined-p handle)
(progn
(let ((mm (current-buffer))
(non-viewer (assoc "non-viewer"
(mailcap-mime-info
- (car (mm-handle-type handle)) t))))
+ (mm-handle-media-type handle)) t)))
(unwind-protect
(if method
(funcall method)
(mm-handle-disposition handle) 'filename))
(needsterm (assoc "needsterm"
(mailcap-mime-info
- (car (mm-handle-type handle)) t)))
+ (mm-handle-media-type handle)) t))
process file buffer)
;; We create a private sub-directory where we store our files.
(make-directory dir)
(mm-handle-set-undisplayer handle nil))))
(defun mm-display-inline (handle)
- (let* ((type (car (mm-handle-type handle)))
+ (let* ((type (mm-handle-media-type handle))
(function (cadr (assoc type mm-inline-media-tests))))
(funcall function handle)
(goto-char (point-min))))
(defun mm-inlinable-p (handle)
"Say whether HANDLE can be displayed inline."
(let ((alist mm-inline-media-tests)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
test)
(while alist
(when (equal type (caar alist))
(defun mm-automatic-display-p (handle)
"Say whether the user wants HANDLE to be displayed automatically."
(let ((methods mm-automatic-display)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
(when (and (string-match method type)
(defun mm-inlined-p (handle)
"Say whether the user wants HANDLE to be displayed automatically."
(let ((methods mm-inlined-types)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
method result)
(while (setq method (pop methods))
(when (and (string-match method type)
(defun mm-attachment-override-p (handle)
"Say whether HANDLE should have attachment behavior overridden."
(let ((types mm-attachment-override-types)
- (type (car (mm-handle-type handle)))
+ (type (mm-handle-media-type handle))
ty)
(catch 'found
(while (setq ty (pop types))
"Insert the contents of HANDLE in the current buffer."
(let ((cur (current-buffer)))
(save-excursion
- (if (member (car (split-string (car (mm-handle-type handle)) "/"))
- '("text" "message"))
+ (if (member (mm-handle-media-supertype handle) '("text" "message"))
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
- (car (mm-handle-type handle)))
+ (mm-handle-media-type handle))
(let ((temp (current-buffer)))
(set-buffer cur)
(insert-buffer-substring temp)))
(insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
- (car (mm-handle-type handle)))
+ (mm-handle-media-type handle))
(let ((temp (current-buffer)))
(set-buffer cur)
(insert-buffer-substring temp)))))))
;; Now every coding system is 100% binary within mm-with-unibyte-buffer
;; Is text still special?
(let ((coding-system-for-write
- (if (equal "text" (car (split-string
- (car (mm-handle-type handle)) "/")))
+ (if (equal "text" (mm-handle-media-supertype handle))
buffer-file-coding-system
'binary))
;; Don't re-compress .gz & al. Arguably we should make
;; ange-ftp which it's reasonable to use here.
(inhibit-file-name-operation 'write-region)
(inhibit-file-name-handlers
- (if (equal (car (mm-handle-type handle))
+ (if (equal (mm-handle-media-type handle)
"application/octet-stream")
(cons 'jka-compr-handler inhibit-file-name-handlers)
inhibit-file-name-handlers)))
(defun mm-interactively-view-part (handle)
"Display HANDLE using METHOD."
- (let* ((type (car (mm-handle-type handle)))
+ (let* ((type (mm-handle-media-type handle))
(methods
(mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
(mailcap-mime-info type 'all)))
(while (setq p (pop prec))
(setq h handles)
(while h
- (setq type
- (if (stringp (caar h))
- (caar h)
- (car (mm-handle-type (car h)))))
(setq handle (car h))
+ (setq type (mm-handle-media-type handle))
(when (and (equal p type)
- (mm-automatic-display-p (car h))
- (or (stringp (caar h))
- (not (mm-handle-disposition (car h)))
- (equal (car (mm-handle-disposition (car h)))
+ (mm-automatic-display-p handle)
+ (or (stringp (car handle))
+ (not (mm-handle-disposition handle))
+ (equal (car (mm-handle-disposition handle))
"inline")))
- (setq result (car h)
+ (setq result handle
h nil
prec nil))
(pop h)))
(defun mm-preferred-alternative-precedence (handles)
"Return the precedence based on HANDLES and mm-discouraged-alternatives."
(let ((seq (nreverse (mapcar (lambda (h)
- (car (mm-handle-type h))) handles))))
+ (mm-handle-media-type h))
+ handles))))
(dolist (disc (reverse mm-discouraged-alternatives))
(dolist (elem (copy-sequence seq))
(when (string-match disc elem)
(defun mm-get-image (handle)
"Return an image instance based on HANDLE."
- (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+ (let ((type (mm-handle-media-subtype handle))
spec)
;; Allow some common translations.
(setq type
(x-ctext . ctext))
"A mapping from invalid charset names to the real charset names.")
+(defconst mm-auto-save-coding-system
+ (cond
+ ((memq 'emacs-mule (mm-get-coding-system-list))
+ (if (memq system-type '(windows-nt ms-dos ms-windows))
+ 'emacs-mule-dos 'emacs-mule))
+ ((memq 'escape-quoted (mm-get-coding-system-list))
+ 'escape-quoted)
+ ((memq 'no-conversion (mm-get-coding-system-list))
+ 'no-conversion)
+ (t nil))
+ "Coding system of auto save file.")
+
;;; Internal variables:
;;; Functions:
(defconst mm-uu-postscript-begin-line "^%!PS-")
(defconst mm-uu-postscript-end-line "^%%EOF$")
-(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")
(defconst mm-uu-uu-end-line "^end[ \t]*$")
-(defvar mm-uu-decode-function 'uudecode-decode-region)
+
+(defcustom mm-uu-decode-function 'uudecode-decode-region
+ "*Function to uudecode.
+Internal function is done in elisp by default, therefore decoding may
+appear to be horribly slow . You can make Gnus use the external Unix
+decoder, such as uudecode."
+ :type '(choice (item :tag "internal" uudecode-decode-region)
+ (item :tag "external" uudecode-decode-region-external))
+ :group 'gnus-article-mime)
(defconst mm-uu-binhex-begin-line
"^:...............................................................$")
(defconst mm-uu-binhex-end-line ":$")
-(defvar mm-uu-binhex-decode-function 'binhex-decode-region)
+
+(defcustom mm-uu-binhex-decode-function 'binhex-decode-region
+ "*Function to binhex decode.
+Internal function is done in elisp by default, therefore decoding may
+appear to be horribly slow . You can make Gnus use the external Unix
+decoder, such as hexbin."
+ :type '(choice (item :tag "internal" binhex-decode-region)
+ (item :tag "external" binhex-decode-region-external))
+ :group 'gnus-article-mime)
(defconst mm-uu-shar-begin-line "^#! */bin/sh")
-(defconst mm-uu-shar-end-line "^exit 0")
+(defconst mm-uu-shar-end-line "^exit 0\\|^$")
;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
;;; Peter von der Ah\'e <pahe@daimi.au.dk>
-(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
+(defconst mm-uu-forward-begin-line "^-+ \\(?:Start of \\)?Forwarded message")
(defconst mm-uu-forward-end-line "^-+ End of forwarded message")
-(defconst mm-uu-begin-line
- (concat mm-uu-postscript-begin-line "\\|"
- mm-uu-uu-begin-line "\\|"
- mm-uu-binhex-begin-line "\\|"
- mm-uu-shar-begin-line "\\|"
- mm-uu-forward-begin-line))
+(defvar mm-uu-begin-line nil)
(defconst mm-uu-identifier-alist
'((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
"The default disposition of uu parts.
This can be either \"inline\" or \"attachment\".")
+(defun mm-uu-configure-p (key val)
+ (member (cons key val) mm-uu-configure-list))
+
+(defun mm-uu-configure (&optional symbol value)
+ (if symbol (set-default symbol value))
+ (setq mm-uu-begin-line nil)
+ (mapcar '(lambda (type)
+ (if (mm-uu-configure-p type 'disabled)
+ nil
+ (setq mm-uu-begin-line
+ (concat mm-uu-begin-line
+ (if mm-uu-begin-line "\\|")
+ (symbol-value
+ (intern (concat "mm-uu-" (symbol-name type)
+ "-begin-line")))))))
+ '(uu postscript binhex shar forward)))
+
+(defcustom mm-uu-configure-list nil
+ "A list of mm-uu configuration.
+To disable dissecting shar codes, for instance, add
+`(shar . disabled)' to this list."
+ :type '(repeat (cons
+ (choice (item postscript)
+ (item uu)
+ (item binhex)
+ (item shar)
+ (item forward))
+ (choice (item disabled))))
+ :group 'gnus-article-mime
+ :set 'mm-uu-configure)
+
+(mm-uu-configure)
+
;;;### autoload
(defun mm-uu-dissect ()
(list (cons 'charset charset)))))
(while (re-search-forward mm-uu-begin-line nil t)
(setq start-char (match-beginning 0))
- (forward-line) ;; in case of failure
- (setq start-char-1 (point))
(setq type (cdr (assq (aref (match-string 0) 0)
mm-uu-identifier-alist)))
(setq file-name
- (if (eq type 'uu)
+ (if (and (eq type 'uu)
+ (looking-at "\\(.+\\)$"))
(and (match-string 1)
(let ((nnheader-file-name-translation-alist
'((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
(nnheader-translate-file-chars (match-string 1))))))
+ (forward-line) ;; in case of failure
+ (setq start-char-1 (point))
(setq end-line (symbol-value
(intern (concat "mm-uu-" (symbol-name type)
"-end-line"))))
- (when (re-search-forward end-line nil t)
+ (when (and (re-search-forward end-line nil t)
+ (not (eq (match-beginning 0) (match-end 0))))
(setq end-char-1 (match-beginning 0))
(forward-line)
(setq end-char (point))
(forward-line)
(let (type end-line result
(case-fold-search t))
- (while (and (not result) (re-search-forward mm-uu-begin-line nil t))
+ (while (and mm-uu-begin-line
+ (not result) (re-search-forward mm-uu-begin-line nil t))
(forward-line)
(setq type (cdr (assq (aref (match-string 0) 0)
mm-uu-identifier-alist)))
(setq end-line (symbol-value
(intern (concat "mm-uu-" (symbol-name type)
"-end-line"))))
- (if (re-search-forward end-line nil t)
+ (if (and (re-search-forward end-line nil t)
+ (not (eq (match-beginning 0) (match-end 0))))
(setq result t)))
result)))
(setq mm-w3-setup t)))
(defun mm-inline-text (handle)
- (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+ (let ((type (mm-handle-media-subtype handle))
text buffer-read-only)
(cond
((equal type "html")
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
- ((setq filename (cdr (assq 'filename cont)))
+ ((and (setq filename (cdr (assq 'filename cont)))
+ (not (equal (cdr (assq 'nofile cont)) "yes")))
(mm-insert-file-contents filename))
(t
(save-restriction
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
- ((setq filename (cdr (assq 'filename cont)))
+ ((and (setq filename (cdr (assq 'filename cont)))
+ (not (equal (cdr (assq 'nofile cont)) "yes")))
(mm-insert-file-contents filename))
(t
(insert (cdr (assq 'contents cont)))))
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
- ((setq filename (cdr (assq 'filename cont)))
+ ((and (setq filename (cdr (assq 'filename cont)))
+ (not (equal (cdr (assq 'nofile cont)) "yes")))
(mm-insert-file-contents filename))
(t
(insert (cdr (assq 'contents cont)))))
(let (textp buffer)
;; Determine type and stuff.
(unless (stringp (car handle))
- (unless (setq textp (equal
- (car (split-string
- (car (mm-handle-type handle)) "/"))
- "text"))
+ (unless (setq textp (equal (mm-handle-media-supertype handle)
+ "text"))
(save-excursion
(set-buffer (setq buffer (generate-new-buffer " *mml*")))
(mm-insert-part handle))))
(unless no-markup
- (mml-insert-mml-markup handle buffer))
+ (mml-insert-mml-markup handle buffer textp))
(cond
((stringp (car handle))
(mapcar 'mml-insert-mime (cdr handle))
(t
(insert "<#/part>\n")))))
-(defun mml-insert-mml-markup (handle &optional buffer)
+(defun mml-insert-mml-markup (handle &optional buffer nofile)
"Take a MIME handle and insert an MML tag."
(if (stringp (car handle))
- (insert "<#multipart type=" (cadr (split-string (car handle) "/"))
+ (insert "<#multipart type=" (mm-handle-media-subtype handle)
">\n")
- (insert "<#part type=" (car (mm-handle-type handle)))
+ (insert "<#part type=" (mm-handle-media-type handle))
(dolist (elem (append (cdr (mm-handle-type handle))
(cdr (mm-handle-disposition handle))))
(insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))
(insert " disposition=" (car (mm-handle-disposition handle))))
(when buffer
(insert " buffer=\"" (buffer-name buffer) "\""))
+ (when nofile
+ (insert " nofile=yes"))
(when (mm-handle-description handle)
(insert " description=\"" (mm-handle-description handle) "\""))
- (equal (split-string (car (mm-handle-type handle)) "/") "text")
(insert ">\n")))
(defun mml-insert-parameter (&rest parameters)
(require 'gnus-start)
(require 'nnmh)
(require 'nnoo)
+(require 'mm-util)
(eval-when-compile
(require 'cl)
;; This is just to shut up the byte-compiler.
(when (and (file-exists-p newest)
(let ((nnmail-file-coding-system
(if (file-newer-than-file-p file auto)
- 'binary
- message-draft-coding-system)))
+ (if (equal group "drafts")
+ message-draft-coding-system
+ mm-text-coding-system)
+ mm-auto-save-coding-system)))
(nnmail-find-file newest)))
(save-excursion
(set-buffer nntp-server-buffer)
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
(while (and (goto-char end-point)
(re-search-backward (cdr cached-pair) nil t))
- (when nnmail-split-tracing
- (push (cdr cached-pair) nnmail-split-trace))
- (let ((split-rest (cddr split))
- (end (match-end 0))
- ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So,
- ;; start-of-value is the the point just before the
- ;; beginning of the value, whereas after-header-name is
- ;; the point just after the field name.
- (start-of-value (match-end 1))
- (after-header-name (match-end 2)))
+ (when nnmail-split-tracing
+ (push (cdr cached-pair) nnmail-split-trace))
+ (let ((split-rest (cddr split))
+ (end (match-end 0))
+ ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So,
+ ;; start-of-value is the the point just before the
+ ;; beginning of the value, whereas after-header-name is
+ ;; the point just after the field name.
+ (start-of-value (match-end 1))
+ (after-header-name (match-end 2)))
;; Start the next search just before the beginning of the
;; VALUE match.
(setq end-point (1- start-of-value))
- ;; Handle - RESTRICTs
- (while (eq (car split-rest) '-)
- ;; RESTRICT must start after-header-name and
- ;; end after start-of-value, so that, for
- ;; (any "foo" - "x-foo" "foo.list")
- ;; we do not exclude foo.list just because
- ;; the header is: ``To: x-foo, foo''
- (goto-char end)
- (if (and (re-search-backward (cadr split-rest)
- after-header-name t)
- (> (match-end 0) start-of-value))
- (setq split-rest nil)
- (setq split-rest (cddr split-rest))))
- (when split-rest
- (goto-char end)
- (let ((value (nth 1 split)))
- (if (symbolp value)
- (setq value (cdr (assq value nnmail-split-abbrev-alist))))
- ;; Someone might want to do a \N sub on this match, so get the
- ;; correct match positions.
- (re-search-backward value start-of-value))
+ ;; Handle - RESTRICTs
+ (while (eq (car split-rest) '-)
+ ;; RESTRICT must start after-header-name and
+ ;; end after start-of-value, so that, for
+ ;; (any "foo" - "x-foo" "foo.list")
+ ;; we do not exclude foo.list just because
+ ;; the header is: ``To: x-foo, foo''
+ (goto-char end)
+ (if (and (re-search-backward (cadr split-rest)
+ after-header-name t)
+ (> (match-end 0) start-of-value))
+ (setq split-rest nil)
+ (setq split-rest (cddr split-rest))))
+ (when split-rest
+ (goto-char end)
+ (let ((value (nth 1 split)))
+ (if (symbolp value)
+ (setq value (cdr (assq value nnmail-split-abbrev-alist))))
+ ;; Someone might want to do a \N sub on this match, so get the
+ ;; correct match positions.
+ (re-search-backward value start-of-value))
(dolist (sp (nnmail-split-it (car split-rest)))
(unless (memq sp split-result)
(push sp split-result))))))
;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
(pop3-pass process))
(t (error "Invalid POP3 authentication scheme.")))
(setq message-count (car (pop3-stat process)))
- (while (<= n message-count)
- (message (format "Retrieving message %d of %d from %s..."
- n message-count pop3-mailhost))
- (pop3-retr process n crashbuf)
- (save-excursion
- (set-buffer crashbuf)
- (write-region (point-min) (point-max) crashbox t 'nomesg)
- (set-buffer (process-buffer process))
- (while (> (buffer-size) 5000)
- (goto-char (point-min))
- (forward-line 50)
- (delete-region (point-min) (point))))
- (pop3-dele process n)
- (setq n (+ 1 n))
- (if pop3-debug (sit-for 1) (sit-for 0.1))
- )
- (pop3-quit process)
+ (unwind-protect
+ (while (<= n message-count)
+ (message (format "Retrieving message %d of %d from %s..."
+ n message-count pop3-mailhost))
+ (pop3-retr process n crashbuf)
+ (save-excursion
+ (set-buffer crashbuf)
+ (write-region (point-min) (point-max) crashbox t 'nomesg)
+ (set-buffer (process-buffer process))
+ (while (> (buffer-size) 5000)
+ (goto-char (point-min))
+ (forward-line 50)
+ (delete-region (point-min) (point))))
+ (pop3-dele process n)
+ (setq n (+ 1 n))
+ (if pop3-debug (sit-for 1) (sit-for 0.1))
+ )
+ (pop3-quit process))
(kill-buffer crashbuf)
)
t)
(get-buffer-create (format "trace of POP session to %s" mailhost)))
(process)
(coding-system-for-read 'binary) ;; because FSF Emacs 20 and
- (coding-system-for-write 'binary) ;; XEmacs 20/1 are st00pid
+ (coding-system-for-write 'binary) ;; XEmacs 20 & 21 are st00pid
)
(save-excursion
(set-buffer process-buffer)
+1999-07-07 10:26:59 Robin S. Socha <robin@socha.net>
+
+ * gnus.texi (Scoring Tips): Typo.
+
1999-07-06 11:41:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Mail Source Specifiers): Fix.
@c \input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.92 Manual
+@settitle Pterodactyl Gnus 0.93 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.92 Manual
+@title Pterodactyl Gnus 0.93 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.92.
+This manual corresponds to Pterodactyl Gnus 0.93.
@end ifinfo
@vindex gnus-signature-limit
@code{gnus-signature-limit} provides a limit to what is considered a
-signature.
+signature when displaying articles.
@enumerate
@item
@item gnus-treat-strip-trailing-blank-lines
@item gnus-treat-strip-leading-blank-lines
@item gnus-treat-strip-multiple-blank-lines
-@item gnus-treat-strip-blank-lines
@item gnus-treat-overstrike
@item gnus-treat-display-xface
@item gnus-treat-display-smileys
a header name, and the value will be inserted in the headers of the
article.
-The attribute value can be a string (used verbatim), a function (the
-return value will be used), a variable (its value will be used) or a
-list (it will be @code{eval}ed and the return value will be used).
+The attribute value can be a string (used verbatim), a function with
+zero arguments (the return value will be used), a variable (its value
+will be used) or a list (it will be @code{eval}ed and the return value
+will be used). The functions and sexps are called/@code{eval}ed in the
+message buffer that is being set up. The headers of the current article
+are available through the @code{message-reply-headers} variable.
If you wish to check whether the message you are about to compose is
meant to be a news article or a mail message, you can check the values
the matches.
@item Marking as read
-You will probably want to mark articles that has a score below a certain
+You will probably want to mark articles that have scores below a certain
number as read. This is most easily achieved by putting the following
in your @file{all.SCORE} file:
@lisp
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.92 Manual
+@settitle Pterodactyl Message 0.93 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.92 Manual
+@title Pterodactyl Message 0.93 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.92. Message is
+This manual corresponds to Pterodactyl Message 0.93. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / elisp / gnus.git- / commitdiff