From 2ef049c961e24c12c5ea1e2c224941d6805f5312 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Wed, 24 Jun 1998 10:55:51 +0000 Subject: [PATCH] Syncup with gnus-5.6.13 --- ChangeLog | 4 ++ lisp/ChangeLog | 88 +++++++++++++++++++++++ lisp/gnus-art.el | 2 +- lisp/gnus-picon.el | 5 +- lisp/gnus-start.el | 8 ++- lisp/gnus-sum.el | 197 +++++++++++++++++++++++++--------------------------- lisp/gnus-topic.el | 65 ++++++++++------- lisp/gnus-uu.el | 4 +- lisp/gnus.el | 4 +- lisp/message.el | 38 +++++++--- lisp/nngateway.el | 7 ++ lisp/nnkiboze.el | 9 ++- lisp/nnmail.el | 13 +++- lisp/nntp.el | 13 +++- lisp/nnvirtual.el | 2 +- 15 files changed, 308 insertions(+), 151 deletions(-) diff --git a/ChangeLog b/ChangeLog index ca110b9..b7ced2b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +1998-06-14 Tatsuya Ichikawa + + * Sync up with Gnus 5.6.13. + 1998-06-24 MORIOKA Tomohiko * lisp/gnus-art.el (gnus-article-display-mime-message): Don't diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7054db5..8b1fe65 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,91 @@ +Wed Jun 24 07:52:30 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.13 is released. + +Wed Jun 24 07:47:04 1998 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-rename): Disallow "nil". + +Wed Jun 24 07:33:17 1998 Vladimir Alexiev + + * nnvirtual.el (nnvirtual-update-xref-header): Regexp-quote group + name. + +Wed Jun 24 06:15:27 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-build-sparse-threads): Give all the sparse + articles the date of the current child. + + * gnus-topic.el (gnus-group-topic-parameters): Didn't compute. + +Wed Jun 24 03:27:44 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.6.12 is released. + +Wed Jun 10 11:06:35 1998 Andreas Schwab + + * message.el (message-mail-other-window): Bind message-this-is-mail. + (message-mail-other-frame): Likewise. + (message-news-other-window): Bind message-this-is-news. + (message-news-other-frame): Likewise. + +1998-06-09 Sam Steingold + + * gnus-uu.el (gnus-uu-default-view-rules): make sed kill ^M only + at the end of line. + +1998-06-05 Hrvoje Niksic + + * nnmail.el (nnmail-get-split-group): Don't regexp-quote + nnmail-procmail-suffix. + +Wed Jun 24 03:04:05 1998 Kim-Minh Kaplan + + * gnus-sum.el (gnus-build-get-header): Fix obarray. + +Wed Jun 24 02:49:57 1998 Castor + + * nntp.el (nntp-open-ssl-stream): + +Wed Jun 24 02:31:46 1998 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-nov-parse-line): Cleaned up. + (gnus-build-all-threads): Put things in the wrong obarray. + +Wed Jun 24 01:43:26 1998 Decklin Foster + + * nngateway.el (nngateway-mail2news-header-transformation): New + function. + +Wed Jun 24 00:25:45 1998 Lars Magne Ingebrigtsen + + * message.el (message-shorten-references): New function. + (message-header-format-alist): Use it. + + * gnus-start.el (gnus-always-read-dribble-file): Customized. + + * message.el (message-generate-new-buffers): Dox fox. + +Tue Jun 23 23:58:48 1998 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-prepare-topic): Respect visible topic + param. + (gnus-topic-hierarchical-parameters): New function. + +1998-06-02 Didier Verna + + * gnus-picon.el (gnus-get-buffer-name): use get-buffer-create + instead of get-buffer + +Wed Jun 3 04:41:45 1998 Lars Magne Ingebrigtsen + + * nnkiboze.el (nnkiboze-request-delete-group): Delete .newsrc + file. + + * nnmail.el (nnmail-article-group): Nuke looong lines. + + * gnus-art.el (gnus-button-alist): Buggy default. + Wed Jun 3 04:03:37 1998 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.6.11 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 6cc3b15..92364d9 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2824,7 +2824,7 @@ groups." ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) - ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 2) + ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-embedded-url 1) diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el index 7579b0c..be64979 100644 --- a/lisp/gnus-picon.el +++ b/lisp/gnus-picon.el @@ -184,8 +184,9 @@ arguments necessary for the job.") (defun gnus-get-buffer-name (variable) "Returns the buffer name associated with the contents of a variable." - (let ((buf (get-buffer (gnus-window-to-buffer-helper - (cdr (assq variable gnus-window-to-buffer)))))) + (let ((buf (get-buffer-create (gnus-window-to-buffer-helper + (cdr + (assq variable gnus-window-to-buffer)))))) (and buf (buffer-name buf)))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index d83f15f..29b6b04 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -383,10 +383,12 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) -;;; Internal variables +(defcustom gnus-always-read-dribble-file nil + "Uncoditionally read the dribble file." + :group 'gnus-newsrc + :type 'boolean) -(defvar gnus-always-read-dribble-file nil - "Uncoditionally read the dribble file.") +;;; Internal variables (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index b086438..e4e3b7d 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2871,25 +2871,24 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-dependencies-add-header (header dependencies force-new) "Enter HEADER into the DEPENDENCIES table if it is not already there. -If FORCE-NEW is not NIL, enter HEADER into the DEPENDENCIES table even +If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even if it was already present. -If `gnus-summary-ignore-duplicates' is NIL then duplicate Message-IDs +If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs will not be entered in the DEPENDENCIES table. Otherwise duplicate Message-IDs will be renamed be renamed to a unique Message-ID before being entered. -Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." - +Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) (id-dep (and id (intern id dependencies))) ref ref-dep ref-header) - ;; Enter this `header' in the `dependencies' table + ;; Enter this `header' in the `dependencies' table. (cond ((not id-dep) (setq header nil)) - ;; The first two cases do the normal part : enter a new `header' - ;; in the `dependencies' table, + ;; The first two cases do the normal part: enter a new `header' + ;; in the `dependencies' table. ((not (boundp id-dep)) (set id-dep (list header))) ((null (car (symbol-value id-dep))) @@ -2897,10 +2896,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." ;; From here the `header' was already present in the ;; `dependencies' table. - (force-new - ;; Overrides an existing entry, - ;; Just set the header part of the entry. + ;; Overrides an existing entry; + ;; just set the header part of the entry. (setcar (symbol-value id-dep) header)) ;; Renames the existing `header' to a unique Message-ID. @@ -2911,11 +2909,11 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (list header)) (mail-header-set-id header id)) - ;; - The last case ignores an existing entry, except it adds - ;; any additional Xrefs (in case the two articles came from - ;; different servers. - ;; Also sets `header' to `nil' meaning that the - ;; `dependencies' table was *not* modified. + ;; The last case ignores an existing entry, except it adds any + ;; additional Xrefs (in case the two articles came from different + ;; servers. + ;; Also sets `header' to `nil' meaning that the `dependencies' + ;; table was *not* modified. (t (mail-header-set-xref (car (symbol-value id-dep)) @@ -2932,9 +2930,10 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (boundp ref-dep) (setq ref-header (car (symbol-value ref-dep)))) (if (string= id ref) - ;; Yuk ! This is a reference loop. Make the article be a + ;; Yuk! This is a reference loop. Make the article be a ;; root article. (progn + (debug) (mail-header-set-references (car (symbol-value id-dep)) "none") (setq ref nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) @@ -2975,19 +2974,21 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. - (mapc #'(lambda (relation) - (when (gnus-dependencies-add-header - (make-full-mail-header gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "") - gnus-newsgroup-dependencies nil) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number))) - (sort relations 'car-less-than-car)) + (mapcar + (lambda (relation) + (when (gnus-dependencies-add-header + (make-full-mail-header + gnus-reffed-article-number + (cadddr relation) "" (mail-header-date header) + (cadr relation) + (or (caddr relation) "") 0 0 "") + gnus-newsgroup-dependencies nil) + (push gnus-reffed-article-number gnus-newsgroup-limit) + (push gnus-reffed-article-number gnus-newsgroup-sparse) + (push (cons gnus-reffed-article-number gnus-sparse-mark) + gnus-newsgroup-reads) + (decf gnus-reffed-article-number))) + (sort relations 'car-less-than-car)) (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () @@ -3010,11 +3011,66 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) +;; The following macros and functions were written by Felix Lee +;; . + +(defmacro gnus-nov-read-integer () + '(prog1 + (if (= (following-char) ?\t) + 0 + (let ((num (ignore-errors (read buffer)))) + (if (numberp num) num 0))) + (unless (eobp) + (search-forward "\t" eol 'move)))) + +(defmacro gnus-nov-skip-field () + '(search-forward "\t" eol 'move)) + +(defmacro gnus-nov-field () + '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) + +;; This function has to be called with point after the article number +;; on the beginning of the line. +(defsubst gnus-nov-parse-line (number dependencies &optional force-new) + (let ((eol (gnus-point-at-eol)) + (buffer (current-buffer)) + header) + + ;; overview: [num subject from date id refs chars lines misc] + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + number ; number + (funcall + gnus-unstructured-field-decoder (gnus-nov-field)) ; subject + (funcall + gnus-structured-field-decoder (gnus-nov-field)) ; from + (gnus-nov-field) ; date + (or (gnus-nov-field) + (nnheader-generate-fake-message-id)) ; id + (gnus-nov-field) ; refs + (gnus-nov-read-integer) ; chars + (gnus-nov-read-integer) ; lines + (unless (= (following-char) ?\n) + (gnus-nov-field))))) ; misc + + (widen)) + + (when gnus-alter-header-function + (funcall gnus-alter-header-function header)) + (gnus-dependencies-add-header header dependencies force-new))) + (defun gnus-build-get-header (id) ;; Look through the buffer of NOV lines and find the header to ;; ID. Enter this line into the dependencies hash table, and return ;; the id of the parent article (if any). - (let (found header) + (let ((deps gnus-newsgroup-dependencies) + found header) (prog1 (save-excursion (set-buffer nntp-server-buffer) @@ -3030,8 +3086,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (when found (beginning-of-line) (and - (setq header (gnus-nov-parse-line (read (current-buffer)) - gnus-newsgroup-dependencies)) + (setq header (gnus-nov-parse-line + (read (current-buffer)) deps)) (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) @@ -3047,6 +3103,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (defun gnus-build-all-threads () "Read all the headers." (let ((gnus-summary-ignore-duplicates t) + (dependencies gnus-newsgroup-dependencies) found header article) (save-excursion (set-buffer nntp-server-buffer) @@ -3054,9 +3111,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." (goto-char (point-min)) (while (not (eobp)) (ignore-errors - (setq article (read (current-buffer))) - (setq header (gnus-nov-parse-line article - gnus-newsgroup-dependencies))) + (setq article (read (current-buffer)) + header (gnus-nov-parse-line + article dependencies))) (when header (push header gnus-newsgroup-headers) (if (memq (setq article (mail-header-number header)) @@ -4402,76 +4459,14 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq id (mail-header-id header) ref (gnus-parent-id (mail-header-references header)))) - (setq header - (gnus-dependencies-add-header header dependencies force-new)) - (if header - (push header headers)) + (when (setq header + (gnus-dependencies-add-header + header dependencies force-new)) + (push header headers)) (goto-char (point-max)) (widen)) (nreverse headers))))) -;; The following macros and functions were written by Felix Lee -;; . - -(defmacro gnus-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (search-forward "\t" eol 'move)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -;; (defvar gnus-nov-none-counter 0) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defun gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header ref id id-dep ref-dep) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (funcall - gnus-unstructured-field-decoder (gnus-nov-field)) ; subject - (funcall - gnus-structured-field-decoder (gnus-nov-field)) ; from - (gnus-nov-field) ; date - (or (gnus-nov-field) - (nnheader-generate-fake-message-id)) ; id - (gnus-nov-field) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (unless (= (following-char) ?\n) - (gnus-nov-field))))) ; misc - - (widen)) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header)) - - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header))) - - (gnus-dependencies-add-header header dependencies force-new) - - header)) - ;; Goes through the xover lines and returns a list of vectors (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 249367d..15e036b 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -166,9 +166,10 @@ with some simple extensions. (when result (symbol-name result)))) -(defun gnus-current-topics () - "Return a list of all current topics, lowest in hierarchy first." - (let ((topic (gnus-current-topic)) +(defun gnus-current-topics (&optional topic) + "Return a list of all current topics, lowest in hierarchy first. +If TOPIC, start with that topic." + (let ((topic (or topic (gnus-current-topic))) topics) (while topic (push topic topics) @@ -199,7 +200,8 @@ with some simple extensions. active (- (1+ (cdr active)) (car active)))) clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)))) + (if (member group gnus-zombie-list) + gnus-level-zombie gnus-level-killed)))) (and unread ; nil means that the group is dead. (<= clevel level) @@ -324,27 +326,32 @@ with some simple extensions. (defun gnus-group-topic-parameters (group) "Compute the group parameters for GROUP taking into account inheritance from topics." - (let ((params-list (list (gnus-group-get-parameter group))) - topics params param out) + (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion (gnus-group-goto-group group) - (setq topics (gnus-current-topics)) - (while topics - (push (gnus-topic-parameters (pop topics)) params-list)) - ;; We probably have lots of nil elements here, so - ;; we remove them. Probably faster than doing this "properly". - (setq params-list (delq nil params-list)) - ;; Now we have all the parameters, so we go through them - ;; and do inheritance in the obvious way. - (while (setq params (pop params-list)) - (while (setq param (pop params)) - (when (atom param) - (setq param (cons param t))) - ;; Override any old versions of this param. - (setq out (delq (assq (car param) out) out)) - (push param out))) - ;; Return the resulting parameter list. - out))) + (nconc params-list + (gnus-topic-hierarchical-parameters (gnus-current-topic)))))) + +(defun gnus-topic-hierarchical-parameters (topic) + "Return a topic list computed for TOPIC." + (let ((topics (gnus-current-topics topic)) + params-list param out params) + (while topics + (push (gnus-topic-parameters (pop topics)) params-list)) + ;; We probably have lots of nil elements here, so + ;; we remove them. Probably faster than doing this "properly". + (setq params-list (delq nil params-list)) + ;; Now we have all the parameters, so we go through them + ;; and do inheritance in the obvious way. + (while (setq params (pop params-list)) + (while (setq param (pop params)) + (when (atom param) + (setq param (cons param t))) + ;; Override any old versions of this param. + (setq out (delq (assq (car param) out) out)) + (push param out))) + ;; Return the resulting parameter list. + out)) ;;; General utility functions @@ -406,7 +413,13 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) - (entries (gnus-topic-find-groups (car type) list-level all lowest)) + (entries (gnus-topic-find-groups + (car type) list-level + (or all + (cdr (assq 'visible + (gnus-topic-hierarchical-parameters + (car type))))) + lowest)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) @@ -1254,6 +1267,10 @@ If COPYP, copy the groups instead." ;; Check whether the new name exists. (when (gnus-topic-find-topology new-name) (error "Topic '%s' already exists")) + ;; "nil" is an invalid name, for reasons I'd rather not go + ;; into here. Trust me. + (when (equal new-name "nil") + (error "Invalid name: %s" nil)) ;; Do the renaming. (let ((top (gnus-topic-find-topology old-name)) (entry (assoc old-name gnus-topic-alist))) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 7b28e53..3a0bf91 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -54,8 +54,8 @@ ;; Default viewing action rules (defcustom gnus-uu-default-view-rules - '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") - ("\\.pas$" "cat %s | sed s/\r//g") + '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") + ("\\.pas$" "cat %s | sed 's/\r$//'") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") diff --git a/lisp/gnus.el b/lisp/gnus.el index 5e52472..46ce5e5 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,11 +250,11 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "6.7.0" +(defconst gnus-version-number "6.7.1" "Version number for this version of gnus.") (defconst gnus-version - (format "Chao-gnus %s (based on Gnus 5.6.11; for SEMI 1.8)" + (format "Chao-gnus %s (based on Gnus 5.6.13; for SEMI 1.8)" gnus-version-number) "Version string for this version of gnus.") diff --git a/lisp/message.el b/lisp/message.el index 08fac7d..645a787 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -251,7 +251,7 @@ nil means let mailer mail back a message to report errors." :type 'boolean) (defcustom message-generate-new-buffers t - "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called. + "*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." @@ -927,7 +927,7 @@ The cdr of ech entry is a function for applying the face to a region.") (Lines) (Expires) (Message-ID) - (References . message-fill-references) + (References . message-shorten-references) (X-Mailer) (X-Newsreader)) "Alist used for formatting headers.") @@ -3183,6 +3183,24 @@ Headers already prepared in the buffer are not modified." (replace-match " " t t)) (goto-char (point-max))))) +(defun message-shorten-references (header references) + "Limit REFERENCES to be shorter than 988 characters." + (let ((max 988) + (cut 4) + refs) + (nnheader-temp-write nil + (insert references) + (goto-char (point-min)) + (while (re-search-forward "<[^>]+>" nil t) + (push (match-string 0) refs)) + (setq refs (nreverse refs)) + (while (> (length (mapconcat 'identity refs " ")) max) + (when (< (length refs) (1+ cut)) + (decf cut)) + (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs))))) + (insert (capitalize (symbol-name header)) ": " + (mapconcat 'identity refs " ") "\n"))) + (defun message-position-point () "Move point to where the user probably wants to find it." (message-narrow-to-headers) @@ -3847,7 +3865,8 @@ you." (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "mail" to))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + (let ((message-this-is-mail t)) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))) ;;;###autoload (defun message-mail-other-frame (&optional to subject) @@ -3859,7 +3878,8 @@ you." (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "mail" to))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + (let ((message-this-is-mail t)) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))) ;;;###autoload (defun message-news-other-window (&optional newsgroups subject) @@ -3871,8 +3891,9 @@ you." (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) + (let ((message-this-is-news t)) + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject "")))))) ;;;###autoload (defun message-news-other-frame (&optional newsgroups subject) @@ -3884,8 +3905,9 @@ you." (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) + (let ((message-this-is-news t)) + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject "")))))) ;;; underline.el diff --git a/lisp/nngateway.el b/lisp/nngateway.el index 909e4f8..168d5f4 100644 --- a/lisp/nngateway.el +++ b/lisp/nngateway.el @@ -75,6 +75,13 @@ parameter -- the gateway address.") (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-) "@" gateway "\n"))) +(defun nngateway-mail2news-header-transformation (gateway) + "Transform the headers for sending to a mail2news gateway." + (message-remove-header "to") + (message-remove-header "cc") + (goto-char (point-min)) + (insert "To: mail2news@" gateway "\n")) + (nnoo-define-skeleton nngateway) (provide 'nngateway) diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index 0df788d..b122d3e 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -158,9 +158,7 @@ (let ((files (nconc (nnkiboze-score-file group) (list (nnkiboze-nov-file-name) - (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".newsrc"))))))) + (nnkiboze-nov-file-name ".newsrc"))))) (while files (and (file-exists-p (car files)) (file-writable-p (car files)) @@ -358,10 +356,11 @@ Finds out what articles are to be part of the nnkiboze groups." (goto-char (1+ (match-beginning 0))) (insert prefix))))) -(defun nnkiboze-nov-file-name () +(defun nnkiboze-nov-file-name (&optional suffix) (concat (file-name-as-directory nnkiboze-directory) (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) + (concat (nnkiboze-prefixed-name nnkiboze-current-group) + (or suffix ".nov"))))) (provide 'nnkiboze) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 516e8b1..7880e2f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -722,7 +722,7 @@ is a spool. If not using procmail, return GROUP." (file-name-as-directory nnmail-procmail-directory))) "\\([^/]*\\)" - (regexp-quote nnmail-procmail-suffix) "$") + nnmail-procmail-suffix "$") (expand-file-name file)) (let ((procmail-group (substring (expand-file-name file) (match-beginning 1) @@ -1069,7 +1069,18 @@ FUNC will be called with the group name to determine the article number." (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) + ;; Nuke pathologically long headers. Since Gnus applies + ;; pathologically complex regexps to the buffer, lines + ;; that are looong will take longer than the Universe's + ;; existence to process. + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (if (> (current-column) 1024) + (gnus-delete-line) + (forward-line 1))) ;; Allow washing. + (goto-char (point-min)) (run-hooks 'nnmail-split-hook) (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) diff --git a/lisp/nntp.el b/lisp/nntp.el index 1d8cfd1..67eafb7 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -211,7 +211,8 @@ server there that you can connect to. See also (defvoo nntp-server-list-active-group 'try) (eval-and-compile - (autoload 'nnmail-read-passwd "nnmail")) + (autoload 'nnmail-read-passwd "nnmail") + (autoload 'open-ssl-stream "ssl")) @@ -845,6 +846,16 @@ password contained in '~/.nntp-authinfo'." (defun nntp-open-network-stream (buffer) (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) +(defun nntp-open-ssl-stream (buffer) + (let* ((ssl-program-arguments '("-connect" (concat host ":" service))) + (proc (open-ssl-stream "nntpd" buffer nntp-address nntp-port-number))) + (save-excursion + (set-buffer buffer) + (nntp-wait-for-string "^\r*20[01]") + (beginning-of-line) + (delete-region (point-min) (point)) + proc))) + (defun nntp-read-server-type () "Find out what the name of the server we have connected to is." ;; Wait for the status string to arrive. diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index df61450..d83356d 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -399,7 +399,7 @@ to virtual article number.") (replace-match "" t t)) (goto-char (point-min)) (when (re-search-forward - (concat (gnus-group-real-name group) ":[0-9]+") + (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") nil t) (replace-match "" t t)) (unless (= (point) (point-max)) -- 1.7.10.4