+1999-04-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/gnus.el (gnus-version-number): Update to 6.10.063.
+ (gnus-revision-number): Fresh start from 00.
+
+ * Sync up with Pterodactyl Gnus v0.83.
+
1999-04-15 NAKAGAWA Tsuneo <yaemon@alles.or.jp>
* REDME.semi.ja: Fix where the required packages are.
* T-gnus 6.10 - this is based on Pterodactyl Gnus.
- The latest T-gnus is T-gnus 6.10.062 (Based on pgnus-0.80).
+ The latest T-gnus is T-gnus 6.10.063 (Based on pgnus-0.83).
It requires SEMI/WEMI-1.12/1.13, the latest FLIM-1.12, and the latest
APEL (9.13 or later).
+Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.83 is released.
+
+1999-04-18 10:55:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-draft.el (gnus-draft-mode): Use mml minor mode.
+
+ * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error.
+
+ * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads.
+
+ * gnus-art.el (gnus-mime-inline-part): Don't do a charset param.
+
+ * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp.
+
+ * message.el (message-generate-headers): Accept continuation
+ headers.
+
+1999-04-18 10:48:57 Renaud Rioboo <Renaud.Rioboo@lip6.fr>
+
+ * gnus-demon.el (gnus-demon-time-to-step): Not strings.
+
+1999-04-18 08:21:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treatment-function-alist): use
+ maybe-hide-headers.
+
+ * message.el (message-inhibit-body-encoding): Typo.
+ (message-resend): Inhibit encoding.
+
+ * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047.
+
+ * gnus-art.el (article-remove-cr): Use re-search.
+
+ * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME
+ headers.
+
+ * mm-decode.el (mm-quote-arg): Quote '.
+
+ * gnus-ems.el (gnus-x-splash): Would place splash wrongly.
+
+ * mm-decode.el (mm-insert-part): Use multibyte for text.
+
+ * gnus-start.el (gnus-read-newsrc-file): New variable.
+ (gnus-read-newsrc-file): Use it.
+
+1999-04-17 18:51:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnvirtual.el (nnvirtual-request-expire-articles): New function.
+
+ * gnus-group.el (gnus-group-expire-articles-1): Made into own
+ function.
+
+Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.82 is released.
+
+1999-04-15 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups
+ for iso8859-2.
+
+1999-04-17 18:23:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from
+ synonym alist.
+
+1999-04-17 18:03:38 Adam P. Jenkins <ajenkins@netway.com>
+
+ * gnus-sum.el (gnus-summary-local-variables): Mark as global.
+
+1999-04-17 18:02:05 Ettore Perazzoli <ettore@comm2000.it>
+
+ * mail-source.el (mail-source-fetch): Ask before bugging out.
+
+1999-03-19 Hrvoje Niksic <hniksic@srce.hr>
+
+ * uudecode.el (uudecode-decode-region-external): Don't assume
+ uudecode-temporary-file-directory ends with a slash.
+
+1999-03-18 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-sum.el (gnus-update-marks):
+ (gnus-update-read-articles):
+ (gnus-summary-expire-articles): Check server.
+
+1999-03-16 Simon Josefsson <jas@pdc.kth.se>
+
+ * mml.el (mml-preview): New function.
+
+1999-04-17 17:10:21 William M. Perry <wmperry@aventail.com>
+
+ * mail-source.el (mail-source-fetch-file): Return the right
+ value.
+
+1999-04-17 07:52:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-insert-parameter): New function.
+ (mml-insert-parameter-string): New function.
+
+ * nnmail.el (nnmail-get-new-mail): Say how many new articles.
+
+ * gnus-art.el (gnus-mime-multipart-functions): New variable.
+ (gnus-mime-display-part): Use it.
+
+ * mm-decode.el (mm-alternative-precedence): Removed.
+ (mm-discouraged-alternatives): New variable.
+ (mm-preferred-alternative-precedence): New function.
+
+ * nnmail.el (nnmail-get-new-mail): Use mail-sources.
+
+ * mail-source.el (mail-sources): New variable.
+
+ * gnus-art.el (article-remove-cr): Remove several trailing CRs.
+
+ * mm-decode.el (mm-valid-image-format-p): New function.
+ (mm-inline-media-tests): Use it.
+ (mm-valid-and-fit-image-p): New function.
+
+ * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged.
+ (gnus-agent-fetch-group): Ditto.
+
+1999-04-12 Didier Verna <verna@inf.enst.fr>
+
+ * nnmail.el (nnmail-article-group): in case of a group name
+ containing "\\n" constructs, be sure to pass the expanded value to
+ nn*-save-mail.
+
+Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.81 is released.
+
+1999-04-16 15:54:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-get-split-value): Reverse result.
+
+1999-04-03 00:17:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-start.el (gnus-always-read-dribble-file): Doc fix.
+
+1999-04-02 15:33:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-insert-tag): Insert concluding part.
+
+ * message.el (message-send-mail): Encode later.
+ (message-send-news): Ditto.
+
+ * nnfolder.el: Don't use mail delim.
+
+1999-03-28 19:14:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-cus.el (gnus-group-customize): Put point at min.
+
+ * mm-view.el (mm-inline-text): Allow toggling html.
+
+1999-03-28 17:11:15 William M. Perry <wmperry@aventail.com>
+
+ * mail-source.el: Added prescript and postscript to file.
+
+1999-03-28 13:46:00 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el: Reverted.
+
+ * gnus-msg.el (gnus-setup-posting-charset): Didn't work.
+ (gnus-setup-posting-charset): Did work.
+
+1999-03-28 13:19:50 Jae-you Chung <jay@pllab.kaist.ac.kr>
+
+ * gnus.el (gnus-short-group-name): Use
+ gnus-group-uncollapsed-levels.
+
+1999-03-28 13:11:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays.
+
+1999-03-26 13:18:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treat-strip-headers-in-body): New variable.
+ (article-strip-headers-from-body): New command and keystroke.
+
+1999-03-14 16:09:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-fetch-pop): Check for symbol first.
+
+ * nnheader.el (nnheader-insert-file-contents): Bind
+ enable-local-eval to nil.
+ (nnheader-find-file-noselect): Ditto.
+
+ * nnmail.el (nnmail-article-group): Don't remove long lines.
+ (nnmail-remove-long-lines): New function.
+ (nnmail-split-header-length-limit): Removed.
+
+ * mml.el (mml-generate-mime-1): Use unibyte buffers.
+
+ * gnus-group.el (gnus-group-kill-all-zombies): Query user.
+
+1999-03-06 07:20:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-generic-mark): New function.
+
+ * nnmail.el (nnmail-split-header-length-limit): Increased.
+ (nnmail-article-group): Allow nil.
+
+ * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion.
+
+ * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers
+ first.
+
+ * mml.el (mml-minibuffer-read-type): Include types from
+ mailcap-mime-data.
+
+ * nndraft.el (nndraft-request-article): Would clobber Japanese.
+
+1999-03-05 Hrvoje Niksic <hniksic@srce.hr>
+
+ * mml.el (mml-insert-tag): New function.
+ (mml-read-file): Renamed to mml-minibuffer-read-file to avoid
+ confusion with functions like `mml-read-tag'.
+ (mml-read-type): Ditto with `mml-minibuffer-read-type'.
+ (mml-minibuffer-read-description): Ditto with
+ `mml-minibuffer-read-description'.
+ (mml-attach-buffer): New function.
+ (mml-mode-map): New entry for /.
+ (mml-minibuffer-read-type): Accept DEFAULT.
+
+ * mml.el (mml-quote-region): Narrow the region.
+
+ * message.el (message-mode-menu): message-mime-attach-file is now
+ mml-attach-file.
+
+1999-03-05 21:24:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier.
+
+1999-03-05 21:08:10 Robert Bihlmeyer <robbe@orcus.priv.at>
+
+ * mml.el (mml-attach-buffer): New command.
+
+1999-02-27 Simon Josefsson <jas@pdc.kth.se>
+
+ * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range
+ with a proper range. Compress range.
+
+ * gnus-range.el (gnus-remove-from-range): Protect arguments.
+
+1999-03-05 20:59:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-get-image): Create a temporary file for xbms.
+
+1999-03-04 04:20:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-picon.el (gnus-picons-x-face-file-name): Removed.
+ (gnus-picons-convert-x-face): Removed.
+ (gnus-picons-article-display-x-face): Removed.
+ (gnus-picons-x-face-sentinel): Ditto.
+ (gnus-picons-display-x-face): Ditto.
+
Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.80 is released.
* nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of
type directory.
+1999-03-04 Robert Bihlmeyer <robbe@orcus.priv.at>
+
+ * gnus-art.el (article-hide-boring-headers): Field names must not
+ contain whitespace.
+
Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.79 is released.
(defun gnus-agent-fetch-groups (n)
"Put all new articles in the current groups into the Agent."
(interactive "P")
+ (unless gnus-plugged
+ (error "Groups can't be fetched when Gnus is unplugged"))
(gnus-group-iterate n 'gnus-agent-fetch-group))
(defun gnus-agent-fetch-group (group)
"Put all new articles in GROUP into the Agent."
(interactive (list (gnus-group-group-name)))
+ (unless gnus-plugged
+ (error "Groups can't be fetched when Gnus is unplugged"))
(unless group
(error "No group on the current line"))
(let ((gnus-command-method (gnus-find-method-for-group group)))
"^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:"
"^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
"^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
- "^Status:" "^X-Gnus-Mail-Source:")
+ "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:")
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
:group 'gnus-article-mime
:type 'function)
+(defcustom gnus-mime-multipart-functions nil
+ "An alist of MIME types to functions to display them.")
+
;;;
;;; The treatment variables
;;;
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
+(defcustom gnus-treat-strip-headers-in-body t
+ "Strip the X-No-Archive header line from the beginning of the body.
+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-strip-trailing-blank-lines nil
"Strip trailing blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
'((gnus-treat-strip-banner gnus-article-strip-banner)
+ (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
(gnus-treat-buttonize gnus-article-add-buttons)
(gnus-treat-fill-article gnus-article-fill-cited-article)
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
- (gnus-treat-hide-headers gnus-article-hide-headers)
+ (gnus-treat-emphasize gnus-article-emphasize)
+ (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
(gnus-treat-hide-signature gnus-article-hide-signature)
(gnus-treat-hide-citation gnus-article-hide-citation)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
(gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
- (gnus-treat-emphasize gnus-article-emphasize)
(gnus-treat-date-ut gnus-article-date-ut)
(gnus-treat-date-local gnus-article-date-local)
(gnus-treat-date-lapsed gnus-article-date-lapsed)
(cond
;; Hide empty headers.
((eq elem 'empty)
- (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t)
+ (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
(forward-line -1)
(gnus-article-hide-text-type
(progn (beginning-of-line) (point))
(forward-sentence)))))
(defun article-remove-cr ()
- "Translate CRLF pairs into LF, and then CR into LF.."
+ "Remove trailing CRs and then translate remaining CRs into LFs."
(interactive)
(save-excursion
(let ((buffer-read-only nil))
(goto-char (point-min))
- (while (search-forward "\r$" nil t)
+ (while (re-search-forward "\r+$" nil t)
(replace-match "" t t))
(goto-char (point-min))
(while (search-forward "\r" nil t)
(gnus-article-hide-text-type
(point-min) (point-max) 'signature)))))))
+(defun article-strip-headers-in-body ()
+ "Strip offensive headers from bodies."
+ (interactive)
+ (save-excursion
+ (article-goto-body)
+ (let ((case-fold-search t))
+ (when (looking-at "x-no-archive:")
+ (gnus-delete-line)))))
+
(defun article-strip-leading-blank-lines ()
"Remove all blank lines from the beginning of the article."
(interactive)
article-strip-banner
article-hide-pem
article-hide-signature
+ article-strip-headers-in-body
article-remove-trailing-blank-lines
article-strip-leading-blank-lines
article-strip-multiple-blank-lines
(when (gnus-visual-p 'article-highlight 'highlight)
(gnus-run-hooks 'gnus-visual-mark-article-hook))
;; Set the global newsgroup variables here.
- ;; Suggested by Jim Sisolak
- ;; <sisolak@trans4.neep.wisc.edu>.
(gnus-set-global-variables)
(setq gnus-have-all-headers
(or all-headers gnus-show-all-headers))))
(setq buffer-file-name nil))
(goto-char (point-min))))
-(defun gnus-mime-inline-part (&optional charset)
+(defun gnus-mime-inline-part (&optional handle)
"Insert the MIME part under point into the current buffer."
- (interactive "P") ; For compatibility reasons we are not using "z".
+ (interactive)
(gnus-article-check-buffer)
- (let* ((data (get-text-property (point) 'gnus-data))
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
contents
(b (point))
buffer-read-only)
- (if (mm-handle-undisplayer data)
- (mm-remove-part data)
- (setq contents (mm-get-part data))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (setq contents (mm-get-part handle))
(forward-line 2)
- (when charset
- (unless (symbolp charset)
- (setq charset (mm-read-coding-system "Charset: ")))
- (setq contents (mm-decode-coding-string contents charset)))
- (mm-insert-inline data contents)
+ (mm-insert-inline handle contents)
(goto-char b))))
(defun gnus-mime-externalize-part (&optional handle)
;; Single part.
((not (stringp (car handle)))
(gnus-mime-display-single handle))
+ ;; User-defined multipart
+ ((cdr (assoc (car handle) gnus-mime-multipart-functions))
+ (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
+ handle))
;; multipart/alternative
((and (equal (car handle) "multipart/alternative")
(not gnus-mime-display-multipart-as-mixed))
"Dissect the article buffer looking for cited text."
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe)
+ (gnus-cite-parse-maybe nil t)
(let ((alist gnus-cite-prefix-alist)
prefix numbers number marks m)
;; Loop through citation prefixes.
(while numbers
(setq number (pop numbers))
(goto-char (point-min))
- (forward-line (1- number))
+ (forward-line number)
(push (cons (point-marker) "") marks)
(while (and numbers
(= (1- number) (car numbers)))
;;; Internal functions:
-
(defun gnus-cite-parse-maybe (&optional force no-overlay)
"Always parse the buffer."
(gnus-cite-localize)
(gnus-delete-overlay overlay))))
(defun gnus-cite-parse-wrapper ()
- ;; Wrap chopped gnus-cite-parse
+ ;; Wrap chopped gnus-cite-parse.
(article-goto-body)
- (save-excursion
- (gnus-cite-parse-attributions))
- (save-excursion
- (gnus-cite-parse))
- (save-excursion
- (gnus-cite-connect-attributions)))
+ (let ((inhibit-point-motion-hooks t))
+ (save-excursion
+ (gnus-cite-parse-attributions))
+ (save-excursion
+ (gnus-cite-parse))
+ (save-excursion
+ (gnus-cite-connect-attributions))))
(defun gnus-cite-parse ()
;; Parse and connect citation prefixes and attribution lines.
:tag "Method"
:value (gnus-info-method info))))
(use-local-map widget-keymap)
- (widget-setup)))
+ (widget-setup)
+ (goto-char (point-min))))
(defun gnus-group-customize-done (&rest ignore)
"Apply changes and bury the buffer."
(nowParts (decode-time now))
;; obtain THEN as discrete components
(thenParts (parse-time-string time))
- (thenHour (string-to-int (elt thenParts 0)))
- (thenMin (string-to-int (elt thenParts 1)))
+ (thenHour (elt thenParts 0))
+ (thenMin (elt thenParts 1))
;; convert time as elements into number of seconds since EPOCH.
(then (encode-time 0
thenMin
(gnus-draft-setup-for-sending article (or group "nndraft:queue"))
(let ((message-syntax-checks (if interactive nil
'dont-check-for-anything-just-trust-me))
- (messgage-inhibit-body-encoding t)
+ (message-inhibit-body-encoding t)
message-send-hook type method)
;; We read the meta-information that says how and where
;; this message is to be sent.
(ignore-errors
(setq pixmap (read (current-buffer))))))
(when pixmap
- (erase-buffer)
(unless (facep 'gnus-splash)
(make-face 'gnus-splash))
(setq height (/ (car pixmap) (frame-char-height))
(insert-char ?\n (* (/ (window-height) 2 height) height))
(setq i height)
(while (> i 0)
- (insert-char ? (* (+ (/ (window-width) 2 width) 1) width))
+ (insert-char ? (* (/ (window-width) 2 width) width))
(setq beg (point))
(insert-char ? width)
(set-text-properties beg (point) '(face gnus-splash))
(error "No groups to expire"))
(while (setq group (pop groups))
(gnus-group-remove-mark group)
- (when (gnus-check-backend-function 'request-expire-articles group)
- (gnus-message 6 "Expiring articles in %s..." group)
- (let* ((info (gnus-get-info group))
- (expirable (if (gnus-group-total-expirable-p group)
- (cons nil (gnus-list-of-read-articles group))
- (assq 'expire (gnus-info-marks info))))
- (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
- (when expirable
- (setcdr
- expirable
- (gnus-compress-sequence
- (if expiry-wait
- ;; We set the expiry variables to the group
- ;; parameter.
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))
- ;; Just expire using the normal expiry values.
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))))
- (gnus-close-group group))
- (gnus-message 6 "Expiring articles in %s...done" group)))
+ (gnus-group-expire-articles-1 group)
(gnus-dribble-touch)
(gnus-group-position-point))))
+(defun gnus-group-expire-articles-1 (group)
+ (when (gnus-check-backend-function 'request-expire-articles group)
+ (gnus-message 6 "Expiring articles in %s..." group)
+ (let* ((info (gnus-get-info group))
+ (expirable (if (gnus-group-total-expirable-p group)
+ (cons nil (gnus-list-of-read-articles group))
+ (assq 'expire (gnus-info-marks info))))
+ (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
+ (when expirable
+ (setcdr
+ expirable
+ (gnus-compress-sequence
+ (if expiry-wait
+ ;; We set the expiry variables to the group
+ ;; parameter.
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group))
+ ;; Just expire using the normal expiry values.
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group))))
+ (gnus-close-group group))
+ (gnus-message 6 "Expiring articles in %s...done" group))))
+
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
(interactive)
(defun gnus-group-kill-all-zombies ()
"Kill all zombie newsgroups."
(interactive)
- (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
- (setq gnus-zombie-list nil)
- (gnus-dribble-touch)
- (gnus-group-list-groups))
+ (when (gnus-yes-or-no-p "Really kill all zombies? ")
+ (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
+ (setq gnus-zombie-list nil)
+ (gnus-dribble-touch)
+ (gnus-group-list-groups)))
(defun gnus-group-kill-region (begin end)
"Kill newsgroups in current region (excluding current point).
(save-excursion
(set-buffer (gnus-get-buffer-create " *gnus environment info*"))
(gnus-debug))
- (insert "<#part type=application/emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>")
+ (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>")
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
:type 'regexp
:group 'picons)
-(defcustom gnus-picons-x-face-file-name
- (format "/tmp/picon-xface.%s.xbm" (user-login-name))
- "*The name of the file in which to store the converted X-face header."
- :type 'string
- :group 'picons)
-
-(defcustom gnus-picons-convert-x-face (format "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pbmtoxbm > %s" gnus-picons-x-face-file-name)
- "*Command to convert the x-face header into a xbm file."
- :type 'string
- :group 'picons)
-
(defcustom gnus-picons-display-as-address t
"*If t display textual email addresses along with pictures."
:type 'boolean
(set-extent-property annot 'duplicable t)
annot))
-(defun gnus-picons-article-display-x-face ()
- "Display the x-face header bitmap in the 'gnus-picons-display-where buffer."
- (let ((gnus-article-x-face-command 'gnus-picons-display-x-face))
- (gnus-article-display-x-face)))
-
-(defun gnus-picons-x-face-sentinel (process event)
- (when (memq process gnus-picons-processes-alist)
- (setq gnus-picons-processes-alist
- (delq process gnus-picons-processes-alist))
- (gnus-picons-set-buffer)
- (gnus-picons-make-annotation
- (make-glyph gnus-picons-x-face-file-name) nil 'text)
- (when (file-exists-p gnus-picons-x-face-file-name)
- (delete-file gnus-picons-x-face-file-name))))
-
-(defun gnus-picons-display-x-face (beg end)
- "Function to display the x-face header in the picons window.
-To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
- (interactive)
- (if (featurep 'xface)
- ;; Use builtin support
- (save-excursion
- ;; Don't remove this binding, it is really needed: when
- ;; `gnus-picons-set-buffer' changes buffer (like when it is
- ;; set to display picons outside of the article buffer), BEG
- ;; and END still refer the buffer current now !
- (let ((buf (current-buffer)))
- (gnus-picons-set-buffer)
- (gnus-picons-make-annotation
- (vector 'xface
- :data (concat "X-Face: " (buffer-substring beg end buf)))
- nil 'text nil nil nil t)))
- ;; convert the x-face header to a .xbm file
- (let* ((process-connection-type nil)
- (process (start-process-shell-command
- "gnus-x-face" nil gnus-picons-convert-x-face)))
- (push process gnus-picons-processes-alist)
- (process-kill-without-query process)
- (set-process-sentinel process 'gnus-picons-x-face-sentinel)
- (process-send-region process beg end)
- (process-send-eof process))))
-
(defun gnus-article-display-picons ()
"Display faces for an author and her domain in gnus-picons-display-where."
(interactive)
"Return a range that has all articles from RANGE2 removed from
RANGE1. The returned range is always a list. RANGE2 can also be a
unsorted list of articles."
- (if (listp (cdr range2))
- (setq range2 (sort range2 (lambda (e1 e2)
- (< (if (consp e1) (car e1) e1)
- (if (consp e2) (car e2) e2))))))
(if (or (null range1) (null range2))
range1
- (let (out r1 r2 r1_min r1_max r2_min r2_max)
+ (let (out r1 r2 r1_min r1_max r2_min r2_max
+ (range1 range1)
+ (range2 (if (listp (cdr range2))
+ (sort range2 (lambda (e1 e2)
+ (< (if (consp e1) (car e1) e1)
+ (if (consp e2) (car e2) e2))))
+ range2)))
(setq range1 (if (listp (cdr range1)) range1 (list range1))
range2 (if (listp (cdr range2)) range2 (list range2))
r1 (car range1)
(push (cons r1_min r1_max) out))
(pop range1))
(while range1
- (push (pop range1) out))
+ (push (pop range1) out))
(nreverse out))))
(defun gnus-member-of-range (number ranges)
:type '(choice integer
(const :tag "none" nil)))
+(defcustom gnus-read-newsrc-file t
+ "*Non-nil means that Gnus will read the `.newsrc' file.
+Gnus always reads its own startup file, which is called
+\".newsrc.eld\". The file called \".newsrc\" is in a format that can
+be readily understood by other newsreaders. If you don't plan on
+using other newsreaders, set this variable to nil to save some time on
+entry."
+ :group 'gnus-newsrc
+ :type 'boolean)
+
(defcustom gnus-save-newsrc-file t
"*Non-nil means that Gnus will save the `.newsrc' file.
Gnus always saves its own startup file, which is called
:type 'boolean)
(defcustom gnus-ignored-newsgroups
- (purecopy (mapconcat 'identity
- '("^to\\." ; not "real" groups
- "^[0-9. \t]+ " ; all digits in name
- "[][\"#'()]" ; bogus characters
- )
- "\\|"))
+ (mapconcat 'identity
+ '("^to\\." ; not "real" groups
+ "^[0-9. \t]+ " ; all digits in name
+ "[][\"#'()]" ; bogus characters
+ )
+ "\\|")
"*A regexp to match uninteresting newsgroups in the active file.
Any lines in the active file matching this regular expression are
removed from the newsgroup list before anything else is done to it,
:type 'hook)
(defcustom gnus-always-read-dribble-file nil
- "Uncoditionally read the dribble file."
+ "Unconditionally read the dribble file."
:group 'gnus-newsrc
:type 'boolean)
;; file (ticked articles, killed groups, foreign methods, etc.)
(gnus-read-newsrc-el-file quick-file)
- (when (and (file-exists-p gnus-current-startup-file)
+ (when (and gnus-read-newsrc-file
+ (file-exists-p gnus-current-startup-file)
(or force
(and (file-newer-than-file-p newsrc-file quick-file)
(file-newer-than-file-p newsrc-file
("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
("^fj\\>\\|^japan\\>" iso-2022-jp-2)
("^relcom\\>" koi8-r)
- ("^\\(cz\\|hun\\|pl\\|sk\\)\\>" iso-8859-2)
+ ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
("^israel\\>" iso-8859-1)
("^han\\>" euc-kr)
("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-thread-expunge-below
- gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
+ gnus-score-alist gnus-current-score-file
+ (gnus-summary-expunge-below . global)
(gnus-summary-mark-below . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
"h" gnus-article-treat-html
+ "H" gnus-article-strip-headers-in-body
"d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
(setq arts (cdr arts)))
(setq list (cdr all))))
- (when (gnus-check-backend-function 'request-set-mark
- gnus-newsgroup-name)
- ;; score & bookmark are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- (unless (memq (cdr type) '(cache score bookmark))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range old list))
- (add (gnus-remove-from-range list old)))
- (if add
- (push (list add 'add (list (cdr type))) delta-marks))
- (if del
- (push (list del 'del (list (cdr type))) delta-marks)))))
-
+ (when (gnus-check-backend-function 'request-set-mark
+ gnus-newsgroup-name)
+ ;; uncompressed:s are not proper flags (they are cons cells)
+ ;; cache is a internal gnus flag
+ (unless (memq (cdr type) (cons 'cache uncompressed))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (list (gnus-compress-sequence (sort list '<)))
+ (del (gnus-remove-from-range old list))
+ (add (gnus-remove-from-range list old)))
+ (if add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (if del
+ (push (list del 'del (list (cdr type))) delta-marks)))))
+
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
(gnus-compress-sequence
(set symbol (sort list '<)) t)))
newmarked)))
- (if delta-marks
- (gnus-request-set-mark gnus-newsgroup-name delta-marks))
-
+ (when delta-marks
+ (unless (gnus-check-group gnus-newsgroup-name)
+ (error "Can't open server for %s" gnus-newsgroup-name))
+ (gnus-request-set-mark gnus-newsgroup-name delta-marks))
+
;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(setcar (nthcdr 3 info) newmarked)
(insert-buffer-substring gnus-original-article-buffer 1 e)
(save-restriction
(narrow-to-region (point-min) (point))
+ (article-decode-encoded-words)
(if (or hidden
(and (numberp arg) (< arg 0)))
(let ((gnus-treat-hide-headers nil)
;; There are expirable articles in this group, so we run them
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
+ (unless (gnus-check-group gnus-newsgroup-name)
+ (error "Can't open server for %s" gnus-newsgroup-name))
;; The list of articles that weren't expired is returned.
(save-excursion
(if expiry-wait
split-name))
((consp result)
(setq split-name (append result split-name)))))))))
- split-name))
+ (nreverse split-name)))
(defun gnus-valid-move-group-p (group)
(and (boundp group)
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
(when (or add del)
+ (unless (gnus-check-group group)
+ (error "Can't open server for %s" group))
(gnus-request-set-mark
group (delq nil (list (if add (list add 'add '(read)))
(if del (list del 'del '(read)))))))))
(put 'gnus-with-article 'lisp-indent-function 1)
(put 'gnus-with-article 'edebug-form-spec '(form body))
+;;;
+;;; Generic summary marking commands
+;;;
+
+(defvar gnus-summary-marking-alist
+ '((read gnus-del-mark "d")
+ (unread gnus-unread-mark "u")
+ (ticked gnus-ticked-mark "!")
+ (dormant gnus-dormant-mark "?")
+ (expirable gnus-expirable-mark "e"))
+ "An alist of names/marks/keystrokes.")
+
+(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
+(defvar gnus-summary-mark-map)
+
+(defun gnus-summary-make-all-marking-commands ()
+ (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
+ (dolist (elem gnus-summary-marking-alist)
+ (apply 'gnus-summary-make-marking-command elem)))
+
+(defun gnus-summary-make-marking-command (name mark keystroke)
+ (let ((map (make-sparse-keymap)))
+ (define-key gnus-summary-generic-mark-map keystroke map)
+ (dolist (lway `((next "next" next nil "n")
+ (next-unread "next unread" next t "N")
+ (prev "previous" prev nil "p")
+ (prev-unread "previous unread" prev t "P")
+ (nomove "" nil nil ,keystroke)))
+ (let ((func (gnus-summary-make-marking-command-1
+ mark (car lway) lway name)))
+ (setq func (eval func))
+ (define-key map (nth 4 lway) func)))))
+
+(defun gnus-summary-make-marking-command-1 (mark way lway name)
+ `(defun ,(intern
+ (format "gnus-summary-put-mark-as-%s%s"
+ name (if (eq way 'nomove)
+ ""
+ (concat "-" (symbol-name way)))))
+ (n)
+ ,(format
+ "Mark the current article as %s%s.
+If N, the prefix, then repeat N times.
+If N is negative, move in reverse order.
+The difference between N and the actual number of articles marked is
+returned."
+ name (cadr lway))
+ (interactive "p")
+ (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
+
+(defun gnus-summary-generic-mark (n mark move unread)
+ "Mark N articles with MARK."
+ (unless (eq major-mode 'gnus-summary-mode)
+ (error "This command can only be used in the summary buffer"))
+ (gnus-summary-show-thread)
+ (let ((nummove
+ (cond
+ ((eq move 'next) 1)
+ ((eq move 'prev) -1)
+ (t 0))))
+ (if (zerop nummove)
+ (setq n 1)
+ (when (< n 0)
+ (setq n (abs n)
+ nummove (* -1 nummove))))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark)
+ (zerop (gnus-summary-next-subject nummove unread t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
(interactive)
- (let ((level (gnus-summary-thread-level)))
- (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1))
- (> (gnus-summary-thread-level) level))))
+ (gnus-save-hidden-threads
+ (let ((level (gnus-summary-thread-level)))
+ (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
+ (zerop (gnus-summary-next-subject 1))
+ (> (gnus-summary-thread-level) level)))))
(gnus-summary-position-point))
(defun gnus-uu-unmark-thread ()
(eval '(run-hooks 'gnus-load-hook))
(eval-when-compile (require 'cl))
-(require 'mm-util)
(require 'custom)
(eval-and-compile
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.062"
+(defconst gnus-version-number "6.10.063"
"Version number for this version of gnus.")
-(defconst gnus-revision-number "09"
+(defconst gnus-revision-number "00"
"Revision number for this version of gnus.")
-(defconst gnus-original-version-number "0.80"
+(defconst gnus-original-version-number "0.83"
"Version number for this version of Gnus.")
(provide 'running-pterodactyl-gnus-0_73-or-later)
gnus-article-delete-invisible-text gnus-treat-article)
("gnus-art" :interactive t
gnus-article-hide-headers gnus-article-hide-boring-headers
- gnus-article-treat-overstrike gnus-article-word-wrap
+ gnus-article-treat-overstrike
gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
gnus-article-display-x-face
gnus-article-hide-pgp
(when info
(gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
-;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
(defun gnus-short-group-name (group &optional levels)
"Collapse GROUP name LEVELS.
Select methods are stripped and any remote host name is stripped down to
(depth 0)
(skip 1)
(levels (or levels
+ gnus-group-uncollapsed-levels
(progn
(while (string-match "\\." group skip)
(setq skip (match-end 0)
url-view-url w3-prepare-buffer
char-int
annotationp delete-annotation make-image-specifier
- make-annotation
- w3-do-setup w3-region
- rmail-summary-exists rmail-select-summary rmail-update-summary
- url-generic-parse-url
- )))
+ make-annotation
+ w3-do-setup w3-region
+ rmail-summary-exists rmail-select-summary rmail-update-summary
+ url-generic-parse-url valid-image-instantiator-format-p
+ )))
(setq load-path (cons "." load-path))
(require 'custom)
"The mail-fetching library."
:group 'gnus)
+(defcustom mail-sources nil
+ "*Where the mail backends will look for incoming mail.
+This variable is a list of mail source specifiers."
+ :group 'mail-source
+ :type 'sexp)
+
(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
"File where mail will be stored while processing it."
:group 'mail-source
(eval-and-compile
(defvar mail-source-keyword-map
'((file
+ (:prescript)
+ (:postscript)
(:path (or (getenv "MAIL")
(concat "/usr/spool/mail/" (user-login-name)))))
(directory
(when (file-exists-p mail-source-crash-box)
(message "Processing mail from %s..." mail-source-crash-box)
(setq found (mail-source-callback
- callback mail-source-crash-box)))
- (+ found (funcall function source callback)))))
+ callback mail-source-crash-box)))
+ (+ found
+ (condition-case err
+ (funcall function source callback)
+ (error
+ (unless (yes-or-no-p
+ (format "Mail source error. Continue? "))
+ (error "Cannot get new mail."))
+ 0))))))
(defun mail-source-make-complex-temp-name (prefix)
(let ((newname (make-temp-name prefix))
(defun mail-source-fetch-file (source callback)
"Fetcher for single-file sources."
(mail-source-bind (file source)
+ (when prescript
+ (if (and (symbolp prescript) (fboundp prescript))
+ (funcall prescript)
+ (call-process shell-file-name nil nil nil
+ shell-command-switch
+ (format-spec
+ prescript
+ (format-spec-make ?t mail-source-crash-box)))))
(let ((mail-source-string (format "file:%s" path)))
(if (mail-source-movemail path mail-source-crash-box)
- (mail-source-callback callback path)
+ (prog1
+ (mail-source-callback callback path)
+ (when prescript
+ (if (and (symbolp prescript) (fboundp prescript))
+ (funcall prescript)
+ (call-process shell-file-name nil nil nil
+ shell-command-switch
+ (format-spec
+ postscript
+ (format-spec-make ?t mail-source-crash-box))))))
0))))
(defun mail-source-fetch-directory (source callback)
"Fetcher for single-file sources."
(mail-source-bind (pop source)
(when prescript
- (if (fboundp prescript)
+ (if (and (symbolp prescript)
+ (fboundp prescript))
(funcall prescript)
(call-process shell-file-name nil nil nil
shell-command-switch
(prog1
(mail-source-callback callback server)
(when prescript
- (if (fboundp prescript)
+ (if (and (symbolp postscript)
+ (fboundp postscript))
(funcall prescript)
(call-process shell-file-name nil nil nil
shell-command-switch
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
["Spellcheck" ispell-message t]
+ ["Attach file as MIME" mime-edit-insert-file t]
"----"
["Send Message" message-send-and-exit t]
["Abort Message" message-dont-send t]
;; colon, if there is none.
(if (/= (char-after) ? ) (insert " ") (forward-char 1))
;; Find out whether the header is empty...
- (looking-at "[ \t]*$")))
+ (looking-at "[ \t]*\n[^ \t]")))
;; So we find out what value we should insert.
(setq value
(cond
;;; MIME functions
;;;
-(defvar messgage-inhibit-body-encoding t)
+(defvar message-inhibit-body-encoding t)
(defun message-encode-message-body ()
- (unless messgage-inhibit-body-encoding
+ (unless message-inhibit-body-encoding
(let ((mail-parse-charset (or mail-parse-charset
message-default-charset
message-posting-charset))
,disposition ,description ,cache ,id))
(defvar mm-inline-media-tests
- '(("image/jpeg" mm-inline-image
- (and window-system (featurep 'jpeg) (mm-image-fit-p handle)))
- ("image/png" mm-inline-image
- (and window-system (featurep 'png) (mm-image-fit-p handle)))
- ("image/gif" mm-inline-image
- (and window-system (featurep 'gif) (mm-image-fit-p handle)))
- ("image/tiff" mm-inline-image
- (and window-system (featurep 'tiff) (mm-image-fit-p handle)))
- ("image/xbm" mm-inline-image
- (and window-system (fboundp 'device-type)
- (eq (device-type) 'x)))
- ("image/x-xbitmap" mm-inline-image
- (and window-system (fboundp 'device-type)
- (eq (device-type) 'x)))
- ("image/xpm" mm-inline-image
- (and window-system (featurep 'xpm)))
- ("image/x-pixmap" mm-inline-image
- (and window-system (featurep 'xpm)))
- ("image/bmp" mm-inline-image
- (and window-system (featurep 'bmp)))
+ '(("image/jpeg" mm-inline-image (mm-valid-and-fit-image-p 'jpeg handle))
+ ("image/png" mm-inline-image (mm-valid-and-fit-image-p 'png handle))
+ ("image/gif" mm-inline-image (mm-valid-and-fit-image-p 'gif handle))
+ ("image/tiff" mm-inline-image (mm-valid-and-fit-image-p 'tiff handle))
+ ("image/xbm" mm-inline-image (mm-valid-and-fit-image-p 'xbm handle))
+ ("image/x-xbitmap" mm-inline-image (mm-valid-and-fit-image-p 'xbm handle))
+ ("image/xpm" mm-inline-image (mm-valid-and-fit-image-p 'xpm handle))
+ ("image/x-pixmap" mm-inline-image (mm-valid-and-fit-image-p 'xpm handle))
+ ("image/bmp" mm-inline-image (mm-valid-and-fit-image-p 'bmp handle))
("text/plain" mm-inline-text t)
("text/enriched" mm-inline-text t)
("text/richtext" mm-inline-text t)
(defvar mm-user-automatic-external-display nil
"List of MIME type regexps that will be displayed externally automatically.")
-(defvar mm-alternative-precedence
- '("multipart/related" "multipart/mixed" "multipart/alternative"
- "image/jpeg" "image/gif" "text/html" "text/enriched"
- "text/richtext" "text/plain")
- "List that describes the precedence of alternative parts.")
+(defvar mm-discouraged-alternatives nil
+ "List of MIME types that are discouraged when viewing multiapart/alternative.
+Viewing agents are supposed to view the last possible part of a message,
+as that is supposed to be the richest. However, users may prefer other
+types instead, and this list says what types are most unwanted. If,
+for instance, text/html parts are very unwanted, and text/richtech are
+somewhat unwanted, then the value of this variable should be set
+to:
+
+ (\"text/html\" \"text/richtext\")")
(defvar mm-tmp-directory
(cond ((fboundp 'temp-directory) (temp-directory))
"Return a version of ARG that is safe to evaluate in a shell."
(let ((pos 0) new-pos accum)
;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[;!`\"$\\& \t{} |()<>]" arg pos))
+ (while (setq new-pos (string-match "[;!'`\"$\\& \t{} |()<>]" arg pos))
(push (substring arg pos new-pos) accum)
(push "\\" accum)
(push (list (aref arg new-pos)) accum)
"Insert the contents of HANDLE in the current buffer."
(let ((cur (current-buffer)))
(save-excursion
- (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)))
- (let ((temp (current-buffer)))
- (set-buffer cur)
- (insert-buffer-substring temp))))))
+ (if (member (car (split-string (car (mm-handle-type 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)))
+ (let ((temp (current-buffer)))
+ (set-buffer cur)
+ (insert-buffer-substring temp)))
+ (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)))
+ (let ((temp (current-buffer)))
+ (set-buffer cur)
+ (insert-buffer-substring temp)))))))
(defvar mm-default-directory nil)
file)))
;; 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)) "/")))
- buffer-file-coding-system
- 'binary))
- ;; Don't re-compress .gz & al. Arguably we should make
- ;; `file-name-handler-alist' nil, but that would chop
- ;; 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))
- "application/octet-stream")
- (cons 'jka-compr-handler inhibit-file-name-handlers)
- inhibit-file-name-handlers)))
- (write-region (point-min) (point-max) file))))))
+ (let ((coding-system-for-write
+ (if (equal "text" (car (split-string
+ (car (mm-handle-type handle)) "/")))
+ buffer-file-coding-system
+ 'binary))
+ ;; Don't re-compress .gz & al. Arguably we should make
+ ;; `file-name-handler-alist' nil, but that would chop
+ ;; 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))
+ "application/octet-stream")
+ (cons 'jka-compr-handler inhibit-file-name-handlers)
+ inhibit-file-name-handlers)))
+ (write-region (point-min) (point-max) file))))))
(defun mm-pipe-part (handle)
"Pipe HANDLE to a process."
(defun mm-preferred-alternative (handles &optional preferred)
"Say which of HANDLES are preferred."
- (let ((prec (if preferred (list preferred) mm-alternative-precedence))
+ (let ((prec (if preferred (list preferred)
+ (mm-preferred-alternative-precedence handles)))
p h result type handle)
(while (setq p (pop prec))
(setq h handles)
(pop h)))
result))
+(defun mm-preferred-alternative-precedence (handles)
+ "Return the precedence based on HANDLES and mm-discouraged-alternatives."
+ (let ((seq (mapcar (lambda (h) (car (mm-handle-type h))) handles)))
+ (dolist (disc (reverse mm-discouraged-alternatives))
+ (dolist (elem (copy-sequence seq))
+ (when (string-match disc elem)
+ (setq seq (nconc (delete elem seq) (list elem))))))
+ seq))
+
(defun mm-get-content-id (id)
"Return the handle(s) referred to by ID."
(cdr (assoc id mm-content-id-alist)))
(prog1
(setq spec
(ignore-errors
- (make-glyph
- (cond
- ((equal type "xbm")
- (let ((height 32)
- (width 32))
- (forward-line 2)
- (vector 'xbm :data (list height width
- (buffer-substring
- (point) (point-max))))))
- (t
+ (cond
+ ((equal type "xbm")
+ ;; xbm images require special handling, since
+ ;; the only way to create glyphs from these
+ ;; (without a ton of work) is to write them
+ ;; out to a file, and then create a file
+ ;; specifier.
+ (let ((file (make-temp-name
+ (expand-file-name "emm.xbm"
+ mm-tmp-directory))))
+ (unwind-protect
+ (progn
+ (write-region (point-min) (point-max) file)
+ (make-glyph (list (cons 'x file))))
+ (ignore-errors
+ (delete-file file)))))
+ (t
+ (make-glyph
(vector (intern type) :data (buffer-string)))))))
(mm-handle-set-cache handle spec))))))
(and (< (glyph-width image) (window-pixel-width))
(< (glyph-height image) (window-pixel-height))))))
+(defun mm-valid-image-format-p (format)
+ "Say whether FORMAT can be displayed natively by Emacs."
+ (and (fboundp 'valid-image-instantiator-format-p)
+ (valid-image-instantiator-format-p format)))
+
+(defun mm-valid-and-fit-image-p (format handle)
+ "Say whether FORMAT can be displayed natively and HANDLE fits the window."
+ (and window-system
+ (mm-valid-image-format-p format)
+ (mm-image-fit-p handle)))
+
(provide 'mm-decode)
;; mm-decode.el ends here
(defvar mm-charset-synonym-alist
'((big5 . cn-big5)
(gb2312 . cn-gb-2312)
- (iso-2022-jp-2 . iso-2022-7bit-ss2)
(x-ctext . ctext))
"A mapping from invalid charset names to the real charset names.")
(let ((w3-strict-width width)
(url-standalone-mode t))
(w3-region (point-min) (point-max)))))
+ (narrow-to-region (1+ (point-min)) (point-max))
(mm-handle-set-undisplayer
handle
`(lambda ()
(let (buffer-read-only)
- (mapc (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
- '(background background-pixmap foreground))
- (delete-region ,(point-min-marker) ,(point-max-marker))))))))
+ (mapc (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop) (current-buffer)))
+ '(background background-pixmap foreground))
+ (delete-region ,(point-min-marker)
+ ,(point-max-marker))))))))
((or (equal type "enriched")
(equal type "richtext"))
(save-excursion
(setq charset (mm-encode-body))
(setq encoding (mm-body-encoding charset))
(setq coded (buffer-string)))
- (with-temp-buffer
+ (mm-with-unibyte-buffer
(cond
((cdr (assq 'buffer cont))
(insert-buffer-substring (cdr (assq 'buffer cont))))
(when name
(setq name (mml-parse-file-name name))
(if (stringp name)
- (insert ";\n " (mail-header-encode-parameter "name" name)
- "\";\n access-type=local-file")
- (insert
- (format ";\n "
- (mail-header-encode-parameter
- "name" (file-name-nondirectory (nth 2 name)))
- (mail-header-encode-parameter "site" (nth 1 name))
- (mail-header-encode-parameter
- "directory" (file-name-directory (nth 2 name)))))
- (insert ";\n access-type="
- (if (member (nth 0 name) '("ftp@" "anonymous@"))
- "anon-ftp"
- "ftp"))))
+ (mml-insert-parameter
+ (mail-header-encode-parameter "name" name)
+ "access-type=local-file")
+ (mml-insert-parameter
+ (mail-header-encode-parameter
+ "name" (file-name-nondirectory (nth 2 name)))
+ (mail-header-encode-parameter "site" (nth 1 name))
+ (mail-header-encode-parameter
+ "directory" (file-name-directory (nth 2 name))))
+ (mml-insert-parameter
+ (concat "access-type="
+ (if (member (nth 0 name) '("ftp@" "anonymous@"))
+ "anon-ftp"
+ "ftp")))))
(when parameters
- (insert parameters)))
+ (mml-insert-parameter-string
+ cont '(expiration size permission))))
(insert "\n\n")
(insert "Content-Type: " (cdr (assq 'type cont)) "\n")
(insert "Content-ID: " (message-make-message-id) "\n")
(insert "; " (mail-header-encode-parameter
"charset" (symbol-name charset))))
(when parameters
- (insert parameters))
+ (mml-insert-parameter-string
+ cont '(name access-type expiration size permission)))
(insert "\n"))
(setq parameters
(mml-parameter-string
parameters)
(insert "Content-Disposition: " (or disposition "inline"))
(when parameters
- (insert parameters))
+ (mml-insert-parameter-string
+ cont '(filename creation-date modification-date read-date)))
(insert "\n"))
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
;; Strip directory component from the filename parameter.
(when (eq type 'filename)
(setq value (file-name-nondirectory value)))
- (setq string (concat string ";\n "
+ (setq string (concat string "; "
(mail-header-encode-parameter
(symbol-name type) value)))))
(when (not (zerop (length string)))
string)))
+(defun mml-insert-parameter-string (cont types)
+ (let (value type)
+ (while (setq type (pop types))
+ (when (setq value (cdr (assq type cont)))
+ ;; Strip directory component from the filename parameter.
+ (when (eq type 'filename)
+ (setq value (file-name-nondirectory value)))
+ (mml-insert-parameter
+ (mail-header-encode-parameter
+ (symbol-name type) value))))))
+
(defvar ange-ftp-path-format)
(defvar efs-path-regexp)
(defun mml-parse-file-name (path)
(equal (split-string (car (mm-handle-type handle)) "/") "text")
(insert ">\n")))
+(defun mml-insert-parameter (&rest parameters)
+ "Insert PARAMETERS in a nice way."
+ (dolist (param parameters)
+ (insert ";")
+ (let ((point (point)))
+ (insert " " param)
+ (when (> (current-column) 71)
+ (goto-char point)
+ (insert "\n ")
+ (end-of-line)))))
+
;;;
;;; Mode for inserting and editing MML forms
;;;
(main (make-sparse-keymap)))
(define-key map "f" 'mml-attach-file)
(define-key map "b" 'mml-attach-buffer)
+ (define-key map "e" 'mml-attach-external)
(define-key map "q" 'mml-quote-region)
(define-key map "m" 'mml-insert-multipart)
(define-key map "p" 'mml-insert-part)
'("MML"
("Attach"
["File" mml-attach-file t]
- ["Buffer" mml-attach-buffer t])
+ ["Buffer" mml-attach-buffer t]
+ ["External" mml-attach-external t])
("Insert"
["Multipart" mml-insert-multipart t]
["Part" mml-insert-part t])
minor-mode-map-alist)))
(run-hooks 'mml-mode-hook))
-(defun mml-read-file (prompt)
+;;;
+;;; Helper functions for reading MIME stuff from the minibuffer and
+;;; inserting stuff to the buffer.
+;;;
+
+(defun mml-minibuffer-read-file (prompt)
(let ((file (read-file-name prompt nil nil t)))
;; Prevent some common errors. This is inspired by similar code in
;; VM.
(error "Permission denied: %s" file))
file))
-(defun mml-read-type (file)
- (let* ((default (or (mm-default-file-encoding file)
+(defun mml-minibuffer-read-type (name &optional default)
+ (let* ((default (or default
+ (mm-default-file-encoding name)
;; Perhaps here we should check what the file
;; looks like, and offer text/plain if it looks
;; like text/plain.
"application/octet-stream"))
(string (completing-read
(format "Content type (default %s): " default)
- (delete-duplicates
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
- :test 'equal))))
+ (mapcar
+ 'list
+ (delete-duplicates
+ (nconc
+ (mapcar (lambda (m) (cdr m))
+ mailcap-mime-extensions)
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (l)
+ (delq nil
+ (mapcar
+ (lambda (m)
+ (let ((type (cdr (assq 'type (cdr m)))))
+ (if (equal (cadr (split-string type "/"))
+ "*")
+ nil
+ type)))
+ (cdr l))))
+ mailcap-mime-data)))
+ :test 'equal)))))
(if (not (equal string ""))
string
default)))
-(defun mml-read-description ()
+(defun mml-minibuffer-read-description ()
(let ((description (read-string "One line description: ")))
(when (string-match "\\`[ \t]*\\'" description)
(setq description nil))
"Quote the MML tags in the region."
(interactive "r")
(save-excursion
- (goto-char beg)
- ;; Quote parts.
- (while (re-search-forward
- "<#/?!*\\(multipart\\|part\\|external\\)" end t)
- (goto-char (match-beginning 1))
- (insert "!"))))
+ (save-restriction
+ ;; Temporarily narrow the region to defend from changes
+ ;; invalidating END.
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ ;; Quote parts.
+ (while (re-search-forward
+ "<#/?!*\\(multipart\\|part\\|external\\)" nil t)
+ (goto-char (match-beginning 1))
+ (insert "!")))))
+
+(defun mml-insert-tag (name &rest plist)
+ "Insert an MML tag described by NAME and PLIST."
+ (when (symbolp name)
+ (setq name (symbol-name name)))
+ (insert "<#" name)
+ (while plist
+ (let ((key (pop plist))
+ (value (pop plist)))
+ (when value
+ ;; Quote VALUE if it contains suspicious characters.
+ (when (string-match "[\"\\~/* \t\n]" value)
+ (setq value (prin1-to-string value)))
+ (insert (format " %s=%s" key value)))))
+ (insert ">\n<#/part>\n"))
+
+;;; Attachment functions.
(defun mml-attach-file (file &optional type description)
"Attach a file to the outgoing MIME message.
string of the form \"type/subtype\". DESCRIPTION is a one-line
description of the attachment."
(interactive
- (let* ((file (mml-read-file "Attach file: "))
- (type (mml-read-type file))
- (description (mml-read-description)))
+ (let* ((file (mml-minibuffer-read-file "Attach file: "))
+ (type (mml-minibuffer-read-type file))
+ (description (mml-minibuffer-read-description)))
(list file type description)))
- (insert
- (format
- "<#part type=%s name=%s filename=%s%s disposition=attachment><#/part>\n"
- type (prin1-to-string (file-name-nondirectory file))
- (prin1-to-string file)
- (if description
- (format " description=%s" (prin1-to-string description))
- ""))))
+ (mml-insert-tag 'part 'type type 'filename file 'disposition "attachment"
+ 'description description))
+
+(defun mml-attach-buffer (buffer &optional type description)
+ "Attach a buffer to the outgoing MIME message.
+See `mml-attach-file' for details of operation."
+ (interactive
+ (let* ((buffer (read-buffer "Attach buffer: "))
+ (type (mml-minibuffer-read-type buffer "text/plain"))
+ (description (mml-minibuffer-read-description)))
+ (list buffer type description)))
+ (mml-insert-tag 'part 'type type 'buffer buffer 'disposition "attachment"
+ 'description description))
(defun mml-attach-external (file &optional type description)
"Attach an external file into the buffer.
FILE is an ange-ftp/efs specification of the part location.
TYPE is the MIME type to use."
(interactive
- (let* ((file (mml-read-file "Attach external file: "))
- (type (mml-read-type file))
- (description (mml-read-description)))
+ (let* ((file (mml-minibuffer-read-file "Attach external file: "))
+ (type (mml-minibuffer-read-type file))
+ (description (mml-minibuffer-read-description)))
(list file type description)))
- (insert (format
- "<#external type=%s name=%s disposition=attachment><#/external>\n"
- type (prin1-to-string file))))
-
-
+ (mml-insert-tag 'external 'type type 'name file 'disposition "attachment"
+ 'description description))
+
+(defun mml-insert-multipart (&optional type)
+ (interactive (list (completing-read "Multipart type (default mixed): ")
+ "mixed"
+ '(("mixed") ("alternative") ("digest") ("parallel")
+ ("signed") ("encrypted"))))
+ (or type
+ (setq type "mixed"))
+ (mml-insert-tag "multipart" 'type type)
+ (insert "<#/!multipart>\n")
+ (forward-line -1))
+
+(defun mml-preview (&optional raw)
+ "Display current buffer with Gnus, in a new buffer.
+If RAW, don't highlight the article."
+ (interactive "P")
+ (let ((buf (current-buffer)))
+ (switch-to-buffer (get-buffer-create
+ (concat (if raw "*Raw MIME preview of "
+ "*MIME preview of ") (buffer-name))))
+ (erase-buffer)
+ (insert-buffer buf)
+ (mml-to-mime)
+ (unless raw
+ (run-hooks 'gnus-article-decode-hook)
+ (let ((gnus-newsgroup-name "dummy"))
+ (gnus-article-prepare-display)))
+ (fundamental-mode)
+ (setq buffer-read-only t)
+ (goto-char (point-min))))
+
(provide 'mml)
;;; mml.el ends here
(defun nndoc-generate-mime-parts-head (article)
(let* ((entry (cdr (assq article nndoc-dissection-alist)))
(headers (nth 6 entry)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert-buffer-substring
+ nndoc-current-buffer (car entry) (nth 1 entry))
+ (goto-char (point-max)))
(when headers
- (insert headers))
- (insert-buffer-substring
- nndoc-current-buffer (car entry) (nth 1 entry))))
+ (insert headers))))
(defun nndoc-clari-briefs-type-p ()
(when (let ((case-fold-search nil))
(goto-char (point-min))
(if xfrom
(insert "From " xfrom "\n")
- (unless (looking-at message-unix-mail-delimiter)
+ (unless (looking-at "From ")
(insert "From nobody " (current-time-string) "\n"))))
(nnfolder-normalize-buffer)
(set-buffer nnfolder-current-buffer)
(let* (save-list group-art)
(goto-char (point-min))
;; The From line may have been quoted by movemail.
- (when (looking-at (concat ">" message-unix-mail-delimiter))
+ (when (looking-at ">From")
(delete-char 1))
;; This might come from somewhere else.
- (unless (looking-at message-unix-mail-delimiter)
+ (unless (looking-at "From ")
(insert "From nobody " (current-time-string) "\n")
(goto-char (point-min)))
;; Quote all "From " lines in the article.
(save-excursion
(nnmail-activate 'nnfolder)
;; Read in the file.
- (let ((delim (concat "^" message-unix-mail-delimiter))
+ (let ((delim "^From ")
(marker (concat "\n" nnfolder-article-marker))
(number "[0-9]+")
(active (or (cadr (assoc group nnfolder-group-alist))
(default-major-mode 'fundamental-mode)
(enable-local-variables nil)
(after-insert-file-functions nil)
+ (enable-local-eval nil)
(find-file-hooks nil))
(insert-file-contents-as-coding-system
nnheader-file-coding-system filename visit beg end replace)))
(default-major-mode 'fundamental-mode)
(enable-local-variables nil)
(after-insert-file-functions nil)
+ (enable-local-eval nil)
(find-file-hooks nil))
(apply 'find-file-noselect-as-coding-system
nnheader-file-coding-system args)))
(require 'custom)
(require 'gnus-util)
(require 'mail-source)
-(require 'mm-util)
(eval-and-compile
(autoload 'gnus-error "gnus-util")
(defcustom nnmail-spool-file '((file))
"*Where the mail backends will look for incoming mail.
This variable is a list of mail source specifiers.
-If this variable is nil, no mail backends will read incoming mail."
+This variable is obsolete; `mail-sources' should be used instead."
:group 'nnmail-files
:type 'sexp)
(let ((methods nnmail-split-methods)
(obuf (current-buffer))
(beg (point-min))
- end group-art method regrepp)
+ end group-art method grp)
(if (and (sequencep methods)
(= (length methods) 1))
;; If there is only just one group to put everything in, we
(not group-art)))
(goto-char (point-max))
(setq method (pop methods)
- regrepp nil)
+ grp (car method))
(if (or methods
(not (equal "" (nth 1 method))))
(when (and
(ignore-errors
(if (stringp (nth 1 method))
- (progn
- (setq regrepp
- (string-match "\\\\[0-9&]" (car method)))
- (re-search-backward (cadr method) nil t))
+ (let ((expand (string-match "\\\\[0-9&]" grp))
+ (pos (re-search-backward (cadr method)
+ nil t)))
+ (and expand
+ (setq grp (nnmail-expand-newtext grp)))
+ pos)
;; Function to say whether this is a match.
- (funcall (nth 1 method) (car method))))
+ (funcall (nth 1 method) grp)))
;; Don't enter the article into the same
;; group twice.
- (not (assoc (car method) group-art)))
- (push (cons (if regrepp
- (nnmail-expand-newtext (car method))
- (car method))
- (funcall func (car method)))
+ (not (assoc grp group-art)))
+ (push (cons grp (funcall func grp))
group-art))
;; This is the final group, which is used as a
;; catch-all.
(defun nnmail-get-new-mail (method exit-func temp
&optional group spool-func)
"Read new incoming mail."
- (let* ((sources (if (listp nnmail-spool-file) nnmail-spool-file
- (list nnmail-spool-file)))
+ (let* ((sources (or mail-sources
+ (if (listp nnmail-spool-file) nnmail-spool-file
+ (list nnmail-spool-file))))
(group-in group)
(i 0)
+ (new 0)
+ (total 0)
incoming incomings source)
(when (and (nnmail-get-value "%s-get-new-mail" method)
nnmail-spool-file)
(list
:predicate
`(lambda (file)
- (string-match
+ (string-match
,(concat
- (regexp-quote (concat group suffix))
+ (regexp-quote (concat group suffix))
"$")
file)))))))
(when nnmail-fetched-sources
(when source
(nnheader-message 4 "%s: Reading incoming mail from %s..."
method (car source))
- (when (mail-source-fetch
- source
- `(lambda (file orig-file)
- (nnmail-split-incoming
- file ',(intern (format "%s-save-mail" method))
- ',spool-func (nnmail-get-split-group orig-file source)
- ',(intern (format "%s-active-number" method)))))
+ (when (setq new
+ (mail-source-fetch
+ source
+ `(lambda (file orig-file)
+ (nnmail-split-incoming
+ file ',(intern (format "%s-save-mail" method))
+ ',spool-func
+ (nnmail-get-split-group orig-file source)
+ ',(intern (format "%s-active-number" method))))))
+ (incf total new)
(incf i))))
;; If we did indeed read any incoming spools, we save all info.
(unless (zerop i)
(when exit-func
(funcall exit-func))
(run-hooks 'nnmail-read-incoming-hook)
- (nnheader-message 4 "%s: Reading incoming mail...done" method))
+ (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
+ total))
;; Close the message-id cache.
(nnmail-cache-close)
;; Allow the user to hook.
(save-excursion
(nnmail-find-file nnml-newsgroups-file)))
-(deffoo nnml-request-expire-articles (articles group
- &optional server force)
+(deffoo nnml-request-expire-articles (articles group &optional server force)
(nnml-possibly-change-directory group server)
(let ((active-articles
(nnheader-directory-articles nnml-current-directory))
(cdr gnus-message-group-art)))))
(gnus-request-post (gnus-find-method-for-group group)))))
+
+(deffoo nnvirtual-request-expire-articles (articles group
+ &optional server force)
+ (nnvirtual-possibly-change-server server)
+ (setq nnvirtual-component-groups
+ (delete (nnvirtual-current-group) nnvirtual-component-groups))
+ (dolist (group nnvirtual-component-groups)
+ (gnus-group-expire-articles-1 group)))
+
\f
;;; Internal functions.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
-;; Version: 1.3q
+;; Version: 1.3r
;; This file is part of GNU Emacs.
(require 'mail-utils)
(provide 'pop3)
-(defconst pop3-version "1.3m")
+(defconst pop3-version "1.3r")
(defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
"*POP3 maildrop.")
(setq From_ (concat (substring From_ 0 (match-beginning 0))
(substring From_ (match-end 0)))))
(goto-char (point-min))
- (insert From_))))))
+ (insert From_)
+ (re-search-forward "\n\n")
+ (narrow-to-region (point) (point-max))
+ (let ((size (- (point-max) (point-min))))
+ (goto-char (point-min))
+ (widen)
+ (forward-line -2)
+ (insert (format "Content-Length: %s\n" size)))
+ )))))
;; The Command Set
(unless (eq c ?\;)
(error "Invalid header: %s" string))
(forward-char 1)
- (setq c (char-after))
- (if (and (memq c ttoken)
- (not (memq c stoken)))
- (setq attribute
- (intern
- (downcase
- (buffer-substring
- (point) (progn (forward-sexp 1) (point))))))
- (error "Invalid header: %s" string))
- (setq c (char-after))
- (setq encoded nil)
- (when (eq c ?*)
- (forward-char 1)
+ ;; If c in nil, then this is an invalid header, but
+ ;; since elm generates invalid headers on this form,
+ ;; we allow it.
+ (when (setq c (char-after))
+ (if (and (memq c ttoken)
+ (not (memq c stoken)))
+ (setq attribute
+ (intern
+ (downcase
+ (buffer-substring
+ (point) (progn (forward-sexp 1) (point))))))
+ (error "Invalid header: %s" string))
(setq c (char-after))
- (when (memq c ntoken)
- (setq number
- (string-to-number
- (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
+ (setq encoded nil)
+ (when (eq c ?*)
+ (forward-char 1)
(setq c (char-after))
- (when (eq c ?*)
- (setq encoded t)
- (forward-char 1)
- (setq c (char-after)))))
- ;; See if we have any previous continuations.
- (when (and prev-attribute
- (not (eq prev-attribute attribute)))
- (push (cons prev-attribute prev-value) parameters)
- (setq prev-attribute nil
- prev-value ""))
- (unless (eq c ?=)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (setq value
- (buffer-substring (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))
- ((and (memq c ttoken)
- (not (memq c stoken)))
- (setq value (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- (t
- (error "Invalid header: %s" string)))
- (when encoded
- (setq value (rfc2231-decode-encoded-string value)))
- (if number
- (setq prev-attribute attribute
- prev-value (concat prev-value value))
- (push (cons attribute value) parameters)))
+ (when (memq c ntoken)
+ (setq number
+ (string-to-number
+ (buffer-substring
+ (point) (progn (forward-sexp 1) (point)))))
+ (setq c (char-after))
+ (when (eq c ?*)
+ (setq encoded t)
+ (forward-char 1)
+ (setq c (char-after)))))
+ ;; See if we have any previous continuations.
+ (when (and prev-attribute
+ (not (eq prev-attribute attribute)))
+ (push (cons prev-attribute prev-value) parameters)
+ (setq prev-attribute nil
+ prev-value ""))
+ (unless (eq c ?=)
+ (error "Invalid header: %s" string))
+ (forward-char 1)
+ (setq c (char-after))
+ (cond
+ ((eq c ?\")
+ (setq value
+ (buffer-substring (1+ (point))
+ (progn (forward-sexp 1) (1- (point))))))
+ ((and (memq c ttoken)
+ (not (memq c stoken)))
+ (setq value (buffer-substring
+ (point) (progn (forward-sexp 1) (point)))))
+ (t
+ (error "Invalid header: %s" string)))
+ (when encoded
+ (setq value (rfc2231-decode-encoded-string value)))
+ (if number
+ (setq prev-attribute attribute
+ prev-value (concat prev-value value))
+ (push (cons attribute value) parameters))))
;; Take care of any final continuations.
(when prev-attribute
;; Copyright (c) 1998 by Shenghuo Zhu <zsh@cs.rochester.edu>
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; $Revision: 5.6 $
+;; $Revision: 5.7 $
;; Keywords: uudecode
;; This file is not part of GNU Emacs, but the same permissions
(defvar uudecode-temporary-file-directory
(cond ((fboundp 'temp-directory) (temp-directory))
((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/")))
+ ("/tmp")))
;;;###autoload
(defun uudecode-decode-region-external (start end &optional file-name)
(setq file-name (read-file-name "File to Name:"
nil nil nil
(match-string 1)))))
- (setq tempfile (expand-file-name
- (or file-name (concat uudecode-temporary-file-directory
- (make-temp-name "uu")))))
+ (setq tempfile (if file-name
+ (expand-file-name file-name)
+ (make-temp-name
+ ;; /tmp/uu...
+ (expand-file-name
+ "uu" uudecode-temporary-file-directory))))
(let ((cdir default-directory) default-process-coding-system)
(unwind-protect
(progn
+1999-04-18 12:46:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Summary Score Commands): Typo.
+ (Choosing a Mail Backend): Addition.
+
+1999-04-18 09:24:51 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
+
+ * gnus.texi (Startup Variables): Fix.
+
+1999-04-18 09:12:28 Starback <starback@ling.uu.se>
+
+ * gnus.texi (Subscription Methods): Typo.
+
+1999-04-18 08:22:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Little Disk Space): Addition.
+
+1999-03-25 Erik Toubro Nielsen <erik@ifad.dk>
+
+ * gnus.texi (gnus-thread-sort-functions). 'reverse' => 'not'
+
+1999-04-17 10:21:01 Jack Twilley <jmt+usenet@nycap.rr.com>
+
+ * gnus.texi (Fancy Mail Splitting): Addition.
+
+1999-04-07 06:13:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Gnus Development): New.
+
+1999-03-06 20:12:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Generic Marking Commands): New.
+
1999-03-01 16:41:42 Rob Browning <rlb@cs.utexas.edu>
* gnus.texi (Score Variables): Clarify.
\input texinfo @c -*-texinfo-*-
@setfilename gnus-ja
-@settitle Semi-gnus 6.10.062 Manual
+@settitle Semi-gnus 6.10.063 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Semi-gnus 6.10.062 Manual
+@title Semi-gnus 6.10.063 Manual
@author by Lars Magne Ingebrigtsen
@author by members of Semi-gnus mailing-list
\e$B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O\e(B Unicode Next Generation\e$B$r\e(B
\e$B$*BT$A$/$@$5$$!#\e(B
-\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10.062 \e$B$KBP1~$7$^$9!#\e(B
+\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10.063 \e$B$KBP1~$7$^$9!#\e(B
@end ifinfo
@vindex gnus-save-newsrc-file
+@vindex gnus-read-newsrc-file
@code{gnus-save-newsrc-file} \e$B$r\e(B @code{nil} \e$B$K$9$k$3$H$K$h$C$F%U%!%$%k\e(B
@file{.newsrc} \e$B$K=q$-9~$`$N$r;_$a$k$3$H$,$G$-$^$9!#$=$&$9$l$P!"$=$N%U%!\e(B
\e$B%$%k$r:o=|$9$k$3$H$,$G$-!"%G%#%9%/MFNL$r@aLs$9$k$3$H$,$G$-!"\e(Bgnus \e$B$N=*N;\e(B
\e$B$,B.$/$J$j$^$9!#$7$+$7!"$=$&$9$k$HB>$N%K%e!<%9%j!<%@!<$r;H$($J$/$J$j$^$9!#\e(B
-\e$B$G$b!"$A$g$C$H!"C/$+$=$&$7$?$$?M$,$$$k$G$7$g$&$+!#\e(B
+\e$B$G$b!"$A$g$C$H!"C/$+$=$&$7$?$$?M$,$$$k$G$7$g$&$+!#\e(B
+\e$BF1$8$h$&$K\e(B @code{gnus-read-newsrc-file} \e$B$r\e(B @code{nil} \e$B$K$9$k$3$H$K$h$C$F\e(B
+@file{.newsrc} \e$B$H$9$Y$F$N\e(B @file{.newsrc-SERVER} \e$B$r:n$i$J$$$h$&$K$J$j$^$9!#\e(B
+\e$B$b$7$"$J$?$,;~!9\e(B Netscape \e$B$r;H$&$N$J$i$P!"$3$&$9$k$N$,ET9g$,NI$$$G$7$g$&!#\e(B
@vindex gnus-save-killed-list
@code{gnus-save-killed-list} (\e$B=i4|@_Dj$G$O\e(B @code{t}) \e$B$,\e(B @code{nil} \e$B$G$"\e(B
@item
@kbd{M-x gnus-version} \e$B$r;n$7$F2<$5$$!#$b$7!"\e(B
-@samp{T-gnus 6.10.062 (based on Pterodactyl Gnus v0.80; for SEMI
+@samp{T-gnus 6.10.063 (based on Pterodactyl Gnus v0.83; for SEMI
1.12/1.13, FLIM 1.12)} \e$B$N$h$&$J$b$N$,=P$F$-$?$J$i!"@5$7$$%U%!%$%k$,\e(B
\e$BFI$_9~$^$l$F$$$^$9!#\e(B
\e$B$b$7!"\e(B@samp{NNTP 3.x} \e$B$d\e(B @samp{nntp flee} \e$B$N$h$&$J$b$N$,=P$F$-$?$H$-$O!"\e(B
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Semi-gnus 6.10.062 Manual
+@settitle Semi-gnus 6.10.063 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Semi-gnus 6.10.062 Manual
+@title Semi-gnus 6.10.063 Manual
@author by Lars Magne Ingebrigtsen
@page
API. So Semi-gnus does not discriminate various language communities.
Oh, if you are a Klingon, please wait Unicode Next Generation.
-This manual corresponds to Semi-gnus 6.10.062.
+This manual corresponds to Semi-gnus 6.10.063.
@end ifinfo
Subscribe all new groups hierarchically. The difference between this
function and @code{gnus-subscribe-alphabetically} is slight.
@code{gnus-subscribe-alphabetically} will subscribe new groups in a strictly
-alphabetical fashion, while this function will enter groups into it's
+alphabetical fashion, while this function will enter groups into its
hierarchy. So if you want to have the @samp{rec} hierarchy before the
@samp{comp} hierarchy, this function will not mess that configuration
up. Or something like that.
not stored in the @file{.newsrc} file.
@vindex gnus-save-newsrc-file
+@vindex gnus-read-newsrc-file
You can turn off writing the @file{.newsrc} file by setting
@code{gnus-save-newsrc-file} to @code{nil}, which means you can delete
the file and save some space, as well as exiting from gnus faster.
However, this will make it impossible to use other newsreaders than
-gnus. But hey, who would want to, right?
+gnus. But hey, who would want to, right? Similarly, setting
+@code{gnus-read-newsrc-file} to @code{nil} makes gnus ignore the
+@file{.newsrc} file and any @file{.newsrc-SERVER} files, which is
+convenient if you have a tendency to use Netscape once in a while.
@vindex gnus-save-killed-list
If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus
A hook that is run as the very last thing after starting up gnus
successfully.
-@item gnus-started-hook
-@vindex gnus-started-hook
+@item gnus-setup-news-hook
+@vindex gnus-setup-news-hook
A hook that is run after reading the @file{.newsrc} file(s), but before
generating the group buffer.
@end ifinfo
@menu
-* Setting Marks:: How to set and remove marks.
-* Setting Process Marks:: How to mark articles for later processing.
+* Setting Marks:: How to set and remove marks.
+* Generic Marking Commands:: How to customize the marking.
+* Setting Process Marks:: How to mark articles for later processing.
@end menu
The default is @code{t}.
+@node Generic Marking Commands
+@subsection Generic Marking Commands
+
+Some people would like the command that ticks an article (@kbd{!}) go to
+the next article. Others would like it to go to the next unread
+article. Yet others would like it to stay on the current article. And
+even though I haven't heard of anybody wanting it to go the the
+previous (unread) article, I'm sure there are people that want that as
+well.
+
+Multiply these five behaviours with five different marking commands, and
+you get a potentially complex set of variable to control what each
+command should do.
+
+To sidestep that mess, Gnus provides commands that do all these
+different things. They can be found on the @kbd{M M} map in the summary
+buffer. Type @kbd{M M C-h} to see them all---there are too many of them
+to list in this manual.
+
+While you can use these commands directly, most users would prefer
+altering the summary mode keymap. For instance, if you would like the
+@kbd{!} command to go the the next article instead of the next unread
+article, you could say something like:
+
+@lisp
+(add-hook 'gnus-summary-mode-hook 'my-alter-summary-map)
+(defun my-alter-summary-map ()
+ (local-set-key "!" 'gnus-summary-put-mark-as-ticked-next))
+@end lisp
+
+or
+
+@lisp
+(defun my-alter-summary-map ()
+ (local-set-key "!" "MM!n"))
+@end lisp
+
+
@node Setting Process Marks
@subsection Setting Process Marks
@cindex setting process marks
(setq gnus-thread-sort-functions
'(gnus-thread-sort-by-number
gnus-thread-sort-by-subject
- (reverse gnus-thread-sort-by-total-score)))
+ (not gnus-thread-sort-by-total-score)))
@end lisp
The threads that have highest score will be displayed first in the
groups adds to all the messages. The way to use this function is to add
the @code{banner} group parameter (@pxref{Group Parameters}) to the
group you want banners stripped from. The parameter either be a string,
-which will be interpreted as a regulax expression matching text to be
+which will be interpreted as a regular expression matching text to be
removed, or the symbol @code{signature}, meaning that the (last)
signature should be removed.
Add clickable buttons to the article headers
(@code{gnus-article-add-buttons-to-head}).
+@item W W H
+@kindex W W H (Summary)
+@findex gnus-article-strip-headers-from-body
+Strip headers like the @code{X-No-Archive} header from the beginning of
+article bodies (@code{gnus-article-strip-headers-from-body}).
+
@item W E l
@kindex W E l (Summary)
@findex gnus-article-strip-leading-blank-lines
'my-save-all-jpeg-parts)
@end lisp
+@vindex gnus-mime-multipart-functions
+@item gnus-mime-multipart-functions
+Alist of @sc{mime} multipart types and functions to handle them.
+
@end table
@item gnus-treat-date-local
@item gnus-treat-date-lapsed
@item gnus-treat-date-original
+@item gnus-treat-strip-headers-in-body
@item gnus-treat-strip-trailing-blank-lines
@item gnus-treat-strip-leading-blank-lines
@item gnus-treat-strip-multiple-blank-lines
@code{nnmail-crosspost-link-function} to @code{copy-file}. (This
variable is @code{add-name-to-file} by default.)
-@findex nnmail-split-header-length-limit
-Header lines may be arbitrarily long. However, the longer a line is,
-the longer it takes to match them. Very long lines may lead to Gnus
-taking forever to split the mail, so Gnus excludes lines that are longer
-than @code{nnmail-split-header-length-limit} (which defaults to 1024).
-
@kindex M-x nnmail-split-history
@kindex nnmail-split-history
If you wish to see where the previous mail split put the messages, you
filter---only files that have the right suffix @emph{and} satisfy this
predicate are considered.
+@item :prescript
+@itemx :postscript
+Script run before/after fetching mail.
+
@end table
An example directory mail source:
@node Fetching Mail
@subsubsection Fetching Mail
+@vindex mail-sources
+@vindex nnmail-spool-file
The way to actually tell Gnus where to get new mail from is to set
-@code{nnmail-spool-file} to a list of mail source specifiers
+@code{mail-sources} to a list of mail source specifiers
(@pxref{Mail Source Specifiers}).
-If this variable is @code{nil}, the mail backends will never attempt to
-fetch mail by themselves.
+If this variable (and the obsolescent @code{nnmail-spool-file}) is
+@code{nil}, the mail backends will never attempt to fetch mail by
+themselves.
If you want to fetch mail both from your local spool as well as a POP
mail server, you'd say something like:
@lisp
-(setq nnmail-spool-file
+(setq mail-sources
'((file)
(pop :server "pop3.mail.server"
:password "secret")))
Or, if you don't want to use any of the keyword defaults:
@lisp
-(setq nnmail-spool-file
+(setq mail-sources
'((file :path "/var/spool/mail/user-name")
(pop :server "pop3.mail.server"
:user "user-name"
(any "debian-\\b\\(\\w+\\)@@lists.debian.org" "mail.debian.\\1")
@end example
+In this example, messages sent to @samp{debian-foo@@lists.debian.org}
+will be filed in @samp{mail.debian.foo}.
+
If the string contains the element @samp{\&}, then the previously
matched string will be substituted. Similarly, the elements @samp{\\1}
up to @samp{\\9} will be substituted with the text matched by the
habit of assuming that you want to read mail with them. This might not
be unreasonable, but it might not be what you want.
-If you set @code{nnmail-spool-file} to @code{nil}, none of the backends
-will ever attempt to read incoming mail, which should help.
+If you set @code{mail-sources} and @code{nnmail-spool-file} to
+@code{nil}, none of the backends will ever attempt to read incoming
+mail, which should help.
@vindex nnbabyl-get-new-mail
@vindex nnmbox-get-new-mail
file is first copied to your home directory. What happens after that
depends on what format you want to store your mail in.
+There are five different mail backends in the standard Gnus, and more
+backends are available separately. The mail backend most people use
+(because it is the fastest and most flexible) is @code{nnml}
+(@pxref{Mail Spool}).
+
@menu
* Unix Mail Box:: Using the (quite) standard Un*x mbox.
* Rmail Babyl:: Emacs programs use the rmail babyl format.
The main way to control what is to be downloaded is to create a
@dfn{category} and then assign some (or all) groups to this category.
-Gnus has its own buffer for creating and managing categories.
+Groups that do not belong in any other category belong to the
+@code{default} category. Gnus has its own buffer for creating and
+managing categories.
@menu
* Category Syntax:: What a category looks like.
@lisp
;;; Define how Gnus is to fetch news. We do this over NNTP
;;; from your ISP's server.
-(setq gnus-select-method '(nntp "nntp.your-isp.com"))
+(setq gnus-select-method '(nntp "news.your-isp.com"))
;;; Define how Gnus is to read your mail. We read mail from
;;; your ISP's POP server.
-(setenv "MAILHOST" "pop.your-isp.com")
-(setq nnmail-spool-file "po:username")
+(setq mail-sources '((pop :server "pop.your-isp.com")))
;;; Say how Gnus is to store the mail. We use nnml groups.
(setq gnus-secondary-select-methods '((nnml "")))
* Compatibility:: Just how compatible is Gnus with @sc{gnus}?
* Conformity:: Gnus tries to conform to all standards.
* Emacsen:: Gnus can be run on a few modern Emacsen.
+* Gnus Development:: How Gnus is developed.
* Contributors:: Oodles of people.
* New Features:: Pointers to some of the new stuff in Gnus.
* Newest Features:: Features so new that they haven't been written yet.
Emacsen.
+@node Gnus Development
+@subsection Gnus Development
+
+Gnus is developed in a two-phased cycle. The first phase involves much
+discussion on the @samp{ding@@gnus.org} mailing list, where people
+propose changes and new features, post patches and new backends. This
+phase is called the @dfn{alpha} phase, since the Gnusae released in this
+phase are @dfn{alpha releases}, or (perhaps more commonly in other
+circles) @dfn{snapshots}. During this phase, Gnus is assumed to be
+unstable and should not be used by casual users. Gnus alpha releases
+have names like ``Red Gnus'' and ``Quassia Gnus''.
+
+After futzing around for 50-100 alpha releases, Gnus is declared
+@dfn{frozen}, and only bug fixes are applied. Gnus loses the prefix,
+and is called things like ``Gnus 5.6.32'' instead. Normal people are
+supposed to be able to use these, and these are mostly discussed on the
+@samp{gnu.emacs.gnus} newsgroup.
+
+@cindex Incoming*
+@vindex nnmail-delete-incoming
+Some variable defaults differ between alpha Gnusae and released Gnusae.
+In particular, @code{nnmail-delete-incoming} defaults to @code{nil} in
+alpha Gnusae and @code{t} in released Gnusae. This is to prevent
+lossage of mail if an alpha release hiccups while handling the mail.
+
+The division of discussion between the ding mailing list and the Gnus
+newsgroup is not purely based on publicity concerns. It's true that
+having people write about the horrible things that an alpha Gnus release
+can do (sometimes) in a public forum may scare people off, but more
+importantly, talking about new experimental features that have been
+introduced may confuse casual users. New features are frequently
+introduced, fiddled with, and judged to be found wanting, and then
+either discarded or totally rewritten. People reading the mailing list
+usually keep up with these rapid changes, whille people on the newsgroup
+can't be assumed to do so.
+
+
+
@node Contributors
@subsection Contributors
@cindex contributors
you press `l', point will move to the first instance of the group.
@item
-The documentation should mention pop3.el, fetchmail, smtpmail and why
-po:username often fails.
-
-@item
Fetch by Message-ID from dejanews.
<URL:http://search.dejanews.com/msgid.xp?MID=%3C62h9l9$hm4@@basement.replay.com%3E&fmt=raw>
It should go somewhere else.
@item
+I'm having trouble accessing a newsgroup with a "+" in its name with
+Gnus. There is a new newsgroup on msnews.microsoft.com named
+"microsoft.public.multimedia.directx.html+time" that I'm trying to
+access as
+"nntp+msnews.microsoft.com:microsoft.public.multimedia.directx.html+time"
+but it gives an error that it cant access the group.
+
+Is the "+" character illegal in newsgroup names? Is there any way in
+Gnus to work around this? (gnus 5.6.45 - XEmacs 20.4)
+
+
+@item
Solve the halting problem.
@c TODO
use any other newsreaders than Gnus. This variable is @code{t} by
default.
+@item gnus-read-newsrc-file
+If this is @code{nil}, Gnus will never read @file{.newsrc}---it will
+only read @file{.newsrc.eld}. This means that you will not be able to
+use any other newsreaders than Gnus. This variable is @code{t} by
+default.
+
@item gnus-save-killed-list
If this is @code{nil}, Gnus will not save the list of dead groups. You
should also set @code{gnus-check-new-newsgroups} to @code{ask-server}
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Message 6.10.062 Manual
+@settitle Message 6.10.063 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Message 6.10.062 Manual
+@title Message 6.10.063 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Message 6.10.062. Message is
+This manual corresponds to Message 6.10.063. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / elisp / gnus.git- / commitdiff