From: ichikawa Date: Sun, 8 Nov 1998 15:35:31 +0000 (+0000) Subject: Sync up with pgnus-0.41 X-Git-Tag: pgnus-ichikawa-199811302358~90 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=29f03d9b1170ef03842cbc1b674e50ce1eb059db;p=elisp%2Fgnus.git- Sync up with pgnus-0.41 --- diff --git a/ChangeLog b/ChangeLog index e12fe9e..4a77304 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +1998-11-09 Tatsuya Ichikawa + + * lisp/gnus.el (gnus-version-number): Update to 6.10.028. + + * Sync up with Pterodactyl Gnus 0.41. + 1998-11-06 Katsumi Yamaoka * lisp/gnus-art.el (gnus-article-make-full-mail-header): New diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 71bb150..c9c5441 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,160 @@ +Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.41 is released. + +1998-11-08 00:52:38 Hrvoje Niksic + + * mm-decode.el (mm-dissect-multipart): Quote regexp. + +1998-10-29 Sudish Joseph + + * gnus.el (gnus-short-group-name): When shortening foreign select + methods, do not scan for plusses beyond the first colon. + +1998-11-07 Mike McEwan + + * gnus-agent.el (gnus-agent-save-group-info): Cater for group info + lines where `group' is the last thing on the line. + +1998-11-08 00:35:09 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Do alternative. + (gnus-mime-display-alternative): Insert marker. + +1998-11-07 14:33:46 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-dissect-multipart): Quote regexp. + + * nnmail.el (nnmail-expired-article-p): Protect against bogus + dates. + + * gnus-cus.el (gnus-topic): Required. + + * nnheader.el (nnheader-parse-nov): Parse extra. + (nnheader-nov-parse-extra): New macro. + +1998-10-31 12:33:22 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Internal move. + +1998-10-28 Per Abrahamsen + + * gnus-cus-new.el (gnus-custom-topic): New free variable. + (gnus-group-customize): Support editing topic parameters. + +1998-10-29 12:09:20 Karl Kleinpaste + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add + indicators. + +1998-10-29 11:31:11 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mm-display-part): Return. + (gnus-article-view-part): Only go if external. + (gnus-article-dumbquotes-map): Do 205. + + * mm-decode.el (mm-display-part): Return what was done. + + * message.el (message-buffer-naming-style): New variable. + (message-generate-new-buffers): Extended. + (message-buffer-naming-style): Removed. + (message-buffer-name): Use it. + (message-do-send-housekeeping): Rename new styling. + + * gnus-sum.el (gnus-summary-recenter): Allow + gnus-auto-center-summary to be a number. + +Wed Nov 4 02:24:39 1998 Shenghuo ZHU + + * pop3.el (pop3-open-server): Use "binary" instead of + "no-conversion". + +Sun Nov 1 01:26:42 1998 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Set + gnus-browse-current-method to the result of gnus-server-to-method. + +Thu Oct 29 01:47:44 1998 Shenghuo ZHU + + * gnus-util.el (gnus-pull): Another optional argument. + * nnweb.el (nnweb-request-delete-group): Delete from + nnweb-group-alist and update active file. + +Thu Oct 29 01:05:08 1998 Shenghuo ZHU + + * gnus-group.el (gnus-group-make-group): Accept group of new + method. + +Wed Oct 28 02:19:16 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble. + +Tue Oct 27 11:59:31 1998 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Postion of html portion. + +1998-10-29 10:26:54 Lars Magne Ingebrigtsen + + * nntp.el (nntp-list-active-group): Waited for short strings. + (nntp-send-mode-reader): Ditto. + (nntp-open-connection): Ditto. + + * gnus-int.el (gnus-request-group-articles): New function. + + * nntp.el (nntp-request-listgroup): New function. + (nntp-request-group-articles): Renamed. + +1998-10-27 10:37:52 Karl Kleinpaste + + * nnheader.el (nnheader-parse-nov): Supply extra. + +1998-10-26 23:03:48 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-push): Don't go to + gnus-article-buffer. + + * mm-view.el (mm-inline-image): Add a newline. + + * gnus-start.el (gnus-check-first-time-used): Check more. + +1998-10-26 23:03:29 Francois Felix Ingrand + + * gnus-start.el (gnus-check-first-time-used): Check current. + +1998-10-26 22:07:52 Lars Magne Ingebrigtsen + + * mm-util.el (mm-find-charset-region): New function. + + * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header. + + * gnus-art.el (gnus-mime-button-menu): Fix. + +1998-10-26 22:07:43 Michael Welsh Duggan + + * gnus-art.el (gnus-mime-button-menu): New definition. + +1998-10-26 01:46:11 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-charset): Downcase charset. + (article-decode-charset): Pass on type. + (article-decode-charset): Check nil charsets. + (article-remove-cr): Translate CR to LF. + (gnus-ignored-mime-types): Default to nil. + + * nnheader.el (nnheader-insert-nov): Work when not Xref. + + * gnus-sum.el (gnus-ignored-from-addresses): Default to + user-mail-address. + (gnus-nov-parse-extra): Didn't return right thing. + +1998-10-25 23:25:27 Lars Magne Ingebrigtsen + + * gnus-xmas.el: Use compiled-function-p. + +Mon Oct 26 14:37:19 1998 Shenghuo ZHU + + * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header. + Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.40 is released. @@ -460,7 +617,7 @@ Sun Oct 18 13:59:07 1998 Kurt Swanson * gnus-draft.el (gnus-draft-send): Allow mail. -1998-10-10 SL Baur +1998-10-10 -SL Baur * message.el (message-check): Move message-check macro above where it is first used. @@ -994,7 +1151,7 @@ Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.27 is released. -1998-09-11 12:42:07 Lars Magne Ingebrigtsen +1998-09-11 12:42:07 Lars Magne Ingebrigtsen- * mm-decode.el (mm-alternative-precedence): New variable. (mm-preferred-alternative): New function. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 3a471c0..0a0c058 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -557,7 +557,7 @@ the actual number of articles toggled is returned." (gnus-delete-line)) (insert group " " (number-to-string (cdr active)) " " (number-to-string (car active)) " y\n")) - (when (re-search-forward (concat (regexp-quote group) " ") nil t) + (when (re-search-forward (concat (regexp-quote group) "\\($\\| \\)") nil t) (gnus-delete-line)) (insert-buffer-substring nntp-server-buffer)))))) @@ -981,7 +981,11 @@ the actual number of articles toggled is returned." (gnus-agent-fetch-articles group (gnus-uncompress-range (cdr arts))) (setq marks (delq arts (gnus-info-marks info))) - (gnus-info-set-marks info marks)))) + (gnus-info-set-marks info marks) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")"))))) ;;; ;;; Agent Category Mode diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 077c119..70dfda0 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -574,6 +574,7 @@ displayed by the first non-nil matching CONTENT face." '(("\202" ",") ("\203" "f") ("\204" ",,") + ("\205" "...") ("\213" "<") ("\214" "OE") ("\205" "...") @@ -590,7 +591,7 @@ displayed by the first non-nil matching CONTENT face." ("\264" "'")) "Table for MS-to-Latin1 translation.") -(defcustom gnus-ignored-mime-types '("text/x-vcard") +(defcustom gnus-ignored-mime-types nil "List of MIME types that should be ignored by Gnus." :group 'gnus-mime :type '(repeat regexp)) @@ -601,7 +602,8 @@ displayed by the first non-nil matching CONTENT face." :type '(choice (const :tag "Off" nil) (const :tag "On" t) (const :tag "Last" last) - (integer :tag "Less"))) + (integer :tag "Less") + (sexp :tag "Predicate"))) ;;; Internal variables @@ -948,13 +950,16 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (end-of-line 2)))))) (defun article-remove-cr () - "Remove carriage returns from an article." + "Translate CRLF pairs into LF, and then CR into LF.." (interactive) (save-excursion (let ((buffer-read-only nil)) (goto-char (point-min)) + (while (search-forward "\r$" nil t) + (replace-match "" t t)) + (goto-char (point-min)) (while (search-forward "\r" nil t) - (replace-match "" t t))))) + (replace-match "\n" t t))))) (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." @@ -1055,6 +1060,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (gnus-group-find-parameter gnus-newsgroup-name 'charset)))) buffer-read-only) + (when charset + (setq charset (downcase charset))) (goto-char (point-max)) (widen) (forward-line 1) @@ -1063,7 +1070,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (equal (car ctl) "text/plain")) (mm-decode-body charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))))))))) + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2311,7 +2319,16 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-button-menu (event) "Construct a context-sensitive menu of MIME commands." (interactive "e") - ) + (let ((response (x-popup-menu + t `("MIME Part" + ("" ,@(mapcar (lambda (c) + (cons (caddr c) (car c))) + gnus-mime-button-commands))))) + (pos (event-start event))) + (when response + (set-buffer (window-buffer (posn-window pos))) + (goto-char (posn-point pos)) + (funcall response)))) (defun gnus-mime-view-all-parts () "View all the MIME parts." @@ -2379,8 +2396,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (gnus-article-goto-part n) - (gnus-set-window-start) - (gnus-mm-display-part handle)))) + (if (equal (car handle) "multipart/alternative") + (gnus-article-press-button) + (when (eq (gnus-mm-display-part handle) 'internal) + (gnus-set-window-start)))))) (defun gnus-mm-display-part (handle) "Display HANDLE and fix MIME button." @@ -2390,8 +2409,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) (gnus-insert-mime-button handle id (list (not (mm-handle-displayed-p handle)))) - (mm-display-part handle) - (goto-char point))) + (prog1 + (mm-display-part handle) + (goto-char point)))) (defun gnus-article-goto-part (n) "Go to MIME part N." @@ -2459,7 +2479,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (while (setq handle (pop handles)) (if (stringp (car handle)) (if (equal (car handle) "multipart/alternative") - (gnus-mime-display-alternative (cdr handle)) + (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (push (cons id handle) gnus-article-mime-handle-alist) + (gnus-mime-display-alternative (cdr handle) nil nil id)) (gnus-mime-display-mixed (cdr handle))) (gnus-mime-display-single handle))))) @@ -2496,17 +2518,42 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))))))) -(defun gnus-mime-display-alternative (handles &optional preferred ibegend) +(defun gnus-mime-display-alternative (handles &optional preferred ibegend id) (let* ((preferred (mm-preferred-alternative handles preferred)) (ihandles handles) (point (point)) - handle buffer-read-only from props begend) + handle buffer-read-only from props begend not-pref) (save-restriction (when ibegend (narrow-to-region (car ibegend) (cdr ibegend)) (delete-region (point-min) (point-max)) (mm-remove-parts handles)) (setq begend (list (point-marker))) + ;; Do the toggle. + (unless (setq not-pref (cadr (member preferred ihandles))) + (setq not-pref (car ihandles))) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "%d. " id)) + (point)) + `(gnus-callback + (lambda (handles) + (gnus-mime-display-alternative + ',ihandles ,(if (stringp (car not-pref)) + (car not-pref) + (car (mm-handle-type not-pref))) + ',begend ,id)) + local-map ,gnus-mime-button-map + ,gnus-mouse-face-prop ,gnus-article-mouse-face + face ,gnus-article-button-face + keymap ,gnus-mime-button-map + gnus-part ,id + gnus-data ,handle)) + (widget-convert-button 'link from (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap) + ;; Do the handles (while (setq handle (pop handles)) (gnus-add-text-properties (setq from (point)) @@ -2523,11 +2570,12 @@ If ALL-HEADERS is non-nil, no headers are hidden." ',ihandles ,(if (stringp (car handle)) (car handle) (car (mm-handle-type handle))) - ',begend)) + ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face keymap ,gnus-mime-button-map + gnus-part ,id gnus-data ,handle)) (widget-convert-button 'link from (point) :action 'gnus-widget-press-button @@ -3569,7 +3617,6 @@ specified by `gnus-button-alist'." (defun gnus-button-push (marker) ;; Push button starting at MARKER. (save-excursion - (set-buffer gnus-article-buffer) (goto-char marker) (let* ((entry (gnus-button-entry)) (inhibit-point-motion-hooks t) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 501d27d..7474f37 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -28,6 +28,7 @@ (require 'wid-edit) (require 'gnus-score) +(require 'gnus-topic) ;;; Widgets: @@ -173,10 +174,11 @@ DOC is a documentation string for the parameter.") (defvar gnus-custom-params) (defvar gnus-custom-method) (defvar gnus-custom-group) +(defvar gnus-custom-topic) -(defun gnus-group-customize (group) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) +(defun gnus-group-customize (group topic) + "Edit the group or topicon the current line." + (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) (let (info (types (mapcar (lambda (entry) `(cons :format "%v%h\n" @@ -184,9 +186,11 @@ DOC is a documentation string for the parameter.") (const :format "" ,(nth 0 entry)) ,(nth 1 entry))) gnus-group-parameters))) - (unless group + (unless (or group topic) (error "No group on current line")) - (unless (setq info (gnus-get-info group)) + (when (and group topic) + (error "Both a group an topic on current line")) + (unless (or topic (setq info (gnus-get-info group))) (error "Killed group; can't be edited")) ;; Ready. (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) @@ -194,13 +198,20 @@ DOC is a documentation string for the parameter.") (gnus-custom-mode) (make-local-variable 'gnus-custom-group) (setq gnus-custom-group group) + (make-local-variable 'gnus-custom-topic) + (setq gnus-custom-topic topic) (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "group parameters" - "(gnus)Group Parameters") + (if group + (widget-create 'info-link + :help-echo "Push me to learn more." + :tag "group parameters" + "(gnus)Group Parameters") + (widget-create 'info-link + :help-echo "Push me to learn more." + :tag "topic parameters" + "(gnus)Topic Parameters")) (widget-insert " for <") - (widget-insert group) + (widget-insert (or group topic)) (widget-insert "> and press ") (widget-create 'push-button :tag "done" @@ -210,15 +221,17 @@ DOC is a documentation string for the parameter.") (make-local-variable 'gnus-custom-params) (setq gnus-custom-params (widget-create 'group - :value (gnus-info-params info) + :value (if group + (gnus-info-params info) + (gnus-topic-parameters topic)) `(set :inline t :greedy t :tag "Parameters" :format "%t:\n%h%v" :doc "\ These special paramerters are recognized by Gnus. -Check the [ ] for the parameters you want to apply to this group, then -edit the value to suit your taste." +Check the [ ] for the parameters you want to apply to this group or +to the groups in this topic, then edit the value to suit your taste." ,@types) '(repeat :inline t :tag "Variables" @@ -244,26 +257,30 @@ form, but who cares?" '(repeat :inline t :tag "Unknown entries" sexp))) - (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link - :tag "select method" - :help-echo "Push me to learn more about select methods." - "(gnus)Select Methods") - (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp - :tag "Method" - :value (gnus-info-method info))) + (when group + (widget-insert "\n\nYou can also edit the ") + (widget-create 'info-link + :tag "select method" + :help-echo "Push me to learn more about select methods." + "(gnus)Select Methods") + (widget-insert " for the group.\n") + (setq gnus-custom-method + (widget-create 'sexp + :tag "Method" + :value (gnus-info-method info)))) (use-local-map widget-keymap) (widget-setup))) (defun gnus-group-customize-done (&rest ignore) "Apply changes and bury the buffer." (interactive) - (gnus-group-edit-group-done 'params gnus-custom-group - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group - (widget-value gnus-custom-method)) + (if gnus-custom-topic + (gnus-topic-set-parameters gnus-custom-topic + (widget-value gnus-custom-params)) + (gnus-group-edit-group-done 'params gnus-custom-group + (widget-value gnus-custom-params)) + (gnus-group-edit-group-done 'method gnus-custom-group + (widget-value gnus-custom-method))) (bury-buffer)) ;;; Score Customization: diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 6c6bb82..fcbcea5 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1815,7 +1815,7 @@ ADDRESS." (gnus-read-method "From method: "))) (when (stringp method) - (setq method (gnus-server-to-method method))) + (setq method (or (gnus-server-to-method method) method))) (let* ((meth (when (and method (not (gnus-server-equal method gnus-select-method))) (if address (list (intern method) address) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 6afd0bd..36fcbd0 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -269,6 +269,14 @@ this group uses will be queried." (funcall (gnus-get-function gnus-command-method func) (gnus-group-real-name group) (nth 1 gnus-command-method))))) +(defun gnus-request-group-articles (group) + "Request a list of existing articles in GROUP." + (let ((gnus-command-method (gnus-find-method-for-group group)) + (func 'request-group-articles)) + (when (gnus-check-backend-function func group) + (funcall (gnus-get-function gnus-command-method func) + (gnus-group-real-name group) (nth 1 gnus-command-method))))) + (defun gnus-close-group (group) "Request the GROUP be closed." (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 560c0e9..0f492e8 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -550,9 +550,9 @@ The following commands are available: (defun gnus-browse-foreign-server (server &optional return-buffer) "Browse the server SERVER." - (setq gnus-browse-current-method server) + (setq gnus-browse-current-method (gnus-server-to-method server)) (setq gnus-browse-return-buffer return-buffer) - (let* ((method (gnus-server-to-method server)) + (let* ((method gnus-browse-current-method) (gnus-select-method method) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index de4564e..45b80e1 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1103,10 +1103,16 @@ for new groups, and subscribe the new groups as zombies." got-new)) (defun gnus-check-first-time-used () - (if (or (file-exists-p gnus-startup-file) - (file-exists-p (concat gnus-startup-file ".el")) - (file-exists-p (concat gnus-startup-file ".eld"))) - nil + (catch 'ended + (let ((files (list gnus-current-startup-file + (concat gnus-current-startup-file ".el") + (concat gnus-current-startup-file ".eld") + gnus-startup-file + (concat gnus-startup-file ".el") + (concat gnus-startup-file ".eld")))) + (while files + (when (file-exists-p (pop files)) + (throw 'ended nil)))) (gnus-message 6 "First time user; subscribing you to default groups") (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 77b5c56..7b5c2e3 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -319,6 +319,7 @@ and non-`vertical', do both horizontal and vertical recentering." :group 'gnus-summary-maneuvering :type '(choice (const :tag "none" nil) (const vertical) + (integer :tag "height") (sexp :menu-tag "both" t))) (defcustom gnus-show-all-headers nil @@ -790,7 +791,7 @@ which it may alter in any way.") :group 'gnus-summary :type '(repeat symbol)) -(defcustom gnus-ignored-from-addresses nil +(defcustom gnus-ignored-from-addresses (regexp-quote user-mail-address) "*Regexp of From headers that may be suppressed in favor of To headers." :group 'gnus-summary :type 'regexp) @@ -2413,14 +2414,16 @@ marks of articles." gnus-ignored-from-addresses (string-match gnus-ignored-from-addresses (mail-header-from header))) - (or (car (funcall gnus-extract-address-components - (funcall gnus-decode-encoded-word-function to))) - (funcall gnus-decode-encoded-word-function to))) + (concat "-> " + (or (car (funcall gnus-extract-address-components + (funcall + gnus-decode-encoded-word-function to))) + (funcall gnus-decode-encoded-word-function to)))) ((and newsgroups gnus-ignored-from-addresses (string-match gnus-ignored-from-addresses (mail-header-from header))) - newsgroups) + (concat "=> " newsgroups)) (t (or (car (funcall gnus-extract-address-components (mail-header-from header))) @@ -3091,8 +3094,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." '(let (out string) (while (not (memq (char-after) '(?\n nil))) (setq string (gnus-nov-field)) - (when (string-match "^\\([^ :]\\): " string) - (push (cons (intern (match-string 1)) + (when (string-match "^\\([^ :]+\\): " string) + (push (cons (intern (match-string 1 string)) (substring string (match-end 0))) out))) out)) @@ -4916,7 +4919,9 @@ displayed, no centering will be performed." ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) - (t 2))) + (t (if (numberp gnus-auto-center-summary) + gnus-auto-center-summary + 2)))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index fe3f92f..397f712 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -904,11 +904,12 @@ ARG is passed to the first function." (setq alist (delq entry alist))) alist)) -(defmacro gnus-pull (key alist) +(defmacro gnus-pull (key alist &optional assoc-p) "Modify ALIST to be without KEY." (unless (symbolp alist) (error "Not a symbol: %s" alist)) - `(setq ,alist (delq (assq ,key ,alist) ,alist))) + (let ((fun (if assoc-p 'assoc 'assq))) + `(setq ,alist (delq (,fun ,key ,alist) ,alist)))) (defun gnus-globalify-regexp (re) "Returns a regexp that matches a whole line, iff RE matches a part of it." diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 79d0a05..334ccfa 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -435,7 +435,7 @@ call it with the value of the `gnus-data' text property." (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (indirect-function func))) - (if (byte-code-function-p fval) + (if (compiled-function-p fval) (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 2b96b5b..d224039 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,10 +259,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.027" +(defconst gnus-version-number "6.10.028" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.40" +(defconst gnus-original-version-number "0.41" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" @@ -2624,22 +2624,18 @@ just the host name." ;; separate foreign select method from group name and collapse. ;; if method contains a server, collapse to non-domain server name, ;; otherwise collapse to select method - (when (string-match ":" group) - (cond ((string-match "+" group) - (let* ((plus (string-match "+" group)) - (colon (string-match ":" group (or plus 0))) - (dot (string-match "\\." group))) - (setq foreign (concat - (substring group (+ 1 plus) - (cond ((null dot) colon) - ((< colon dot) colon) - ((< dot colon) dot))) - ":") - group (substring group (+ 1 colon))))) - (t - (let* ((colon (string-match ":" group))) - (setq foreign (concat (substring group 0 (+ 1 colon))) - group (substring group (+ 1 colon))))))) + (let* ((colon (string-match ":" group)) + (server (and colon (substring group 0 colon))) + (plus (and server (string-match "+" server)))) + (when server + (cond (plus + (setq foreign (substring server (+ 1 plus) + (string-match "\\." server)) + group (substring group (+ 1 colon)))) + (t + (setq foreign server + group (substring group (+ 1 colon))))) + (setq foreign (concat foreign ":")))) ;; collapse group name leaving LEVELS uncollapsed elements (while group (if (and (string-match "\\." group) (> levels 0)) diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 713b14a..865ddff 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -226,7 +226,7 @@ "Narrow to the header section in the current buffer." (narrow-to-region (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) + (if (re-search-forward "^\n" nil 1) (1- (point)) (point-max))) (goto-char (point-min))) diff --git a/lisp/message.el b/lisp/message.el index 22bfc3e..939f888 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -305,14 +305,15 @@ nil means let mailer mail back a message to report errors." :group 'message-mail :type 'boolean) -(defcustom message-generate-new-buffers t +(defcustom message-generate-new-buffers 'unique "*Non-nil means that a new message buffer will be created whenever `message-setup' is called. If this is a function, call that function with three parameters: The type, the to address and the group name. (Any of these may be nil.) The function should return the new buffer name." :group 'message-buffers :type '(choice (const :tag "off" nil) - (const :tag "on" t) + (const :tag "unique" unique) + (const :tag "unsuniqueent" unsent) (function fun))) (defcustom message-kill-buffer-on-exit nil @@ -768,6 +769,13 @@ If nil, Message won't auto-save." :group 'message-buffers :type 'directory) +(defcustom message-buffer-naming-style 'unique + "*The way new message buffers are named. +Valid valued are `unique' and `unsent'." + :group 'message-buffers + :type '(choice (const :tag "unique" unique) + (const :tag "unsent" unsent))) + ;;; Internal variables. ;;; Well, not really internal. @@ -3455,7 +3463,7 @@ Headers already prepared in the buffer are not modified." ((message-functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) ;; Generate a new buffer name The Message Way. - (message-generate-new-buffers + ((eq message-generate-new-buffers 'unique) (generate-new-buffer-name (concat "*" type (if to @@ -3465,6 +3473,16 @@ Headers already prepared in the buffer are not modified." "") (if (and group (not (string= group ""))) (concat " on " group) "") "*"))) + ((eq message-generate-new-buffers 'unsent) + (generate-new-buffer-name + (concat "*unsent " type + (if to + (concat " to " + (or (car (mail-extract-address-components to)) + to) "") + "") + (if (and group (not (string= group ""))) (concat " on " group) "") + "*"))) ;; Use standard name. (t (format "*%s message*" type)))) @@ -3520,7 +3538,7 @@ Headers already prepared in the buffer are not modified." ;; Rename the buffer. (if message-send-rename-function (funcall message-send-rename-function) - (when (string-match "\\`\\*" (buffer-name)) + (when (string-match "\\`\\*\\(unsent \\)?" (buffer-name)) (rename-buffer (concat "*sent " (substring (buffer-name) (match-end 0))) t))) ;; Push the current buffer onto the list. diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index b7611c3..d4e05f0 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -43,7 +43,7 @@ If no encoding was done, nil is returned." (save-excursion (goto-char (point-min)) (let ((charsets - (delq 'ascii (find-charset-region (point-min) (point-max)))) + (delq 'ascii (mm-find-charset-region (point-min) (point-max)))) charset) (cond ;; No encoding. @@ -121,16 +121,15 @@ If no encoding was done, nil is returned." (funcall encoding (point-min) (point-max)) (error nil))) (t - (message "Unknown encoding %s; defaulting to 8bit" encoding) - ))) + (message "Unknown encoding %s; defaulting to 8bit" encoding)))) -(defun mm-decode-body (charset &optional encoding) +(defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." (setq charset (or charset rfc2047-default-charset)) (save-excursion (when encoding - (mm-decode-content-transfer-encoding encoding)) + (mm-decode-content-transfer-encoding encoding type)) (when (featurep 'mule) (let (mule-charset) (when (and charset diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 6344209..ab07f8d 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -145,7 +145,7 @@ (defun mm-dissect-multipart (ctl) (goto-char (point-min)) (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) - (close-delimiter (concat boundary "--[ \t]*$")) + (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) start parts (end (save-excursion (goto-char (point-max)) @@ -174,7 +174,7 @@ (let ((obuf (current-buffer)) beg) (goto-char (point-min)) - (search-forward "\n\n" nil t) + (search-forward-regexp "^\n" nil t) (setq beg (point)) (set-buffer (generate-new-buffer " *mm*")) (insert-buffer-substring obuf beg) @@ -185,7 +185,9 @@ (eq (mm-user-method type) 'inline)) (defun mm-display-part (handle &optional no-default) - "Display the MIME part represented by HANDLE." + "Display the MIME part represented by HANDLE. +Returns nil if the part is removed; inline if displayed inline; +external if displayed external." (save-excursion (mailcap-parse-mailcaps) (if (mm-handle-displayed-p handle) @@ -203,10 +205,13 @@ (if (and (not user-method) (not method) (equal "text" (car (split-string type)))) - (mm-insert-inline handle (mm-get-part handle)) + (progn + (mm-insert-inline handle (mm-get-part handle)) + 'inline) (mm-display-external handle (or user-method method - 'mailcap-save-binary-file))))))))) + 'mailcap-save-binary-file)) + 'external))))))) (defun mm-display-external (handle method) "Display HANDLE using METHOD." diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 79454d0..eeff82f 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -222,6 +222,21 @@ See also `with-temp-file' and `with-output-to-string'." (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) +(defun mm-find-charset-region (b e) + "Return a list of charsets in the region." + (if enable-multibyte-characters + (find-charset-region b e) + ;; We are in a unibyte buffer, so we futz around a bit. + (save-excursion + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((entry (assoc current-language-environment language-info-alist))) + (skip-chars-forward "\0-\177") + (if (eobp) + '(ascii) + (list 'ascii (car (last (assq 'charset entry)))))))))) + (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 2d2a1d6..0335cdb 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -46,7 +46,7 @@ (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t) (mm-handle-set-undisplayer handle annot)) - (insert " "))) + (insert " \n"))) (defun mm-inline-text (handle) (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) @@ -85,8 +85,8 @@ (require 'url) (save-window-excursion (w3-region (point-min) (point-max)) - (setq text (buffer-string)))) - (mm-insert-inline handle text))) + (setq text (buffer-string))))) + (mm-insert-inline handle text)) ((or (equal type "enriched") (equal type "richtext")) (save-excursion diff --git a/lisp/nnheader.el b/lisp/nnheader.el index cb872ba..e56decf 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -295,6 +295,16 @@ on your system, you could say something like: (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) +(defmacro nnheader-nov-parse-extra () + '(let (out string) + (while (not (memq (char-after) '(?\n nil))) + (setq string (nnheader-nov-field)) + (when (string-match "^\\([^ :]+\\): " string) + (push (cons (intern (match-string 1 string)) + (substring string (match-end 0))) + out))) + out)) + (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) (make-full-mail-header @@ -310,7 +320,7 @@ on your system, you could say something like: (if (eq (char-after) ?\n) nil (nnheader-nov-field)) ; misc - ))) + (nnheader-nov-parse-extra)))) ; extra (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) @@ -327,9 +337,11 @@ on your system, you could say something like: (insert "\t") (princ (or (mail-header-lines header) 0) (current-buffer)) (insert "\t") + (when (mail-header-xref header) + (insert "Xref: " (mail-header-xref header))) (when (or (mail-header-xref header) (mail-header-extra header)) - (insert "Xref: " (mail-header-xref header) "\t")) + (insert "\t")) (when (mail-header-extra header) (let ((extra (mail-header-extra header))) (while extra diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 8e8fbfc..c3617fa 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1642,7 +1642,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ((numberp days) (setq days (days-to-time days)) ;; Compare the time with the current time. - (time-less-p days (time-since time))))))) + (condition-case () + (time-less-p days (time-since time)) + (error nil))))))) (defvar nnmail-read-passwd nil) (defun nnmail-read-passwd (prompt &rest args) @@ -1774,7 +1776,11 @@ If ARGS, PROMPT is used as an argument to `format'." (defun nnmail-pop3-movemail (inbox crashbox) "Function to move mail from INBOX on a pop3 server to file CRASHBOX." (let ((pop3-maildrop - (substring inbox (match-end (string-match "^po:" inbox))))) + (substring inbox (match-end (string-match "^po:" inbox)))) + (pop3-password + (or nnmail-pop-password + (nnmail-read-passwd + (format "Password for %s: " inbox))))) (pop3-movemail crashbox))) (defun nnmail-within-headers-p () diff --git a/lisp/nntp.el b/lisp/nntp.el index 3f1c00f..6ef1110 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,5 +1,5 @@ ;;; nntp.el --- nntp access for Gnus -;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc. +;;; Copyright (C) 1987-90,92-98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -270,9 +270,9 @@ If this variable is nil, which is the default, no timers are set.") (nntp-decode-text (not decode)) (unless discard (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) + (set-buffer buffer) + (goto-char (point-max)) + (insert-buffer-substring (process-buffer process)) ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) @@ -614,9 +614,14 @@ If this variable is nil, which is the default, no timers are set.") (setq nntp-server-list-active-group t))))) (deffoo nntp-list-active-group (group &optional server) - "Return the active info on GROUP (which can be a regexp." + "Return the active info on GROUP (which can be a regexp)." (nntp-possibly-change-group nil server) - (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) + (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)) + +(deffoo nntp-request-group-articles (group &optional server) + "Return the list of existing articles in GROUP." + (nntp-possibly-change-group nil server) + (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)) (deffoo nntp-request-article (article &optional group server buffer command) (nntp-possibly-change-group group server) @@ -745,7 +750,7 @@ If this variable is nil, which is the default, no timers are set.") This function is supposed to be called from `nntp-server-opened-hook'. It will make innd servers spawn an nnrpd process to allow actual article reading." - (nntp-send-command "^.*\r?\n" "MODE READER")) + (nntp-send-command "^.*\n" "MODE READER")) (defun nntp-send-authinfo (&optional send-if-force) "Send the AUTHINFO to the nntp server. @@ -1110,7 +1115,6 @@ password contained in '~/.nntp-authinfo'." (delete-char -1)) (goto-char (point-min)) (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ") - ;;(copy-to-buffer nntp-server-buffer (point-min) (point-max)) t)))) nntp-server-xover) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 4ab9ec4..42dc338 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -214,7 +214,8 @@ and `altavista'.") (deffoo nnweb-request-delete-group (group &optional force server) (nnweb-possibly-change-server group server) - (gnus-pull group nnweb-group-alist) + (gnus-pull group nnweb-group-alist t) + (nnweb-write-active) (gnus-delete-file (nnweb-overview-file group)) t) diff --git a/texi/ChangeLog b/texi/ChangeLog index 978e94c..2d1e9e8 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,12 @@ +1998-11-07 17:18:07 Lars Magne Ingebrigtsen + + * gnus.texi (Gnus Reference Guide): Renamed. + +1998-10-26 22:03:08 Lars Magne Ingebrigtsen + + * gnus.texi (Article Washing): Fix. + (MIME Commands): Change. + 1998-10-25 01:51:56 Lars Magne Ingebrigtsen * gnus.texi (Headers): Addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index fcc6c84..bab61e7 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Semi-gnus 6.10.027 Manual +@settitle Semi-gnus 6.10.028 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.10.027 Manual +@title Semi-gnus 6.10.028 Manual @author by Lars Magne Ingebrigtsen @page @@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE 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.027. +This manual corresponds to Semi-gnus 6.10.028. @end ifinfo @@ -3459,7 +3459,7 @@ headers are used instead. @vindex nnmail-extra-headers A related variable is @code{nnmail-extra-headers}, which controls when -to include extra headers when generating active files. +to include extra headers when generating overview (@sc{nov}) files. In summary, you'd typically do something like the following: @@ -3652,6 +3652,9 @@ action. This will also inhibit horizontal re-centering of the summary buffer, which might make it more inconvenient to read extremely long threads. +This variable can also be a number. In that case, center the window at +the given number of lines from the top. + @end table @@ -3913,7 +3916,7 @@ goes out to all people listed in the @code{To}, @code{From} (or @kindex S W (Summary) @findex gnus-summary-wide-reply-with-original Mail a wide reply to the current article and include the original -message (@code{gnus-summary-reply-with-original}). This command uses +message (@code{gnus-summary-wide-reply-with-original}). This command uses the process/prefix convention. @item S o m @@ -6583,7 +6586,9 @@ when filling. @item W c @kindex W c (Summary) @findex gnus-article-remove-cr -Remove CR (i. e., @samp{^M}s on the end of the lines) +Translate CRLF pairs (i. e., @samp{^M}s on the end of the lines) into LF +(this takes care of DOS line endings), and then translate any remaining +CRs into LF (this takes care of Mac line endings) (@code{gnus-article-remove-cr}). @item W f @@ -6922,7 +6927,14 @@ Relevant variables: @vindex gnus-ignored-mime-types This is a list of regexps. @sc{mime} types that match a regexp from this list will be completely ignored by Gnus. The default value is -@code{("text/x-vcard")}. +@code{nil}. + +To have all Vcards be ignored, you'd say something like this: + +@lisp +(setq gnus-ignored-mime-types + '("text/x-vcard")) +@end lisp @end table @@ -14388,6 +14400,15 @@ and so on. Create as many faces as you wish. The same goes for the @code{mouse-face} specs---you can say @samp{%3(hello%)} to have @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. +Text inside the @samp{%<} and @samp{%>} specifiers will get the special +@code{balloon-help} property set to @code{gnus-balloon-face-0}. If you say +@samp{%1<}, you'll get @code{gnus-balloon-face-1} and so on. The +@code{gnus-balloon-face-*} variables should be either strings or +symbols naming functions that return a string. Under @code{balloon-help-mode}, +when the mouse passes over text with this property set, a balloon window +will appear and display the string. Please refer to the doc string of +@code{balloon-help-mode} for more information on this. + Here's an alternative recipe for the group buffer: @lisp @@ -15869,7 +15890,7 @@ but at the common table.@* * Terminology:: We use really difficult, like, words here. * Customization:: Tailoring Gnus to your needs. * Troubleshooting:: What you might try if things do not work. -* A Programmers Guide to Gnus:: Rilly, rilly technical stuff. +* Gnus Reference Guide:: Rilly, rilly technical stuff. * Emacs for Heathens:: A short introduction to Emacsian terms. * Frequently Asked Questions:: A question-and-answer session. @end menu @@ -18290,6 +18311,11 @@ The documentation should mention pop3.el, fetchmail, smtpmail and why po:username often fails. @item +Fetch by Message-ID from dejanews. + + + +@item Solve the halting problem. @c TODO @@ -18756,8 +18782,8 @@ Write to @samp{ding-request@@gnus.org} to subscribe. @page -@node A Programmers Guide to Gnus -@section A Programmer@'s Guide to Gnus +@node Gnus Reference Guide +@section Gnus Reference Guide It is my hope that other people will figure out smart stuff that Gnus can do, and that other people will write those smart things as well. To diff --git a/texi/message.texi b/texi/message.texi index 3834bd8..b305e32 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.40 Manual +@settitle Pterodactyl Message 0.41 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.40 Manual +@title Pterodactyl Message 0.41 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.40. Message is +This manual corresponds to Pterodactyl Message 0.41. Message is distributed with the Gnus distribution bearing the same version number as this manual.