(lambda (spec)
(list
(format format (car spec) (cadr spec))
- 2 3 (intern (format "gnus-emphasis-%s" (car (cddr spec))))))
+ 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
types)))
"Alist that says how to fontify certain phrases.
Each item looks like this:
:type 'hook
:group 'gnus-article-various)
+(defcustom gnus-article-hide-pgp-hook nil
+ "*A hook called after successfully hiding a PGP signature."
+ :type 'hook
+ :group 'gnus-article-various)
+
(defcustom gnus-article-button-face 'bold
"Face used for highlighting buttons in the article buffer.
:type 'face
:group 'gnus-article-buttons)
-(defcustom gnus-signature-face 'italic
- "Face used for highlighting a signature in the article buffer."
+(defcustom gnus-signature-face 'gnus-signature-face
+ "Face used for highlighting a signature in the article buffer.
+Obsolete; use the face `gnus-signature-face' for customizations instead."
:type 'face
:group 'gnus-article-highlight
:group 'gnus-article-signature)
+(defface gnus-signature-face
+ '((((type x))
+ (:italic t)))
+ "Face used for highlighting a signature in the article buffer."
+ :group 'gnus-article-highlight
+ :group 'gnus-article-signature)
+
(defface gnus-header-from-face
'((((class color)
(background dark))
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
- (let ((e (point-min))
- b)
- (while (setq b (text-property-any e (point-max) 'article-type type))
- (setq e (text-property-not-all b (point-max) 'article-type type))
- (delete-region b e)))))
+ (let ((b (point-min)))
+ (while (setq b (text-property-any b (point-max) 'article-type type))
+ (delete-region
+ b (or (text-property-not-all b (point-max) 'article-type type)
+ (point-max)))))))
(defun gnus-article-delete-invisible-text ()
"Delete all invisible text in the current buffer."
(save-excursion
- (let ((e (point-min))
- b)
- (while (setq b (text-property-any e (point-max) 'invisible t))
- (setq e (text-property-not-all b (point-max) 'invisible t))
- (delete-region b e)))))
+ (let ((b (point-min)))
+ (while (setq b (text-property-any b (point-max) 'invisible t))
+ (delete-region
+ b (or (text-property-not-all b (point-max) 'invisible t)
+ (point-max)))))))
(defun gnus-article-text-type-exists-p (type)
"Say whether any text of type TYPE exists in the buffer."
(nnheader-narrow-to-headers)
(setq from (message-fetch-field "from"))
(goto-char (point-min))
- (when (and gnus-article-x-face-command
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and gnus-article-x-face-too-ugly from
- (not (string-match gnus-article-x-face-too-ugly
- from))))
- ;; Has to be present.
- (re-search-forward "^X-Face: " nil t))
+ (while (and gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
+ from))))
+ ;; Has to be present.
+ (re-search-forward "^X-Face: " nil t))
;; We now have the area of the buffer where the X-Face is stored.
- (let ((beg (point))
- (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
- ;; We display the face.
- (if (symbolp gnus-article-x-face-command)
- ;; The command is a lisp function, so we call it.
- (if (gnus-functionp gnus-article-x-face-command)
- (funcall gnus-article-x-face-command beg end)
- (error "%s is not a function" gnus-article-x-face-command))
- ;; The command is a string, so we interpret the command
- ;; as a, well, command, and fork it off.
- (let ((process-connection-type nil))
- (process-kill-without-query
- (start-process
- "article-x-face" nil shell-file-name shell-command-switch
- gnus-article-x-face-command))
- (process-send-region "article-x-face" beg end)
- (process-send-eof "article-x-face")))))))))
+ (save-excursion
+ (let ((beg (point))
+ (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
+ ;; We display the face.
+ (if (symbolp gnus-article-x-face-command)
+ ;; The command is a lisp function, so we call it.
+ (if (gnus-functionp gnus-article-x-face-command)
+ (funcall gnus-article-x-face-command beg end)
+ (error "%s is not a function" gnus-article-x-face-command))
+ ;; The command is a string, so we interpret the command
+ ;; as a, well, command, and fork it off.
+ (let ((process-connection-type nil))
+ (process-kill-without-query
+ (start-process
+ "article-x-face" nil shell-file-name shell-command-switch
+ gnus-article-x-face-command))
+ (process-send-region "article-x-face" beg end)
+ (process-send-eof "article-x-face"))))))))))
+
+(defun gnus-hack-decode-rfc1522 ()
+ "Emergency hack function for avoiding problems when decoding."
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ ;; Remove encoded TABs.
+ (while (search-forward "=09" nil t)
+ (replace-match " " t t))
+ ;; Remove encoded newlines.
+ (goto-char (point-min))
+ (while (search-forward "=10" nil t)
+ (replace-match " " t t))))
(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
;; Hide the "header".
(when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
(gnus-article-hide-text-type (1+ (match-beginning 0))
- (match-end 0) 'pgp))
- (setq beg (point))
- ;; Hide the actual signature.
- (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
- (setq end (1+ (match-beginning 0)))
- (gnus-article-hide-text-type
- end
- (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
- (match-end 0)
- ;; Perhaps we shouldn't hide to the end of the buffer
- ;; if there is no end to the signature?
- (point-max))
- 'pgp))
- ;; Hide "- " PGP quotation markers.
- (when (and beg end)
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (re-search-forward "^- " nil t)
- (gnus-article-hide-text-type
- (match-beginning 0) (match-end 0) 'pgp))
- (widen))))))
+ (match-end 0) 'pgp)
+ (setq beg (point))
+ ;; Hide the actual signature.
+ (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-article-hide-text-type
+ end
+ (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
+ (match-end 0)
+ ;; Perhaps we shouldn't hide to the end of the buffer
+ ;; if there is no end to the signature?
+ (point-max))
+ 'pgp))
+ ;; Hide "- " PGP quotation markers.
+ (when (and beg end)
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward "^- " nil t)
+ (gnus-article-hide-text-type
+ (match-beginning 0) (match-end 0) 'pgp))
+ (widen))
+ (run-hooks 'gnus-article-hide-pgp-hook))))))
(defun article-hide-pem (&optional arg)
"Toggle hiding of any PEM headers and signatures in the current article.
nil)))
(eval-and-compile
- (autoload 'w3-parse-buffer "w3-parse"))
+ (autoload 'w3-display "w3-parse")
+ (autoload 'w3-do-setup "w3" "" t))
(defun gnus-article-treat-html ()
"Render HTML."
(let ((cbuf (current-buffer)))
(set-buffer gnus-article-buffer)
(let (buf buffer-read-only b e)
+ (w3-do-setup)
(goto-char (point-min))
(narrow-to-region
(if (search-forward "\n\n" nil t)
(setq e (point-max)))
(nnheader-temp-write nil
(insert-buffer-substring gnus-article-buffer b e)
+ (require 'url)
(save-window-excursion
- (setq buf (car (w3-parse-buffer (current-buffer))))))
+ (w3-region (point-min) (point-max))
+ (setq buf (buffer-substring-no-properties (point-min) (point-max)))))
(when buf
(delete-region (point-min) (point-max))
- (insert-buffer-substring buf)
- (kill-buffer buf))
+ (insert buf))
(widen)
(goto-char (point-min))
(set-window-start (get-buffer-window (current-buffer)) (point-min))
(gnus-article-hide-headers 1 t)))
(save-window-excursion
(if (not gnus-default-article-saver)
- (error "No default saver is defined.")
+ (error "No default saver is defined")
;; !!! Magic! The saving functions all save
;; `gnus-original-article-buffer' (or so they think), but we
;; bind that variable to our save-buffer.
default-name))
;; A single split name was found
((= 1 (length split-name))
- (let* ((name (car split-name))
+ (let* ((name (expand-file-name
+ (car split-name) gnus-article-save-directory))
(dir (cond ((file-directory-p name)
(file-name-as-directory name))
((file-exists-p name) name)
(put 'gnus-article-mode 'mode-class 'special)
-(when t
- (gnus-define-keys gnus-article-mode-map
- " " gnus-article-goto-next-page
- "\177" gnus-article-goto-prev-page
- [delete] gnus-article-goto-prev-page
- "\C-c^" gnus-article-refer-article
- "h" gnus-article-show-summary
- "s" gnus-article-show-summary
- "\C-c\C-m" gnus-article-mail
- "?" gnus-article-describe-briefly
- gnus-mouse-2 gnus-article-push-button
- "\r" gnus-article-press-button
- "\t" gnus-article-next-button
- "\M-\t" gnus-article-prev-button
- "e" gnus-article-edit
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug
-
- "\C-d" gnus-article-read-summary-keys
- "\M-*" gnus-article-read-summary-keys
- "\M-#" gnus-article-read-summary-keys
- "\M-^" gnus-article-read-summary-keys
- "\M-g" gnus-article-read-summary-keys)
-
- (substitute-key-definition
- 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
+(gnus-define-keys gnus-article-mode-map
+ " " gnus-article-goto-next-page
+ "\177" gnus-article-goto-prev-page
+ [delete] gnus-article-goto-prev-page
+ "\C-c^" gnus-article-refer-article
+ "h" gnus-article-show-summary
+ "s" gnus-article-show-summary
+ "\C-c\C-m" gnus-article-mail
+ "?" gnus-article-describe-briefly
+ gnus-mouse-2 gnus-article-push-button
+ "\r" gnus-article-press-button
+ "\t" gnus-article-next-button
+ "\M-\t" gnus-article-prev-button
+ "e" gnus-article-edit
+ "<" beginning-of-buffer
+ ">" end-of-buffer
+ "\C-c\C-i" gnus-info-find-node
+ "\C-c\C-b" gnus-bug
+
+ "\C-d" gnus-article-read-summary-keys
+ "\M-*" gnus-article-read-summary-keys
+ "\M-#" gnus-article-read-summary-keys
+ "\M-^" gnus-article-read-summary-keys
+ "\M-g" gnus-article-read-summary-keys)
+
+(substitute-key-definition
+ 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
(defun gnus-article-make-menu-bar ()
(gnus-turn-off-edit-menu 'article)
;; save it to file.
(goto-char (point-max))
(insert "\n")
- (append-to-file (point-min) (point-max) file-name))))
+ (append-to-file (point-min) (point-max) file-name)
+ t)))
(defun gnus-narrow-to-page (&optional arg)
"Narrow the article buffer to a page.
(interactive)
(if (not (gnus-buffer-live-p gnus-summary-buffer))
(error "There is no summary buffer for this article buffer")
+ (gnus-article-set-globals)
(gnus-configure-windows 'article)
(gnus-summary-goto-subject gnus-current-article)))
(interactive "P")
(when (and (not force)
(gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
(gnus-article-edit-article
`(lambda ()
(gnus-summary-edit-article-done
(let ((winconf (current-window-configuration)))
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
- (set-text-properties (point-min) (point-max) nil)
+ (gnus-set-text-properties (point-min) (point-max) nil)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(setq gnus-prev-winconf winconf)
(defcustom gnus-button-alist
`(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
gnus-button-message-id 2)
- ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1)
+ ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1)
("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
gnus-button-fetch-group 4)
("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
- ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 1)
- ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2)
+ ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
+ ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
;; Raw URLs.
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0 t gnus-button-mailto 0)
("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
;;; Internal functions:
+(defun gnus-article-set-globals ()
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables)))
+
(defun gnus-signature-toggle (end)
(save-excursion
(set-buffer gnus-article-buffer)
(mail-header-set-number headers (cdr result))))
(let ((number (mail-header-number headers))
file dir)
- (when (and (> number 0) ; Reffed article.
+ (when (and number
+ (> number 0) ; Reffed article.
(or force
(and (or (not gnus-uncacheable-groups)
(not (string-match
(defun gnus-cache-possibly-alter-active (group active)
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
- (when (equal group "no.norsk") (error "hie"))
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (and cache-active
- (< (car cache-active) (car active))
- (setcar active (car cache-active)))
- (and cache-active
- (> (cdr cache-active) (cdr active))
- (setcdr active (cdr cache-active))))))
+ (when cache-active
+ (when (< (car cache-active) (car active))
+ (setcar active (car cache-active)))
+ (when (> (cdr cache-active) (cdr active))
+ (setcdr active (cdr cache-active)))))))
(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
"Retrieve the headers for ARTICLES in GROUP."
(defun gnus-cache-articles-in-group (group)
"Return a sorted list of cached articles in GROUP."
- (let ((dir (file-name-directory (gnus-cache-file-name group 1))))
+ (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
+ articles)
(when (file-exists-p dir)
- (sort (mapcar (lambda (name) (string-to-int name))
- (directory-files dir nil "^[0-9]+$" t))
- '<))))
-
-(defun gnus-cache-braid-nov (group cached)
+ (setq articles
+ (sort (mapcar (lambda (name) (string-to-int name))
+ (directory-files dir nil "^[0-9]+$" t))
+ '<))
+ ;; Update the cache active file, just to synch more.
+ (when articles
+ (gnus-cache-update-active group (car articles) t)
+ (gnus-cache-update-active group (car (last articles))))
+ articles)))
+
+(defun gnus-cache-braid-nov (group cached &optional file)
(let ((cache-buf (get-buffer-create " *gnus-cache*"))
beg end)
(gnus-cache-save-buffers)
(set-buffer cache-buf)
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (insert-file-contents (gnus-cache-file-name group ".overview"))
+ (insert-file-contents (or file (gnus-cache-file-name group ".overview")))
(goto-char (point-min))
(insert "\n")
(goto-char (point-min)))
(gnus)
;; Go through all groups...
(gnus-group-mark-buffer)
- (gnus-group-universal-argument
- nil nil
- (lambda ()
- (interactive)
- (gnus-summary-read-group (gnus-group-group-name) nil t)
- ;; ... and enter the articles into the cache.
- (when (eq major-mode 'gnus-summary-mode)
- (gnus-uu-mark-buffer)
- (gnus-cache-enter-article)
- (kill-buffer (current-buffer)))))))
+ (gnus-group-iterate nil
+ (lambda (group)
+ (let (gnus-auto-select-next)
+ (gnus-summary-read-group group nil t)
+ ;; ... and enter the articles into the cache.
+ (when (eq major-mode 'gnus-summary-mode)
+ (gnus-uu-mark-buffer)
+ (gnus-cache-enter-article)
+ (kill-buffer (current-buffer))))))))
(defun gnus-cache-read-active (&optional force)
"Read the cache active file."
(gnus-make-directory gnus-cache-directory)
- (if (not (and (file-exists-p gnus-cache-active-file)
- (or force (not gnus-cache-active-hashtb))))
+ (if (or (not (file-exists-p gnus-cache-active-file))
+ force)
;; There is no active file, so we generate one.
(gnus-cache-generate-active)
;; We simply read the active file.
(defun gnus-cache-move-cache (dir)
"Move the cache tree to somewhere else."
- (interactive "DMove the cache tree to: ")
+ (interactive "FMove the cache tree to: ")
(rename-file gnus-cache-directory dir))
(provide 'gnus-cache)
:group 'gnus-cite
:type 'integer)
-(defcustom gnus-cite-attribution-prefix "in article\\|in <"
+(defcustom gnus-cite-attribution-prefix
+ "in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),"
"Regexp matching the beginning of an attribution line."
:group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-attribution-suffix
- "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$"
+ "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ ]*$"
"Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
:group 'gnus-cite
(setq gnus-cite-prefix-alist nil
gnus-cite-attribution-alist nil
gnus-cite-loose-prefix-alist nil
- gnus-cite-loose-attribution-alist nil)))))
+ gnus-cite-loose-attribution-alist nil
+ gnus-cite-article nil)))))
(defun gnus-article-hide-citation (&optional arg force)
"Toggle hiding of all cited text except attribution lines.
"Find out how many seconds to TIME, which is on the form \"17:43\"."
(if (not (stringp time))
time
- (let* ((date (current-time-string))
- (dv (timezone-parse-date date))
- (tdate (timezone-make-arpa-date
- (string-to-number (aref dv 0))
- (string-to-number (aref dv 1))
- (string-to-number (aref dv 2)) time
- (or (aref dv 4) "UT")))
- (nseconds (gnus-time-minus
- (gnus-encode-date tdate) (gnus-encode-date date))))
- (round
- (/ (+ (if (< (car nseconds) 0)
- 86400 0)
- (* 65536 (car nseconds))
- (nth 1 nseconds))
- gnus-demon-timestep)))))
+ (let* ((now (current-time))
+ ;; obtain NOW as discrete components -- make a vector for speed
+ (nowParts (apply 'vector (decode-time now)))
+ ;; obtain THEN as discrete components
+ (thenParts (timezone-parse-time time))
+ (thenHour (string-to-int (elt thenParts 0)))
+ (thenMin (string-to-int (elt thenParts 1)))
+ ;; convert time as elements into number of seconds since EPOCH.
+ (then (encode-time 0
+ thenMin
+ thenHour
+ ;; If THEN is earlier than NOW, make it
+ ;; same time tomorrow. Doc for encode-time
+ ;; says that this is OK.
+ (+ (elt nowParts 3)
+ (if (or (< thenHour (elt nowParts 2))
+ (and (= thenHour (elt nowParts 2))
+ (<= thenMin (elt nowParts 1))))
+ 1 0))
+ (elt nowParts 4)
+ (elt nowParts 5)
+ (elt nowParts 6)
+ (elt nowParts 7)
+ (elt nowParts 8)))
+ ;; calculate number of seconds between NOW and THEN
+ (diff (+ (* 65536 (- (car then) (car now)))
+ (- (cadr then) (cadr now)))))
+ ;; return number of timesteps in the number of seconds
+ (round (/ diff gnus-demon-timestep)))))
(defun gnus-demon ()
"The Gnus daemon that takes care of running all Gnus handlers."
(t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
;; So we call the handler.
(progn
- (funcall (car handler))
+ (ignore-errors (funcall (car handler)))
;; And reset the timer.
(setcar (nthcdr 1 handler)
(gnus-demon-time-to-step
((null (setq idle (nth 2 handler)))
;; We do nothing.
)
- ((not (numberp idle))
+ ((and (not (numberp idle))
+ (gnus-demon-is-idle-p))
;; We want to call this handler each and every time that
;; Emacs is idle.
- (funcall (car handler)))
+ (ignore-errors (funcall (car handler))))
(t
;; We want to call this handler only if Emacs has been idle
;; for a specified number of timesteps.
(and (not (memq (car handler) gnus-demon-idle-has-been-called))
(< idle gnus-demon-idle-time)
+ (gnus-demon-is-idle-p)
(progn
- (funcall (car handler))
+ (ignore-errors (funcall (car handler)))
;; Make sure the handler won't be called once more in
;; this idle-cycle.
(push (car handler) gnus-demon-idle-has-been-called)))))))))
(defun gnus-demon-add-nocem ()
"Add daemonic NoCeM handling to Gnus."
- (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t))
+ (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
(defun gnus-demon-scan-nocem ()
"Scan NoCeM groups for NoCeM messages."
(defvar gnus-mouse-2 [mouse-2])
(defvar gnus-down-mouse-2 [down-mouse-2])
+(defvar gnus-mode-line-modified
+ (if (or gnus-xemacs
+ (< emacs-major-version 20))
+ '("--**-" . "-----")
+ '("**" "--")))
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(autoload 'gnus-xmas-redefine "gnus-xmas")
- (autoload 'appt-select-lowest-window "appt.el"))
+ (autoload 'appt-select-lowest-window "appt"))
(or (fboundp 'mail-file-babyl-p)
(fset 'mail-file-babyl-p 'rmail-file-p))
(truncate-string valstr (, max-width))
valstr))))
+(defun gnus-encode-coding-string (string system)
+ string)
+
(eval-and-compile
(if (string-match "XEmacs\\|Lucid" emacs-version)
nil
(defvar gnus-mouse-face-prop 'mouse-face
- "Property used for highlighting mouse regions.")
-
- (defvar gnus-article-x-face-command
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
- "String or function to be executed to display an X-Face header.
-If it is a string, the command will be executed in a sub-shell
-asynchronously. The compressed face will be piped to this command."))
+ "Property used for highlighting mouse regions."))
(cond
((string-match "XEmacs\\|Lucid" emacs-version)
(fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
(fset 'gnus-max-width-function 'gnus-mule-max-width-function)
(fset 'gnus-summary-set-display-table 'ignore)
+ (fset 'gnus-encode-coding-string 'encode-coding-string)
(when (boundp 'gnus-check-before-posting)
(setq gnus-check-before-posting
(boundp 'mark-active)
mark-active))
+(defun gnus-add-minor-mode (mode name map)
+ (if (fboundp 'add-minor-mode)
+ (add-minor-mode mode name map)
+ (unless (assq mode minor-mode-alist)
+ (push `(,mode ,name) minor-mode-alist))
+ (unless (assq mode minor-mode-map-alist)
+ (push (cons mode map)
+ minor-mode-map-alist))))
+
(provide 'gnus-ems)
;; Local Variables:
(when (and menu-bar-mode
(gnus-visual-p 'grouplens-menu 'menu))
(gnus-grouplens-make-menu-bar))
- (unless (assq 'gnus-grouplens-mode minor-mode-alist)
- (push '(gnus-grouplens-mode " GroupLens") minor-mode-alist))
- (unless (assq 'gnus-grouplens-mode minor-mode-map-alist)
- (push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map)
- minor-mode-map-alist))
+ (gnus-add-minor-mode
+ 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map)
(run-hooks 'gnus-grouplens-mode-hook))))
(provide 'gnus-gl)
(defcustom gnus-permanently-visible-groups nil
"*Regexp to match groups that should always be listed in the group buffer.
-This means that they will still be listed when there are no unread
-articles in the groups."
+This means that they will still be listed even when there are no
+unread articles in the groups.
+
+If nil, no groups are permanently visible."
:group 'gnus-group-listing
:type '(choice regexp (const nil)))
"r" gnus-group-read-init-file
"B" gnus-group-browse-foreign-server
"b" gnus-group-check-bogus-groups
- "F" gnus-find-new-newsgroups
+ "F" gnus-group-find-new-groups
"\C-c\C-d" gnus-group-describe-group
"\M-d" gnus-group-describe-all-groups
"\C-c\C-a" gnus-group-apropos
"m" gnus-group-mark-group
"u" gnus-group-unmark-group
"w" gnus-group-mark-region
- "m" gnus-group-mark-buffer
+ "b" gnus-group-mark-buffer
"r" gnus-group-mark-regexp
"U" gnus-group-unmark-all-groups)
(gnus-group-group-name)]
["Info" gnus-group-edit-group (gnus-group-group-name)]
["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
- ["Global kill file" gnus-group-edit-global-kill t])
- ))
+ ["Global kill file" gnus-group-edit-global-kill t])))
(easy-menu-define
gnus-group-group-menu gnus-group-mode-map ""
["First unread group" gnus-group-first-unread-group t]
["Best unread group" gnus-group-best-unread-group t])
["Delete bogus groups" gnus-group-check-bogus-groups t]
- ["Find new newsgroups" gnus-find-new-newsgroups t]
+ ["Find new newsgroups" gnus-group-find-new-groups t]
["Transpose" gnus-group-transpose-groups
(gnus-group-group-name)]
- ["Read a directory as a group..." gnus-group-enter-directory t]
- ))
+ ["Read a directory as a group..." gnus-group-enter-directory t]))
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
["Flush score cache" gnus-score-flush-cache t]
["Toggle topics" gnus-topic-mode t]
["Exit from Gnus" gnus-group-exit t]
- ["Exit without saving" gnus-group-quit t]
- ))
+ ["Exit without saving" gnus-group-quit t]))
(run-hooks 'gnus-group-menu-hook)))
(not (zerop (buffer-size))))))
(mode-string (eval gformat)))
;; Say whether the dribble buffer has been modified.
- (setq mode-line-modified (if modified "**" "--"))
+ (setq mode-line-modified
+ (if modified (car gnus-mode-line-modified)
+ (cdr gnus-mode-line-modified)))
;; If the line is too long, we chop it off.
(when (> (length mode-string) max-len)
(setq mode-string (substring mode-string 0 (- max-len 4))))
(not (eobp))
(not (setq
found
- (and (or all
- (and
- (let ((unread
- (get-text-property (point) 'gnus-unread)))
- (and (numberp unread) (> unread 0)))
- (setq lev (get-text-property (point)
+ (and
+ (get-text-property (point) 'gnus-group)
+ (or all
+ (and
+ (let ((unread
+ (get-text-property (point) 'gnus-unread)))
+ (and (numberp unread) (> unread 0)))
+ (setq lev (get-text-property (point)
+ 'gnus-level))
+ (<= lev gnus-level-subscribed)))
+ (or (not level)
+ (and (setq lev (get-text-property (point)
'gnus-level))
- (<= lev gnus-level-subscribed)))
- (or (not level)
- (and (setq lev (get-text-property (point)
- 'gnus-level))
- (or (= lev level)
- (and (< lev low)
- (< level lev)
- (progn
- (setq low lev)
- (setq pos (point))
- nil))))))))
+ (or (= lev level)
+ (and (< lev low)
+ (< level lev)
+ (progn
+ (setq low lev)
+ (setq pos (point))
+ nil))))))))
(zerop (forward-line way)))))
(if found
(progn (gnus-group-position-point) t)
FUNCTION will be called with the group name as the paremeter
and with point over the group in question."
(let ((groups (gnus-group-process-prefix arg))
+ (window (selected-window))
group)
(while (setq group (pop groups))
+ (select-window window)
(gnus-group-remove-mark group)
- (funcall function group))))
+ (save-selected-window
+ (save-excursion
+ (funcall function group))))))
(put 'gnus-group-iterate 'lisp-indent-function 1)
(let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
nil t)
gnus-useful-groups)))
- (list (cadr entry) (nth 2 entry))))
+ (list (cadr entry) (caddr entry))))
(setq method (gnus-copy-sequence method))
(let (entry)
(while (setq entry (memq (assq 'eval method) method))
(let* ((group
(if solid (gnus-read-group "Group name: ")
(message-unique-id)))
+ (default-type (or (car gnus-group-web-type-history)
+ (symbol-name (caar nnweb-type-definition))))
(type
- (completing-read
- "Search engine type: "
- (mapcar (lambda (elem) (list (symbol-name (car elem))))
- nnweb-type-definition)
- nil t (cons (or (car gnus-group-web-type-history)
- (symbol-name (caar nnweb-type-definition)))
- 0)
- 'gnus-group-web-type-history))
+ (gnus-string-or
+ (completing-read
+ (format "Search engine type (default %s): " default-type)
+ (mapcar (lambda (elem) (list (symbol-name (car elem))))
+ nnweb-type-definition)
+ nil t nil 'gnus-group-web-type-history)
+ default-type))
(search
(read-string
"Search string: "
(pgroup (gnus-group-prefixed-name group method)))
;; Check whether it exists already.
(when (gnus-gethash pgroup gnus-newsrc-hashtb)
- (error "Group %s already exists." pgroup))
+ (error "Group %s already exists" pgroup))
;; Subscribe the new group after the group on the current line.
(gnus-subscribe-group pgroup (gnus-group-group-name) method)
(gnus-group-update-group pgroup)
(gnus-group-list-groups (and (numberp arg)
(max (car gnus-group-list-mode) arg)))))
-(defun gnus-group-get-new-news-this-group (&optional n)
+(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
"Check for newly arrived news in the current group (and the N-1 next groups).
The difference between N and the number of newsgroup checked is returned.
If N is negative, this group and the N-1 previous groups will be checked."
(gnus-group-remove-mark group)
;; Bypass any previous denials from the server.
(gnus-remove-denial (gnus-find-method-for-group group))
- (if (gnus-activate-group group 'scan)
+ (if (gnus-activate-group group (if dont-scan nil 'scan))
(progn
(gnus-get-unread-articles-in-group
(gnus-get-info group) (gnus-active group) t)
(interactive
(list
(gnus-group-group-name)
- (cond (current-prefix-arg
- (completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
- gnus-group-faq-directory)))))))
+ (when current-prefix-arg
+ (completing-read
+ "Faq dir: " (and (listp gnus-group-faq-directory)
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
(unless group
(error "No group name given"))
(let ((dirs (or faq-dir gnus-group-faq-directory))
(defun gnus-group-read-init-file ()
"Read the Gnus elisp init file."
(interactive)
- (gnus-read-init-file))
+ (gnus-read-init-file)
+ (gnus-message 5 "Read %s" gnus-init-file))
(defun gnus-group-check-bogus-groups (&optional silent)
"Check bogus newsgroups.
(gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
(gnus-group-list-groups))
+(defun gnus-group-find-new-groups (&optional arg)
+ "Search for new groups and add them.
+Each new group will be treated with `gnus-subscribe-newsgroup-method.'
+If ARG (the prefix), use the `ask-server' method to query
+the server for new groups."
+ (interactive "P")
+ (gnus-find-new-newsgroups arg)
+ (gnus-group-list-groups))
+
(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
If GROUP, edit that local kill file instead."
last)))
(defun gnus-request-replace-article (article group buffer)
- (let ((func (car (gnus-find-method-for-group group))))
+ (let ((func (car (gnus-group-name-to-method group))))
(funcall (intern (format "%s-request-replace-article" func))
article (gnus-group-real-name group) buffer)))
"Move group INFO from FROM-SERVER to TO-SERVER."
(let ((group (gnus-info-group info))
to-active hashtb type mark marks
- to-article to-reads to-marks article)
+ to-article to-reads to-marks article
+ act-articles)
(gnus-message 7 "Translating %s..." group)
(when (gnus-request-group group nil to-server)
(setq to-active (gnus-parse-active)
- hashtb (gnus-make-hashtable 1024))
+ hashtb (gnus-make-hashtable 1024)
+ act-articles (gnus-uncompress-range to-active))
;; Fetch the headers from the `to-server'.
(when (and to-active
+ act-articles
(setq type (gnus-retrieve-headers
- (gnus-uncompress-range to-active)
+ act-articles
group to-server)))
;; Convert HEAD headers. I don't care.
(when (eq type 'headers)
;; into the Gnus info format.
(setq to-reads
(gnus-range-add
- (gnus-compress-sequence (sort to-reads '<) t)
+ (gnus-compress-sequence (and to-reads (sort to-reads '<)) t)
(cons 1 (1- (car to-active)))))
(gnus-info-set-read info to-reads)
;; Do the marks. I'm sure y'all understand what's
(cons article (cdr a)))))
(setq a lists)
(while a
- (setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<)))
+ (setcdr (car a) (gnus-compress-sequence
+ (and (cdar a) (sort (cdar a) '<))))
(pop a))
(gnus-info-set-marks info lists t)))))
(gnus-message 7 "Translating %s...done" group)))
;; Dummy to avoid byte-compile warning.
(defvar nnspool-rejected-article-hook)
+(defvar xemacs-codename)
;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
;;; as well include the Emacs version as well.
(substring emacs-version
(match-beginning 3)
(match-end 3))
- "")))
+ "")
+ (if (boundp 'xemacs-codename)
+ (concat " - \"" xemacs-codename "\""))))
(t emacs-version))))
;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
(message-goto-subject)
(re-search-forward " *$")
(replace-match " (crosspost notification)" t t)
+ (when (fboundp 'deactivate-mark)
+ (deactivate-mark))
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit)))))))
:type '(repeat (string :tag "Group")))
(defcustom gnus-nocem-issuers
- '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm]
- "rbraver@ohww.norman.ok.us" ; Robert Braver
- "clewis@ferret.ocunix.on.ca;" ; Chris Lewis
- "jem@xpat.com;" ; Despammer from Korea
- "snowhare@xmission.com" ; Benjamin "Snowhare" Franz
- "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM!
- )
+ '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm]
+ "rbraver@ohww.norman.ok.us" ; Robert Braver
+ "clewis@ferret.ocunix.on.ca" ; Chris Lewis
+ "jem@xpat.com" ; Despammer from Korea
+ "snowhare@xmission.com" ; Benjamin "Snowhare" Franz
+ "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM!
+ )
"List of NoCeM issuers to pay attention to."
:group 'gnus-nocem
:type '(repeat string))
(defun gnus-nocem-cache-file ()
(concat (file-name-as-directory gnus-nocem-directory) "cache"))
+;;
+;; faster lookups for group names:
+;;
+
+(defvar gnus-nocem-real-group-hashtb nil
+ "Real-name mappings of subscribed groups.")
+
+(defun gnus-fill-real-hashtb ()
+ "Fill up a hash table with the real-name mappings from the user's
+active file."
+ (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable
+ (length gnus-newsrc-alist)))
+ (mapcar (lambda (group)
+ (setq group (gnus-group-real-name (car group)))
+ (gnus-sethash group t gnus-nocem-real-group-hashtb))
+ gnus-newsrc-alist))
+
(defun gnus-nocem-scan-groups ()
"Scan all NoCeM groups for new NoCeM messages."
(interactive)
(gnus-make-directory gnus-nocem-directory)
;; Load any previous NoCeM headers.
(gnus-nocem-load-cache)
+ ;; Get the group name mappings:
+ (gnus-fill-real-hashtb)
;; Read the active file if it hasn't been read yet.
(and (file-exists-p (gnus-nocem-active-file))
(not gnus-nocem-active)
(narrow-to-region b e)
(setq issuer (mail-fetch-field "issuer"))
(widen)
+ (or (member issuer gnus-nocem-issuers)
+ (message "invalid NoCeM issuer: %s" issuer))
(and (member issuer gnus-nocem-issuers) ; We like her....
(gnus-nocem-verify-issuer issuer) ; She is who she says she is...
(gnus-nocem-enter-article) ; We gobble the message..
(defun gnus-nocem-verify-issuer (person)
"Verify using PGP that the canceler is who she says she is."
(if (fboundp gnus-nocem-verifyer)
- (funcall gnus-nocem-verifyer)
+ (ignore-errors
+ (funcall gnus-nocem-verifyer))
;; If we don't have Mailcrypt, then we use the message anyway.
t))
;; Make sure all entries in the hashtb are bound.
(set group nil))
(t
- (when (gnus-gethash (symbol-name group) gnus-newsrc-hashtb)
+ (when (gnus-gethash (gnus-group-real-name (symbol-name group))
+ gnus-nocem-real-group-hashtb)
;; Valid group.
(beginning-of-line)
(while (= (following-char) ?\t)
gnus-nocem-hashtb nil
gnus-nocem-active nil
gnus-nocem-touched-alist nil
- gnus-nocem-seen-message-ids nil))
+ gnus-nocem-seen-message-ids nil
+ gnus-nocem-real-group-hashtb nil))
(defun gnus-nocem-unwanted-article-p (id)
"Say whether article ID in the current group is wanted."
(setcar ranges (cons (car ranges)
(cadr ranges)))
(setcdr ranges (cddr ranges)))
- (when (= (1+ (car ranges)) (car (cadr ranges)))
+ (when (= (1+ (car ranges)) (caadr ranges))
(setcar (cadr ranges) (car ranges))
(setcar ranges (cadr ranges))
(setcdr ranges (cddr ranges)))))
(when (= (1+ (cdar ranges)) (cadr ranges))
(setcdr (car ranges) (cadr ranges))
(setcdr ranges (cddr ranges)))
- (when (= (1+ (cdar ranges)) (car (cadr ranges)))
- (setcdr (car ranges) (cdr (cadr ranges)))
+ (when (= (1+ (cdar ranges)) (caadr ranges))
+ (setcdr (car ranges) (cdadr ranges))
(setcdr ranges (cddr ranges))))))
(setq ranges (cdr ranges)))
out)))
(defvar gnus-pick-mode nil
"Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
-(defvar gnus-pick-display-summary nil
- "*Display summary while reading.")
-
-(defvar gnus-pick-mode-hook nil
- "Hook run in summary pick mode buffers.")
-
-(defvar gnus-mark-unpicked-articles-as-read nil
- "*If non-nil, mark all unpicked articles as read.")
-
-(defvar gnus-pick-elegant-flow t
- "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked.")
-
-(defvar gnus-summary-pick-line-format
+(defcustom gnus-pick-display-summary nil
+ "*Display summary while reading."
+ :type 'boolean
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-pick-mode-hook nil
+ "Hook run in summary pick mode buffers."
+ :type 'hook
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-mark-unpicked-articles-as-read nil
+ "*If non-nil, mark all unpicked articles as read."
+ :type 'boolean
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-pick-elegant-flow t
+ "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked."
+ :type 'boolean
+ :group 'gnus-summary-pick)
+
+(defcustom gnus-summary-pick-line-format
"%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
"*The format specification of the lines in pick buffers.
-It accepts the same format specs that `gnus-summary-line-format' does.")
+It accepts the same format specs that `gnus-summary-line-format' does."
+ :type 'string
+ :group 'gnus-summary-pick)
;;; Internal variables.
;; Set up the menu.
(when (gnus-visual-p 'pick-menu 'menu)
(gnus-pick-make-menu-bar))
- (unless (assq 'gnus-pick-mode minor-mode-alist)
- (push '(gnus-pick-mode " Pick") minor-mode-alist))
- (unless (assq 'gnus-pick-mode minor-mode-map-alist)
- (push (cons 'gnus-pick-mode gnus-pick-mode-map)
- minor-mode-map-alist))
+ (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map)
(run-hooks 'gnus-pick-mode-hook))))
(defun gnus-pick-setup-message ()
(if gnus-pick-elegant-flow
(progn
(when (or catch-up gnus-mark-unpicked-articles-as-read)
- (gnus-summary-limit-mark-excluded-as-read))
+ (gnus-summary-catchup nil t))
(if (gnus-group-quit-config gnus-newsgroup-name)
(gnus-summary-exit)
(gnus-summary-next-group)))
;; Set up the menu.
(when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar))
- (unless (assq 'gnus-binary-mode minor-mode-alist)
- (push '(gnus-binary-mode " Binary") minor-mode-alist))
- (unless (assq 'gnus-binary-mode minor-mode-map-alist)
- (push (cons 'gnus-binary-mode gnus-binary-mode-map)
- minor-mode-map-alist))
+ (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map)
(run-hooks 'gnus-binary-mode-hook))))
(defun gnus-binary-display-article (article &optional all-header)
;;; gnus-tree-mode
;;;
-(defvar gnus-tree-line-format "%(%[%3,3n%]%)"
- "Format of tree elements.")
+(defcustom gnus-tree-line-format "%(%[%3,3n%]%)"
+ "Format of tree elements."
+ :type 'string
+ :group 'gnus-summary-tree)
-(defvar gnus-tree-minimize-window t
+(defcustom gnus-tree-minimize-window t
"If non-nil, minimize the tree buffer window.
If a number, never let the tree buffer grow taller than that number of
-lines.")
+lines."
+ :type 'boolean
+ :group 'gnus-summary-tree)
-(defvar gnus-selected-tree-face 'modeline
- "*Face used for highlighting selected articles in the thread tree.")
+(defcustom gnus-selected-tree-face 'modeline
+ "*Face used for highlighting selected articles in the thread tree."
+ :type 'face
+ :group 'gnus-summary-tree)
(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
(?\{ . ?\}) (?< . ?>))
(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
"Characters used to connect parents with children.")
-(defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
- "*The format specification for the tree mode line.")
+(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z"
+ "*The format specification for the tree mode line."
+ :type 'string
+ :group 'gnus-summary-tree)
-(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree
+(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree
"*Function for generating a thread tree.
Two predefined functions are available:
-`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.")
+`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'."
+ :type '(radio (function-item gnus-generate-vertical-tree)
+ (function-item gnus-generate-horizontal-tree)
+ (function :tag "Other" nil))
+ :group 'gnus-summary-tree)
-(defvar gnus-tree-mode-hook nil
- "*Hook run in tree mode buffers.")
+(defcustom gnus-tree-mode-hook nil
+ "*Hook run in tree mode buffers."
+ :type 'hook
+ :group 'gnus-summary-tree)
;;; Internal variables.
"\r" gnus-tree-select-article
gnus-mouse-2 gnus-tree-pick-article
"\C-?" gnus-tree-read-summary-keys
+ "h" gnus-tree-show-summary
"\C-c\C-i" gnus-info-find-node)
(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
(gnus-tree-minimize))))
+(defun gnus-tree-show-summary ()
+ "Reconfigure windows to show summary buffer."
+ (interactive)
+ (if (not (gnus-buffer-live-p gnus-summary-buffer))
+ (error "There is no summary buffer for this tree buffer")
+ (gnus-configure-windows 'article)
+ (gnus-summary-goto-subject gnus-current-article)))
+
(defun gnus-tree-select-article (article)
"Select the article under point, if any."
(interactive (list (gnus-tree-article-number)))
"Generate a horizontal tree."
(let* ((dummy (stringp (car thread)))
(do (or dummy
- (memq (mail-header-number (car thread)) gnus-tmp-limit)))
+ (and (car thread)
+ (memq (mail-header-number (car thread))
+ gnus-tmp-limit))))
col beg)
(if (not do)
;; We don't want this article.
(delete-char -1)
(insert (cadr gnus-tree-parent-child-edges))
(setq beg (point))
+ (forward-char -1)
;; Draw "-" lines leftwards.
- (while (progn
- (unless (bolp)
- (forward-char -2))
- (= (following-char) ? ))
- (delete-char 1)
- (insert (car gnus-tree-parent-child-edges)))
+ (while (= (char-after (1- (point))) ? )
+ (delete-char -1)
+ (insert (car gnus-tree-parent-child-edges))
+ (forward-char -1))
(goto-char beg)
(gnus-tree-forward-line 1)))
(setq dummyp nil)
\\{gnus-carpal-mode-map}"
(interactive)
(kill-all-local-variables)
- (setq mode-line-modified "-- ")
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
(setq major-mode 'gnus-carpal-mode)
(setq mode-name "Gnus Carpal")
(setq mode-line-process nil)
-;;; gnus-score.el --- scoring code for Gnus
+1;;; gnus-score.el --- scoring code for Gnus
;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-range)
+(require 'message)
(defcustom gnus-global-score-files nil
"List of global score files and directories.
(gnus-score-kill-help-buffer)
(unless (setq entry (assq (downcase hchar) char-to-header))
- (if mimic (error "%c %c" prefix hchar) (error "")))
+ (if mimic (error "%c %c" prefix hchar)
+ (error "Illegal header type")))
(when (/= (downcase hchar) hchar)
;; This was a majuscule, so we end reading and set the defaults.
(setq tchar (or tchar ?s)
pchar (or pchar ?t)))
- ;; We continue reading - the type.
- (while (not tchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c-" prefix hchar))
- (message "%s header '%s' with match type (%s?): "
- (if increase "Increase" "Lower")
- (nth 1 entry)
- (mapconcat (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- (char-to-string (car s))
- ""))
- char-to-type "")))
- (setq tchar (read-char))
- (when (or (= tchar ??) (= tchar ?\C-h))
- (setq tchar nil)
- (gnus-score-insert-help
- "Match type"
- (delq nil
- (mapcar (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- s nil))
- char-to-type))
- 2)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
- (if mimic (error "%c %c" prefix hchar) (error "")))
+ (let ((legal-types
+ (delq nil
+ (mapcar (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ s nil))
+ char-to-type))))
+ ;; We continue reading - the type.
+ (while (not tchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c-" prefix hchar))
+ (message "%s header '%s' with match type (%s?): "
+ (if increase "Increase" "Lower")
+ (nth 1 entry)
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ legal-types "")))
+ (setq tchar (read-char))
+ (when (or (= tchar ??) (= tchar ?\C-h))
+ (setq tchar nil)
+ (gnus-score-insert-help "Match type" legal-types 2)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
+ (if mimic (error "%c %c" prefix hchar)
+ (error "Illegal match type"))))
(when (/= (downcase tchar) tchar)
;; It was a majuscule, so we end reading and use the default.
(error "You rang?"))
(if mimic
(error "%c %c %c %c" prefix hchar tchar pchar)
- (error ""))))
+ (error "Illegal match duration"))))
;; Always kill the score help buffer.
(gnus-score-kill-help-buffer))
(gnus-make-directory (file-name-directory file))
(setq gnus-score-edit-buffer (find-file-noselect file))
(gnus-configure-windows 'edit-score)
+ (select-window (get-buffer-window gnus-score-edit-buffer))
(gnus-score-mode)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
(make-local-variable 'gnus-prev-winconf)
(decay (car (gnus-score-get 'decay alist)))
(eval (car (gnus-score-get 'eval alist))))
;; Perform possible decays.
- (when (and gnus-decay-scores
- (gnus-decay-scores
- alist (or decay (gnus-time-to-day (current-time)))))
- (gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
+ (when gnus-decay-scores
+ (when (or (not decay)
+ (gnus-decay-scores alist decay))
+ (gnus-score-set 'touched '(t) alist)
+ (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))))
;; We do not respect eval and files atoms from global score
;; files.
(and files (not global)
(erase-buffer)
(let (emacs-lisp-mode-hook)
(if (string-match
- (concat (regexp-quote gnus-adaptive-file-suffix)
- "$")
+ (concat (regexp-quote gnus-adaptive-file-suffix) "$")
file)
;; This is an adaptive score file, so we do not run
;; it through `pp'. These files can get huge, and
(save-excursion
(set-buffer (get-buffer-create "*Headers*"))
(buffer-disable-undo (current-buffer))
+ (message-clone-locals gnus-summary-buffer)
;; Set the global variant of this variable.
(setq gnus-current-score-file current-score-file)
(gnus-add-current-to-buffer-list)
(while trace
(insert (format "%S -> %s\n" (cdar trace)
- (file-name-nondirectory (caar trace))))
+ (if (caar trace)
+ (file-name-nondirectory (caar trace))
+ "(non-file rule)")))
(setq trace (cdr trace)))
(goto-char (point-min))
(gnus-configure-windows 'score-trace)))
(if (looking-at "not.")
(progn
(setq not-match t)
- (setq regexp (concat "^" (buffer-substring 5 (point-max)))))
- (setq regexp (concat "^" (buffer-substring 1 (point-max))))
+ (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$")))
+ (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
(setq not-match nil))
;; Finally - if this resulting regexp matches the group name,
;; we add this score file to the list of score files
;;;
(defun gnus-decay-score (score)
- "Decay SCORE."
+ "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
(floor
(- score
- (* (if (< score 0) 1 -1)
- (min score
+ (* (if (< score 0) -1 1)
+ (min (abs score)
(max gnus-score-decay-constant
(* (abs score)
gnus-score-decay-scale)))))))
(while (setq kill (pop entry))
(when (nth 2 kill)
(setq updated t)
- (setq score (or (car kill) gnus-score-interactive-default-score)
+ (setq score (or (nth 1 kill)
+ gnus-score-interactive-default-score)
n times)
(while (natnump (decf n))
(setq score (funcall gnus-decay-score-function score)))
- (setcar kill score))))))
+ (setcdr kill (cons score
+ (cdr (cdr kill)))))))))
;; Return whether this score file needs to be saved. By Je-haysuss!
updated))
(call-process shell-file-name nil nil nil shell-command-switch
(concat "cd " dir " ; rm " files))
(gnus-message 4 "Packing...done" packer))
- (error "Couldn't pack packet."))))
+ (error "Couldn't pack packet"))))
(defun gnus-soup-parse-areas (file)
"Parse soup area file FILE.
(goto-char (point-min))
(while (not (eobp))
(unless (looking-at "#! *rnews +\\([0-9]+\\)")
- (error "Bad header."))
+ (error "Bad header"))
(forward-line 1)
(setq beg (point)
end (+ (point) (string-to-int
"n" gnus-browse-next-group
"p" gnus-browse-prev-group
"\177" gnus-browse-prev-group
+ [delete] gnus-browse-prev-group
"N" gnus-browse-next-group
"P" gnus-browse-prev-group
"\M-n" gnus-browse-next-group
(cond
((not (gnus-check-server method))
(gnus-message
- 1 "Unable to contact server: %s" (gnus-status-message method))
+ 1 "Unable to contact server %s: %s" (nth 1 method)
+ (gnus-status-message method))
nil)
((not
(prog2
"(Un)subscribe to the next ARG groups."
(interactive "p")
(when (eobp)
- (error "No group at current line."))
+ (error "No group at current line"))
(let ((ward (if (< arg 0) -1 1))
(arg (abs arg)))
(while (and (> arg 0)
;; If this group it killed, then we want to subscribe it.
(when (= (following-char) ?K)
(setq sub t))
- (setq group (gnus-browse-group-name))
+ (when (gnus-gethash (setq group (gnus-browse-group-name))
+ gnus-newsrc-hashtb)
+ (error "Group already subscribed"))
;; Make sure the group has been properly removed before we
;; subscribe to it.
(gnus-kill-ephemeral-group group)
'request-regenerate (car (gnus-server-to-method server))))
(error "This backend doesn't support regeneration")
(gnus-message 5 "Requesting regeneration of %s..." server)
+ (unless (gnus-open-server server)
+ (error "Couldn't open server"))
(if (gnus-request-regenerate server)
(gnus-message 5 "Requesting regeneration of %s...done" server)
(gnus-message 5 "Couldn't regenerate %s" server)))))
:group 'gnus-dribble-file
:type '(choice directory (const nil)))
-(defcustom gnus-check-new-newsgroups t
+(defcustom gnus-check-new-newsgroups 'ask-server
"*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
This normally finds new newsgroups by comparing the active groups the
servers have already reported with those Gnus already knows, either alive
:group 'gnus-start-server
:type 'boolean)
-(defcustom gnus-read-active-file t
+(defcustom gnus-read-active-file 'some
"*Non-nil means that Gnus will read the entire active file at startup.
If this variable is nil, Gnus will only know about the groups in your
`.newsrc' file.
(gnus-splash)
(gnus-clear-system)
(nnheader-init-server-buffer)
- (gnus-read-init-file)
(setq gnus-slave slave)
+ (gnus-read-init-file)
(when (and (string-match "XEmacs" (emacs-version))
gnus-simple-splash)
"Unload all Gnus features."
(interactive)
(unless (boundp 'load-history)
- (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
+ (error "Sorry, `gnus-unload' is not implemented in this Emacs version"))
(let ((history load-history)
feature)
(while history
;; Set the file modes to reflect the .newsrc file modes.
(save-buffer)
(when (and (file-exists-p gnus-current-startup-file)
+ (file-exists-p dribble-file)
(setq modes (file-modes gnus-current-startup-file)))
(set-file-modes dribble-file modes))
;; Possibly eval the file later.
;; done in `gnus-get-unread-articles'.
(and gnus-read-active-file
(not level)
- (gnus-read-active-file))
+ (gnus-read-active-file nil dont-connect))
(unless gnus-active-hashtb
(setq gnus-active-hashtb (gnus-make-hashtable 4096)))
;; See whether we need to read the description file.
(when (and (boundp 'gnus-group-line-format)
- (string-match "%[-,0-9]*D" gnus-group-line-format)
+ (let ((case-fold-search nil))
+ (string-match "%[-,0-9]*D" gnus-group-line-format))
(not gnus-description-hashtb)
(not dont-connect)
gnus-read-active-file)
"Search for new newsgroups and add them.
Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
The `-n' option line from .newsrc is respected.
-If ARG (the prefix), use the `ask-server' method to query
-the server for new groups."
+If ARG (the prefix), use the `ask-server' method to query the server
+for new groups."
(interactive "P")
(let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
(null gnus-read-active-file)
nil
(gnus-message 6 "First time user; subscribing you to default groups")
(unless (gnus-read-active-file-p)
- (gnus-read-active-file))
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
(setq gnus-newsrc-last-checked-date (current-time-string))
(let ((groups gnus-default-subscribed-newsgroups)
group)
(format
"(gnus-group-set-info '%S)" info)))))
(when gnus-group-change-level-function
- (funcall gnus-group-change-level-function group level oldlevel)))))
+ (funcall gnus-group-change-level-function
+ group level oldlevel previous)))))
(defun gnus-kill-newsgroup (newsgroup)
"Obsolete function. Kills a newsgroup."
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (and cache-active
- (< (car cache-active) (car active))
- (setcar active (car cache-active)))
- (and cache-active
- (> (cdr cache-active) (cdr active))
- (setcdr active (cdr cache-active)))))))
+ (when cache-active
+ (when (< (car cache-active) (car active))
+ (setcar active (car cache-active)))
+ (when (> (cdr cache-active) (cdr active))
+ (setcdr active (cdr cache-active))))))))
(defun gnus-activate-group (group &optional scan dont-check method)
;; Check whether a group has been activated or not.
(inline (gnus-request-group group dont-check method))
(error nil)
(quit nil))
- (gnus-set-active group (setq active (gnus-parse-active)))
- ;; Return the new active info.
- active)))
+ (setq active (gnus-parse-active))
+ ;; If there are no articles in the group, the GROUP
+ ;; command may have responded with the `(0 . 0)'. We
+ ;; ignore this if we already have an active entry
+ ;; for the group.
+ (if (and (zerop (car active))
+ (zerop (cdr active))
+ (gnus-active group))
+ (gnus-active group)
+ (gnus-set-active group active)
+ ;; Return the new active info.
+ active))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
(gnus-dribble-touch))
;; Get the active file(s) from the backend(s).
-(defun gnus-read-active-file (&optional force)
+(defun gnus-read-active-file (&optional force not-native)
(gnus-group-set-mode-line)
(let ((methods
(append
- (if (gnus-check-server gnus-select-method)
+ (if (and (not not-native)
+ (gnus-check-server gnus-select-method))
;; The native server is available.
(cons gnus-select-method gnus-secondary-select-methods)
;; The native server is down, so we just do the
(t
(if (not (gnus-request-list method))
(unless (equal method gnus-message-archive-method)
- (gnus-error 1 "Cannot read active file from %s server."
+ (gnus-error 1 "Cannot read active file from %s server"
(car method)))
(gnus-message 5 mesg)
(gnus-active-to-gnus-format method gnus-active-hashtb)
(gnus-make-hashtable
(count-lines (point-min) (point-max)))
(gnus-make-hashtable 4096)))))))
- ;; Delete unnecessary lines, cleaned up dmoore@ucsd.edu 31.10.1996
+ ;; Delete unnecessary lines.
(goto-char (point-min))
(cond ((gnus-ignored-newsgroups-has-to-p)
(delete-matching-lines gnus-ignored-newsgroups))
;; Make the group names readable as a lisp expression even if they
;; contain special characters.
- ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
(goto-char (point-max))
(while (re-search-backward "[][';?()#]" nil t)
(insert ?\\))
;; If these are groups from a foreign select method, we insert the
;; group prefix in front of the group names.
- (and method (not (gnus-server-equal
- (gnus-server-get-method nil method)
- (gnus-server-get-method nil gnus-select-method)))
- (let ((prefix (gnus-group-prefixed-name "" method)))
- (goto-char (point-min))
- (while (and (not (eobp))
- (progn (insert prefix)
- (zerop (forward-line 1)))))))
+ (when (not (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method nil gnus-select-method)))
+ (let ((prefix (gnus-group-prefixed-name "" method)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
;; Store the active file in a hash table.
(goto-char (point-min))
(let (group max min)
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
- (let ((print-quoted t))
+ (let ((print-quoted t)
+ (print-escape-newlines t))
(insert ";; -*- emacs-lisp -*-\n")
(insert ";; Gnus startup file.\n")
(insert
:type 'function)
(defcustom gnus-parse-headers-hook
- (list 'gnus-decode-rfc1522)
+ (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
"*A hook called before parsing the headers."
:group 'gnus-various
:type 'hook)
"j" gnus-summary-goto-article
"g" gnus-summary-goto-subject
"l" gnus-summary-goto-last-article
- "p" gnus-summary-pop-article)
+ "o" gnus-summary-pop-article)
(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
"k" gnus-summary-kill-thread
(defmacro gnus-summary-article-sparse-p (article)
"Say whether this article is a sparse article or not."
- ` (memq ,article gnus-newsgroup-sparse))
+ `(memq ,article gnus-newsgroup-sparse))
(defmacro gnus-summary-article-ancient-p (article)
"Say whether this article is a sparse article or not."
"Return the headers of the GENERATIONeth parent of HEADERS."
(unless generation
(setq generation 1))
- (let (references parent)
- (while (and headers (not (zerop generation)))
+ (let ((parent t)
+ references)
+ (while (and parent headers (not (zerop generation)))
(setq references (mail-header-references headers))
(when (and references
(setq parent (gnus-parent-id references))
(set var (delq article (symbol-value var))))))
;; Adjust assocs.
((memq mark uncompressed)
+ (when (not (listp (cdr (symbol-value var))))
+ (set var (list (symbol-value var))))
+ (when (not (listp (cdr articles)))
+ (setq articles (list articles)))
(while articles
(when (or (not (consp (setq article (pop articles))))
(< (car article) min)
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
+ (if (numberp (setq lines (ignore-errors (read cur))))
lines 0)
0))
;; Xref.
(not non-destructive))
(setq gnus-newsgroup-scored nil))
;; Set the new ranges of read articles.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-force-boundary))
(gnus-update-read-articles
group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
;; Set the current article marks.
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(mode major-mode)
+ (group-point nil)
(buf (current-buffer)))
(run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(run-hooks 'gnus-summary-exit-hook)
(unless quit-config
(gnus-group-next-unread-group 1))
+ (setq group-point (point))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
;; Clear the current group name.
(if (not quit-config)
(progn
- (gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
+ (goto-char group-point)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
(unless quit-config
(suppress-keymap gnus-dead-summary-mode-map)
(substitute-key-definition
'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (let ((keys '("\C-d" "\r" "\177")))
+ (let ((keys '("\C-d" "\r" "\177" [delete])))
(while keys
(define-key gnus-dead-summary-mode-map
(pop keys) 'gnus-summary-wake-up-the-dead))))
(if (null arg) (not gnus-dead-summary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-dead-summary-mode
- (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
- (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
- (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
- (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
- minor-mode-map-alist)))))
+ (gnus-add-minor-mode
+ 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
(defun gnus-deaden-summary ()
"Make the current summary buffer into a dead summary buffer."
(when current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
- gnus-group-faq-directory)))))
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(when (setq gnus-faq-buffer
(gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
(gnus-summary-read-group
- target-group nil no-article current-buffer))
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
did)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
- (error "This is a pseudo-article."))
+ (error "This is a pseudo-article"))
(prog1
(save-excursion
(set-buffer gnus-summary-buffer)
'<)
(sort gnus-newsgroup-limit '<)))
article)
- (setq gnus-newsgroup-unreads nil)
+ (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
(mail-header-number (car thread))))
(progn
(if (<= (length (cdr thread)) 1)
- (setq thread (cadr thread))
+ (setq gnus-newsgroup-limit
+ (delq (mail-header-number (car thread))
+ gnus-newsgroup-limit)
+ thread (cadr thread))
(when (gnus-invisible-cut-children (cdr thread))
(let ((th (cdr thread)))
(while th
gnus-newsgroup-limit)
(setq thread (car th)
th nil)
- (setq th (cdr th)))))))))
- ))
+ (setq th (cdr th)))))))))))
thread)
(defun gnus-cut-threads (threads)
(gnus-nocem-unwanted-article-p
(mail-header-id (car thread))))
(progn
- (setq gnus-newsgroup-reads
+ (setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
t))))
;; Nope, invisible article.
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
(gnus-summary-article-sparse-p
- (mail-header-number header)))))
- (if header
+ (mail-header-number header))
+ (memq (mail-header-number header)
+ gnus-newsgroup-limit))))
+ (if (and header
+ (or (not (gnus-summary-article-sparse-p
+ (mail-header-number header)))
+ sparse))
(prog1
- ;; The article is present in the buffer, to we just go to it.
+ ;; The article is present in the buffer, so we just go to it.
(gnus-summary-goto-article
- (mail-header-number header) nil header)
+ (mail-header-number header) nil t)
(when sparse
(gnus-summary-update-article (mail-header-number header))))
;; We fetch the article
"Search for an article containing REGEXP.
Optional argument BACKWARD means do search for backward.
`gnus-select-article-hook' is not called during the search."
+ ;; We have to require this here to make sure that the following
+ ;; dynamic binding isn't shadowed by autoloading.
+ (require 'gnus-async)
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
+ (gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
(found nil)
point)
(cond
;; Move the article.
((eq action 'move)
+ ;; Remove this article from future suppression.
+ (gnus-dup-unsuppress-article article)
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
(save-excursion
(set-buffer gnus-group-buffer)
(when (gnus-group-goto-group (car to-groups) t)
- (gnus-group-get-new-news-this-group 1))
+ (gnus-group-get-new-news-this-group 1 t))
(pop to-groups)))
(gnus-kill-buffer copy-buf)
(gnus-set-global-variables)
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
- (error "The current newsgroup does not support article deletion."))
+ (error "The current newsgroup does not support article deletion"))
;; Compute the list of articles to delete.
(let ((articles (gnus-summary-work-articles n))
not-deleted)
(gnus-set-global-variables)
(when (and (not force)
(gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
;; Select article if needed.
(unless (eq (gnus-summary-article-number)
gnus-current-article)
(gnus-summary-select-article t))
+ (gnus-article-date-original)
(gnus-article-edit-article
`(lambda ()
(gnus-summary-edit-article-done
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
(current-buffer))))
- (error "Couldn't replace article.")
+ (error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(setq scored (cdr scored)))
(if (not headers)
(when (not no-error)
- (error "No expunged articles hidden."))
+ (error "No expunged articles hidden"))
(goto-char (point-min))
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(if (and not-mark
(not gnus-newsgroup-adaptive)
(not gnus-newsgroup-auto-expire)
- (not gnus-suppress-duplicates))
+ (not gnus-suppress-duplicates)
+ (or (not gnus-use-cache)
+ (not (eq gnus-use-cache 'passive))))
(progn
(when all
(setq gnus-newsgroup-marked nil
is non-nil or the Subject: of both articles are the same."
(interactive)
(unless (not (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
(unless (<= (length gnus-newsgroup-processable) 1)
- (error "No more than one article may be marked."))
+ (error "No more than one article may be marked"))
(save-window-excursion
(let ((gnus-article-buffer " *reparent*")
(current-article (gnus-summary-article-number))
(save-excursion
(if (eq (forward-line -1) 0)
(gnus-summary-article-number)
- (error "Beginning of summary buffer."))))))
+ (error "Beginning of summary buffer"))))))
(unless (not (eq current-article parent-article))
- (error "An article may not be self-referential."))
+ (error "An article may not be self-referential"))
(let ((message-id (mail-header-id
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
- (error "No message-id in desired parent."))
+ (error "No message-id in desired parent"))
(gnus-summary-select-article t t nil current-article)
(set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
(unless (gnus-request-replace-article
current-article (car gnus-article-current)
(current-buffer))
- (error "Couldn't replace article."))))
+ (error "Couldn't replace article"))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-rethread-current)
- (gnus-message 3 "Article %d is now the child of article %d."
+ (gnus-message 3 "Article %d is now the child of article %d"
current-article parent-article)))))
(defun gnus-summary-toggle-threads (&optional arg)
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(setq buffer-read-only nil)
- (let ((command (if automatic command (read-string "Command: " command))))
+ (let ((command (if automatic command
+ (read-string "Command: " (cons command 0)))))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
(lambda (buf) (switch-to-buffer buf) (gnus-summary-exit))
buffers)))))
+(gnus-ems-redefine)
+
(provide 'gnus-sum)
(run-hooks 'gnus-sum-load-hook)
(defvar gnus-topic-killed-topics nil)
(defvar gnus-topic-inhibit-change-level nil)
-(defvar gnus-topic-tallied-groups nil)
(defconst gnus-topic-line-format-alist
`((?n name ?s)
(let ((buffer-read-only nil)
(lowest (or lowest 1)))
- (setq gnus-topic-tallied-groups nil)
-
(when (or (not gnus-topic-alist)
(not gnus-topology-checked-p))
(gnus-topic-check-topology))
(gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))))
(when (and (listp entry)
- (numberp (car entry))
- (not (member (gnus-info-group (setq info (nth 2 entry)))
- gnus-topic-tallied-groups)))
- (push (gnus-info-group info) gnus-topic-tallied-groups)
+ (numberp (car entry)))
(incf unread (car entry)))
(when (listp entry)
(setq tick t)))
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec)
- (gnus-topic-remove-excess-properties)1)
+ (eval gnus-topic-line-format-spec))
(list 'gnus-topic (intern name)
'gnus-topic-level level
'gnus-topic-unread unread
(when (and (eq major-mode 'gnus-group-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
+ (m (point-marker))
(buffer-read-only nil))
(when (and group
(gnus-get-info group)
(gnus-topic-goto-topic (gnus-current-topic)))
(gnus-topic-update-topic-line (gnus-group-topic-name))
- (gnus-group-goto-group group)
+ (goto-char m)
+ (set-marker m nil)
(gnus-group-position-point)))))
(defun gnus-topic-goto-missing-group (group)
(setq gnus-topic-active-topology nil
gnus-topic-active-alist nil
gnus-topic-killed-topics nil
- gnus-topic-tallied-groups nil
gnus-topology-checked-p nil))
(defun gnus-topic-check-topology ()
;; they belong to some topic.
(let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
gnus-topic-alist)))
- (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
+ (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
(newsrc (cdr gnus-newsrc-alist))
group)
(while newsrc
(unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
- (setcdr entry (cons group (cdr entry))))))
+ (setcdr entry (list group))
+ (setq entry (cdr entry)))))
;; Go through all topics and make sure they contain only living groups.
(let ((alist gnus-topic-alist)
topic)
(while (setq topic (pop alist))
(while (cdr topic)
- (if (gnus-gethash (cadr topic) gnus-newsrc-hashtb)
+ (if (and (cadr topic)
+ (gnus-gethash (cadr topic) gnus-newsrc-hashtb))
(setq topic (cdr topic))
(setcdr topic (cddr topic)))))))
(push (cons topic-name (nreverse filtered-topic)) result)))
(setq gnus-topic-alist (nreverse result))))
-(defun gnus-topic-change-level (group level oldlevel)
+(defun gnus-topic-change-level (group level oldlevel &optional previous)
"Run when changing levels to enter/remove groups from topics."
(save-excursion
(set-buffer gnus-group-buffer)
+ (gnus-group-goto-group (or (car (nth 2 previous)) group))
(when (and gnus-topic-mode
gnus-topic-alist
(not gnus-topic-inhibit-change-level))
"\C-i" gnus-topic-indent
[tab] gnus-topic-indent
"r" gnus-topic-rename
- "\177" gnus-topic-delete)
+ "\177" gnus-topic-delete
+ [delete] gnus-topic-delete
+ "h" gnus-topic-toggle-display-empty-topics)
(gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
"s" gnus-topic-sort-groups
["Rename" gnus-topic-rename t]
["Create" gnus-topic-create-topic t]
["Mark" gnus-topic-mark-topic t]
- ["Indent" gnus-topic-indent t])
+ ["Indent" gnus-topic-indent t]
+ ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t]
+ ["Edit parameters" gnus-topic-edit-parameters t])
["List active" gnus-topic-list-active t]))))
(defun gnus-topic-mode (&optional arg redisplay)
(if (null arg) (not gnus-topic-mode)
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
- (when gnus-topic-mode
+ (if (not gnus-topic-mode)
+ (setq gnus-goto-missing-group-function nil)
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(setq gnus-topic-line-format-spec
(gnus-parse-format gnus-topic-line-format
gnus-topic-line-format-alist t))
- (unless (assq 'gnus-topic-mode minor-mode-alist)
- (push '(gnus-topic-mode " Topic") minor-mode-alist))
- (unless (assq 'gnus-topic-mode minor-mode-map-alist)
- (push (cons 'gnus-topic-mode gnus-topic-mode-map)
- minor-mode-map-alist))
+ (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
(add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
(set (make-local-variable 'gnus-group-prepare-function)
(gnus-group-read-group all no-article group)))
(defun gnus-topic-create-topic (topic parent &optional previous full-topic)
+ "Create a new TOPIC under PARENT.
+When used interactively, PARENT will be the topic under point."
(interactive
(list
(read-string "New topic: ")
;; Remove from alist.
(setq gnus-topic-alist (delq entry gnus-topic-alist))
;; Remove from topology.
- (gnus-topic-find-topology topic nil nil 'delete)))
+ (gnus-topic-find-topology topic nil nil 'delete)
+ (gnus-dribble-touch)))
(defun gnus-topic-rename (old-name new-name)
"Rename a topic."
gnus-killed-list gnus-zombie-list)
(gnus-group-list-groups 9 nil 1)))
+(defun gnus-topic-toggle-display-empty-topics ()
+ "Show/hide topics that have no unread articles."
+ (interactive)
+ (setq gnus-topic-display-empty-topics
+ (not gnus-topic-display-empty-topics))
+ (gnus-group-list-groups)
+ (message "%s empty topics"
+ (if gnus-topic-display-empty-topics
+ "Showing" "Hiding")))
+
;;; Topic sorting functions
(defun gnus-topic-edit-parameters (group)
(if group
(gnus-group-edit-group-parameters group)
(if (not (gnus-group-topic-p))
- (error "Nothing to edit on the current line.")
+ (error "Nothing to edit on the current line")
(let ((topic (gnus-group-topic-name)))
(gnus-edit-form
(gnus-topic-parameters topic)
"\M-\C-_" gnus-undo
"\C-_" gnus-undo
"\C-xu" gnus-undo
- [(control /)] gnus-undo ; many people are used to type `C-/' on
- ; X terminals and get `C-_'.
- ))
+ ;; many people are used to type `C-/' on X terminals and get `C-_'.
+ [(control /)] gnus-undo))
(defun gnus-undo-make-menu-bar ()
+ ;; This is disabled for the time being.
(when nil
- (define-key-after (current-local-map) [menu-bar file gnus-undo]
- (cons "Undo" 'gnus-undo-actions)
- [menu-bar file whatever])))
+ (define-key-after (current-local-map) [menu-bar file gnus-undo]
+ (cons "Undo" 'gnus-undo-actions)
+ [menu-bar file whatever])))
(defun gnus-undo-mode (&optional arg)
"Minor mode for providing `undo' in Gnus buffers.
;; Set up the menu.
(when (gnus-visual-p 'undo-menu 'menu)
(gnus-undo-make-menu-bar))
- ;; Don't display anything in the mode line -- too annoying.
- ;;(unless (assq 'gnus-undo-mode minor-mode-alist)
- ;; (push '(gnus-undo-mode " Undo") minor-mode-alist))
- (unless (assq 'gnus-undo-mode minor-mode-map-alist)
- (push (cons 'gnus-undo-mode gnus-undo-mode-map)
- minor-mode-map-alist))
+ (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
(make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'gnus-undo-boundary nil t)
- (add-hook 'gnus-summary-exit-hook 'gnus-undo-boundary)
(run-hooks 'gnus-undo-mode-hook)))
;;; Interface functions.
(setq gnus-undo-boundary-inhibit nil)
(setq gnus-undo-boundary t)))
+(defun gnus-undo-force-boundary ()
+ "Set Gnus undo boundary."
+ (setq gnus-undo-boundary-inhibit nil
+ gnus-undo-boundary t))
+
(defun gnus-undo-register (form)
"Register FORMS as something to be performed to undo a change.
FORMS may use backtick quote syntax."
(date (mapcar (lambda (d) (and d (string-to-int d))) parse))
(time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
(encode-time (caddr time) (cadr time) (car time)
- (caddr date) (cadr date) (car date) (nth 4 date))))
+ (caddr date) (cadr date) (car date)
+ (* 60 (timezone-zone-to-minute (nth 4 date))))))
(defun gnus-time-minus (t1 t2)
"Subtract two internal times."
(unless gnus-xemacs
(let* ((overlayss (overlay-lists))
(buffer-read-only nil)
- (overlays (nconc (car overlayss) (cdr overlayss))))
+ (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
(while overlays
(delete-overlay (pop overlays))))))
(if (not (looking-at gnus-uu-begin-string))
(setq state (list 'middle))
- ;; This is the beginning of an uuencoded article.
+ ;; This is the beginning of a uuencoded article.
;; We replace certain characters that could make things messy.
(setq gnus-uu-file-name
(let ((nnheader-file-name-translation-alist
This may not be smart, as no other decoder I have seen are able to
follow threads when collecting uuencoded articles. (Well, I have seen
one package that does that - gnus-uu, but somehow, I don't think that
-counts...) Default is nil."
+counts...) The default is nil."
:group 'gnus-extract-post
:type 'boolean)
(setq file-name gnus-uu-post-inserted-file-name)
(setq file-name (gnus-uu-post-insert-binary)))
- (if gnus-uu-post-threaded
- (let ((message-required-news-headers
- (if (memq 'Message-ID message-required-news-headers)
- message-required-news-headers
- (cons 'Message-ID message-required-news-headers)))
- gnus-inews-article-hook)
-
- (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
- gnus-inews-article-hook
- (list gnus-inews-article-hook)))
- (push
- '(lambda ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
- (setq gnus-uu-post-message-id
- (buffer-substring
- (match-beginning 1) (match-end 1)))
- (setq gnus-uu-post-message-id nil))))
- gnus-inews-article-hook)
- (gnus-uu-post-encoded file-name t))
- (gnus-uu-post-encoded file-name nil)))
+ (gnus-uu-post-encoded file-name gnus-uu-post-threaded))
(setq gnus-uu-post-inserted-file-name nil)
(when gnus-uu-winconf-post-news
(set-window-configuration gnus-uu-winconf-post-news)))
(goto-char (point-min))
(setq length (count-lines 1 (point-max)))
(setq parts (/ length gnus-uu-post-length))
- (when (not (< (% length gnus-uu-post-length) 4))
- (setq parts (1+ parts))))
+ (unless (< (% length gnus-uu-post-length) 4)
+ (incf parts)))
(when gnus-uu-post-separate-description
(forward-line -1))
- (kill-region (point) (point-max))
+ (delete-region (point) (point-max))
(goto-char (point-min))
(re-search-forward
(setq header (buffer-substring 1 (point)))
(goto-char (point-min))
- (if (not gnus-uu-post-separate-description)
- ()
- (when (and (not threaded) (re-search-forward "^Subject: " nil t))
+ (when gnus-uu-post-separate-description
+ (when (re-search-forward "^Subject: " nil t)
(end-of-line)
(insert (format " (0/%d)" parts)))
- (message-send))
+ (save-excursion
+ (message-send))
+ (setq gnus-uu-post-message-id (message-fetch-field "message-id")))
(save-excursion
(setq i 1)
(erase-buffer)
(insert header)
(when (and threaded gnus-uu-post-message-id)
- (insert (format "References: %s\n" gnus-uu-post-message-id)))
+ (insert "References: " gnus-uu-post-message-id "\n"))
(insert separator)
(setq whole-len
(- 62 (length (format top-string "" file-name i parts ""))))
(if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
(goto-char (point-min))
- (if (not (re-search-forward "^Subject: " nil t))
- ()
- (if (not threaded)
- (progn
- (end-of-line)
- (insert (format " (%d/%d)" i parts)))
- (when (or (and (= i 2) gnus-uu-post-separate-description)
- (and (= i 1) (not gnus-uu-post-separate-description)))
- (replace-match "Subject: Re: "))))
+ (when (re-search-forward "^Subject: " nil t)
+ (end-of-line)
+ (insert (format " (%d/%d)" i parts)))
(goto-char (point-max))
(save-excursion
(forward-line -4))
(setq end (point)))
(insert-buffer-substring uubuf beg end)
- (insert beg-line)
- (insert "\n")
+ (insert beg-line "\n")
(setq beg end)
- (setq i (1+ i))
+ (incf i)
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(insert beg-line)
(insert "\n")
(let (message-sent-message-via)
- (message-send))))
+ (save-excursion
+ (message-send))
+ (setq gnus-uu-post-message-id
+ (concat (message-fetch-field "references") " "
+ (message-fetch-field "message-id"))))))
- (when (setq buf (get-buffer send-buffer-name))
- (kill-buffer buf))
- (when (setq buf (get-buffer encoded-buffer-name))
- (kill-buffer buf))
+ (gnus-kill-buffer send-buffer-name)
+ (gnus-kill-buffer encoded-buffer-name)
(when (not gnus-uu-post-separate-description)
(set-buffer-modified-p nil)
(faq . gnus-faq-buffer)
(picons . "*Picons*")
(tree . gnus-tree-buffer)
+ (score-trace . "*Score Trace*")
(info . gnus-info-buffer)
(article-copy . gnus-article-copy)
(draft . gnus-draft-buffer))
:link '(custom-manual "(gnus)Various Summary Stuff")
:group 'gnus-summary)
+(defgroup gnus-summary-pick nil
+ "Pick mode in the summary buffer."
+ :link '(custom-manual "(gnus)Pick and Read")
+ :prefix "gnus-pick-"
+ :group 'gnus-summary)
+
+(defgroup gnus-summary-tree nil
+ "Tree display of threads in the summary buffer."
+ :link '(custom-manual "(gnus)Tree Display")
+ :prefix "gnus-tree-"
+ :group 'gnus-summary)
+
;; Belongs to gnus-uu.el
(defgroup gnus-extract-view nil
"Viewing extracted files."
(defalias 'gnus-extent-start-open 'ignore)
(defalias 'gnus-set-text-properties 'set-text-properties)
(defalias 'gnus-group-remove-excess-properties 'ignore)
- (defalias 'gnus-topic-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'identity)
(save-excursion
(save-restriction
(narrow-to-region start end)
- (indent-rigidly start end arg)
- ;; We translate tabs into spaces -- not everybody uses
- ;; an 8-character tab.
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t)))))
+ (let ((tab-width 8))
+ (indent-rigidly start end arg)
+ ;; We translate tabs into spaces -- not everybody uses
+ ;; an 8-character tab.
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t))))))
(defvar gnus-simple-splash nil)
(when (and gnus-default-nntp-server
(not (string= gnus-default-nntp-server "")))
gnus-default-nntp-server)
- (system-name)))
+ "news"))
(if (or (null gnus-nntp-service)
(equal gnus-nntp-service "nntp"))
nil
gnus-article-fill-cited-article
gnus-article-remove-cr
gnus-article-de-quoted-unreadable
- gnus-article-display-x-face
gnus-summary-stop-page-breaking
;; gnus-summary-caesar-message
;; gnus-summary-verbose-headers
gnus-article-strip-leading-blank-lines
gnus-article-strip-multiple-blank-lines
gnus-article-strip-blank-lines
- gnus-article-treat-overstrike))
+ gnus-article-treat-overstrike
+ gnus-article-display-x-face
+ gnus-smiley-display))
(defcustom gnus-article-save-directory gnus-directory
"*Name of the directory articles will be saved in (default \"~/News\")."
gnus-article-next-page gnus-article-prev-page
gnus-request-article-this-buffer gnus-article-mode
gnus-article-setup-buffer gnus-narrow-to-page
- gnus-article-delete-invisible-text)
+ gnus-article-delete-invisible-text gnus-hack-decode-rfc1522)
("gnus-art" :interactive t
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike gnus-article-word-wrap
;;; Gnus Utility Functions
;;;
+(defmacro gnus-string-or (&rest strings)
+ "Return the first element of STRINGS that is a non-blank string.
+STRINGS will be evaluated in normal `or' order."
+ `(gnus-string-or-1 ',strings))
+
+(defun gnus-string-or-1 (strings)
+ (let (string)
+ (while strings
+ (setq string (eval (pop strings)))
+ (if (string-match "^[ \t]*$" string)
+ (setq string nil)
+ (setq strings nil)))
+ string))
+
;; Add the current buffer to the list of buffers to be killed on exit.
(defun gnus-add-current-to-buffer-list ()
(or (memq (current-buffer) gnus-buffer-list)
(string-match gnus-total-expirable-newsgroups group)))))
(defun gnus-group-auto-expirable-p (group)
- "Check whether GROUP is total-expirable or not."
+ "Check whether GROUP is auto-expirable or not."
(let ((params (gnus-group-find-parameter group))
val)
(cond
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
- (setq mode-line-modified "-- ")
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
(when (listp mode-line-format)
(make-local-variable 'mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
"If non-nil, delete the deletable headers before feeding to mh.")
+(defvar message-send-method-alist
+ '((news message-news-p message-send-via-news)
+ (mail message-mail-p message-send-via-mail))
+ "Alist of ways to send outgoing messages.
+Each element has the form
+
+ \(TYPE PREDICATE FUNCTION)
+
+where TYPE is a symbol that names the method; PREDICATE is a function
+called without any parameters to determine whether the message is
+a message of type TYPE; and FUNCTION is a function to be called if
+PREDICATE returns non-nil. FUNCTION is called with one parameter --
+the prefix.")
+
+(defvar message-mail-alias-type 'abbrev
+ "*What alias expansion type to use in Message buffers.
+The default is `abbrev', which uses mailabbrev. nil switches
+mail aliases off.")
+
;;; Internal variables.
;;; Well, not really internal.
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-"))
(content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
- `((,(concat "^\\(To:\\)" content)
+ `((,(concat "^\\([Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
- (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content)
+ (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-cc-face nil t))
- (,(concat "^\\(Subject:\\)" content)
+ (,(concat "^\\([Ss]ubject:\\)" content)
(1 'message-header-name-face)
(2 'message-header-subject-face nil t))
- (,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content)
+ (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-newsgroups-face nil t))
- (,(concat "^\\([^: \n\t]+:\\)" content)
+ (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
(1 'message-header-name-face)
(2 'message-header-other-face nil t))
(,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
- (if (fboundp 'mail-abbrevs-setup)
- (mail-abbrevs-setup)
- (funcall (intern "mail-aliases-setup")))
+ (when (eq message-mail-alias-type 'abbrev)
+ (if (fboundp 'mail-abbrevs-setup)
+ (mail-abbrevs-setup)
+ (funcall (intern "mail-aliases-setup"))))
(run-hooks 'text-mode-hook 'message-mode-hook))
\f
\f
-(defun message-insert-to ()
- "Insert a To header that points to the author of the article being replied to."
- (interactive)
+(defun message-insert-to (&optional force)
+ "Insert a To header that points to the author of the article being replied to.
+If the original author requested not to be sent mail, the function signals
+an error.
+With the prefix argument FORCE, insert the header anyway."
+ (interactive "P")
(let ((co (message-fetch-reply-field "mail-copies-to")))
- (when (and co
+ (when (and (null force)
+ co
(equal (downcase co) "never"))
(error "The user has requested not to have copies sent via mail")))
(when (and (message-position-on-field "To")
(message-fix-before-sending)
(run-hooks 'message-send-hook)
(message "Sending...")
- (when (and (or (not (message-news-p))
- (and (or (not (memq 'news message-sent-message-via))
- (y-or-n-p
- "Already sent message via news; resend? "))
- (funcall message-send-news-function arg)))
- (or (not (message-mail-p))
- (and (or (not (memq 'mail message-sent-message-via))
- (y-or-n-p
- "Already sent message via mail; resend? "))
- (message-send-mail arg))))
- (message-do-fcc)
- ;;(when (fboundp 'mail-hist-put-headers-into-history)
- ;; (mail-hist-put-headers-into-history))
- (run-hooks 'message-sent-hook)
- (message "Sending...done")
- ;; If buffer has no file, mark it as unmodified and delete autosave.
- (unless buffer-file-name
- (set-buffer-modified-p nil)
- (delete-auto-save-file-if-necessary t))
- ;; Delete other mail buffers and stuff.
- (message-do-send-housekeeping)
- (message-do-actions message-send-actions)
- ;; Return success.
- t)))
+ (let ((alist message-send-method-alist)
+ (success t)
+ elem sent)
+ (while (and success
+ (setq elem (pop alist)))
+ (when (and (or (not (funcall (cadr elem)))
+ (and (or (not (memq (car elem)
+ message-sent-message-via))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem))))
+ (setq success (funcall (caddr elem) arg)))))
+ (setq sent t)))
+ (when (and success sent)
+ (message-do-fcc)
+ ;;(when (fboundp 'mail-hist-put-headers-into-history)
+ ;; (mail-hist-put-headers-into-history))
+ (run-hooks 'message-sent-hook)
+ (message "Sending...done")
+ ;; If buffer has no file, mark it as unmodified and delete autosave.
+ (unless buffer-file-name
+ (set-buffer-modified-p nil)
+ (delete-auto-save-file-if-necessary t))
+ ;; Delete other mail buffers and stuff.
+ (message-do-send-housekeeping)
+ (message-do-actions message-send-actions)
+ ;; Return success.
+ t))))
+
+(defun message-send-via-mail (arg)
+ "Send the current message via mail."
+ (message-send-mail arg))
+
+(defun message-send-via-news (arg)
+ "Send the current message via news."
+ (funcall message-send-news-function arg))
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
;; qmail-inject doesn't say anything on it's stdout/stderr,
;; we have to look at the retval instead
(0 nil)
- (1 (error "qmail-inject reported permanent failure."))
- (111 (error "qmail-inject reported transient failure."))
+ (1 (error "qmail-inject reported permanent failure"))
+ (111 (error "qmail-inject reported transient failure"))
;; should never happen
- (t (error "qmail-inject reported unknown failure."))))
+ (t (error "qmail-inject reported unknown failure"))))
(defun message-send-mail-with-mh ()
"Send the prepared message buffer with mh."
(funcall (intern (format "%s-open-server" (car method)))
(cadr method) (cddr method))
(setq result
- (funcall (intern (format "%s-request-post" (car method))))))
+ (funcall (intern (format "%s-request-post" (car method)))
+ (cadr method))))
(kill-buffer tembuf))
(set-buffer messbuf)
(if result
(y-or-n-p
(format "The %s header looks odd: \"%s\". Really post? "
(car headers) header)))))
+ (message-check 'repeated-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error groups group)
+ (while (and headers
+ (not error))
+ (when (setq header (mail-fetch-field (pop headers)))
+ (setq groups (message-tokenize-header header ","))
+ (while (setq group (pop groups))
+ (when (member group groups)
+ (setq error group
+ groups nil)))))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "Group %s is repeated in headers. Really post? " error)))))
;; Check the From header.
(message-check 'from
(let* ((case-fold-search t)
(concat "^" (regexp-quote mail-header-separator) "$"))
(while (not (eobp))
(when (not (looking-at "[ \t\n]"))
- (setq sum (logxor (ash sum 1) (following-char))))
+ (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+ (following-char))))
(forward-char 1)))
sum))
(defun message-make-message-id ()
"Make a unique Message-ID."
(concat "<" (message-unique-id)
- (let ((psubject (save-excursion (message-fetch-field "subject"))))
- (if (and message-reply-headers
- (mail-header-references message-reply-headers)
- (mail-header-subject message-reply-headers)
- psubject
- (mail-header-subject message-reply-headers)
- (not (string=
- (message-strip-subject-re
- (mail-header-subject message-reply-headers))
- (message-strip-subject-re psubject))))
+ (let ((psubject (save-excursion (message-fetch-field "subject")))
+ (psupersedes
+ (save-excursion (message-fetch-field "supersedes"))))
+ (if (or
+ (and message-reply-headers
+ (mail-header-references message-reply-headers)
+ (mail-header-subject message-reply-headers)
+ psubject
+ (mail-header-subject message-reply-headers)
+ (not (string=
+ (message-strip-subject-re
+ (mail-header-subject message-reply-headers))
+ (message-strip-subject-re psubject))))
+ (and psupersedes
+ (string-match "_-_@" psupersedes)))
"_-_" ""))
"@" (message-make-fqdn) ">"))
(let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
(concat (if stop-pos (substring from 0 stop-pos) from)
- "'s message of "
+ "'s message of \""
(if (or (not date) (string= date ""))
- "(unknown date)" date)))))))
+ "(unknown date)" date)
+ "\""))))))
(defun message-make-distribution ()
"Make a Distribution header."
header value elem)
;; First we remove any old generated headers.
(let ((headers message-deletable-headers))
+ (unless (buffer-modified-p)
+ (setq headers (delq 'Message-ID (copy-sequence headers))))
(while headers
(goto-char (point-min))
(and (re-search-forward
(message-narrow-to-headers)
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)
(run-hooks 'message-setup-hook)
(message-position-point)
(undo-boundary))
(let ((name (make-temp-name
(expand-file-name
(concat (file-name-as-directory message-autosave-directory)
- "msg.")))))
+ "msg."
+ (nnheader-replace-chars-in-string
+ (nnheader-replace-chars-in-string
+ (buffer-name) ?* ?.)
+ ?/ ?-))))))
(setq buffer-auto-save-file-name
(save-excursion
(prog1
mail-header-separator "\n"
message-cancel-message)
(message "Canceling your article...")
- (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function))
- (message "Canceling your article...done")
+ (if (let ((message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
+ (message "Canceling your article...done"))
(kill-buffer buf)))))
;;;###autoload
(insert string)
(if (not comp)
(message "No matching groups")
- (pop-to-buffer "*Completions*")
- (buffer-disable-undo (current-buffer))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
- (goto-char (point-min))
- (pop-to-buffer cur)))))))
+ (save-selected-window
+ (pop-to-buffer "*Completions*")
+ (buffer-disable-undo (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (display-completion-list (sort completions 'string<)))
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 3) (point))))))))))
;;; Help stuff.
Then clone the local variables and values from the old buffer to the
new one, cloning only the locals having a substring matching the
regexp varstr."
- (let ((oldlocals (buffer-local-variables)))
+ (let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
- (mapcar (lambda (dude)
- (when (and (car dude)
- (or (not varstr)
- (string-match varstr (symbol-name (car dude)))))
- (ignore-errors
- (set (make-local-variable (car dude))
- (cdr dude)))))
- oldlocals)
+ (message-clone-locals oldbuf)
(current-buffer))))
+(defun message-clone-locals (buffer)
+ "Clone the local variables from BUFFER to the current buffer."
+ (let ((locals (save-excursion
+ (set-buffer buffer)
+ (buffer-local-variables)))
+ (regexp "^gnus\\|^nn\\|^message"))
+ (mapcar
+ (lambda (local)
+ (when (and (car local)
+ (string-match regexp (symbol-name (car local))))
+ (ignore-errors
+ (set (make-local-variable (car local))
+ (cdr local)))))
+ locals)))
+
(run-hooks 'message-load-hook)
(provide 'message)
(when group
(unless (assoc group nnfolder-group-alist)
(push (list group (cons 1 0)) nnfolder-group-alist)
- (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
+ (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
+ (nnfolder-read-folder group)))
t)
(deffoo nnfolder-request-list (&optional server)
(kill-buffer (current-buffer))
t))))
+(defun nnfolder-request-regenerate (server)
+ (nnfolder-possibly-change-group nil server)
+ (nnfolder-generate-active-file)
+ t)
+
\f
;;; Internal functions.
;; Change group.
(when (and group
(not (equal group nnfolder-current-group)))
- ;; 1997/8/14 by MORIOKA Tomohiko
- ;; for XEmacs/mule.
(let ((pathname-coding-system 'binary))
(nnmail-activate 'nnfolder)
(when (and (not (assoc group nnfolder-group-alist))
;; The group doesn't exist, so we create a new entry for it.
(push (list group (cons 1 0)) nnfolder-group-alist)
(nnmail-save-active nnfolder-group-alist nnfolder-active-file))
-
+
(if dont-check
- (setq nnfolder-current-group group)
+ (setq nnfolder-current-group group
+ nnfolder-current-buffer nil)
(let (inf file)
;; If we have to change groups, see if we don't already have the
;; folder in memory. If we do, verify the modtime and destroy
;; the folder if needed so we can rescan it.
- (when (setq inf (assoc group nnfolder-buffer-alist))
- (setq nnfolder-current-buffer (nth 1 inf)))
-
+ (setq nnfolder-current-buffer
+ (nth 1 (assoc group nnfolder-buffer-alist)))
+
;; If the buffer is not live, make sure it isn't in the alist. If it
;; is live, verify that nobody else has touched the file since last
;; time.
(not (gnus-buffer-live-p nnfolder-current-buffer)))
(setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
nnfolder-current-buffer nil))
-
+
(setq nnfolder-current-group group)
-
+
(when (or (not nnfolder-current-buffer)
(not (verify-visited-file-modtime nnfolder-current-buffer)))
(save-excursion
(defun nnfolder-group-pathname (group)
"Make pathname for GROUP."
- ;; 1997/8/14 by MORIOKA Tomohiko
- ;; encode file name for Emacs 20.
- (setq group (encode-coding-string group nnmail-pathname-coding-system))
+ (setq group (gnus-encode-coding-string group nnmail-pathname-coding-system))
(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
"Save the buffer."
(when (buffer-modified-p)
(run-hooks 'nnfolder-save-buffer-hook)
+ (gnus-make-directory (file-name-directory (buffer-file-name)))
(save-buffer)))
(provide 'nnfolder)
(insert-buffer-substring buf)
(message-narrow-to-head)
(funcall nngateway-header-transformation nngateway-address)
+ (goto-char (point-max))
+ (insert mail-header-separator "\n")
(widen)
(let (message-required-mail-headers)
- (message-send-mail))))))
+ (funcall message-send-mail-function))))))
;;; Internal functions
(concat dir group "/")
;; If not, we translate dots into slashes.
(concat dir
- ;; 1997/8/10 by MORIOKA Tomohiko
- ;; encode file name for Emacs 20.
- (encode-coding-string
+ (gnus-encode-coding-string
(nnheader-replace-chars-in-string group ?. ?/)
nnheader-pathname-coding-system)
"/")))
(nnkiboze-possibly-change-group group)
(when force
(let ((files (list (nnkiboze-nov-file-name)
- (concat nnkiboze-directory group ".newsrc")
+ (concat nnkiboze-directory
+ (nnheader-translate-file-chars
+ (concat group ".newsrc")))
(nnkiboze-score-file group))))
(while files
(and (file-exists-p (car files))
(defun nnkiboze-generate-group (group)
(let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
- (newsrc-file (concat nnkiboze-directory group ".newsrc"))
- (nov-file (concat nnkiboze-directory group ".nov"))
+ (newsrc-file (concat nnkiboze-directory
+ (nnheader-translate-file-chars
+ (concat group ".newsrc"))))
+ (nov-file (concat nnkiboze-directory
+ (nnheader-translate-file-chars
+ (concat group ".nov"))))
method nnkiboze-newsrc gname newsrc active
ginfo lowest glevel orig-info nov-buffer
;; Bind various things to nil to make group entry faster.
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
(defcustom nnmail-keep-last-article nil
- "If non-nil, nnmail will never delete the last expired article in a directory.
+ "If non-nil, nnmail will never delete/move a group's last article.
+It can be marked expirable, so it will be deleted when it is no longer last.
+
You may need to set this variable if other programs are putting
new mail into folder numbers that Gnus has marked as expired."
:group 'nnmail-procmail
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
(mail . "mailer-daemon\\|postmaster\\|uucp")
(to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
- (from . "from\\|sender\\|resent-from"))
+ (from . "from\\|sender\\|resent-from")
+ (nato . "to\\|cc\\|resent-to\\|resent-cc")
+ (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
"Alist of abbreviations allowed in `nnmail-split-fancy'."
:group 'nnmail-split
:type '(repeat (cons :format "%v" symbol regexp)))
(concat dir group "/")
;; If not, we translate dots into slashes.
(concat dir
- ;; 1997/8/10 by MORIOKA Tomohiko
- ;; encode file name for Emacs 20.
- (encode-coding-string
+ (gnus-encode-coding-string
(nnheader-replace-chars-in-string group ?. ?/)
nnmail-pathname-coding-system)
"/")))
(defun nnmail-move-inbox (inbox)
"Move INBOX to `nnmail-crash-box'."
(if (not (file-writable-p nnmail-crash-box))
- (gnus-error 1 "Can't write to crash box %s. Not moving mail."
+ (gnus-error 1 "Can't write to crash box %s. Not moving mail"
nnmail-crash-box)
;; If the crash box exists and is empty, we delete it.
(when (and (file-exists-p nnmail-crash-box)
(zerop (nnheader-file-size (file-truename nnmail-crash-box))))
(delete-file nnmail-crash-box))
- (let ((inbox (file-truename (expand-file-name inbox)))
- (tofile (file-truename (expand-file-name nnmail-crash-box)))
- movemail popmail errors result)
- (if (setq popmail (string-match
- "^po:" (file-name-nondirectory inbox)))
- (setq inbox (file-name-nondirectory inbox))
+ (let ((tofile (file-truename (expand-file-name nnmail-crash-box)))
+ (popmail (string-match "^po:" inbox))
+ movemail errors result)
+ (unless popmail
+ (setq inbox (file-truename (expand-file-name inbox)))
(setq movemail t)
;; On some systems, /usr/spool/mail/foo is a directory
;; and the actual inbox is /usr/spool/mail/foo/foo.
(nnmail-read-passwd
(format "Password for %s: "
(substring inbox (+ popmail 3))))))
- (message "Getting mail from post office ..."))
+ (message "Getting mail from the post office..."))
(when (or (and (file-exists-p tofile)
(/= 0 (nnheader-file-size tofile)))
(and (file-exists-p inbox)
(= (following-char) ?\n)))
(save-excursion
(forward-line 1)
- (while (looking-at ">From ")
+ (while (looking-at ">From \\|From ")
(forward-line 1))
(looking-at "[^ \n\t:]+[ \n\t]*:")))
(setq found 'yes)))))
(= (following-char) ?\n)))
(save-excursion
(forward-line 1)
- (while (looking-at ">From ")
+ (while (looking-at ">From \\|From ")
(forward-line 1))
(looking-at "[^ \n\t:]+[ \n\t]*:")))
(setq found 'yes)))))
(fboundp nnmail-split-methods))
(let ((split
(condition-case nil
+ ;; `nnmail-split-methods' is a function, so we
+ ;; just call this function here and use the
+ ;; result.
(or (funcall nnmail-split-methods)
'("bogus"))
(error
"Error in `nnmail-split-methods'; using `bogus' mail group")
(sit-for 1)
'("bogus")))))
- (unless (equal split '(junk))
- ;; `nnmail-split-methods' is a function, so we just call
- ;; this function here and use the result.
+ ;; The article may be "cross-posted" to `junk'. What
+ ;; to do? Just remove the `junk' spec. Don't really
+ ;; see anything else to do...
+ (let (elem)
+ (while (setq elem (car (memq 'junk split)))
+ (setq split (delq elem split))))
+ (when split
(setq group-art
(mapcar
(lambda (group) (cons group (funcall func group)))
;; See whether the split methods returned `junk'.
(if (equal group-art '(junk))
nil
- (nreverse (delq 'junk group-art)))))))
+ ;; The article may be "cross-posted" to `junk'. What
+ ;; to do? Just remove the `junk' spec. Don't really
+ ;; see anything else to do...
+ (let (elem)
+ (while (setq elem (car (memq 'junk group-art)))
+ (setq group-art (delq elem group-art)))
+ (nreverse group-art)))))))
(defun nnmail-insert-lines ()
"Insert how many lines there are in the body of the mail.
(progn (forward-line 1) (point))))
(insert (format "Xref: %s" (system-name)))
(while group-alist
- ;; 1997/8/10 by MORIOKA Tomohiko
- ;; encode file name for Emacs 20.
(insert (format " %s:%d"
- (encode-coding-string (caar group-alist)
+ (gnus-encode-coding-string (caar group-alist)
nnmail-pathname-coding-system)
(cdar group-alist)))
(setq group-alist (cdr group-alist)))
(deffoo nnmh-request-list (&optional server dir)
(nnheader-insert "")
- (let (;; 1997/8/14 by MORIOKA Tomohiko
- ;; for XEmacs/mule.
- (pathname-coding-system 'binary)
+ (let ((pathname-coding-system 'binary)
(nnmh-toplev
- (or dir (file-truename (file-name-as-directory nnmh-directory)))))
+ (file-truename (or dir (file-name-as-directory nnmh-directory)))))
(nnmh-request-list-1 nnmh-toplev))
(setq nnmh-group-alist (nnmail-get-active))
t)
(nnoo-declare nnml)
(defvoo nnml-directory message-directory
- "Mail spool directory.")
+ "Spool directory for the nnml mail backend.")
(defvoo nnml-active-file
(concat (file-name-as-directory nnml-directory) "active")
(defun nnml-article-to-file (article)
(nnml-update-file-alist)
(let (file)
- (when (setq file (cdr (assq article nnml-article-file-alist)))
- (concat nnml-current-directory file))))
+ (if (setq file (cdr (assq article nnml-article-file-alist)))
+ (concat nnml-current-directory file)
+ ;; Just to make sure nothing went wrong when reading over NFS --
+ ;; check once more.
+ (when (file-exists-p
+ (setq file (concat nnml-current-directory "/"
+ (number-to-string article))))
+ (nnml-update-file-alist t)
+ file))))
(defun nnml-deletable-article-p (group article)
"Say whether ARTICLE in GROUP can be deleted."
(search-forward "\n\n" nil t)
(setq chars (- (point-max) (point)))
(max 1 (1- (point)))))
- (when (and (not (= 0 chars)) ; none of them empty files...
- (not (= (point-min) (point-max))))
+ (unless (zerop (buffer-size))
(goto-char (point-min))
(setq headers (nnml-parse-head chars (caar files)))
(save-excursion
(setf (car active) num)))))))
t))
-(defun nnml-update-file-alist ()
- (unless nnml-article-file-alist
+(defun nnml-update-file-alist (&optional force)
+ (when (or (not nnml-article-file-alist)
+ force)
(setq nnml-article-file-alist
(nnheader-article-to-file-alist nnml-current-directory))))
(def (assq backend nnoo-definition-alist))
(parents (nth 1 def)))
(unless def
- (error "%s belongs to a backend that hasn't been declared." var))
+ (error "%s belongs to a backend that hasn't been declared" var))
(setcar (nthcdr 2 def)
(delq (assq var (nth 2 def)) (nth 2 def)))
(setcar (nthcdr 2 def)
(deffoo nnsoup-request-type (group &optional article)
(nnsoup-possibly-change-group group)
- ;; Try to guess the type based on the first articl ein the group.
+ ;; Try to guess the type based on the first article in the group.
(when (not article)
(setq article
(cdaar (cddr (assoc group nnsoup-group-alist)))))
(nnsoup-write-replies)
;; Check whether there is anything here.
(when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
- (error "No files to pack."))
+ (error "No files to pack"))
;; Pack all these files into a SOUP packet.
(gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
Two pre-made functions are `nntp-open-network-stream', which is the
default, and simply connects to some port or other on the remote
-system (see nntp-port-number). The other are `nntp-open-rlogin', which
-does an rlogin on the remote system, and then does a telnet to the
-NNTP server available there (see nntp-rlogin-parameters) and `nntp-open-telnet' which
-telnets to a remote system, logs in and does the same")
+system (see nntp-port-number). The other are `nntp-open-rlogin',
+which does an rlogin on the remote system, and then does a telnet to
+the NNTP server available there (see nntp-rlogin-parameters) and
+`nntp-open-telnet' which telnets to a remote system, logs in and does
+the same.")
(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
"*Parameters to `nntp-open-login'.
(defvoo nntp-telnet-passwd nil
"Password to use to log in via telnet with.")
+(defvoo nntp-telnet-command "telnet"
+ "Command used to start telnet.")
+
+(defvoo nntp-telnet-switches '("-8")
+ "Switches given to the telnet command.")
+
(defvoo nntp-end-of-line "\r\n"
"String to use on the end of lines when talking to the NNTP server.
This is \"\\r\\n\" by default, but should be \"\\n\" when
none of the commands are successful, nntp will just grab headers one
by one.")
-(defvoo nntp-nov-gap 20
+(defvoo nntp-nov-gap 5
"*Maximum allowed gap between two articles.
If the gap between two consecutive articles is bigger than this
variable, split the XOVER request into two requests.")
(save-excursion
(set-buffer (process-buffer process))
(goto-char (point-min))
- (while (or (not (memq (following-char) '(?2 ?3 ?4 ?5)))
+ (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
(looking-at "480"))
(when (looking-at "480")
(erase-buffer)
(when (nntp-send-command-and-decode
"\r?\n\\.\r?\n" "ARTICLE"
(if (numberp article) (int-to-string article) article))
- (when (and buffer
- (not (equal buffer nntp-server-buffer)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number)))
- (nntp-find-group-and-number)))
+ (if (and buffer
+ (not (equal buffer nntp-server-buffer)))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer buffer (point-min) (point-max))
+ (nntp-find-group-and-number))
+ (nntp-find-group-and-number))))
(deffoo nntp-request-head (article &optional group server)
(nntp-possibly-change-group group server)
- (when (nntp-send-command-and-decode
+ (when (nntp-send-command
"\r?\n\\.\r?\n" "HEAD"
(if (numberp article) (int-to-string article) article))
- (nntp-find-group-and-number)))
+ (prog1
+ (nntp-find-group-and-number)
+ (nntp-decode-text))))
(deffoo nntp-request-body (article &optional group server)
(nntp-possibly-change-group group server)
(save-excursion
(set-buffer buffer)
(erase-buffer)
- (let ((proc (start-process
- "nntpd" buffer "telnet" "-8"))
+ (let ((proc (apply
+ 'start-process
+ "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
(case-fold-search t))
(when (memq (process-status proc) '(open run))
(process-send-string proc "set escape \^X\n")
(insert "Xref: " system-name " " group ":")
(princ article (current-buffer))
+ (insert " ")
;; If there were existing xref lines, clean them up to have the correct
;; component server prefix.
- (let ((xref-end (save-excursion
- (search-forward "\t" (gnus-point-at-eol) 'move)
- (point)))
- (len (length prefix)))
- (unless (= (point) xref-end)
+ (save-restriction
+ (narrow-to-region (point)
+ (or (search-forward "\t" (gnus-point-at-eol) t)
+ (gnus-point-at-eol)))
+ (goto-char (point-min))
+ (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
+ (replace-match "" t t))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat (gnus-group-real-name group) ":[0-9]+")
+ nil t)
+ (replace-match "" t t))
+ (unless (= (point) (point-max))
(insert " ")
(when (not (string= "" prefix))
- (while (re-search-forward "[^ ]+:[0-9]+" xref-end t)
+ (while (re-search-forward "[^ ]+:[0-9]+" nil t)
(save-excursion
(goto-char (match-beginning 0))
- (insert prefix))
- (setq xref-end (+ xref-end len)))
- )))
+ (insert prefix))))))
;; Ensure a trailing \t.
(end-of-line)
(save-excursion
(set-buffer nnweb-buffer)
(erase-buffer)
- (prog1
- (url-insert-file-contents url)
- (copy-to-buffer buf (point-min) (point-max)))))
+ (url-insert-file-contents url)
+ (copy-to-buffer buf (point-min) (point-max))
+ t))
(nnweb-url-retrieve-asynch
url 'nnweb-callback (current-buffer) nnheader-callback-function)
t)))
(goto-char (point-min))
(while (re-search-forward "&\\([a-z]+\\);" nil t)
(replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
- w3-html-entities ))
+ w3-html-entities))
?#))
t t)))
(replace-match "\\1 " t)
(forward-line 1))
(when (re-search-forward "\n\n+" nil t)
- (replace-match "\n" t t))))
+ (replace-match "\n" t t))
+ (goto-char (point-min))
+ (when (search-forward "[More Headers]" nil t)
+ (replace-match "" t t))))
(defun nnweb-dejanews-search (search)
(nnweb-fetch-form
(set-marker body nil))))
(defun nnweb-reference-search (search)
- (prog1
- (url-insert-file-contents
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("search" . "advanced")
- ("querytext" . ,search)
- ("subj" . "")
- ("name" . "")
- ("login" . "")
- ("host" . "")
- ("organization" . "")
- ("groups" . "")
- ("keywords" . "")
- ("choice" . "Search")
- ("startmonth" . "Jul")
- ("startday" . "25")
- ("startyear" . "1996")
- ("endmonth" . "Aug")
- ("endday" . "24")
- ("endyear" . "1996")
- ("mode" . "Quick")
- ("verbosity" . "Verbose")
- ("ranking" . "Relevance")
- ("first" . "1")
- ("last" . "25")
- ("score" . "50")))))
- (setq buffer-file-name nil))
+ (url-insert-file-contents
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("search" . "advanced")
+ ("querytext" . ,search)
+ ("subj" . "")
+ ("name" . "")
+ ("login" . "")
+ ("host" . "")
+ ("organization" . "")
+ ("groups" . "")
+ ("keywords" . "")
+ ("choice" . "Search")
+ ("startmonth" . "Jul")
+ ("startday" . "25")
+ ("startyear" . "1996")
+ ("endmonth" . "Aug")
+ ("endday" . "24")
+ ("endyear" . "1996")
+ ("mode" . "Quick")
+ ("verbosity" . "Verbose")
+ ("ranking" . "Relevance")
+ ("first" . "1")
+ ("last" . "25")
+ ("score" . "50")))))
+ (setq buffer-file-name nil)
t)
;;;
(nnweb-remove-markup)))
(defun nnweb-altavista-search (search &optional part)
- (prog1
- (url-insert-file-contents
- (concat
- (nnweb-definition 'address)
- "?"
- (nnweb-encode-www-form-urlencoded
- `(("pg" . "aq")
- ("what" . "news")
- ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
- ("fmt" . "d")
- ("q" . ,search)
- ("r" . "")
- ("d0" . "")
- ("d1" . "")))))
- (setq buffer-file-name nil)))
+ (url-insert-file-contents
+ (concat
+ (nnweb-definition 'address)
+ "?"
+ (nnweb-encode-www-form-urlencoded
+ `(("pg" . "aq")
+ ("what" . "news")
+ ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
+ ("fmt" . "d")
+ ("q" . ,search)
+ ("r" . "")
+ ("d0" . "")
+ ("d1" . "")))))
+ (setq buffer-file-name nil)
+ t)
(provide 'nnweb)
;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996, Free Software Foundation, Inc.
+;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Keywords: mail, pop3
-;; Version: 1.3e
+;; Version: 1.3g
;; This file is part of GNU Emacs.
(require 'mail-utils)
(provide 'pop3)
-(defconst pop3-version "1.3c")
+(defconst pop3-version "1.3g")
(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
"*POP3 maildrop.")
(set-buffer (process-buffer process))
(goto-char pop3-read-point)
(while (not (search-forward "\r\n" nil t))
- (accept-process-output process)
+ (accept-process-output process 3)
(goto-char pop3-read-point))
(setq match-end (point))
(goto-char pop3-read-point)
(defun pop3-munge-message-separator (start end)
"Check to see if a message separator exists. If not, generate one."
+ (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message"))
(save-excursion
(save-restriction
(narrow-to-region start end)
(looking-at "BABYL OPTIONS:") ; Babyl
))
(let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
- (date (pop3-string-to-list (mail-fetch-field "Date")))
+ (date (pop3-string-to-list (or (mail-fetch-field "Date")
+ (message-make-date))))
(From_))
;; sample date formats I have seen
;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
(save-excursion
(set-buffer (process-buffer process))
(while (not (re-search-forward "^\\.\r\n" nil t))
- (accept-process-output process)
+ (accept-process-output process 3)
;; bill@att.com ... to save wear and tear on the heap
(if (> (buffer-size) 20000) (sleep-for 1))
(if (> (buffer-size) 50000) (sleep-for 1))
projects / emacs.git / commitdiff