*** pub/sgnus/lisp/gnus-msg.el Tue Apr 2 15:58:49 1996 --- sgnus/lisp/gnus-msg.el Wed Apr 3 19:14:08 1996 *************** *** 651,665 **** (defun gnus-bug () "Send a bug report to the Gnus maintainers." (interactive) ! (let ((winconf (current-window-configuration))) (delete-other-windows) (switch-to-buffer "*Gnus Help Bug*") (erase-buffer) (insert gnus-bug-message) (goto-char (point-min)) ! (gnus-setup-message 'bug ! (message-pop-to-buffer "*Gnus Bug*") ! (message-setup `((To . ,gnus-maintainer) (Subject . "")))) (push `(gnus-bug-kill-buffer) message-send-actions) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) --- 651,664 ---- (defun gnus-bug () "Send a bug report to the Gnus maintainers." (interactive) ! (gnus-setup-message 'bug (delete-other-windows) (switch-to-buffer "*Gnus Help Bug*") (erase-buffer) (insert gnus-bug-message) (goto-char (point-min)) ! (message-pop-to-buffer "*Gnus Bug*") ! (message-setup `((To . ,gnus-maintainer) (Subject . ""))) (push `(gnus-bug-kill-buffer) message-send-actions) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) *************** *** 681,687 **** "Attemps to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path." (interactive) ! (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el")) file dirs expr olist sym) (message "Please wait while we snoop your variables...") (sit-for 0) --- 680,687 ---- "Attemps to go through the Gnus source file and report what variables have been changed. The source file has to be in the Emacs load path." (interactive) ! (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el" ! "message.el")) file dirs expr olist sym) (message "Please wait while we snoop your variables...") (sit-for 0) *** pub/sgnus/lisp/gnus-score.el Tue Apr 2 15:58:51 1996 --- sgnus/lisp/gnus-score.el Wed Apr 3 21:49:25 1996 *************** *** 2082,2087 **** --- 2082,2091 ---- (search-forward "+") (forward-char -1) (insert "\\"))) + ;; Kludge to deal with "++" groups. + (while (search-forward "++" nil t) + (replace-match "\\+\\+" t t)) + (goto-char (point-min)) ;; Translate "all" to ".*". (while (search-forward "all" nil t) (replace-match ".*" t t)) *** pub/sgnus/lisp/gnus-topic.el Tue Apr 2 15:58:53 1996 --- sgnus/lisp/gnus-topic.el Wed Apr 3 21:49:25 1996 *************** *** 326,331 **** --- 326,345 ---- (setq topology (cdr topology))) (or result (and found parent)))) + (defun gnus-topic-next-topic (topic &optional previous) + "Return the next sibling of TOPIC." + (let ((topology gnus-topic-topology) + (parentt (cddr (gnus-topic-find-topology + (gnus-topic-parent-topic topic)))) + prev) + (while (and parentt + (not (equal (caaar parentt) topic))) + (setq prev (caaar parentt) + parentt (cdr parentt))) + (if previous + prev + (caaadr parentt)))) + (defun gnus-topic-find-topology (topic &optional topology level remove) "Return the topology of TOPIC." (unless topology *************** *** 849,855 **** (item (cdr (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic (caar item) (gnus-topic-parent-topic previous) previous ! item)) (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation --- 863,870 ---- (item (cdr (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic (caar item) (gnus-topic-parent-topic previous) previous ! item) ! (gnus-topic-goto-topic (caar item))) (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation *************** *** 982,989 **** (when topic (gnus-topic-goto-topic topic) (gnus-topic-kill-group) ! (gnus-topic-create-topic topic parent) ! (gnus-topic-goto-topic topic))))) (defun gnus-topic-unindent () "Unindent a topic." --- 997,1006 ---- (when topic (gnus-topic-goto-topic topic) (gnus-topic-kill-group) ! (gnus-topic-create-topic ! topic parent nil (cdr (pop gnus-topic-killed-topics))) ! (or (gnus-topic-goto-topic topic) ! (gnus-topic-goto-topic parent)))))) (defun gnus-topic-unindent () "Unindent a topic." *************** *** 996,1002 **** (when topic (gnus-topic-goto-topic topic) (gnus-topic-kill-group) ! (gnus-topic-create-topic topic grandparent) (gnus-topic-goto-topic topic)))) (defun gnus-topic-list-active (&optional force) --- 1013,1021 ---- (when topic (gnus-topic-goto-topic topic) (gnus-topic-kill-group) ! (gnus-topic-create-topic ! topic grandparent (gnus-topic-next-topic parent) ! (cdr (pop gnus-topic-killed-topics))) (gnus-topic-goto-topic topic)))) (defun gnus-topic-list-active (&optional force) *** pub/sgnus/lisp/gnus-uu.el Tue Apr 2 15:58:54 1996 --- sgnus/lisp/gnus-uu.el Wed Apr 3 19:14:10 1996 *************** *** 476,484 **** (progn (delete-region (point) (gnus-point-at-eol)) (insert from))) ! (if post ! (gnus-forward-using-post) ! (gnus-mail-forward)) (delete-file file) (kill-buffer buf) (setq gnus-uu-digest-from-subject nil))) --- 476,482 ---- (progn (delete-region (point) (gnus-point-at-eol)) (insert from))) ! (message-forward post) (delete-file file) (kill-buffer buf) (setq gnus-uu-digest-from-subject nil))) *** pub/sgnus/lisp/gnus.el Tue Apr 2 15:58:59 1996 --- sgnus/lisp/gnus.el Wed Apr 3 22:35:44 1996 *************** *** 31,36 **** --- 31,37 ---- (require 'mail-utils) (require 'timezone) (require 'nnheader) + (require 'message) (eval-when-compile (require 'cl)) *************** *** 909,914 **** --- 910,919 ---- (summary 0.25 point) (if gnus-carpal '(summary-carpal 4)) ("*Shell Command Output*" 1.0))) + (bug + (vertical 1.0 + ("*Gnus Help Bug*" 0.5) + ("*Gnus Bug*" 1.0 point))) (compose-bounce (vertical 1.0 (article 0.5) *************** *** 1688,1694 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.62" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1693,1699 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.63" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1966,1971 **** --- 1971,1977 ---- gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) ("nnsoup" nnsoup-pack-replies) + ("gnus-scomo" :interactive t gnus-score-mode) ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) *************** *** 4539,4544 **** --- 4545,4553 ---- (gnus-server-to-method method)) ((and (stringp (car method)) group) (gnus-server-extend-method group method)) + ((and method (not group) + (equal (cadr method) "")) + method) (t (gnus-server-add-address method)))) *************** *** 6334,6340 **** (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) ! (unless (gnus-get-new-news-in-group group) (ding) (gnus-message 3 "%s error: %s" group (gnus-status-message group)))) (when gnus-goto-next-group-when-activating --- 6343,6354 ---- (setq group (car groups) groups (cdr groups)) (gnus-group-remove-mark group) ! (if (and group (gnus-activate-group group 'scan)) ! (progn ! (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-active group) t) ! (gnus-close-group group) ! (gnus-group-update-group group)) (ding) (gnus-message 3 "%s error: %s" group (gnus-status-message group)))) (when gnus-goto-next-group-when-activating *************** *** 6342,6356 **** (gnus-summary-position-point) ret)) - (defun gnus-get-new-news-in-group (group) - (when (and group (gnus-activate-group group 'scan)) - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) - (gnus-close-group group) - (when (gnus-group-goto-group group) - (gnus-group-update-group-line)) - t)) - (defun gnus-group-fetch-faq (group &optional faq-dir) "Fetch the FAQ for the current group." (interactive --- 6356,6361 ---- *************** *** 13333,13338 **** --- 13338,13344 ---- (if (gnus-request-article article group (current-buffer)) (progn (and gnus-keep-backlog + (numberp article) (gnus-backlog-enter-article group article (current-buffer))) 'article)))) *************** *** 14880,14885 **** --- 14886,14894 ---- ;; Make sure there's a newline at the end of the article. (when (stringp method) (setq method (gnus-server-to-method method))) + (when (and (not method) + (stringp group)) + (setq method (gnus-find-method-for-group group))) (goto-char (point-max)) (unless (bolp) (insert "\n")) *************** *** 14887,14892 **** --- 14896,14902 ---- (car (or method (gnus-find-method-for-group group)))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) + (cadr method) last))) (defun gnus-request-replace-article (article group buffer) *************** *** 15605,15611 **** (setq gnus-killed-hashtb (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) ! (while (setq list (symbol-value (pop lists))) (while list (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) --- 15615,15622 ---- (setq gnus-killed-hashtb (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) ! (while (setq list (pop lists)) ! (setq list (symbol-value list)) (while list (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) *** pub/sgnus/lisp/message.el Tue Apr 2 15:59:01 1996 --- sgnus/lisp/message.el Wed Apr 3 22:06:42 1996 *************** *** 27,32 **** --- 27,66 ---- ;; consists mainly of large chunks of code from the sendmail.el, ;; gnus-msg.el and rnewspost.el files. + ;;; underline.el + + ;; This code should be moved to underline.el (from which it is stolen). + + ;;;###autoload + (defun bold-region (start end) + "Bold all nonblank characters in the region. + Works by overstriking characters. + Called from program, takes two arguments START and END + which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (< (point) end1) + (or (looking-at "[_\^@- ]") + (insert (following-char) "\b")) + (forward-char 1))))) + + ;;;###autoload + (defun unbold-region (start end) + "Remove all boldness (overstruck characters) in the region. + Called from program, takes two arguments START and END + which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (re-search-forward "\b" end1 t) + (if (eq (following-char) (char-after (- (point) 2))) + (delete-char -2)))))) + ;;; Code: (eval-when-compile *************** *** 87,93 **** ;;;###autoload (defvar message-required-mail-headers ! '(From Date To Subject (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer)) "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be --- 121,127 ---- ;;;###autoload (defvar message-required-mail-headers ! '(From Date Subject (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer)) "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be *************** *** 99,109 **** ;;;###autoload (defvar message-ignored-news-headers ! "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:" "*Regexp of headers to be removed unconditionally before posting.") ;;;###autoload ! (defvar message-ignored-mail-headers "^Gcc:" "*Regexp of headers to be removed unconditionally before mailing.") ;;;###autoload --- 133,143 ---- ;;;###autoload (defvar message-ignored-news-headers ! "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:" "*Regexp of headers to be removed unconditionally before posting.") ;;;###autoload ! (defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:" "*Regexp of headers to be removed unconditionally before mailing.") ;;;###autoload *************** *** 199,204 **** --- 233,240 ---- ignore the \"poster\" value. If it is the symbol `use', always use the value.") + (defvar gnus-post-method) + (defvar gnus-select-method) ;;;###autoload (defvar message-post-method (cond ((boundp 'gnus-post-method) *************** *** 372,377 **** --- 408,422 ---- . font-lock-string-face))) "Additional expressions to highlight in Message mode.") + (defvar message-face-alist + '((bold . bold-region) + (underline . underline-region) + (default . (lambda (b e) + (unbold-region b e) + (ununderline-region b e)))) + "Alist of mail and news faces for facemenu. + The cdr of ech entry is a function for applying the face to a region.") + (defvar message-send-hook nil "Hook run before sending messages.") *************** *** 617,622 **** --- 662,677 ---- (setq buffer-offer-save t) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(message-font-lock-keywords t)) + (make-local-variable 'facemenu-add-face-function) + (make-local-variable 'facemenu-remove-face-function) + (setq facemenu-add-face-function + (lambda (face end) + (let ((face-fun (cdr (assq face message-face-alist)))) + (if face-fun + (funcall face-fun (point) end) + (error "Face %s not configured for %s mode" face mode-name))) + "") + facemenu-remove-face-function t) (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-start) (setq paragraph-start (concat (regexp-quote mail-header-separator) *************** *** 724,730 **** (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." (interactive) ! (message-position-on-field "newsgroups") (insert (or (message-fetch-reply-field "newsgroups") ""))) --- 779,785 ---- (defun message-insert-newsgroups () "Insert the Newsgroups header from the article being replied to." (interactive) ! (message-position-on-field "Newsgroups") (insert (or (message-fetch-reply-field "newsgroups") ""))) *************** *** 927,934 **** (defun message-remove-signature () "Remove the signature from the text between point and mark. ! The text will also be indented the normal way. ! This function can be used in `message-citation-hook', for instance." (save-excursion (let ((start (point)) mark) --- 982,988 ---- (defun message-remove-signature () "Remove the signature from the text between point and mark. ! The text will also be indented the normal way." (save-excursion (let ((start (point)) mark) *************** *** 954,978 **** ;;; Sending messages ;;; ! (defun message-send-and-exit (&optional arg) ! "Send message like `message-send', then, if no errors, exit from mail buffer. ! Prefix arg means don't delete this window." ! (interactive "P") ! (message-send) ! (bury-buffer (current-buffer)) ! ; (message-bury arg) ! ) ! ! (defun message-dont-send (&optional arg) ! "Don't send the message you have been editing. ! Prefix arg means don't delete this window." ! (interactive "P") ! (message-bury arg)) ! (defun message-bury (arg) "Bury this mail buffer." ! (let ((newbuf (other-buffer (current-buffer)))) ! (bury-buffer (current-buffer)) (if (and (fboundp 'frame-parameters) (cdr (assq 'dedicated (frame-parameters))) (not (null (delq (selected-frame) (visible-frame-list))))) --- 1008,1031 ---- ;;; Sending messages ;;; ! (defun message-send-and-exit () ! "Send message like `message-send', then, if no errors, exit from mail buffer." ! (interactive) ! (let ((buf (current-buffer))) ! (message-send) ! (bury-buffer buf) ! (when (eq buf (current-buffer)) ! (message-bury buf)))) ! ! (defun message-dont-send () ! "Don't send the message you have been editing." ! (interactive) ! (message-bury (current-buffer))) ! (defun message-bury (buffer) "Bury this mail buffer." ! (let ((newbuf (other-buffer buffer))) ! (bury-buffer buffer) (if (and (fboundp 'frame-parameters) (cdr (assq 'dedicated (frame-parameters))) (not (null (delq (selected-frame) (visible-frame-list))))) *** pub/sgnus/lisp/nnbabyl.el Tue Apr 2 15:59:01 1996 --- sgnus/lisp/nnbabyl.el Wed Apr 3 22:11:48 1996 *************** *** 88,94 **** (let ((number (length sequence)) (count 0) article art-string start stop) ! (nnbabyl-possibly-change-newsgroup newsgroup) (while sequence (setq article (car sequence)) (setq art-string (nnbabyl-article-string article)) --- 88,94 ---- (let ((number (length sequence)) (count 0) article art-string start stop) ! (nnbabyl-possibly-change-newsgroup newsgroup server) (while sequence (setq article (car sequence)) (setq art-string (nnbabyl-article-string article)) *************** *** 162,168 **** nnbabyl-status-string) (defun nnbabyl-request-article (article &optional newsgroup server buffer) ! (nnbabyl-possibly-change-newsgroup newsgroup) (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) --- 162,168 ---- nnbabyl-status-string) (defun nnbabyl-request-article (article &optional newsgroup server buffer) ! (nnbabyl-possibly-change-newsgroup newsgroup server) (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) *************** *** 205,211 **** (cond ((null active) (nnheader-report 'nnbabyl "No such group: %s" group)) ! ((null (nnbabyl-possibly-change-newsgroup group)) (nnheader-report 'nnbabyl "No such group: %s" group)) (dont-check (nnheader-report 'nnbabyl "Selected group %s" group) --- 205,211 ---- (cond ((null active) (nnheader-report 'nnbabyl "No such group: %s" group)) ! ((null (nnbabyl-possibly-change-newsgroup group server)) (nnheader-report 'nnbabyl "No such group: %s" group)) (dont-check (nnheader-report 'nnbabyl "Selected group %s" group) *************** *** 265,271 **** (defun nnbabyl-request-expire-articles (articles newsgroup &optional server force) ! (nnbabyl-possibly-change-newsgroup newsgroup) (let* ((is-old t) rest) (nnmail-activate 'nnbabyl) --- 265,271 ---- (defun nnbabyl-request-expire-articles (articles newsgroup &optional server force) ! (nnbabyl-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnbabyl) *************** *** 301,307 **** (defun nnbabyl-request-move-article (article group server accept-form &optional last) ! (nnbabyl-possibly-change-newsgroup group) (let ((buf (get-buffer-create " *nnbabyl move*")) result) (and --- 301,307 ---- (defun nnbabyl-request-move-article (article group server accept-form &optional last) ! (nnbabyl-possibly-change-newsgroup group server) (let ((buf (get-buffer-create " *nnbabyl move*")) result) (and *************** *** 326,332 **** (and last (save-buffer)))) result)) ! (defun nnbabyl-request-accept-article (group &optional last) (let ((buf (current-buffer)) result beg) (and --- 326,333 ---- (and last (save-buffer)))) result)) ! (defun nnbabyl-request-accept-article (group &optional server last) ! (nnbabyl-possibly-change-newsgroup group server) (let ((buf (current-buffer)) result beg) (and *************** *** 366,372 **** t))) (defun nnbabyl-request-delete-group (group &optional force server) ! (nnbabyl-possibly-change-newsgroup group) ;; Delete all articles in GROUP. (if (not force) () ; Don't delete the articles. --- 367,373 ---- t))) (defun nnbabyl-request-delete-group (group &optional force server) ! (nnbabyl-possibly-change-newsgroup group server) ;; Delete all articles in GROUP. (if (not force) () ; Don't delete the articles. *************** *** 389,395 **** t) (defun nnbabyl-request-rename-group (group new-name &optional server) ! (nnbabyl-possibly-change-newsgroup group) (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) --- 390,396 ---- t) (defun nnbabyl-request-rename-group (group new-name &optional server) ! (nnbabyl-possibly-change-newsgroup group server) (save-excursion (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) *************** *** 441,447 **** (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) ! (defun nnbabyl-possibly-change-newsgroup (newsgroup) (if (or (not nnbabyl-mbox-buffer) (not (buffer-name nnbabyl-mbox-buffer))) (save-excursion (nnbabyl-read-mbox))) --- 442,451 ---- (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) ! (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server ! (not (nnbabyl-server-opened server))) ! (nnbabyl-open-server server)) (if (or (not nnbabyl-mbox-buffer) (not (buffer-name nnbabyl-mbox-buffer))) (save-excursion (nnbabyl-read-mbox))) *** pub/sgnus/lisp/nndir.el Tue Apr 2 15:59:01 1996 --- sgnus/lisp/nndir.el Wed Apr 3 19:14:33 1996 *************** *** 121,129 **** (nndir-execute-nnmh-command `(nnmh-request-expire-articles ',articles nndir-group ,server ,force))) ! (defun nndir-request-accept-article (nndir-group &optional last) (nndir-execute-nnmh-command ! `(nnmh-request-accept-article nndir-group ,last))) (defun nndir-close-group (nndir-group &optional server) t) --- 121,129 ---- (nndir-execute-nnmh-command `(nnmh-request-expire-articles ',articles nndir-group ,server ,force))) ! (defun nndir-request-accept-article (nndir-group &optional server last) (nndir-execute-nnmh-command ! `(nnmh-request-accept-article nndir-group ,server ,last))) (defun nndir-close-group (nndir-group &optional server) t) *** pub/sgnus/lisp/nndraft.el Tue Apr 2 15:59:01 1996 --- sgnus/lisp/nndraft.el Wed Apr 3 19:14:33 1996 *************** *** 159,165 **** (defun nndraft-request-associate-buffer (group) "Associate the current buffer with some article in the draft group." (let* ((gnus-verbose-backends nil) ! (article (cdr (nndraft-request-accept-article group t 'noinsert))) (file (nndraft-article-filename article))) (setq buffer-file-name file) (setq buffer-auto-save-file-name (make-auto-save-file-name)) --- 159,166 ---- (defun nndraft-request-associate-buffer (group) "Associate the current buffer with some article in the draft group." (let* ((gnus-verbose-backends nil) ! (article (cdr (nndraft-request-accept-article ! group nndraft-current-server t 'noinsert))) (file (nndraft-article-filename article))) (setq buffer-file-name file) (setq buffer-auto-save-file-name (make-auto-save-file-name)) *************** *** 198,210 **** (funcall nnmail-delete-file-function auto))))) res)) ! (defun nndraft-request-accept-article (group &optional last noinsert) (let* ((point (point)) (mode major-mode) (name (buffer-name)) (gnus-verbose-backends nil) (gart (nndraft-execute-nnmh-command ! `(nnmh-request-accept-article group ,last noinsert))) (state (nndraft-article-filename (cdr gart) ".state"))) ;; Write the "state" file. --- 199,211 ---- (funcall nnmail-delete-file-function auto))))) res)) ! (defun nndraft-request-accept-article (group &optional server last noinsert) (let* ((point (point)) (mode major-mode) (name (buffer-name)) (gnus-verbose-backends nil) (gart (nndraft-execute-nnmh-command ! `(nnmh-request-accept-article group ,server ,last noinsert))) (state (nndraft-article-filename (cdr gart) ".state"))) ;; Write the "state" file. *** pub/sgnus/lisp/nnfolder.el Tue Apr 2 15:59:01 1996 --- sgnus/lisp/nnfolder.el Wed Apr 3 21:49:24 1996 *************** *** 104,146 **** ;;; Interface functions ! (defun nnfolder-retrieve-headers (sequence &optional newsgroup server fetch-old) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) article art-string start stop) ! (when nnfolder-current-buffer ! (nnfolder-possibly-change-group newsgroup server) ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-min)) ! (if (stringp (car sequence)) ! 'headers ! (while sequence ! (setq article (car sequence)) ! (setq art-string (nnfolder-article-string article)) ! (set-buffer nnfolder-current-buffer) ! (if (or (search-forward art-string nil t) ! ;; Don't search the whole file twice! Also, articles ! ;; probably have some locality by number, so searching ! ;; backwards will be faster. Especially if we're at the ! ;; beginning of the buffer :-). -SLB ! (search-backward art-string nil t)) ! (progn ! (setq start (or (re-search-backward delim-string nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nnfolder-current-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq sequence (cdr sequence))) ! ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines) ! 'headers))))) (defun nnfolder-open-server (server &optional defs) (nnheader-change-server 'nnfolder server defs) --- 104,145 ---- ;;; Interface functions ! (defun nnfolder-retrieve-headers (articles &optional group server fetch-old) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) article art-string start stop) ! (nnfolder-possibly-change-group group server) ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-min)) ! (if (stringp (car articles)) ! 'headers ! (while articles ! (setq article (car articles)) ! (setq art-string (nnfolder-article-string article)) ! (set-buffer nnfolder-current-buffer) ! (if (or (search-forward art-string nil t) ! ;; Don't search the whole file twice! Also, articles ! ;; probably have some locality by number, so searching ! ;; backwards will be faster. Especially if we're at the ! ;; beginning of the buffer :-). -SLB ! (search-backward art-string nil t)) ! (progn ! (setq start (or (re-search-backward delim-string nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nnfolder-current-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq articles (cdr articles))) ! ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines) ! 'headers)))) (defun nnfolder-open-server (server &optional defs) (nnheader-change-server 'nnfolder server defs) *************** *** 185,192 **** (nnfolder-possibly-change-group nil server) nnfolder-status-string) ! (defun nnfolder-request-article (article &optional newsgroup server buffer) ! (nnfolder-possibly-change-group newsgroup server) (save-excursion (set-buffer nnfolder-current-buffer) (goto-char (point-min)) --- 184,191 ---- (nnfolder-possibly-change-group nil server) nnfolder-status-string) ! (defun nnfolder-request-article (article &optional group server buffer) ! (nnfolder-possibly-change-group group server) (save-excursion (set-buffer nnfolder-current-buffer) (goto-char (point-min)) *************** *** 230,246 **** t) (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) ! (range (cadr active)) ! (minactive (car range)) ! (maxactive (cdr range))) (cond ((null active) (nnheader-report 'nnfolder "No such group: %s" group)) (t (nnheader-report 'nnfolder "Selected group %s" group) (nnheader-insert "211 %d %d %d %s\n" ! (1+ (- maxactive minactive)) ! minactive maxactive group)))))))) (defun nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group group server) --- 229,243 ---- t) (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) ! (range (cadr active))) (cond ((null active) (nnheader-report 'nnfolder "No such group: %s" group)) (t (nnheader-report 'nnfolder "Selected group %s" group) (nnheader-insert "211 %d %d %d %s\n" ! (1+ (- (cdr range) (car range))) ! (car range) (cdr range) group)))))))) (defun nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group group server) *************** *** 270,285 **** (when (or (assoc group nnfolder-buffer-alist) (equal group nnfolder-current-group)) (nnfolder-possibly-change-group group server) ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! ;; If the buffer was modified, write the file out now. ! (and (buffer-modified-p) (save-buffer)) ! ;; If we're shutting the server down, we need to kill the ! ;; buffer and remove it from the open buffer list. Or, of ! ;; course, if we're trying to minimize our space impact. ! (kill-buffer (current-buffer)) ! (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) ! nnfolder-buffer-alist)))) (setq nnfolder-current-group nil nnfolder-current-buffer nil) t) --- 267,283 ---- (when (or (assoc group nnfolder-buffer-alist) (equal group nnfolder-current-group)) (nnfolder-possibly-change-group group server) ! (when nnfolder-current-buffer ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! ;; If the buffer was modified, write the file out now. ! (and (buffer-modified-p) (save-buffer)) ! ;; If we're shutting the server down, we need to kill the ! ;; buffer and remove it from the open buffer list. Or, of ! ;; course, if we're trying to minimize our space impact. ! (kill-buffer (current-buffer)) ! (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) ! nnfolder-buffer-alist))))) (setq nnfolder-current-group nil nnfolder-current-buffer nil) t) *************** *** 381,387 **** (save-buffer)))) result)) ! (defun nnfolder-request-accept-article (group &optional last) (and (stringp group) (nnfolder-possibly-change-group group)) (let ((buf (current-buffer)) result) --- 379,386 ---- (save-buffer)))) result)) ! (defun nnfolder-request-accept-article (group &optional server last) ! (nnfolder-possibly-change-group group server) (and (stringp group) (nnfolder-possibly-change-group group)) (let ((buf (current-buffer)) result) *************** *** 425,432 **** () ; Don't delete the articles. ;; Delete the file that holds the group. (condition-case nil ! (delete-file (directory-file-name ! (nnmail-group-pathname group nnfolder-directory))) (error nil))) ;; Remove the group from all structures. (setq nnfolder-group-alist --- 424,430 ---- () ; Don't delete the articles. ;; Delete the file that holds the group. (condition-case nil ! (delete-file (nnfolder-group-pathname group)) (error nil))) ;; Remove the group from all structures. (setq nnfolder-group-alist *************** *** 446,453 **** (progn (rename-file buffer-file-name ! (directory-file-name ! (nnmail-group-pathname new-name nnfolder-directory))) t) (error nil)) ;; That went ok, so we change the internal structures. --- 444,450 ---- (progn (rename-file buffer-file-name ! (nnfolder-group-pathname new-name)) t) (error nil)) ;; That went ok, so we change the internal structures. *************** *** 498,505 **** (nnfolder-possibly-activate-groups nil) (or (assoc group nnfolder-group-alist) (not (file-exists-p ! (directory-file-name ! (nnmail-group-pathname group nnfolder-directory)))) (progn (setq nnfolder-group-alist (cons (list group (cons 1 0)) nnfolder-group-alist)) --- 495,501 ---- (nnfolder-possibly-activate-groups nil) (or (assoc group nnfolder-group-alist) (not (file-exists-p ! (nnfolder-group-pathname group))) (progn (setq nnfolder-group-alist (cons (list group (cons 1 0)) nnfolder-group-alist)) *************** *** 536,543 **** (if inf () (save-excursion ! (setq file (directory-file-name ! (nnmail-group-pathname group nnfolder-directory))) (if (file-directory-p (file-truename file)) () (unless (file-exists-p file) --- 532,538 ---- (if inf () (save-excursion ! (setq file (nnfolder-group-pathname group)) (if (file-directory-p (file-truename file)) () (unless (file-exists-p file) *************** *** 732,737 **** --- 727,742 ---- (nnfolder-read-folder file) (nnfolder-close-group file)) (message "")))) + + (defun nnfolder-group-pathname (group) + "Make pathname for GROUP." + (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) + ;; If this file exists, we use it directly. + (if (or nnmail-use-long-file-names + (file-exists-p (concat dir group))) + (concat dir group) + ;; If not, we translate dots into slashes. + (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) (provide 'nnfolder) *** pub/sgnus/lisp/nnmbox.el Tue Apr 2 15:59:02 1996 --- sgnus/lisp/nnmbox.el Wed Apr 3 22:11:48 1996 *************** *** 86,92 **** (let ((number (length sequence)) (count 0) article art-string start stop) ! (nnmbox-possibly-change-newsgroup newsgroup) (while sequence (setq article (car sequence)) (setq art-string (nnmbox-article-string article)) --- 86,92 ---- (let ((number (length sequence)) (count 0) article art-string start stop) ! (nnmbox-possibly-change-newsgroup newsgroup server) (while sequence (setq article (car sequence)) (setq art-string (nnmbox-article-string article)) *************** *** 155,161 **** nnmbox-status-string) (defun nnmbox-request-article (article &optional newsgroup server buffer) ! (nnmbox-possibly-change-newsgroup newsgroup) (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) --- 155,161 ---- nnmbox-status-string) (defun nnmbox-request-article (article &optional newsgroup server buffer) ! (nnmbox-possibly-change-newsgroup newsgroup server) (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) *************** *** 187,193 **** (cond ((null active) (nnheader-report 'nnmbox "No such group: %s" group)) ! ((null (nnmbox-possibly-change-newsgroup group)) (nnheader-report 'nnmbox "No such group: %s" group)) (dont-check (nnheader-report 'nnmbox "Selected group %s" group) --- 187,193 ---- (cond ((null active) (nnheader-report 'nnmbox "No such group: %s" group)) ! ((null (nnmbox-possibly-change-newsgroup group server)) (nnheader-report 'nnmbox "No such group: %s" group)) (dont-check (nnheader-report 'nnmbox "Selected group %s" group) *************** *** 234,240 **** (defun nnmbox-request-expire-articles (articles newsgroup &optional server force) ! (nnmbox-possibly-change-newsgroup newsgroup) (let* ((is-old t) rest) (nnmail-activate 'nnmbox) --- 234,240 ---- (defun nnmbox-request-expire-articles (articles newsgroup &optional server force) ! (nnmbox-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnmbox) *************** *** 269,275 **** (defun nnmbox-request-move-article (article group server accept-form &optional last) ! (nnmbox-possibly-change-newsgroup group) (let ((buf (get-buffer-create " *nnmbox move*")) result) (and --- 269,275 ---- (defun nnmbox-request-move-article (article group server accept-form &optional last) ! (nnmbox-possibly-change-newsgroup group server) (let ((buf (get-buffer-create " *nnmbox move*")) result) (and *************** *** 296,302 **** (and last (save-buffer)))) result)) ! (defun nnmbox-request-accept-article (group &optional last) (let ((buf (current-buffer)) result) (goto-char (point-min)) --- 296,303 ---- (and last (save-buffer)))) result)) ! (defun nnmbox-request-accept-article (group &optional server last) ! (nnmbox-possibly-change-newsgroup group server) (let ((buf (current-buffer)) result) (goto-char (point-min)) *************** *** 335,341 **** t))) (defun nnmbox-request-delete-group (group &optional force server) ! (nnmbox-possibly-change-newsgroup group) ;; Delete all articles in GROUP. (if (not force) () ; Don't delete the articles. --- 336,342 ---- t))) (defun nnmbox-request-delete-group (group &optional force server) ! (nnmbox-possibly-change-newsgroup group server) ;; Delete all articles in GROUP. (if (not force) () ; Don't delete the articles. *************** *** 358,364 **** t) (defun nnmbox-request-rename-group (group new-name &optional server) ! (nnmbox-possibly-change-newsgroup group) (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) --- 359,365 ---- t) (defun nnmbox-request-rename-group (group new-name &optional server) ! (nnmbox-possibly-change-newsgroup group server) (save-excursion (set-buffer nnmbox-mbox-buffer) (goto-char (point-min)) *************** *** 409,415 **** (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) ! (defun nnmbox-possibly-change-newsgroup (newsgroup) (if (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) (save-excursion --- 410,419 ---- (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) (delete-region (point-min) (point-max)))))) ! (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server ! (not (nnmbox-server-opened server))) ! (nnmbox-open-server server)) (if (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) (save-excursion *** pub/sgnus/lisp/nnmh.el Tue Apr 2 15:59:02 1996 --- sgnus/lisp/nnmh.el Wed Apr 3 22:11:49 1996 *************** *** 86,92 **** (> number nnmail-large-newsgroup))) (count 0) beg article) ! (nnmh-possibly-change-directory newsgroup) ;; We don't support fetching by Message-ID. (if (stringp (car articles)) 'headers --- 86,92 ---- (> number nnmail-large-newsgroup))) (count 0) beg article) ! (nnmh-possibly-change-directory newsgroup server) ;; We don't support fetching by Message-ID. (if (stringp (car articles)) 'headers *************** *** 152,158 **** nnmh-status-string) (defun nnmh-request-article (id &optional newsgroup server buffer) ! (nnmh-possibly-change-directory newsgroup) (let ((file (if (stringp id) nil (concat nnmh-current-directory (int-to-string id)))) --- 152,158 ---- nnmh-status-string) (defun nnmh-request-article (id &optional newsgroup server buffer) ! (nnmh-possibly-change-directory newsgroup server) (let ((file (if (stringp id) nil (concat nnmh-current-directory (int-to-string id)))) *************** *** 242,248 **** (nnmh-request-list server)) (defun nnmh-request-expire-articles (articles newsgroup &optional server force) ! (nnmh-possibly-change-directory newsgroup) (let* ((active-articles (mapcar (function --- 242,248 ---- (nnmh-request-list server)) (defun nnmh-request-expire-articles (articles newsgroup &optional server force) ! (nnmh-possibly-change-directory newsgroup server) (let* ((active-articles (mapcar (function *************** *** 294,300 **** (file-error nil))) result)) ! (defun nnmh-request-accept-article (group &optional last noinsert) (if (stringp group) (and (nnmail-activate 'nnmh) --- 294,301 ---- (file-error nil))) result)) ! (defun nnmh-request-accept-article (group &optional server last noinsert) ! (nnmh-possibly-change-directory group server) (if (stringp group) (and (nnmail-activate 'nnmh) *************** *** 326,332 **** (setq nnmh-group-alist (cons (list group (setq active (cons 1 0))) nnmh-group-alist)) (nnmh-possibly-create-directory group) ! (nnmh-possibly-change-directory group) (let ((articles (mapcar (lambda (file) (string-to-int file)) --- 327,333 ---- (setq nnmh-group-alist (cons (list group (setq active (cons 1 0))) nnmh-group-alist)) (nnmh-possibly-create-directory group) ! (nnmh-possibly-change-directory group server) (let ((articles (mapcar (lambda (file) (string-to-int file)) *************** *** 339,345 **** t) (defun nnmh-request-delete-group (group &optional force server) ! (nnmh-possibly-change-directory group) ;; Delete all articles in GROUP. (if (not force) () ; Don't delete the articles. --- 340,346 ---- t) (defun nnmh-request-delete-group (group &optional force server) ! (nnmh-possibly-change-directory group server) ;; Delete all articles in GROUP. (if (not force) () ; Don't delete the articles. *************** *** 362,368 **** t) (defun nnmh-request-rename-group (group new-name &optional server) ! (nnmh-possibly-change-directory group) ;; Rename directory. (and (file-writable-p nnmh-current-directory) (condition-case () --- 363,369 ---- t) (defun nnmh-request-rename-group (group new-name &optional server) ! (nnmh-possibly-change-directory group server) ;; Rename directory. (and (file-writable-p nnmh-current-directory) (condition-case () *************** *** 382,388 **** ;;; Internal functions. ! (defun nnmh-possibly-change-directory (newsgroup) (if newsgroup (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) (if (file-directory-p pathname) --- 383,392 ---- ;;; Internal functions. ! (defun nnmh-possibly-change-directory (newsgroup &optional server) ! (when (and server ! (not (nnmh-server-opened server))) ! (nnmh-open-server server)) (if newsgroup (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) (if (file-directory-p pathname) *** pub/sgnus/lisp/nnml.el Tue Apr 2 15:59:02 1996 --- sgnus/lisp/nnml.el Wed Apr 3 19:14:35 1996 *************** *** 351,357 **** (and last (nnml-save-nov)))) result)) ! (defun nnml-request-accept-article (group &optional last) (let (result) (if (stringp group) (and --- 351,358 ---- (and last (nnml-save-nov)))) result)) ! (defun nnml-request-accept-article (group &optional server last) ! (nnml-possibly-change-directory group server) (let (result) (if (stringp group) (and *** pub/sgnus/lisp/ChangeLog Tue Apr 2 15:59:12 1996 --- sgnus/lisp/ChangeLog Wed Apr 3 22:06:44 1996 *************** *** 1,4 **** --- 1,69 ---- + Wed Apr 3 18:23:35 1996 Lars Magne Ingebrigtsen + + * message.el (message-insert-newsgroups): Capitilize Newsgroups. + + * gnus.el (gnus-make-hashtable-from-killed): Wouldn't use + `gnus-zombie-list'. + + * nnfolder.el (nnfolder-group-pathname): New function; return the + right folder. + + * gnus-score.el (gnus-score-find-bnews): Recognize "++" groups. + + * gnus-topic.el (gnus-topic-yank-group): Remain in the topic. + + * gnus.el (gnus-get-new-news-in-group): Removed function. + (gnus-group-get-new-news-this-group): Update all instances of the + group. + + * gnus-topic.el (gnus-topic-unindent): Insert at the right place. + (gnus-topic-next-topic): New function. + (gnus-topic-unindent): Would swallow sub-topics. + (gnus-topic-indent): Ditto. + + Wed Apr 3 17:18:08 1996 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-bug): Wouldn't restore window conf. + + * gnus.el (gnus-buffer-configuration): `bug' configuration. + + Tue Apr 2 22:33:25 1996 Lars Magne Ingebrigtsen + + * gnus-scomo.el: New file. + + Tue Apr 2 12:31:48 1996 Per Abrahamsen + + * message.el (bold-region): New function. + (unbold-region): New function. + (message-face-alist): New variable. + (message-mode): Add facemenu support. + + Tue Apr 2 20:46:11 1996 Lars Magne Ingebrigtsen + + * message.el (message-required-mail-headers): `To' isn't + required. + (message-ignored-news-headers): Remove Fcc headers. + (message-ignored-mail-headers): Ditto. + + * gnus.el (gnus-request-article-this-buffer): Would bug out on + backlogs. + + * message.el (message-send-and-exit): Bury buffer. + + * gnus-uu.el (gnus-uu-digest-mail-forward): Use `message'. + + * nnfolder.el (nnfolder-close-group): Would try to `set-buffer' + nil. + + * gnus.el (gnus-server-get-method): Would return extended servers + too often. + + * nnml.el (nnml-request-accept-article): Accept a server + parameter. + Tue Apr 2 15:05:14 1996 Lars Magne Ingebrigtsen + + * gnus.el: September Gnus v0.62 is released. * nnfolder.el (nnfolder-possibly-change-group): Make sure the directory exists before writing file.