+Thu Apr 18 20:10:11 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
+
+ * gnus.el (gnus-summary-show-article): Stop page breaking when
+ given a prefix.
+
+ * gnus-vis.el (gnus-summary-make-menu-bar): Removed obsolete
+ functions.
+
+ * gnus-msg.el (gnus-summary-reply): Pass on `broken-reply-to'.
+
+ * message.el (message-reply): Allow broken reply-to.
+
+ * gnus.el (gnus-group-jump-to-group): Refuse to treat groups that
+ have control characters in them.
+
+Thu Apr 18 18:47:16 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-vis.el (gnus-button-url-regexp): Allow "!" in URLs.
+
+ * gnus.el (gnus-summary-exit): Always run
+ `gnus-summary-prepare-exit-hook'.
+
+Thu Apr 18 12:15:27 1996 Lars Magne Ingebrigtsen <larsi@trym.ifi.uio.no>
+
+ * gnus.el: September Gnus v0.74 is released.
+
+ * gnus.el (gnus-summary-update-mark): Would but out on eob.
+
+ * gnus-msg.el (gnus-post-method): Would bug out.
+
+Thu Apr 18 09:08:53 1996 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-get-newsgroup-headers-xover): Deleted duplicate
+ line.
+
+Thu Apr 18 11:06:10 1996 Lars Magne Ingebrigtsen <larsi@trym.ifi.uio.no>
+
+ * gnus.el (gnus-parse-headers-hook): Enable de-QP by default.
+
+Wed Apr 17 08:59:20 1996 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * gnus-nocem.el (gnus-nocem-enter-article): added some simple
+ error recovery for read calls on article content.
+
+Wed Apr 17 00:51:19 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-error): New function.
+
+ * nnsoup.el: Generate headers.
+
+Tue Apr 16 08:06:12 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-user-mail-address): Use
+ `mail-extract-address-components'.
+
+ * gnus.el (gnus-group-make-group): Use method history.
+ (gnus-group-browse-foreign-server): Ditto.
+ (gnus-ask-server-for-new-groups): Make sure symbols are bound.
+
+Tue Apr 16 00:07:47 1996 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus.el (gnus-completing-read): New function.
+ (gnus-method-history): New variable.
+ (gnus-summary-respool-default-method): New user option.
+ (gnus-summary-respool-article): Use them.
+
+Tue Apr 16 07:36:18 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-summary-mode): Make line format bufffer local.
+
+Mon Apr 15 08:41:35 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-vis.el (gnus-button-url-regexp): "-" was not in the regexp.
+
+ * nntp.el (nntp-open-server): Would choke on port numbers.
+
+ * gnus-soup.el (gnus-soup-send-packet): Insert
+ X-Newsreader/X-Mailer.
+
+ * nntp.el (nntp-open-server-semi-internal): Clear the server
+ buffer.
+
+Sun Apr 14 17:11:49 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-msg.el (gnus-setup-message): Don't clobber
+ message-header-setup-hook.
+
+ * nndoc.el (nndoc-type-alist): Would show end line in forwards.
+
+ * gnus.el (gnus-window-to-buffer): Allow `mail' value.
+
+ * message.el (message-send-mail): Would choke on Resent-to.
+ (message-generate-new-buffers): New variable.
+ (message-pop-to-buffer): Use it.
+ (message-kill-buffer-on-exit): New variable.
+ (message-send-and-exit): Use it.
+
Sun Apr 14 08:54:37 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+ * gnus.el: September Gnus v0.73 is released.
+
* message.el (message-mode): Mail-hist isn't defined in XEmacs
19.13.
+ * gnus.el: September Gnus v0.72 is released.
+
* nnoo.el (defvoo): Didn't work under XEmacs.
Sun Apr 14 06:27:19 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
(gnus-score-load file)
(setq gnus-score-custom-file file)
(custom-reset-all)
- (message "Loaded")))
+ (gnus-message 4 "Loaded")))
(defun gnus-score-custom-save ()
(interactive)
(gnus-make-directory (file-name-directory file))
(write-region (point-min) (point-max) file nil 'silent)
(kill-buffer (current-buffer))))
- (message "Saved"))
+ (gnus-message 4 "Saved"))
(provide 'gnus-edit)
(cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
;; Ignores global KILL.
(if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
- (message "Note: Ignoring %s.KILL; preferring .SCORE"
- gnus-newsgroup-name))
+ (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
+ gnus-newsgroup-name))
0)
((or (file-exists-p (gnus-newsgroup-kill-file nil))
(file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
`(let ((,winconf (current-window-configuration))
(,buffer (current-buffer))
(,article (and gnus-article-reply (gnus-summary-article-number)))
- message-header-setup-hook)
+ (message-header-setup-hook
+ (copy-sequence message-header-setup-hook)))
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
,@forms
(when gnus-post-method
(if (listp (car gnus-post-method))
gnus-post-method
- (listp gnus-post-method)))
+ (list gnus-post-method)))
gnus-secondary-select-methods
(list gnus-select-method)
(list group-method)))
(gnus-setup-message (if yank 'reply-yank 'reply)
(gnus-summary-select-article)
(set-buffer (gnus-copy-article-buffer))
- (message-reply)
+ (message-reply nil nil (gnus-group-get-parameter
+ gnus-newsgroup-name 'broken-reply-to))
(when yank
(gnus-inews-yank-articles yank)))))
(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...")
+ (gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
(save-excursion
(set-buffer (get-buffer-create " *gnus bug info*"))
(insert-file-contents file)
(goto-char (point-min))
(if (not (re-search-forward "^;;* *Internal variables" nil t))
- (message "Malformed sources in file %s" file)
+ (gnus-message 4 "Malformed sources in file %s" file)
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(while (setq expr (condition-case ()
(defvar gnus-nocem-issuers
'("Automoose-1" ; The CancelMoose[tm] on autopilot.
"clewis@ferret.ocunix.on.ca;" ; Chris Lewis -- Canadian angel & despammer.
- "jem@xpat.com;" ; Jem -- Korean despammer.
+ "jem@xpat.com;" ; John Milburn -- despammer in Korea.
"red@redpoll.mrfs.oh.us (Richard E. Depew)" ; Spew/bincancel guy.
)
"*List of NoCeM issuers to pay attention to.")
(narrow-to-region b (1+ (match-beginning 0)))
(goto-char (point-min))
(while (search-forward "\t" nil t)
- (when (boundp (let ((obarray gnus-active-hashtb)) (read buf)))
+ (when (condition-case nil
+ (boundp (let ((obarray gnus-active-hashtb)) (read buf)))
+ (error nil))
(beginning-of-line)
(while (= (following-char) ?\t)
(forward-line -1))
(interactive)
(setq gnus-score-default-fold (not gnus-score-default-fold))
(if gnus-score-default-fold
- (message "New score file entries will be case insensitive.")
- (message "New score file entries will be case sensitive.")))
+ (gnus-message 1 "New score file entries will be case insensitive.")
+ (gnus-message 1 "New score file entries will be case sensitive.")))
(provide 'gnus-score)
(or (file-directory-p dir)
(gnus-make-directory dir))
(setq gnus-soup-areas nil)
- (message "Packing %s..." packer)
+ (gnus-message 4 "Packing %s..." packer)
(if (zerop (call-process "sh" nil nil nil "-c"
(concat "cd " dir " ; " packer)))
(progn
(call-process "sh" nil nil nil "-c"
(concat "cd " dir " ; rm " files))
- (message "Packing...done" packer))
+ (gnus-message 4 "Packing...done" packer))
(error "Couldn't pack packet."))))
(defun gnus-soup-parse-areas (file)
"Unpack PACKET into DIR using UNPACKER.
Return whether the unpacking was successful."
(gnus-make-directory dir)
- (message "Unpacking: %s" (format unpacker packet))
+ (gnus-message 4 "Unpacking: %s" (format unpacker packet))
(prog1
(zerop (call-process
"sh" nil nil nil "-c"
(format "cd %s ; %s" (expand-file-name dir)
(format unpacker packet))))
- (message "Unpacking...done")))
+ (gnus-message 4 "Unpacking...done")))
(defun gnus-soup-send-packet (packet)
(gnus-soup-unpack-packet
(search-forward "\n\n")
(forward-char -1)
(insert mail-header-separator)
+ (setq message-newsreader (setq message-mailer
+ (gnus-extended-version)))
(cond
((string= (gnus-soup-reply-kind (car replies)) "news")
- (message "Sending news message to %s..."
- (mail-fetch-field "newsgroups"))
+ (gnus-message 5 "Sending news message to %s..."
+ (mail-fetch-field "newsgroups"))
(sit-for 1)
(funcall message-send-news-function))
((string= (gnus-soup-reply-kind (car replies)) "mail")
- (message "Sending mail to %s..."
+ (gnus-message 5 "Sending mail to %s..."
(mail-fetch-field "to"))
(sit-for 1)
(funcall message-send-mail-function))
(delete-file (buffer-file-name))
(kill-buffer msg-buf)
(kill-buffer tmp-buf)
- (message "Sent packet"))))
+ (gnus-message 4 "Sent packet"))))
(setq replies (cdr replies)))
t)))
(when (or (not (file-exists-p to-file))
(gnus-y-or-n-p (format "%s exists; overwrite? " to-file)))
(copy-file file to-file t t)))))
- (message "Saved %d file%s" len (if (= len 1) "" "s"))))
+ (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
;; Functions for saving and possibly digesting articles without
;; any decoding.
(setq state 'last)))
(let ((part (gnus-uu-part-number article)))
- (message "Getting article %d%s..."
- article (if (string= part "") "" (concat ", " part))))
+ (gnus-message 6 "Getting article %d%s..."
+ article (if (string= part "") "" (concat ", " part))))
(gnus-summary-display-article article)
;; Push the article to the processing function.
(memq 'middle process-state)))
(progn
(setq process-state (list 'error))
- (message "No begin part at the beginning")
+ (gnus-message 2 "No begin part at the beginning")
(sleep-for 2))
(setq state 'middle)))
(message "")
(cond
((not has-been-begin)
- (message "Wrong type file"))
+ (gnus-message 2 "Wrong type file"))
((memq 'error process-state)
- (message "An error occurred during decoding"))
+ (gnus-message 2 "An error occurred during decoding"))
((not (or (memq 'ok process-state)
(memq 'end process-state)))
- (message "End of articles reached before end of file")))
+ (gnus-message 2 "End of articles reached before end of file")))
;; Make unsuccessfully decoded articles unread.
(when gnus-uu-unmark-articles-not-decoded
(while article-series
(error
(progn
(delete-process gnus-uu-uudecode-process)
- (message "gnus-uu: Couldn't uudecode")
+ (gnus-message 2 "gnus-uu: Couldn't uudecode")
(setq state (list 'wrong-type)))))
(if (memq 'end state)
(set-buffer (get-buffer-create gnus-uu-output-buffer-name))
(erase-buffer))
- (message "Unpacking: %s..." (gnus-uu-command action file-path))
+ (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
(if (= 0 (call-process "sh" nil
(get-buffer-create gnus-uu-output-buffer-name)
nil "-c" command))
(message "")
- (message "Error during unpacking of archive")
+ (gnus-message 2 "Error during unpacking of archive")
(setq did-unpack nil))
(if (member action gnus-uu-destructive-archivers)
(progn
(setq did-unpack (cons file did-unpack))
(or (gnus-uu-treat-archive file)
- (message "Error during unpacking of %s" file))
+ (gnus-message 2 "Error during unpacking of %s" file))
(let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
(nfiles newfiles))
(gnus-uu-add-file newfiles)
;(defvar gnus-signature-face 'italic
; "Face used for signature.")
-(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[\\w-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[\\w-a-zA-Z0-9_=#$@~`%&*+|\\/]"
+(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]"
"*Regular expression that matches URLs.")
(defvar gnus-button-alist
["Resend message" gnus-summary-resend-message t]
["Send bounced mail" gnus-summary-resend-bounced-mail t]
["Send a mail" gnus-summary-mail-other-window t]
- ["Reply & followup" gnus-summary-followup-and-reply t]
- ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t]
["Uuencode and post" gnus-uu-post-news t]
("Draft"
["Send" gnus-summary-send-draft t]
(fboundp (symbol-value fun)))
(apply (symbol-value fun) args))
(t
- (message "You must define `%S' to use this button"
- (cons fun args)))))))
+ (gnus-message 1 "You must define `%S' to use this button"
+ (cons fun args)))))))
(defun gnus-button-message-id (message-id)
"Fetch MESSAGE-ID."
(browse-carpal . gnus-carpal-browse-buffer)
(edit-score . gnus-score-edit-buffer)
(message . gnus-message-buffer)
+ (mail . gnus-message-buffer)
+ (post-news . gnus-message-buffer)
(faq . gnus-faq-buffer)
(picons . "*Picons*")
(tree . gnus-tree-buffer)
(defvar gnus-parse-headers-hook nil
"*A hook called before parsing the headers.")
+(add-hook 'gnus-parse-headers-hook 'gnus-headers-decode-quoted-printable)
(defvar gnus-exit-group-hook nil
"*A hook called when exiting (not quitting) summary mode.")
(remove-hook 'gnus-summary-prepare-hook
'hilit-rehighlight-buffer-quietly)
(remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
- (setq gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read))
+ (setq gnus-mark-article-hook
+ '(gnus-summary-mark-read-and-unread-as-read))
(remove-hook 'gnus-article-prepare-hook
'hilit-rehighlight-buffer-quietly)))
\f
;; Internal variables
+(defvar gnus-method-history nil)
+;; Variable holding the user answers to all method prompts.
+
(defvar gnus-server-alist nil
"List of available servers.")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.73"
+(defconst gnus-version "September Gnus v0.75"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(push group groups)))
(nreverse groups)))
+(defun gnus-completing-read (default prompt &rest args)
+ ;; Like `completing-read', except that DEFAULT is the default argument.
+ (let* ((prompt (concat prompt " (default " default ") "))
+ (answer (apply 'completing-read prompt args)))
+ (if (or (null answer) (zerop (length answer)))
+ default
+ answer)))
+
;; Two silly functions to ensure that all `y-or-n-p' questions clear
;; the echo area.
(defun gnus-y-or-n-p (prompt)
;; from `message'.
(apply 'format args)))
+(defun gnus-error (level &rest args)
+ "Beep an error if `gnus-verbose' is on LEVEL or less."
+ (when (<= (floor level) gnus-verbose)
+ (apply 'message args)
+ (ding)
+ (let (duration)
+ (when (and (floatp level)
+ (not (zerop (setq duration (* 10 (- level (floor level)))))))
+ (sit-for duration))))
+ nil)
+
;; Generate a unique new group name.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(substitute-command-keys
"\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
'undefined)
- (progn
- (message "Undefined key")
- (ding))
+ (gnus-error 1 "Undefined key")
(while groups
(gnus-group-remove-mark (setq group (pop groups)))
(command-execute func))))
"Group: " gnus-active-hashtb nil
(memq gnus-select-method gnus-have-read-active-file))))
- (if (equal group "")
- (error "Empty group name"))
+ (when (equal group "")
+ (error "Empty group name"))
+
+ (when (string-match "[\000-\032]" group)
+ (error "Control characters in group: %s" group))
(let ((b (text-property-any
(point-min) (point-max)
(let ((method
(completing-read
"Method: " (append gnus-valid-select-methods gnus-server-alist)
- nil t)))
+ nil t nil 'gnus-method-history)))
(cond ((assoc method gnus-valid-select-methods)
(list method
(if (memq 'prompt-address
() ; Whew!
(gnus-message 6 "Deleting group %s..." group)
(if (not (gnus-request-delete-group group force))
- (progn
- (gnus-message 3 "Couldn't delete group %s" group)
- (ding))
+ (gnus-error 3 "Couldn't delete group %s" group)
(gnus-message 6 "Deleting group %s...done" group)
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-message 6 "Renaming group %s to %s..." group new-name)
(prog1
(if (not (gnus-request-rename-group group new-name))
- (progn
- (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
- (ding))
+ (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
;; We rename the group internally by killing it...
(gnus-group-goto-group group)
(gnus-group-kill-group)
"etc/gnus-tut.txt"))))
(setq path nil)))
(if (not file)
- (message "Couldn't find doc group")
+ (gnus-message 1 "Couldn't find doc group")
(gnus-group-make-group
(gnus-group-real-name name)
(list 'nndoc "gnus-help"
(unless (gnus-virtual-group-p group)
(gnus-close-group group))
(gnus-group-update-group group))
- (ding)
- (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
(when beg (goto-char beg))
(when gnus-goto-next-group-when-activating
(gnus-group-next-unread-group 1 t))
gnus-description-hashtb))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
- (message
+ (gnus-message 1
(or desc (gnus-gethash group gnus-description-hashtb)
"No description available")))))
(list (let ((how (completing-read
"Which backend: "
(append gnus-valid-select-methods gnus-server-alist)
- nil t (cons "nntp" 0))))
+ nil t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a backend name or a virtual server name.
;; If the first, we also need an address.
(if (assoc how gnus-valid-select-methods)
(setq selective-display-ellipses t) ;Display `...'
(setq buffer-display-table gnus-summary-display-table)
(setq gnus-newsgroup-name group)
+ (make-local-variable 'gnus-summary-line-format)
+ (make-local-variable 'gnus-summary-line-format-spec)
(run-hooks 'gnus-summary-mode-hook))
(defun gnus-summary-make-display-table ()
(set-buffer nntp-server-buffer)
;; Allow the user to mangle the headers before parsing them.
(run-hooks 'gnus-parse-headers-hook)
- ;; Allow the user to mangle the headers before parsing them.
- (run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(while (and sequence (not (eobp)))
(setq number (read cur))
(gnus-nov-field)) ; misc
))
(error (progn
- (ding)
- (gnus-message 4 "Strange nov line")
+ (gnus-error 4 "Strange nov line")
(setq header nil)
(goto-char eol))))
"\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
))))
'undefined)
- (progn
- (message "Undefined key")
- (ding))
+ (gnus-error 1 "Undefined key")
(save-excursion
(while articles
(gnus-summary-goto-subject (setq article (pop articles)))
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(mode major-mode)
(buf (current-buffer)))
- (unless temporary
- (run-hooks 'gnus-summary-prepare-exit-hook))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(let ((gnus-have-all-headers t)
gnus-article-display-hook
gnus-article-prepare-hook
+ gnus-break-pages
gnus-visual)
(gnus-summary-select-article nil 'force)))
; (gnus-configure-windows 'article)
(interactive "P")
(gnus-summary-move-article n nil nil 'crosspost))
+(defvar gnus-summary-respool-default-method nil
+ "Default method for respooling an article.
+If nil, use to the current newsgroup method.")
+
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
(list current-prefix-arg
(let* ((methods (gnus-methods-using 'respool))
(methname
- (symbol-name (car (gnus-find-method-for-group
- gnus-newsgroup-name))))
+ (symbol-name (or gnus-summary-respool-default-method
+ (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))))
(method
- (completing-read
- "What backend do you want to use when respooling? "
- methods nil t (cons methname 0)))
+ (gnus-completing-read
+ methname "What backend do you want to use when? "
+ methods nil t nil 'gnus-method-history))
ms)
(cond
((zerop (length (setq ms (gnus-servers-using-backend method))))
(if (gnus-group-read-only-p)
(progn
(gnus-summary-edit-article-postpone)
- (gnus-message
- 1 "The current newsgroup does not support article editing.")
- (ding))
+ (gnus-error
+ 1 "The current newsgroup does not support article editing."))
(let ((buf (format "%s" (buffer-string))))
(erase-buffer)
(insert buf)
"Return the score of the current article."
(interactive)
(gnus-set-global-variables)
- (message "%s" (gnus-summary-article-score)))
+ (gnus-message 1 "%s" (gnus-summary-article-score)))
;; Summary marking commands.
(beginning-of-line)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
- (when forward
+ (when (and forward
+ (<= (+ forward (point)) (point-max)))
;; Go to the right position on the line.
- (forward-char forward)
+ (goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
(subst-char-in-region (point) (1+ (point)) (following-char) mark)
;; Optionally update the marks by some user rule.
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-rethread-current)
- (message "Article %d is now the child of article %d."
- current-article parent-article)))))
+ (gnus-message 3 "Article %d is now the child of article %d."
+ current-article parent-article)))))
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
(setq gnus-current-article article)
(gnus-summary-mark-article article gnus-canceled-mark))
(unless (memq article gnus-newsgroup-sparse)
- (gnus-message
- 1 "No such article (may have expired or been canceled)")
- (ding)
- nil))
+ (gnus-error
+ 1 "No such article (may have expired or been canceled)")))
(if (or (eq result 'pseudo) (eq result 'nneething))
(progn
(save-excursion
"%s (%s) open error: '%s'. Continue? "
(car gnus-select-method) (cadr gnus-select-method)
(gnus-status-message gnus-select-method)))
- (progn
- (gnus-message 1 "Couldn't open server on %s"
- (nth 1 gnus-select-method))
- (ding)
- nil)))))
+ (gnus-error 1 "Couldn't open server on %s"
+ (nth 1 gnus-select-method))))))
(defun gnus-check-group (group)
"Try to make sure that the server where GROUP exists is alive."
(mapatoms
(lambda (group-sym)
(if (or (null (setq group (symbol-name group-sym)))
+ (not (boundp group-sym))
(null (symbol-value group-sym))
(gnus-gethash group gnus-newsrc-hashtb)
(member group gnus-zombie-list)
(setq list-type (gnus-retrieve-groups groups method))
(cond
((not list-type)
- (gnus-message
- 1 "Cannot read partial active file from %s server."
- (car method))
- (ding)
- (sit-for 2))
+ (gnus-error
+ 1.2 "Cannot read partial active file from %s server."
+ (car method)))
((eq list-type 'active)
(gnus-active-to-gnus-format method gnus-active-hashtb))
(t
(gnus-groups-to-gnus-format method gnus-active-hashtb))))))
(t
(if (not (gnus-request-list method))
- (progn
- (unless (equal method gnus-message-archive-method)
- (gnus-message 1 "Cannot read active file from %s server."
- (car method))
- (ding)))
+ (unless (equal method gnus-message-archive-method)
+ (gnus-error 1 "Cannot read active file from %s server."
+ (car method)))
(gnus-active-to-gnus-format method)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
(condition-case nil
(load ding-file t t t)
(error
- (gnus-message 1 "Error in %s" ding-file)
- (ding)))
+ (gnus-error 1 "Error in %s" ding-file)))
(when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc)))
(gnus-make-hashtable-from-newsrc-alist)
(progn
;; The line was buggy.
(setq group nil)
- (gnus-message 3 "Mangled line: %s"
- (buffer-substring (gnus-point-at-bol)
- (gnus-point-at-eol)))
- (ding)
- (sit-for 1)))
+ (gnus-error 3.1 "Mangled line: %s"
+ (buffer-substring (gnus-point-at-bol)
+ (gnus-point-at-eol)))))
nil))
;; Skip past ", ". Spaces are illegal in these ranges, but
;; we allow them, because it's a common mistake to put a
(eval-buffer (current-buffer))
t)
(error
- (gnus-message 3 "Possible error in %s" file)
- (ding)
- (sit-for 2)
+ (gnus-error 3.2 "Possible error in %s" file)
nil))
(or gnus-slave ; Slaves shouldn't delete these files.
(condition-case ()
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors.")
+;;;###autoload
+(defvar message-generate-new-buffers nil
+ "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.")
+
+;;;###autoload
+(defvar message-kill-buffer-on-exit nil
+ "*Non-nil means that the message buffer will be killed after sending a message.")
+
(defvar gnus-local-organization)
;;;###autoload
(defvar message-user-organization
(let ((buf (current-buffer)))
(when (and (message-send arg)
(buffer-name buf))
- (bury-buffer buf)
- (when (eq buf (current-buffer))
- (message-bury buf)))))
+ (if message-kill-buffer-on-exit
+ (kill-buffer buf)
+ (bury-buffer buf)
+ (when (eq buf (current-buffer))
+ (message-bury buf))))))
(defun message-dont-send ()
"Don't send the message you have been editing."
(tembuf (generate-new-buffer " message temp"))
(case-fold-search nil)
(news (message-news-p))
- (resend-to-addresses (mail-fetch-field "resent-to"))
- delimline
+ resend-to-addresses delimline
(mailbuf (current-buffer)))
(save-restriction
(message-narrow-to-headers)
+ (setq resend-to-addresses (mail-fetch-field "resent-to"))
;; Insert some headers.
(message-generate-headers message-required-mail-headers)
;; Let the user do all of the above.
(defun message-user-mail-address ()
"Return the pertinent part of `user-mail-address'."
- (when (string-match
- "\\(\\`\\|[ <\t]\\)\\([^ \t@]+@[^ \t]+\\)\\(\\'\\|[> \t]\\)"
- user-mail-address)
- (match-string 2 user-mail-address)))
+ (when user-mail-address
+ (nth 1 (mail-extract-address-components user-mail-address))))
(defun message-make-fqdm ()
"Return user's fully qualified domain name."
(defun message-pop-to-buffer (name)
"Pop to buffer NAME, and warn if it already exists and is modified."
- (let ((buffer (get-buffer name)))
- (if (and buffer
- (buffer-name buffer))
- (progn
- (set-buffer (pop-to-buffer buffer))
- (when (and (buffer-modified-p)
- (not (y-or-n-p
- "Message already being composed; erase? ")))
- (error "Message being composed")))
- (set-buffer (pop-to-buffer name)))
- (erase-buffer)
- (message-mode)))
+ (if message-generate-new-buffers
+ (set-buffer (pop-to-buffer (generate-new-buffer name)))
+ (let ((buffer (get-buffer name)))
+ (if (and buffer
+ (buffer-name buffer))
+ (progn
+ (set-buffer (pop-to-buffer buffer))
+ (when (and (buffer-modified-p)
+ (not (y-or-n-p
+ "Message already being composed; erase? ")))
+ (error "Message being composed")))
+ (set-buffer (pop-to-buffer name)))))
+ (erase-buffer)
+ (message-mode))
(defun message-setup (headers &optional replybuffer actions)
(setq message-send-actions actions)
(Subject . ,(or subject "")))))
;;;###autoload
-(defun message-reply (&optional to-address wide)
+(defun message-reply (&optional to-address wide ignore-reply-to)
"Start editing a reply to the article in the current buffer."
(interactive)
(let ((cur (current-buffer))
to (mail-fetch-field "to")
cc (mail-fetch-field "cc")
mct (mail-fetch-field "mail-copies-to")
- reply-to (mail-fetch-field "reply-to")
+ reply-to (unless ignore-reply-to (mail-fetch-field "reply-to"))
references (mail-fetch-field "references")
message-id (mail-fetch-field "message-id"))
;; Remove any (buggy) Re:'s that are present and make a
(cond
((equal (downcase followup-to) "poster")
(if (or (eq message-use-followup-to 'use)
- (y-or-n-p "Use Followup-To \"poster\"? "))
+ (yes-or-no-p "Use Followup-To \"poster\"? "))
(cons 'To (or reply-to from ""))
(cons 'Newsgroups newsgroups)))
(t
(if (or (equal followup-to newsgroups)
(not (eq message-use-followup-to 'ask))
- (y-or-n-p (format "Use Followup-To %s? " followup-to)))
+ (yes-or-no-p
+ (format "Use Followup-To %s? " followup-to)))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
(t
--- /dev/null
+;;; nndb.el --- nndb access for Gnus
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; I have shamelessly snarfed the code of nntp.el from sgnus.
+;; Kai
+
+
+;;-
+;; Register nndb with known select methods.
+
+(setq gnus-valid-select-methods
+ (cons '("nndb" mail address respool prompt-address)
+ gnus-valid-select-methods))
+
+
+;;; Code:
+
+(require 'rnews)
+(require 'sendmail)
+(require 'nnheader)
+(require 'nntp)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (unless (fboundp 'open-network-stream)
+ (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'cancel-timer "timer")
+ (autoload 'telnet "telnet" nil t)
+ (autoload 'telnet-send-input "telnet" nil t)
+ (autoload 'timezone-parse-date "timezone"))
+
+;; Declare nndb as derived from nntp
+
+(nnoo-declare nndb nntp)
+
+;; Variables specific to nndb
+
+;;- currently not used but just in case...
+(defvoo nndb-deliver-program "nndel"
+ "*The program used to put a message in an NNDB group.")
+
+;; Variables copied from nntp
+
+(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
+ "Like nntp-server-opened-hook."
+ nntp-server-opened-hook)
+
+;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000")
+; "*Parameters to nndb-open-login. Like nntp-rlogin-parameters."
+; nntp-rlogin-parameters)
+
+;(defvoo nndb-rlogin-user-name nil
+; "*User name for rlogin connect method."
+; nntp-rlogin-user-name)
+
+(defvoo nndb-address "localhost"
+ "*The name of the NNDB server."
+ nntp-address)
+
+(defvoo nndb-port-number 9000
+ "*Port number to connect to."
+ nntp-port-number)
+
+;(defvoo nndb-current-group ""
+; "Like nntp-current-group."
+; nntp-current-group)
+
+(defvoo nndb-status-string nil "" nntp-status-string)
+
+\f
+
+(defconst nndb-version "nndb 0.3"
+ "Version numbers of this version of NNDB.")
+
+\f
+;;; Interface functions.
+
+(nnoo-define-basics nndb)
+
+;;- maybe this should be mail??
+;;-(defun nndb-request-type (group &optional article)
+;;- 'news)
+
+;;------------------------------------------------------------------
+;;- only new stuff below
+
+; nndb-request-update-info does not exist and is not needed
+
+; nndb-request-update-mark does not exist and is not needed
+
+; nndb-request-scan does not exist
+; get new mail from somewhere -- maybe this is not needed?
+; --> todo
+
+(deffoo nndb-request-create-group (group &optional server)
+ "Creates a group if it doesn't exist yet."
+ (nntp-send-command "^[23].*\n" "MKGROUP" group))
+
+; todo -- use some other time than the creation time of the article
+; best is time since article has been marked as expirable
+(deffoo nndb-request-expire-articles
+ (articles &optional group server force)
+ "Expires ARTICLES from GROUP on SERVER.
+If FORCE, delete regardless of exiration date, otherwise use normal
+expiry mechanism."
+ (let (msg)
+ (nntp-possibly-change-server group server) ;;-
+ (while articles
+ (setq art (pop articles))
+ (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
+ (setq msg (nndb-status-message))
+ ;; CCC we shouldn't be using the variable nndb-status-string?
+ (if (string-match "^423" (nnheader-get-report 'nndb))
+ ()
+ (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
+ (error "Not a valid response for DATE command: %s"
+ msg))
+ (if (nnmail-expired-article-p
+ group
+ (list (string-to-int
+ (substring msg (match-beginning 1) (match-end 1)))
+ (string-to-int
+ (substring msg (match-beginning 2) (match-end 2))))
+ force)
+ (nnheader-message 5 "Deleting article %s in %s..."
+ art group)
+ (nntp-send-command "^[23].*\n" "DELETE" art))))))
+
+(deffoo nndb-request-move-article
+ (article group server accept-form &optional last)
+ "Move ARTICLE (a number) from GROUP on SERVER.
+Evals ACCEPT-FORM in current buffer, where the article is.
+Optional LAST is ignored."
+ (let ((artbuf (get-buffer-create " *nndb move*")))
+ (and
+ (nndb-request-article article group server artbuf)
+ (save-excursion
+ (set-buffer artbuf)
+ (setq result (eval accept-form))
+ (kill-buffer (current-buffer))
+ result)
+ (nndb-request-expire-articles (list article)
+ group
+ server
+ t))
+ result))
+
+(deffoo nndb-request-accept-article (group server &optional last)
+ "The article in the current buffer is put into GROUP."
+ (nntp-possibly-change-server group server) ;;-
+ (let (art statmsg)
+ (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
+ (nnheader-insert "")
+ (nntp-encode-text)
+ (nntp-send-region-to-server (point-min) (point-max))
+ ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+ ;; appended to end of the status message.
+ (nntp-wait-for-response "^[23].*\n")
+ (setq statmsg (nntp-status-message))
+ (or (string-match "^\\([0-9]+\\)" statmsg)
+ (error "nndb: %s" statmsg))
+ (setq art (substring statmsg
+ (match-beginning 1)
+ (match-end 1)))
+ (message "nndb: accepted %s" art)
+ (list art))))
+
+(deffoo nndb-request-replace-article (article group buffer)
+ "ARTICLE is the number of the article in GROUP to be replaced
+with the contents of the BUFFER."
+ (set-buffer buffer)
+ (let (art statmsg)
+ (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
+ (nnheader-insert "")
+ (nntp-encode-text)
+ (nntp-send-region-to-server (point-min) (point-max))
+ ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+ ;; appended to end of the status message.
+ (nntp-wait-for-response "^[23].*\n")
+; (setq statmsg (nntp-status-message))
+; (or (string-match "^\\([0-9]+\\)" statmsg)
+; (error "nndb: %s" statmsg))
+; (setq art (substring statmsg
+; (match-beginning 1)
+; (match-end 1)))
+; (message "nndb: replaced %s" art)
+ (list (int-to-string article)))))
+
+; nndb-request-delete-group does not exist
+; todo -- maybe later
+
+; nndb-request-rename-group does not exist
+; todo -- maybe later
+
+;; Import stuff from nntp
+
+
+
+;; Import other stuff from nntp as is.
+
+(nnoo-import nndb
+ (nntp))
+
+(provide 'nndb)
+
+
(head-begin . "^[0-9].*\n"))
(forward
(article-begin . "^-+ Start of forwarded message -+\n+")
- (body-end . "^-+ End of forwarded message -+\n")
+ (body-end . "^-+ End of forwarded message -+$")
(prepare-body . nndoc-unquote-dashes))
(clari-briefs
(article-begin . "^ \\*")
(save-restriction
(message-narrow-to-headers)
;; Remove some headers.
- (message-remove-header message-ignored-mail-headers t))
+ (message-remove-header message-ignored-mail-headers t)
+ (if (equal kind "mail")
+ (message-generate-headers message-required-mail-headers)
+ (message-generate-headers message-required-news-headers)))
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
"Open the virtual server SERVER.
If CONNECTIONLESS is non-nil, don't attempt to connect to any physical
servers."
+ ;; Called with just a port number as the defs.
+ (when (or (stringp (car defs))
+ (numberp (car defs)))
+ (setq defs `((nntp-port-number ,(car defs)))))
+ (unless (assq 'nntp-address defs)
+ (setq defs (append defs `((nntp-address ,server)))))
(nnoo-change-server 'nntp server defs)
(if (nntp-server-opened server)
t
- (if (or (stringp (car defs))
- (numberp (car defs)))
- (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
- (or (assq 'nntp-address defs)
- (setq defs (append defs (list (list 'nntp-address server)))))
(or (nntp-server-opened server)
connectionless
(prog2
(error nil))
(delete-process proc)))
(and nntp-async-buffer
- (get-buffer nntp-async-buffer)
+ (buffer-name nntp-async-buffer)
(kill-buffer nntp-async-buffer))
(let ((alist (cddr (assq 'nntp nnoo-state-alist))))
(while (setq entry (pop alist))
- (and (setq proc (nth 1 (assq 'nntp-async-buffer entry)))
+ (and (setq proc (cdr (assq 'nntp-async-buffer entry)))
(buffer-name proc)
(kill-buffer proc))))
(nnoo-close-server 'nntp)
"Open SERVER.
If SERVER is nil, use value of environment variable `NNTPSERVER'.
If SERVICE, this this as the port number."
+ (nnheader-insert "")
(let ((server (or server (getenv "NNTPSERVER")))
(status nil)
(timer
+Wed Apr 17 19:10:17 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (posting): Update to use message.
+
Sat Apr 13 13:53:34 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Writing New Backends): New node.
More complex stuff:
@lisp
(setq gnus-message-archive-group
- '((if (eq major-mode news-reply-mode)
+ '((if (message-news-p)
"misc-news"
"misc-mail")))
@end lisp
@lisp
(setq gnus-message-archive-group
- '((if (eq major-mode news-reply-mode)
+ '((if (message-news-p)
"misc-news"
(concat "mail." (format-time-string
"%Y-%m" (current-time))))))
projects / gnus / commitdiff