+Sun Jan 21 01:59:13 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * gnus.el (gnus-summary-recenter): Recenter horizontally.
+
+Sun Jan 21 01:08:58 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el (gnus-horizontal-recenter): Would infloop.
+ (gnus-cut-threads): Cut off `more' threads.
+
+ * gnus-xmas.el (gnus-xmas-move-overlay): Handle detached extents.
+ (gnus-xmas-make-overlay): New function.
+
+ * gnus-salt.el (gnus-tree-recenter): Search all frames.
+
+ * gnus.el (gnus-all-windows-visible-p): Be `frame' aware.
+
+ * gnus-salt.el (gnus-salt): Provide.
+
+ * gnus-xmas.el (gnus-xmas-tree-minimize): New function.
+
+ * gnus-salt.el (gnus-tree-read-summary-keys): Don't use
+ `overlay-end'.
+
+ * gnus-xmas.el (gnus-xmas-define): Redefine overlay-end.
+
+ * gnus-ems.el (gnus-overlay-end): New alias.
+
+ * gnus-salt.el (gnus-tree-minimize): Don't use
+ `save-selected-window'.
+
+Sat Jan 20 08:40:46 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-uu.el (gnus-uu-grab-articles): Give a better message.
+
+Sat Jan 20 08:19:29 1996 Colin Rafferty <craffert@sps.ml.com>
+
+ * gnus.el (gnus-summary-reparent-thread): New command and
+ keystroke.
+
+Sat Jan 20 04:12:17 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-score.el (gnus-score-kill-help-buffer): New function.
+ (gnus-summary-increase-score): Use the default values.
+
+ * gnus-cache.el (gnus-jog-cache): Make sure Gnus is started.
+ (gnus-jog-cache): New implementation.
+
+ * gnus.el (gnus-unload): Also unload nn*.
+ (gnus-group-mark-region): New command and keystroke.
+
+ * nnmail.el (nnmail-process-babyl-mail-format): Fold case.
+ (nnmail-process-unix-mail-format): Ditto.
+ (nnmail-process-mmdf-mail-format): Ditto.
+
+ * gnus.el (gnus-group-faq-directory): New default.
+
+ * gnus-mh.el (gnus-mh-mail-setup): Use original article buffer.
+
+ * gnus-salt.el (gnus-tree-highlight-article): Move point.
+
+Sat Jan 20 03:32:17 1996 Kai Grossjohann <grossjoh@ls6.informatik.uni-dortmund.de>
+
+ * gnus.el (gnus-summary-find-matching): Typo.
+
+Sat Jan 20 00:54:13 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-build-sparse-threads): Allow `more' as a value.
+ (gnus-request-update-mark): Wrong number of parameters.
+
+ * gnus-vis.el (gnus-article-highlight-signature): Use new function.
+
+ * gnus.el (gnus-group-uncollapsed-levels): New variable.
+ (gnus-short-group-name): Use it.
+ (gnus-narrow-to-signature): New function.
+ (gnus-article-hide-signature): Use it.
+
+ * gnus-msg.el (gnus-inews-insert-archive-gcc): Allow disabling
+ archiving.
+ (gnus-inews-insert-archive-gcc): Allow var to be a function.
+ (gnus-inews-real-user-address): Always use `system-name'.
+
+ * gnus.el (gnus-sort-threads): Would choke when no sorting
+ functions were specified.
+ (gnus-group-sort-groups): Ditto.
+
+ * gnus-cite.el (gnus-dissect-cited-text): New function.
+ (gnus-article-toggle-cited-text): New function.
+ (gnus-cited-text-button-line-format): New variable.
+ (gnus-article-hide-citation): Add buttons.
+ (gnus-cited-lines-visible): New variable.
+
+ * gnus.el (gnus-summary-move-article): Don't allow moving to the
+ current group.
+
+Sat Jan 20 00:50:36 1996 Kai Grossjohann <grossjoh@ls6.informatik.uni-dortmund.de>
+
+ * gnus.el (gnus-summary-move-article): Didn't update marks.
+
+Sat Jan 20 00:16:44 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-request-accept-article): Make sure there's a
+ newline at the end of the article.
+
+ * gnus-soup.el (gnus-soup-parse-areas): Kill buffer after
+ parsing.
+
+Thu Jan 18 11:50:06 1996 Wes Hardaker <hardaker@ece.ucdavis.edu>
+
+ * gnus.el (auto-load): Added gnus-group-display-picons to the
+ gnus-picon auto-load list. Also made the refernce(s) interactive.
+
+Fri Jan 19 04:20:16 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-xmas.el (gnus-xmas-read-event-char): Don't force event keys
+ to be numbers.
+
+Fri Jan 19 04:11:39 1996 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * gnus-srvr.el (gnus-server-position-point): Define.
+
+ * gnus-salt.el (gnus-tree-recenter): Don't use
+ `save-selected-window'.
+
+Thu Jan 18 03:08:40 1996 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * gnus.el: 0.29 is released.
+
Wed Jan 17 17:00:55 1996 Steven L. Baur <steve@miranova.com>
* gnus-msg.el (gnus-inews-domain-name): mail-host-address may not
(gnus-cache-braid-heads group cached)
type)))))
-(defun gnus-cache-enter-article (n)
+(defun gnus-cache-enter-article (&optional n)
"Enter the next N articles into the cache.
If not given a prefix, use the process marked articles instead.
Returns the list of articles entered."
(defun gnus-jog-cache ()
"Go through all groups and put the articles into the cache."
(interactive)
- (let ((newsrc (cdr gnus-newsrc-alist))
- (gnus-cache-enter-articles '(unread))
- (gnus-mark-article-hook nil)
+ (let ((gnus-mark-article-hook nil)
(gnus-expert-user t)
(nnmail-spool-file nil)
(gnus-use-dribble-file nil)
(gnus-novice-user nil)
(gnus-large-newsgroup nil))
- (while newsrc
- (gnus-summary-read-group (car (pop newsrc)) nil t)
- (when (eq major-mode 'gnus-summary-mode)
- (while gnus-newsgroup-unreads
- (gnus-summary-select-article t t nil (pop gnus-newsgroup-unreads)))
- (kill-buffer (current-buffer))))))
+ ;; Start Gnus.
+ (gnus)
+ ;; Go through all groups...
+ (gnus-group-mark-buffer)
+ (gnus-group-universal-argument
+ nil nil
+ (lambda ()
+ (gnus-summary-read-group nil 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."
;;; Customization:
+(defvar gnus-cited-text-button-line-format "%(%{[...]%}%)"
+ "Format of cited text buttons.")
+
+(defvar gnus-cited-lines-visible nil
+ "The number of lines of hidden cited text to remain visible.")
+
(defvar gnus-cite-parse-max-size 25000
"Maximum article size (in bytes) where parsing citations is allowed.
Set it to nil to parse all articles.")
;; PREFIX: Is the citation prefix of the attribution line(s), and
;; TAG: Is a SuperCite tag, if any.
+(defvar gnus-cited-text-button-line-format-alist
+ `((?b beg ?d)
+ (?e end ?d)
+ (?l (- end beg) ?d)))
+(defvar gnus-cited-text-button-line-format-spec nil)
+
;;; Commands:
(defun gnus-article-highlight-citation (&optional force)
skip (gnus-cite-find-prefix number))
(gnus-cite-add-face number skip gnus-cite-attribution-face)))))
-(defun gnus-article-fill-cited-article (&optional force)
- "Do word wrapping in the current article."
- (interactive (list t))
+(defun gnus-dissect-cited-text ()
+ "Dissect the article buffer looking for cited text."
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe force)
- (let ((buffer-read-only nil)
- (alist gnus-cite-prefix-alist)
- (inhibit-point-motion-hooks t)
- prefix numbers number marks
- (adaptive-fill-mode nil))
+ (gnus-cite-parse-maybe)
+ (let ((alist gnus-cite-prefix-alist)
+ prefix numbers number marks)
;; Loop through citation prefixes.
(while alist
(setq numbers (pop alist)
(push (car omarks) marks))
(setq omarks (cdr omarks)))
(push (car omarks) marks)
- (setq marks (nreverse marks)))
+ (nreverse marks)))))
+
+(defun gnus-article-fill-cited-article (&optional force)
+ "Do word wrapping in the current article."
+ (interactive (list t))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (marks (gnus-dissect-cited-text))
+ (adaptive-fill-mode nil))
(save-restriction
(while (cdr marks)
(widen)
(let ((adaptive-fill-regexp (concat "^" (regexp-quote
(cdr (car marks)))
" *"))
- (fill-prefix (cdr (car marks)))
- )
+ (fill-prefix (cdr (car marks))))
(fill-region (point-min) (point-max)))
(set-marker (caar marks) nil)
(setq marks (cdr marks)))
If given a negative prefix, always show; if given a positive prefix,
always hide."
(interactive (list current-prefix-arg 'force))
+ (setq gnus-cited-text-button-line-format-spec
+ (gnus-parse-format gnus-cited-text-button-line-format
+ gnus-cited-text-button-line-format-alist t))
(unless (gnus-article-check-hidden-text 'cite arg)
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
- (alist gnus-cite-prefix-alist)
+ (marks (gnus-dissect-cited-text))
(inhibit-point-motion-hooks t)
(props (nconc (list 'gnus-type 'cite)
gnus-hidden-properties))
- numbers number)
- (while alist
- (setq numbers (cdr (car alist))
- alist (cdr alist))
- (while numbers
- (setq number (car numbers)
- numbers (cdr numbers))
- (goto-line number)
- (or (assq number gnus-cite-attribution-alist)
- (add-text-properties
- (point) (progn (forward-line 1) (point)) props))))))))
+ beg end)
+ (while marks
+ (setq beg nil
+ end nil)
+ (while (and marks (string= (cdar marks) ""))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq beg (caar marks)))
+ (while (and marks (not (string= (cdar marks) "")))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq end (caar marks)))
+ ;; Skip past lines we want to leave visible.
+ (when (and beg gnus-cited-lines-visible)
+ (goto-char beg)
+ (forward-line gnus-cited-lines-visible)
+ (if (> (point) end)
+ (setq beg nil)
+ (setq beg (point))))
+ (when (and beg end)
+ (add-text-properties beg end props)
+ (goto-char beg)
+ (put-text-property beg end 'gnus-type 'cite)
+ (gnus-article-add-button
+ (point)
+ (progn (eval gnus-cited-text-button-line-format-spec) (point))
+ `gnus-article-toggle-cited-text (cons beg end))))))))
+
+(defun gnus-article-toggle-cited-text (region)
+ "Toggle hiding the text in REGION."
+ (funcall
+ (if (text-property-any
+ (car region) (cdr region)
+ (car gnus-hidden-properties) (cadr gnus-hidden-properties))
+ 'remove-text-properties 'add-text-properties)
+ (car region) (cdr region) gnus-hidden-properties))
(defun gnus-article-hide-citation-maybe (&optional arg force)
"Toggle hiding of cited text that has an attribution line.
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-overlay-put 'overlay-put)
(defalias 'gnus-move-overlay 'move-overlay)
+(defalias 'gnus-overlay-end 'overlay-end)
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
'((?: . ?_)
(?+ . ?-))))))))
+(defvar gnus-tmp-unread)
+(defvar gnus-tmp-replied)
+(defvar gnus-tmp-score-char)
+(defvar gnus-tmp-indentation)
+(defvar gnus-tmp-opening-bracket)
+(defvar gnus-tmp-lines)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-closing-bracket)
+(defvar gnus-tmp-subject-or-nil)
+
(defun gnus-ems-redefine ()
(cond
((string-match "XEmacs\\|Lucid" emacs-version)
(save-excursion
(goto-char (point-min))
(insert "In-Reply-To: " in-reply-to "\n")))
- (setq mh-sent-from-folder gnus-article-copy)
+ (setq mh-sent-from-folder gnus-original-article-buffer)
(setq mh-sent-from-msg 1)
(setq gnus-mail-buffer (buffer-name (current-buffer)))
(use-local-map (copy-keymap (current-local-map)))
"Return the \"real\" user address.
This function tries to ignore all user modifications, and
give as trustworthy answer as possible."
- (concat (user-login-name) "@" (gnus-inews-full-address)))
+ (concat (user-login-name) "@" (system-name)))
(defun gnus-inews-login-name ()
"Return login name."
(gnus-summary-select-article)
(gnus-copy-article-buffer)
(if post
- (gnus-forward-using-post gnus-article-copy)
- (gnus-mail-forward gnus-article-copy)))
+ (gnus-forward-using-post gnus-original-article-buffer)
+ (gnus-mail-forward gnus-original-article-buffer)))
(defun gnus-summary-resend-message (address)
"Resend the current article to ADDRESS."
((stringp var)
;; Just a single group.
(list var))
+ ((null var)
+ ;; We don't want this.
+ nil)
((and (listp var) (stringp (car var)))
;; A list of groups.
var)
+ ((gnus-functionp var)
+ ;; A function.
+ (funcall var gnus-newsgroup-name))
(t
;; An alist of regexps/functions/forms.
(while (and var
;;; Code:
(require 'gnus)
+(eval-when-compile (require 'cl))
;;;
;;; gnus-pick-mode
(when (setq win (get-buffer-window buf))
(select-window win)
(when gnus-selected-tree-overlay
- (goto-char (overlay-end gnus-selected-tree-overlay)))
+ (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
(gnus-tree-minimize))))
(defun gnus-tree-select-article (article)
(defun gnus-tree-recenter ()
"Center point in the tree window."
- (when (get-buffer-window (current-buffer))
- (save-selected-window
- (select-window (get-buffer-window (current-buffer)))
+ (let ((selected (selected-window))
+ (cur-window (get-buffer-window (current-buffer) t)))
+ (when cur-window
+ (select-window cur-window)
+ (when gnus-selected-tree-overlay
+ (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
- (t 2)))
+ (t 2)))
(height (1- (window-height)))
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
+ (point))))
;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- window (min bottom (save-excursion
- (forward-line (- top)) (point))))))))
+ cur-window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
+ (select-window selected))))
(defun gnus-get-tree-buffer ()
"Return the tree buffer properly initialized."
(wh (and win (1- (window-height win)))))
(when (and win
(not (eq tot wh)))
- (save-selected-window
+ (let ((selected (selected-window)))
(select-window win)
- (enlarge-window (- tot wh)))))))
+ (enlarge-window (- tot wh))
+ (select-window selected))))))
;;; Generating the tree.
(goto-char (point-min))
(gnus-tree-minimize)
(gnus-tree-recenter)
- (gnus-horizontal-recenter))))
+ (let ((selected (selected-window)))
+ (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected)))))
(defun gnus-generate-horizontal-tree (thread level &optional dummyp)
"Generate a horizontal tree."
region)
(set-buffer gnus-tree-buffer)
(when (setq region (gnus-tree-article-region article))
- (unless gnus-selected-tree-overlay
+ (when (or (not gnus-selected-tree-overlay)
+ (and (fboundp 'extent-detached-p)
+ (extent-detached-p gnus-selected-tree-overlay)))
;; Create a new overlay.
(gnus-overlay-put
- (setq gnus-selected-tree-overlay (gnus-make-overlay 1 1))
+ (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
'face gnus-selected-tree-face))
;; Move the overlay to the article.
(gnus-move-overlay
gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
(gnus-tree-minimize)
(gnus-tree-recenter)
- (gnus-horizontal-recenter))
+ (let ((selected (selected-window)))
+ (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected)))
;; If we remove this save-excursion, it updates the wrong mode lines?!?
(save-excursion
(set-buffer gnus-tree-buffer)
(set-buffer (gnus-get-tree-buffer))
(let (region)
(when (setq region (gnus-tree-article-region article))
- (put-text-property (car region) (cdr region) 'face face)))))
+ (put-text-property (car region) (cdr region) 'face face)
+ (set-window-point
+ (get-buffer-window (current-buffer) t) (cdr region))))))
+
+
+;;; Allow redefinition of functions.
+(gnus-ems-redefine)
+
+(provide 'gnus-salt)
;;; gnus-salt.el ends here
(defvar gnus-score-default-duration nil
"*The default score duration to use on when entering a score rule interactively.")
+(defun gnus-score-kill-help-buffer ()
+ (when (get-buffer "*Score Help*")
+ (kill-buffer "*Score Help*")
+ (and gnus-score-help-winconf
+ (set-window-configuration gnus-score-help-winconf))))
+
(defun gnus-summary-increase-score (&optional score)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
(list (list ?t (current-time-string) "temporary")
'(?p perm "permanent") '(?i now "immediate")))
(mimic gnus-score-mimic-keymap)
- hchar entry temporary tchar pchar end type match)
+ (hchar gnus-score-default-header)
+ (tchar gnus-score-default-type)
+ (pchar gnus-score-default-duration)
+ entry temporary end type match)
;; First we read the header to score.
(while (not hchar)
(mapconcat (lambda (s) (char-to-string (car s)))
char-to-header "")))
(setq hchar (read-char))
- (if (not (or (= hchar ??) (= hchar ?\C-h)))
- ()
+ (when (or (= hchar ??) (= hchar ?\C-h))
(setq hchar nil)
(gnus-score-insert-help "Match on header" char-to-header 1)))
- (and (get-buffer "*Score Help*")
- (progn
- (kill-buffer "*Score Help*")
- (and gnus-score-help-winconf
- (set-window-configuration gnus-score-help-winconf))))
-
- (or (setq entry (assq (downcase hchar) char-to-header))
- (progn
- (ding)
- (setq end t)
- (if mimic (message "%c %c" prefix hchar) (message ""))))
- (if (or end (/= (downcase hchar) hchar))
- (progn
- ;; This was a majuscle, so we end reading and set the defaults.
- (if mimic (message "%c %c" prefix hchar) (message ""))
- (setq type gnus-score-default-type
- temporary (and gnus-score-default-duration
- (assq
- (aref (symbol-name gnus-score-default-duration)
- 0)
- char-to-perm))))
-
- ;; 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))
- (if (not (or (= tchar ??) (= tchar ?\C-h)))
- ()
- (setq tchar nil)
- (gnus-score-insert-help "Match type" char-to-type 2)))
-
- (and (get-buffer "*Score Help*")
- (progn
- (and gnus-score-help-winconf
- (set-window-configuration gnus-score-help-winconf))
- (kill-buffer "*Score Help*")))
-
- (or (setq type (nth 1 (assq (downcase tchar) char-to-type)))
+ (gnus-score-kill-help-buffer)
+ (unless (setq entry (assq (downcase hchar) char-to-header))
+ (if mimic (error "%c %c" prefix hchar) (error "")))
+
+ (when (/= (downcase hchar) hchar)
+ ;; This was a majuscle, so we end reading and set the defaults.
+ (if mimic (message "%c %c" prefix hchar) (message ""))
+ (setq tchar (or gnus-score-default-type ?s)
+ pchar (or gnus-score-default-duration ?t)))
+
+ ;; We continue reading - the type.
+ (while (not tchar)
+ (if mimic
(progn
- (ding)
- (if mimic (message "%c %c" prefix hchar) (message ""))
- (setq end t)))
- (if (or end (/= (downcase tchar) tchar))
+ (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" 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 "")))
+
+ (when (/= (downcase tchar) tchar)
+ ;; It was a majuscle, so we end reading and the the default.
+ (if mimic (message "%c %c %c" prefix hchar tchar)
+ (message ""))
+ (setq pchar (or gnus-score-default-duration ?p)))
+
+ ;; We continue reading.
+ (while (not pchar)
+ (if mimic
(progn
- ;; It was a majuscle, so we end reading and the the default.
- (if mimic (message "%c %c %c" prefix hchar tchar)
- (message ""))
- (setq temporary
- (and gnus-score-default-duration
- (assq
- (aref (symbol-name gnus-score-default-duration)
- 0)
- char-to-perm))))
-
- ;; We continue reading.
- (while (not pchar)
- (if mimic
- (progn
- (sit-for 1)
- (message "%c %c %c-" prefix hchar tchar))
- (message "%s permanence (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-perm "")))
- (setq pchar (read-char))
- (if (not (or (= pchar ??) (= pchar ?\C-h)))
- ()
- (setq pchar nil)
- (gnus-score-insert-help "Match permanence" char-to-perm 2)))
-
- (and (get-buffer "*Score Help*")
- (progn
- (and gnus-score-help-winconf
- (set-window-configuration gnus-score-help-winconf))
- (kill-buffer "*Score Help*")))
-
- (if mimic (message "%c %c %c" prefix hchar tchar pchar)
- (message ""))
- (if (setq temporary (nth 1 (assq pchar char-to-perm)))
- ()
- (ding)
- (setq end t)
- (if mimic
- (message "%c %c %c %c" prefix hchar tchar pchar)
- (message "")))))
+ (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
+ (message "%s permanence (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-perm "")))
+ (setq pchar (read-char))
+ (when (or (= pchar ??) (= pchar ?\C-h))
+ (setq pchar nil)
+ (gnus-score-insert-help "Match permanence" char-to-perm 2)))
+
+ (gnus-score-kill-help-buffer)
+ (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (message ""))
+ (unless (setq temporary (assq pchar char-to-perm))
+ (if mimic
+ (error "%c %c %c %c" prefix hchar tchar pchar)
+ (error "")))
;; We have all the data, so we enter this score.
- (if end
- ()
- (setq match (if (string= (nth 2 entry) "") ""
- (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
+ (setq match (if (string= (nth 2 entry) "") ""
+ (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
- ;; Modify the match, perhaps.
- (cond
- ((equal (nth 1 entry) "xref")
- (when (string-match "^Xref: *" match)
- (setq match (substring match (match-end 0))))
- (when (string-match "^[^:]* +" match)
- (setq match (substring match (match-end 0))))))
-
- (gnus-summary-score-entry
- (nth 1 entry) ; Header
- match ; Match
- type ; Type
- (if (eq 's score) nil score) ; Score
- (if (eq 'perm temporary) ; Temp
- nil
- temporary)
- (not (nth 3 entry))) ; Prompt
- )))
+ ;; Modify the match, perhaps.
+ (cond
+ ((equal (nth 1 entry) "xref")
+ (when (string-match "^Xref: *" match)
+ (setq match (substring match (match-end 0))))
+ (when (string-match "^[^:]* +" match)
+ (setq match (substring match (match-end 0))))))
+
+ (gnus-summary-score-entry
+ (nth 1 entry) ; Header
+ match ; Match
+ type ; Type
+ (if (eq 's score) nil score) ; Score
+ (if (eq 'perm temporary) ; Temp
+ nil
+ (nth 1 temporary))
+ (not (nth 3 entry))) ; Prompt
+ ))
(defun gnus-score-insert-help (string alist idx)
(setq gnus-score-help-winconf (current-window-configuration))
(string-to-int (gnus-soup-field))))
areas))
(if (eq (preceding-char) ?\t)
- (beginning-of-line 2))))
+ (beginning-of-line 2)))
+ (kill-buffer (current-buffer)))
areas))
(defun gnus-soup-parse-replies (file)
(when gnus-carpal
(gnus-carpal-setup-buffer 'server)))))
+(fset 'gnus-server-position-point 'gnus-goto-colon)
+
(defun gnus-server-prepare ()
(setq gnus-server-mode-line-format-spec
(gnus-parse-format gnus-server-mode-line-format
(setq state 'first-and-last)
(setq state 'last)))
- (message "Getting article %d, %s" article (gnus-uu-part-number article))
+ (let ((part (gnus-uu-part-number article)))
+ (message "Getting article %d%s..."
+ article (if (string= part "") "" (concat ", " part))))
(gnus-summary-display-article article)
;; Push the article to the processing function.
["Unmark all" gnus-group-unmark-all-groups t]
["Mark regexp" gnus-group-mark-regexp t]
["Mark region" gnus-group-mark-region t]
+ ["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument t])
("Subscribe"
["Subscribe to random group" gnus-group-unsubscribe-group t]
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t))
- (goto-char (point-max))
- (and (re-search-backward gnus-signature-separator nil t)
- gnus-signature-face
- (let ((start (match-beginning 0))
- (end (match-end 0)))
- (gnus-article-add-button start end 'gnus-signature-toggle end)
- (gnus-overlay-put (gnus-make-overlay end (point-max))
- 'face gnus-signature-face))))))
+ (save-restriction
+ (when (and gnus-signature-face
+ (gnus-narrow-to-signature))
+ (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
+ 'face gnus-signature-face)
+ (widen)
+ (re-search-backward gnus-signature-separator nil t)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ (gnus-article-add-button start end 'gnus-signature-toggle
+ end)))))))
(defun gnus-article-add-buttons (&optional force)
"Find external references in the article and make buttons of them.
;;; Code:
(require 'text-props)
+(eval-when-compile (require 'cl))
(defvar menu-bar-mode t)
(defvar gnus-xmas-glyph-directory nil
(defun gnus-xmas-move-overlay (extent start end &optional buffer)
(set-extent-endpoints extent start end))
+(defun gnus-xmas-make-overlay (from to &optional buf)
+ (let ((extent (make-extent from to buf)))
+ (set-extent-property extent 'detachable nil)
+ extent))
+
;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
(defun gnus-xmas-article-add-button (from to fun &optional data)
"Create a button between FROM and TO with callback FUN and data DATA."
(defun gnus-xmas-window-top-edge (&optional window)
(nth 1 (window-pixel-edges window)))
+(defun gnus-xmas-tree-minimize ()
+ (when (and gnus-tree-minimize-window
+ (not (one-window-p)))
+ (let* ((window-min-height 2)
+ (height (1+ (count-lines (point-min) (point-max))))
+ (min (max (1- window-min-height) height))
+ (tot (if (numberp gnus-tree-minimize-window)
+ (min gnus-tree-minimize-window min)
+ min))
+ (win (get-buffer-window (current-buffer)))
+ (wh (and win (1- (window-height win)))))
+ (when (and win
+ (not (eq tot wh)))
+ (let ((selected (selected-window)))
+ (select-window win)
+ (enlarge-window (- tot wh))
+ (select-window selected))))))
+
;; Select the lowest window on the frame.
(defun gnus-xmas-appt-select-lowest-window ()
(let* ((lowest-window (selected-window))
(while (not (key-press-event-p event))
(setq event (next-event)))
(cons (and (key-press-event-p event)
- (numberp (event-key event))
+ ; (numberp (event-key event))
(event-to-character event))
event)))
(or (face-differs-from-default-p 'underline)
(funcall (intern "set-face-underline-p") 'underline t))
- (fset 'gnus-make-overlay 'make-extent)
+ (fset 'gnus-make-overlay 'gnus-xmas-make-overlay)
(fset 'gnus-overlay-put 'set-extent-property)
(fset 'gnus-move-overlay 'gnus-xmas-move-overlay)
+ (fset 'gnus-overlay-end 'extent-end-position)
(fset 'set-text-properties 'gnus-xmas-set-text-properties)
(fset 'set-text-properties 'gnus-xmas-set-text-properties)
(fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
(fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
+ (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
(or (fboundp 'appt-select-lowest-window)
(fset 'appt-select-lowest-window
(defvar gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
; "/ftp@ftp.uu.net:/usenet/news.answers/"
+ "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
"/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
"/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
ftp.seas.gwu.edu /pub/rtfm
rtfm.mit.edu /pub/usenet/news.answers
Europe: ftp.uni-paderborn.de /pub/FAQ
+ src.doc.ic.ac.uk /usenet/news-FAQS
ftp.sunet.se /pub/usenet
Asia: nctuccca.edu.tw /USENET/FAQ
hwarang.postech.ac.kr /pub/usenet/news.answers
(defvar gnus-build-sparse-threads nil
"*If non-nil, fill in the gaps in threads.
If `some', only fill in the gaps that are needed to tie loose threads
-together. If non-nil and non-`some', fill in all gaps that Gnus
-manages to guess.")
+together. If `more', fill in all leaf nodes that Gnus can find. If
+non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
(defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
"Function used for gathering loose threads.
(say) one week. (This only goes for mail groups and the like, of
course.)")
+(defvar gnus-group-uncollapsed-levels 1
+ "Number of group name elements to leave alone when making a short group name.")
+
(defvar gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text.")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.29"
+(defconst gnus-version "September Gnus v0.30"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
("gnus-uu" :interactive t
gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
- gnus-uu-mark-series gnus-uu-mark-region
+ gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
gnus-uu-mark-by-regexp gnus-uu-mark-all
gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
gnus-summary-reply gnus-summary-reply-with-original
gnus-summary-mail-forward gnus-summary-mail-other-window
gnus-bug)
- ("gnus-picon" gnus-article-display-picons)
+ ("gnus-picon" :interactive t gnus-article-display-picons
+ gnus-group-display-picons)
("gnus-vm" gnus-vm-mail-setup)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm gnus-yank-article))))
(cond
((null split)
t)
- ((not (or (eq type 'horizontal) (eq type 'vertical)))
+ ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
(let ((buffer (cond ((stringp type) type)
(t (cdr (assq type gnus-window-to-buffer)))))
win buf)
(error "Illegal buffer type: %s" type))
(when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
buffer)))
- (setq win (get-buffer-window buf)))
+ (setq win (get-buffer-window buf t)))
(when win
(if (memq 'point split)
win
"m" gnus-group-mark-group
"u" gnus-group-unmark-group
"w" gnus-group-mark-region
+ "m" gnus-group-mark-buffer
"r" gnus-group-mark-regexp
"U" gnus-group-unmark-all-groups)
(let ((history load-history)
feature)
(while history
- (and (string-match "^gnus" (car (car history)))
+ (and (string-match "^\\(gnus\\|nn\\)" (caar history))
(setq feature (cdr (assq 'provide (car history))))
(unload-feature feature 'force))
(setq history (cdr history)))))
(goto-char beg)
(- num (gnus-group-mark-group num unmark)))))
+(defun gnus-group-mark-buffer (unmark)
+ "Mark all groups in the buffer.
+If UNMARK, remove the mark instead."
+ (interactive "P")
+ (gnus-group-mark-region unmark (point-min) (point-max)))
+
(defun gnus-group-mark-regexp (regexp)
"Mark all groups that match some regexp."
(interactive "sMark (regexp): ")
(interactive (list gnus-group-sort-function
current-prefix-arg))
(let ((func (cond
- ((not (listp func))
- func)
- ((= 1 (length func))
- (car func))
- (t
- `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse func)))))))
+ ((not (listp func)) func)
+ ((null func) func)
+ ((= 1 (length func)) (car func))
+ (t `(lambda (t1 t2)
+ ,(gnus-make-sort-function
+ (reverse func)))))))
;; We peel off the dummy group from the alist.
- (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
- (pop gnus-newsrc-alist))
- ;; Do the sorting.
- (setq gnus-newsrc-alist
- (sort gnus-newsrc-alist func))
- (when reverse
- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
- ;; Regenerate the hash table.
- (gnus-make-hashtable-from-newsrc-alist)
- (gnus-group-list-groups)))
+ (when func
+ (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
+ (pop gnus-newsrc-alist))
+ ;; Do the sorting.
+ (setq gnus-newsrc-alist
+ (sort gnus-newsrc-alist func))
+ (when reverse
+ (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
+ ;; Regenerate the hash table.
+ (gnus-make-hashtable-from-newsrc-alist)
+ (gnus-group-list-groups))))
(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
"Sort the group buffer alphabetically by group name.
"i" gnus-summary-raise-thread
"T" gnus-summary-toggle-threads
"t" gnus-summary-rethread-current
+ "^" gnus-summary-reparent-thread
"s" gnus-summary-show-thread
"S" gnus-summary-show-all-threads
"h" gnus-summary-hide-thread
(defun gnus-sort-threads (threads)
"Sort THREADS."
- (when gnus-thread-sort-functions
+ (if (not gnus-thread-sort-functions)
+ threads
(let ((func (if (= 1 (length gnus-thread-sort-functions))
(car gnus-thread-sort-functions)
`(lambda (t1 t2)
window (min bottom (save-excursion
(forward-line (- top)) (point)))))
;; Do horizontal recentering while we're at it.
- (gnus-summary-position-point)
- (gnus-horizontal-recenter))))
+ (let ((selected (selected-window)))
+ (select-window (get-buffer-window (current-buffer) t))
+ (gnus-summary-position-point)
+ (gnus-horizontal-recenter)
+ (select-window selected)))))
(defun gnus-horizontal-recenter ()
"Recenter the current buffer horizontally."
(if (< (current-column) (/ (window-width) 2))
- (set-window-hscroll (get-buffer-window (current-buffer)) 0)
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
(let* ((orig (point))
- (end (window-end))
+ (end (window-end (get-buffer-window (current-buffer) t)))
(max 0))
;; Find the longest line currently displayed in the window.
(goto-char (window-start))
- (while (< (point) end)
+ (while (and (not (eobp))
+ (< (point) end))
(end-of-line)
(setq max (max max (current-column)))
(forward-line 1))
;; Scroll horizontally to center (sort of) the point.
(if (> max (window-width))
(set-window-hscroll
- (get-buffer-window (current-buffer))
+ (get-buffer-window (current-buffer) t)
(min (- (current-column) (/ (window-width) 3))
(+ 2 (- max (window-width)))))
- (set-window-hscroll (get-buffer-window (current-buffer)) 0))
+ (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
max)))
-
+
;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
(defun gnus-short-group-name (group &optional levels)
"Collapse GROUP name LEVELS."
- (let* ((name "") (foreign "") (depth 0) (skip 1)
+ (let* ((name "")
+ (foreign "")
+ (depth 0)
+ (skip 1)
(levels (or levels
(progn
(while (string-match "\\." group skip)
(setq foreign (substring group 0 (match-end 0))
group (substring group (match-end 0))))
(while group
- (if (and (string-match "\\." group) (> levels 0))
+ (if (and (string-match "\\." group)
+ (> levels (- gnus-group-uncollapsed-levels 1)))
(setq name (concat name (substring group 0 1))
group (substring group (match-end 0))
levels (- levels 1)
(defun gnus-cut-threads (threads)
"Cut off all uninteresting articles from the beginning of threads."
(when (or (eq gnus-fetch-old-headers 'some)
- (eq gnus-build-sparse-threads 'some))
+ (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
(let ((th threads))
(while th
(setcar th (gnus-cut-thread (car th)))
(not (eq gnus-fetch-old-headers 'some))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
+ (not (eq gnus-build-sparse-threads 'more))
(null gnus-thread-expunge-below)))
() ; Do nothing.
(push gnus-newsgroup-limit gnus-newsgroup-limits)
gnus-thread-expunge-below))
(gnus-expunge-thread (pop nodes))
(setq thread (pop nodes))
- ;(when (or (eq gnus-fetch-old-headers 'some)
- ; (eq gnus-build-sparse-threads 'some))
- ; (setq thread (gnus-cut-thread thread)))
(gnus-summary-limit-children thread))))))
gnus-newsgroup-dependencies)
;; If this limitation resulted in an empty group, we might
(zerop children))
;; If this is a sparsely inserted article with no children,
;; we don't want it.
- (and gnus-build-sparse-threads
+ (and (eq gnus-build-sparse-threads 'some)
(memq number gnus-newsgroup-sparse)
(zerop children))
;; If we use expunging, and this article is really
(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search (not not-case-fold))
articles d)
- (or (fboundp func) (error "%s is not a valid header" header))
+ (or (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
(while data
(setq d (car data))
(and (or (not unread) ; We want all articles...
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (if select-method (list select-method "")
(gnus-find-method-for-group to-newsgroup)))
+ (when (equal to-newsgroup gnus-newsgroup-name)
+ (error "Can't %s to the same group you're already in" action))
;; Check the method we are to move this article to...
(or (gnus-check-backend-function 'request-accept-article (car to-method))
(error "%s does not support article copying" (car to-method)))
(intern (format "gnus-newsgroup-%s"
(caar marks)))))
(gnus-add-marked-articles
- (gnus-info-group info) (cadr marks)
+ (gnus-info-group info) (caar marks)
(list to-article) info))
(setq marks (cdr marks)))))
(gnus-rebuild-thread id)
(gnus-summary-goto-subject article)))
+(defun gnus-summary-reparent-thread ()
+ "Make current article child of the marked (or previous) article.
+
+Note that the re-threading will only work if `gnus-thread-ignore-subject'
+is non-nil or the Subject: of both articles are the same.
+
+The change will not be visible until the next group retrieval."
+ (interactive)
+ (or (not (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing."))
+ (or (<= (length gnus-newsgroup-processable) 1)
+ (error "No more than one article may be marked."))
+ (save-window-excursion
+ (let ((gnus-article-buffer " *reparent*")
+ (current-article (gnus-summary-article-number))
+ ; first grab the marked article, otherwise one line up.
+ (parent-article (if (not (null gnus-newsgroup-processable))
+ (car gnus-newsgroup-processable)
+ (save-excursion
+ (if (eq (forward-line -1) 0)
+ (gnus-summary-article-number)
+ (error "Beginning of summary buffer."))))))
+ (or (not (eq current-article parent-article))
+ (error "An article may not be self-referential."))
+ (let ((message-id (mail-header-id
+ (gnus-summary-article-header parent-article))))
+ (or (and message-id (not (equal message-id "")))
+ (error "No message-id in desired parent."))
+ (gnus-summary-select-article t t nil current-article)
+ (set-buffer gnus-article-buffer)
+ (setq buffer-read-only nil)
+ (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
+ (erase-buffer)
+ (insert buf))
+ (goto-char (point-min))
+ (if (search-forward-regexp "^References: " nil t)
+ (insert message-id " " )
+ (insert "References: " message-id "\n"))
+ (or (gnus-request-replace-article current-article
+ (car gnus-article-current)
+ gnus-article-buffer)
+ (error "Couldn't replace article."))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-unmark-all-processable)
+ (message "Article %d is now the child of article %d."
+ current-article parent-article)))))
+
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
(add-text-properties
b e (list 'gnus-number gnus-reffed-article-number
gnus-mouse-face-prop gnus-mouse-face))
- (gnus-data-enter after-article
- gnus-reffed-article-number
- gnus-unread-mark
- b
- (car pslist)
- 0
- (- e b))
- (setq gnus-newsgroup-unreads
- (cons gnus-reffed-article-number gnus-newsgroup-unreads))
+ (gnus-data-enter
+ after-article gnus-reffed-article-number
+ gnus-unread-mark b (car pslist) 0 (- e b))
+ (push gnus-reffed-article-number gnus-newsgroup-unreads)
(setq gnus-reffed-article-number (1- gnus-reffed-article-number))
(setq pslist (cdr pslist)))))))
(unless (gnus-article-check-hidden-text 'signature arg)
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil))
- (goto-char (point-max))
- (and (re-search-backward gnus-signature-separator nil t)
- gnus-signature-face
- (add-text-properties
- (match-end 0) (point-max)
- (nconc (list 'gnus-type 'signature)
- gnus-hidden-properties)))))))
+ (save-restriction
+ (let ((buffer-read-only nil))
+ (when (gnus-narrow-to-signature)
+ (add-text-properties
+ (point-min) (point-max)
+ (nconc (list 'gnus-type 'signature)
+ gnus-hidden-properties))))))))
+
+(defvar gnus-signature-limit nil
+ "Provide a limit to what is considered a signature.
+If it is a number, no signature may not be longer (in characters) than
+that number. If it is a function, the function will be called without
+any parameters, and if it returns nil, there is no signature in the
+buffer. If it is a string, it will be used as a regexp. If it
+matches, the text in question is not a signature.")
+
+(defun gnus-narrow-to-signature ()
+ "Narrow to the signature."
+ (widen)
+ (goto-char (point-max))
+ (when (re-search-backward gnus-signature-separator nil t)
+ (forward-line 1)
+ (when (or (null gnus-signature-limit)
+ (and (numberp gnus-signature-limit)
+ (< (- (point-max) (point)) gnus-signature-limit))
+ (and (gnus-functionp gnus-signature-limit)
+ (funcall gnus-signature-limit))
+ (and (stringp gnus-signature-limit)
+ (not (re-search-forward gnus-signature-limit nil t))))
+ (narrow-to-region (point) (point-max))
+ t)))
(defun gnus-article-check-hidden-text (type arg)
"Return nil if hiding is necessary."
(if (not (gnus-check-backend-function 'request-update-mark (car method)))
mark
(funcall (gnus-get-function method 'request-update-mark)
- (gnus-group-real-name group) article))))
+ (gnus-group-real-name group) article mark))))
(defun gnus-request-article (article group &optional buffer)
"Request the ARTICLE in GROUP.
(nth 1 method) accept-function last)))
(defun gnus-request-accept-article (group &optional last method)
+ ;; Make sure there's a newline at the end of the article.
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
(let ((func (if (symbolp group) group
(car (or method (gnus-find-method-for-group group))))))
(funcall (intern (format "%s-request-accept-article" func))
--- /dev/null
+;;; nntp.el --- nntp access for Gnus
+;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'rnews)
+(require 'sendmail)
+(require 'nnheader)
+
+(eval-and-compile
+ (unless (fboundp 'open-network-stream)
+ (require 'tcp)))
+
+(eval-when-compile (require 'cl))
+
+(defvar nntp-address nil
+ "Address of the physical nntp server.")
+
+(defvar nntp-port-number "nntp"
+ "Port number on the physical nntp server.")
+
+(defvar nntp-server-hook nil
+ "*Hooks for the NNTP server.
+If the kanji code of the NNTP server is different from the local kanji
+code, the correct kanji code of the buffer associated with the NNTP
+server must be specified as follows:
+
+\(setq nntp-server-hook
+ (lambda ()
+ ;; Server's Kanji code is EUC (NEmacs hack).
+ (make-local-variable 'kanji-fileio-code)
+ (setq kanji-fileio-code 0)))
+
+If you'd like to change something depending on the server in this
+hook, use the variable `nntp-address'.")
+
+(defvar nntp-server-opened-hook nil
+ "*Hook used for sending commands to the server at startup.
+The default value is `nntp-send-mode-reader', which makes an innd
+server spawn an nnrpd server. Another useful function to put in this
+hook might be `nntp-send-authinfo', which will prompt for a password
+to allow posting from the server. Note that this is only necessary to
+do on servers that use strict access control.")
+(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
+
+(defvar nntp-server-action-alist
+ '(("nntpd 1\\.5\\.11t"
+ (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
+ "Alist of regexps to match on server types and actions to be taken.
+For instance, if you want Gnus to beep every time you connect
+to innd, you could say something like:
+
+\(setq nntp-server-action-alist
+ '((\"innd\" (ding))))
+
+You probably don't want to do that, though.")
+
+(defvar nntp-open-connection-function 'nntp-open-network-stream
+ "*Function used for connecting to a remote system.
+It will be called with the address of the remote system.
+
+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 is `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).")
+
+(defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
+ "*Parameters to `nntp-open-login'.
+That function may be used as `nntp-open-server-function'. In that
+case, this list will be used as the parameter list given to rsh.")
+
+(defvar nntp-rlogin-user-name nil
+ "*User name on remote system when using the rlogin connect method.")
+
+(defvar nntp-large-newsgroup 50
+ "*The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+(defvar nntp-maximum-request 400
+ "*The maximum number of the requests sent to the NNTP server at one time.
+If Emacs hangs up while retrieving headers, set the variable to a
+lower value.")
+
+(defvar nntp-nov-is-evil nil
+ "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
+
+(defvar nntp-xover-commands '("XOVER" "XOVERVIEW")
+ "*List of strings that are used as commands to fetch NOV lines from a server.
+The strings are tried in turn until a positive response is gotten. If
+none of the commands are successful, nntp will just grab headers one
+by one.")
+
+(defvar nntp-nov-gap 20
+ "*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.")
+
+(defvar nntp-connection-timeout nil
+ "*Number of seconds to wait before an nntp connection times out.
+If this variable is nil, which is the default, no timers are set.")
+
+(defvar nntp-news-default-headers nil
+ "*If non-nil, override `mail-default-headers' when posting news.")
+
+(defvar nntp-prepare-server-hook nil
+ "*Hook run before a server is opened.
+If can be used to set up a server remotely, for instance. Say you
+have an account at the machine \"other.machine\". This machine has
+access to an NNTP server that you can't access locally. You could
+then use this hook to rsh to the remote machine and start a proxy NNTP
+server there that you can connect to.")
+
+(defvar nntp-warn-about-losing-connection t
+ "*If non-nil, beep when a server closes connection.")
+
+\f
+
+;;; Internal variables.
+
+(defvar nntp-connection-alist nil)
+(defvar nntp-status-string "")
+(defconst nntp-version "nntp 5.0")
+(defvar nntp-inhibit-erase nil)
+
+(defvar nntp-server-xover 'try)
+(defvar nntp-server-list-active-group 'try)
+
+;; Virtual server defs.
+(defvar nntp-current-server nil)
+(defvar nntp-server-alist nil)
+(defvar nntp-server-variables
+ `((nntp-address ,nntp-address)
+ (nntp-open-connection-function ,nntp-open-connection-function)
+ (nntp-port-number ,nntp-port-number)
+ (nntp-status-string ,nntp-status-string)
+ (nntp-connection-alist nil)))
+
+\f
+
+;;; Interface functions.
+
+(defun nntp-retrieve-headers (articles &optional group server fetch-old)
+ "Retrieve the headers of ARTICLES."
+ (nntp-possibly-change-group group server)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (if (and (not gnus-nov-is-evil)
+ (not nntp-nov-is-evil)
+ (nntp-retrieve-headers-with-xover articles fetch-old))
+ ;; We successfully retrieved the headers via XOVER.
+ 'nov
+ ;; XOVER didn't work, so we do it the hard, slow and inefficient
+ ;; way.
+ (let ((number (length articles))
+ (count 0)
+ (received 0)
+ (last-point (point-min)))
+ ;; Send HEAD command.
+ (while articles
+ (nntp-send-command
+ nil
+ "HEAD" (if (numberp (car articles))
+ (int-to-string (car articles))
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ (car articles)))
+ (setq articles (cdr articles)
+ count (1+ count))
+ ;; Every 400 header requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (message "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
+ ;; Wait for text of last command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (- (point-max) 3))
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (message "NNTP: Receiving headers...done"))
+
+ ;; Now all of replies are received. Fold continuation lines.
+ (nnheader-fold-continuation-lines)
+ ;; Remove all "\r"'s.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+ 'headers))))
+
+(defun nntp-request-article (article &optional group server buffer)
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+ (nntp-possibly-change-group group server)
+ (nntp-send-command-and-decode
+ "\r\n\\.\r\n" "ARTICLE"
+ (if (numberp article) (int-to-string article) article))))
+
+(defun nntp-request-body (article &optional group server)
+ (nntp-possibly-change-group group server)
+ (nntp-send-command
+ "\r\n\\.\r\n" "BODY"
+ (if (numberp article) (int-to-string article) article)))
+
+(defun nntp-request-group (group &optional server dont-check)
+ (nntp-possibly-change-group nil server)
+ (when (nntp-send-command "^2.*\r\n" "GROUP" group)
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (setcar (cddr entry) group))))
+
+(defun nntp-close-group (group &optional server)
+ t)
+
+(defun nntp-server-opened (server)
+ (and (equal server nntp-current-server)
+ nntp-server-buffer
+ (buffer-name nntp-server-buffer)))
+
+(defun nntp-open-server (server &optional defs connectionless)
+ (nnheader-init-server-buffer)
+ (if (nntp-server-opened server)
+ t
+ (when (or (stringp (car defs))
+ (numberp (car defs)))
+ (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
+ (unless (assq 'nntp-address defs)
+ (setq defs (append defs (list (list 'nntp-address server)))))
+ (nnheader-change-server 'nntp server defs)
+ (or (nntp-find-connection nntp-server-buffer)
+ (nntp-open-connection nntp-server-buffer))))
+
+(defun nntp-close-server (&optional server)
+ (nntp-possibly-change-group nil server t)
+ (let (process)
+ (while (setq process (car (pop nntp-connection-alist)))
+ (when (memq (process-status process) '(open run))
+ (set-process-sentinel process nil)
+ (set-process-filter process nil)
+ (nntp-send-string process "QUIT"))
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process))))))
+
+(defun nntp-request-list (&optional server)
+ (nntp-possibly-change-group nil server)
+ (nntp-send-command "\r\n\\.\r\n" "LIST"))
+
+(defun nntp-request-list-newsgroups (&optional server)
+ (nntp-possibly-change-group nil server)
+ (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS"))
+
+(defun nntp-asynchronous-p ()
+ t)
+
+
+;;; Hooky functions.
+
+(defun nntp-send-mode-reader ()
+ "Send the MODE READER command to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will make innd servers spawn an nnrpd process to allow actual article
+reading."
+ (nntp-send-command "^.*\r\n" "MODE READER"))
+
+(defun nntp-send-nosy-authinfo ()
+ "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+ (nntp-send-command "^.*\r\n" "AUTHINFO USER"
+ (read-string "NNTP user name: "))
+ (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
+ (read-string "NNTP password: ")))
+
+(defun nntp-send-authinfo ()
+ "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+ (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
+ (read-string "NNTP password: ")))
+
+(defun nntp-send-authinfo-from-file ()
+ "Send the AUTHINFO to the nntp server.
+This function is supposed to be called from `nntp-server-opened-hook'.
+It will prompt for a password."
+ (when (file-exists-p "~/.nntp-authinfo")
+ (save-excursion
+ (set-buffer (get-buffer-create " *authinfo*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-file-contents "~/.nntp-authinfo")
+ (goto-char (point-min))
+ (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command
+ "^.*\r\n" "AUTHINFO PASS"
+ (buffer-substring (point) (progn (end-of-line) (point))))
+ (kill-buffer (current-buffer)))))
+
+;;; Internal functions.
+
+(defun nntp-send-command (wait-for &rest strings)
+ "Send STRINGS to server and wait until WAIT-FOR returns."
+ (nntp-retrieve-data
+ (mapconcat 'identity strings " ")
+ nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function))
+
+(defun nntp-send-command-and-decode (wait-for &rest strings)
+ "Send STRINGS to server and wait until WAIT-FOR returns."
+ (nntp-retrieve-data
+ (mapconcat 'identity strings " ")
+ nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function t))
+
+(defun nntp-find-connection (buffer)
+ "Find the connection delivering to BUFFER."
+ (let ((alist nntp-connection-alist)
+ process entry)
+ (while (setq entry (pop alist))
+ (when (eq buffer (cadr entry))
+ (setq process (car entry)
+ alist nil)))
+ (when process
+ (if (memq (process-status process) '(open run))
+ process
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process)))
+ (setq nntp-connection-alist (delq entry nntp-connection-alist))
+ nil))))
+
+(defun nntp-find-connection-entry (buffer)
+ "Return the entry for the connection to BUFFER."
+ (assq (nntp-find-connection buffer) nntp-connection-alist))
+
+(defun nntp-open-connection (buffer)
+ "Open a connection to PORT on ADDRESS delivering output to BUFFER."
+ (let* ((pbuffer (save-excursion
+ (set-buffer
+ (generate-new-buffer
+ (format " *nntpd %s %s %s*"
+ nntp-address nntp-port-number
+ (buffer-name (get-buffer buffer)))))
+ (buffer-disable-undo (current-buffer))
+ (current-buffer)))
+ (process (funcall nntp-open-connection-function pbuffer)))
+ (when process
+ (process-kill-without-query process)
+ (nntp-wait-for process "^.*\r\n" buffer)
+ (if (memq (process-status process) '(open run))
+ (caar (push (list process buffer nil)
+ nntp-connection-alist))
+ (when (buffer-name (process-buffer process))
+ (kill-buffer (process-buffer process)))
+ nil))))
+
+(defun nntp-open-network-stream (buffer)
+ (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
+
+(defvar nntp-tmp-first)
+(defvar nntp-tmp-wait-for)
+(defvar nntp-tmp-callback)
+(defvar nntp-tmp-buffer)
+
+(defun nntp-make-process-filter (wait-for callback buffer decode)
+ `(lambda (proc string)
+ (let ((nntp-tmp-wait-for ,wait-for)
+ (nntp-tmp-callback ,callback)
+ (nntp-tmp-buffer ,buffer))
+ (nntp-process-filter proc string))))
+
+(defun nntp-process-filter (proc string)
+ (let ((old-buffer (current-buffer)))
+ (unwind-protect
+ (let (point)
+ (set-buffer (process-buffer proc))
+ ;; Insert the text, moving the process-marker.
+ (setq point (goto-char (process-mark proc)))
+ (insert string)
+ (set-marker (process-mark proc) (point))
+ (if (and (= point (point-min))
+ (string-match "^45" string))
+ (progn
+ (nntp-snarf-error-message)
+ (funcall nntp-tmp-callback nil)
+ (set-process-filter proc nil))
+ (setq nntp-tmp-first nil)
+ (if (re-search-backward nntp-tmp-wait-for nil t)
+ (progn
+ (if (buffer-name (get-buffer nntp-tmp-buffer))
+ (save-excursion
+ (set-buffer (get-buffer nntp-tmp-buffer))
+ (insert-buffer-substring (process-buffer proc))))
+ (funcall nntp-tmp-callback t)
+ (set-process-filter proc nil)
+ (erase-buffer)))))
+ (set-buffer old-buffer))))
+
+(defun nntp-retrieve-data (command address port buffer
+ &optional wait-for callback decode)
+ "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
+ (let ((process (or (nntp-find-connection buffer)
+ (nntp-open-connection buffer))))
+ (if (not process)
+ (nnheader-report 'nntp "Couldn't open connection to %a" address)
+ (unless nntp-inhibit-erase
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (erase-buffer)))
+ (nntp-send-string process command)
+ (cond
+ ((eq callback 'ignore)
+ t)
+ ((and callback wait-for)
+ (set-process-filter
+ process (nntp-make-process-filter wait-for callback buffer decode))
+ t)
+ (wait-for
+ (nntp-wait-for process wait-for buffer decode))
+ (t t)))))
+
+(defun nntp-send-string (process string)
+ "Send STRING to PROCESS."
+ (process-send-string process (concat string "\r\n")))
+
+(defun nntp-wait-for (process wait-for buffer &optional decode)
+ "Wait for WAIT-FOR to arrive from PROCESS."
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-min))
+ (while (not (looking-at "[2345]"))
+ (nntp-accept-process-output process)
+ (goto-char (point-min)))
+ (prog1
+ (if (looking-at "[345]")
+ (progn
+ (nntp-snarf-error-message)
+ nil)
+ (goto-char (point-max))
+ (while (not (re-search-backward wait-for nil t))
+ (nntp-accept-process-output process))
+ (nntp-decode-text (not decode))
+ (save-excursion
+ (set-buffer buffer)
+ (insert-buffer-substring (process-buffer process))
+ t))
+ (erase-buffer))))
+
+(defun nntp-snarf-error-message ()
+ "Save the error message in the current buffer."
+ (setq nntp-status-string (buffer-string)))
+
+(defun nntp-accept-process-output (process)
+ "Wait for output from PROCESS and message some dots."
+ (message "Reading%s" (make-string (/ (point-max) 1000) ?.))
+ (accept-process-output process))
+
+(defun nntp-accept-response ()
+ "Wait for output from the process that outputs to BUFFER."
+ (nntp-accept-process-output (nntp-find-connection nntp-server-buffer)))
+
+(defun nntp-possibly-change-group (group server &optional connectionless)
+ (when server
+ (or (nntp-server-opened server)
+ (nntp-open-server server nil connectionless)))
+
+ (or (nntp-find-connection nntp-server-buffer)
+ (nntp-open-connection nntp-server-buffer))
+
+ (when group
+ (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
+ (when (not (equal group (caddr entry)))
+ (nntp-request-group group)))))
+
+(defun nntp-decode-text (&optional cr-only)
+ "Decode the text in the current buffer."
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (delete-char -1))
+ (unless cr-only
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (looking-at ".\n")
+ (delete-char 2))
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (while (search-forward "\n.." nil t)
+ (delete-char -1))))
+
+(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
+ (erase-buffer)
+ (cond
+
+ ;; This server does not talk NOV.
+ ((not nntp-server-xover)
+ nil)
+
+ ;; We don't care about gaps.
+ ((or (not nntp-nov-gap)
+ fetch-old)
+ (nntp-send-xover-command
+ (if fetch-old
+ (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (car articles))
+ (last articles) 'wait)
+
+ (goto-char (point-min))
+ (when (looking-at "[1-5][0-9][0-9] ")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max))
+ (forward-line -1)
+ (when (looking-at "\\.")
+ (delete-region (point) (progn (forward-line 1) (point)))))
+
+ ;; We do it the hard way. For each gap, an XOVER command is sent
+ ;; to the server. We do not wait for a reply from the server, we
+ ;; just send them off as fast as we can. That means that we have
+ ;; to count the number of responses we get back to find out when we
+ ;; have gotten all we asked for.
+ ((numberp nntp-nov-gap)
+ (let ((count 0)
+ (received 0)
+ (last-point (point-min))
+ (buf nntp-server-buffer) ;(process-buffer (nntp-find-connection (current-buffer))))
+ first)
+ ;; We have to check `nntp-server-xover'. If it gets set to nil,
+ ;; that means that the server does not understand XOVER, but we
+ ;; won't know that until we try.
+ (while (and nntp-server-xover articles)
+ (setq first (car articles))
+ ;; Search forward until we find a gap, or until we run out of
+ ;; articles.
+ (while (and (cdr articles)
+ (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
+ (setq articles (cdr articles)))
+
+ (when (nntp-send-xover-command first (car articles))
+ (setq articles (cdr articles)
+ count (1+ count))
+
+ ;; Every 400 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (accept-process-output)
+ ;; On some Emacs versions the preceding function has
+ ;; a tendency to change the buffer. Perhaps. It's
+ ;; quite difficult to reproduce, because it only
+ ;; seems to happen once in a blue moon.
+ (set-buffer buf)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (accept-process-output)
+ (set-buffer buf)))))
+
+ (when nntp-server-xover
+ ;; Wait for the reply from the final command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9][0-9][0-9] " nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)))
+
+ ;; We remove any "." lines and status lines.
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (delete-char -1))
+ (goto-char (point-min))
+ (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
+ ;(save-excursion
+ ; (set-buffer nntp-server-buffer)
+ ; (insert-buffer-substring buf))
+ ;(erase-buffer)
+ ))))
+
+ nntp-server-xover)
+
+(defun nntp-send-xover-command (beg end &optional wait-for-reply)
+ "Send the XOVER command to the server."
+ (let ((range (format "%d-%d" beg end))
+ (nntp-inhibit-erase t))
+ (if (stringp nntp-server-xover)
+ ;; If `nntp-server-xover' is a string, then we just send this
+ ;; command.
+ (if wait-for-reply
+ (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range)
+ ;; We do not wait for the reply.
+ (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range))
+ (let ((commands nntp-xover-commands))
+ ;; `nntp-xover-commands' is a list of possible XOVER commands.
+ ;; We try them all until we get at positive response.
+ (while (and commands (eq nntp-server-xover 'try))
+ (nntp-send-command "\r\n\\.\r\n" (car commands) range)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (and (looking-at "[23]") ; No error message.
+ ;; We also have to look at the lines. Some buggy
+ ;; servers give back simple lines with just the
+ ;; article number. How... helpful.
+ (progn
+ (forward-line 1)
+ (looking-at "[0-9]+\t...")) ; More text after number.
+ (setq nntp-server-xover (car commands))))
+ (setq commands (cdr commands)))
+ ;; If none of the commands worked, we disable XOVER.
+ (when (eq nntp-server-xover 'try)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq nntp-server-xover nil)))
+ nntp-server-xover))))
+
+(provide 'nntp)
+
+;;; nntp.el ends here
(defvar news-reply-yank-from nil)
(defvar news-reply-yank-message-id nil)
+(defvar nnheader-callback-function nil)
+
(defun nnheader-init-server-buffer ()
"Initialize the Gnus-backend communication buffer."
(save-excursion
(set (car (car state)) (nth 1 (car state)))
(setq state (cdr state))))
+(defun nnheader-change-server (backend server defs)
+ (let ((current-server (intern (format "%s-current-server" backend)))
+ (alist (intern (format "%s-server-alist" backend)))
+ (variables (intern (format "%s-server-variables" backend))))
+
+ (when (and (symbol-value current-server)
+ (not (equal server (symbol-value current-server))))
+ (set alist
+ (cons (list (symbol-value current-server)
+ (nnheader-save-variables (symbol-value variables)))
+ (symbol-value alist))))
+ (let ((state (assoc server (symbol-value alist))))
+ (if (not state)
+ (nnheader-set-init-variables (symbol-value variables) defs)
+ (nnheader-restore-variables (nth 1 state))
+ (set alist (delq state (symbol-value alist)))))
+ (set current-server server)))
+
;;; Various functions the backends use.
(defun nnheader-insert-head (file)
group))
(defun nnmail-process-babyl-mail-format (func)
- (let (start message-id content-length do-search end)
+ (let ((case-fold-search t)
+ start message-id content-length do-search end)
(while (not (eobp))
(goto-char (point-min))
(re-search-forward
(goto-char end))))
(defun nnmail-process-unix-mail-format (func)
- (let ((delim (concat "^" rmail-unix-mail-delimiter))
+ (let ((case-fold-search t)
+ (delim (concat "^" rmail-unix-mail-delimiter))
start message-id content-length end skip head-end)
(goto-char (point-min))
(if (not (and (re-search-forward delim nil t)
(defun nnmail-process-mmdf-mail-format (func)
(let ((delim "^\^A\^A\^A\^A$")
+ (case-fold-search t)
start message-id end)
(goto-char (point-min))
(if (not (and (re-search-forward delim nil t)
(cons (list nntp-current-server
(nnheader-save-variables nntp-server-variables))
nntp-server-alist)))
- (let ((state (assoc server nntp-server-alist)))
+ (let ((state (assoc server nntp-server-alist)))
(if state
(progn
(nnheader-restore-variables (nth 1 state))
(mapcar
(lambda (g)
(let* ((active (or (gnus-active g) (gnus-activate-group g)))
- (unreads (gnus-list-of-unread-articles g))
+ (unreads (and active (gnus-list-of-unread-articles
+ g)))
(marks (gnus-uncompress-marks
(gnus-info-marks (gnus-get-info g)))))
- (when gnus-use-cache
- (push (cons 'cache (gnus-cache-articles-in-group g))
- marks))
(when active
- (setq div (/ (float (car active))
- (if (zerop (cdr active))
- 1 (cdr active))))
- (mapcar (lambda (n)
- (list (* div (- n (car active)))
- g n (and (memq n unreads) t)
- (nnvirtual-marks n marks)))
- (gnus-uncompress-range active)))))
+ (when gnus-use-cache
+ (push (cons 'cache (gnus-cache-articles-in-group g))
+ marks))
+ (when active
+ (setq div (/ (float (car active))
+ (if (zerop (cdr active))
+ 1 (cdr active))))
+ (mapcar (lambda (n)
+ (list (* div (- n (car active)))
+ g n (and (memq n unreads) t)
+ (nnvirtual-marks n marks)))
+ (gnus-uncompress-range active))))))
nnvirtual-component-groups))
(lambda (m1 m2)
(< (car m1) (car m2)))))
+Sat Jan 20 01:44:32 1996 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Article Hiding): Addition.
+ (Group Buffer Format): Addition.
+ (Article Hiding): Addition.
+ (Customizing Threading): Addition.
+ (Marking Groups): Addition.
+ (Thread Commands): Addition.
+
Wed Jan 17 02:26:15 1996 Lars Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Group Maintenance): Addition.
used.
@item c
-Short (collapsed) group name.
+@vindex gnus-group-uncollapsed-levels
+Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels}
+variable says how many levels to leave at the end of the group name.
+The default is @samp{1}.
@item u
User defined specifier. The next character in the format string should
@findex gnus-group-mark-region
Mark all groups between point and mark (@code{gnus-group-mark-region}).
+@item M b
+@kindex M b (Group)
+@findex gnus-group-mark-buffer
+Mark all groups in the buffer (@code{gnus-group-mark-buffer}).
+
@item M r
@kindex M r (Group)
@findex gnus-group-mark-regexp
lines. If you select a gap, Gnus will try to fetch the article in
question.) If this variable is @code{t}, Gnus will display all these
"gaps" without regard for whether they are useful for completing the
-thread or not. This variable is @code{nil} by default.
+thread or not. Finally, if this variable is @code{more}, Gnus won't cut
+off sparse leaf nodes that don't lead anywhere. This variable is
+@code{nil} by default.
@item gnus-summary-gather-subject-limit
@vindex gnus-summary-gather-subject-limit
@findex gnus-summary-hide-all-threads
Hide all threads (@code{gnus-summary-hide-all-threads}).
-@item T R
-@kindex T R (Summary)
+@item T t
+@kindex T t (Summary)
@findex gnus-summary-rethread-current
Re-thread the thread the current article is part of
(@code{gnus-summary-rethread-current}). This works even when the
summary buffer is otherwise unthreaded.
+@item T ^
+@kindex T ^ (Summary)
+@findex gnus-summary-reparent-thread
+Make the current article the child of the marked (or previous) article
+(@code{gnus-summary-reparent-thread}. The change will not be visible
+until the next group retrieval.
+
@end table
The following commands are thread movement commands. They all
@item W W c
@kindex W W c (Summary)
@findex gnus-article-hide-citation
-Hide citation (@code{gnus-article-hide-citation}). Two variables for
+Hide citation (@code{gnus-article-hide-citation}). Some variables for
customizing the hiding:
@table @code
The cited text must be have at least this length (default 10) before it
is hidden.
+@item gnus-cited-text-button-line-format
+@vindex gnus-cited-text-button-line-format
+Gnus adds buttons show where the cited text has been hidden, and to
+allow toggle hiding the text. The format of the variable is specified
+by this format-like variable. These specs are legal:
+
+@table @samp
+@item b
+Start point of the hidden text.
+@item e
+End point of the hidden text.
+@item l
+Length of the hidden text.
+@end table
+
+@item gnus-cited-lines-visible
+@vindex gnus-cited-lines-visible
+The number of lines at the beginning of the cited text to leave shown.
+
@end table
@item W W C
Also see @xref{Article Highlighting} for further variables for
citation customization.
+@vindex gnus-signature-limit
+@code{gnus-signature-limit} provides a limit to what is considered a
+signature. If it is a number, no signature may not be longer (in
+characters) than that number. If it is a function, the function will be
+called without any parameters, and if it returns @code{nil}, there is no
+signature in the buffer. If it is a string, it will be used as a
+regexp. If it matches, the text in question is not a signature.
+
@node Article Washing
@subsection Article Washing
projects / gnus / commitdiff