(defun gnus-mh-mail-setup (to subject in-reply-to cc replybuffer actions)
(let ((config (current-window-configuration)))
- (setq mh-show-buffer gnus-article-copy)
(mh-find-path)
(mh-send-sub (or to "") (or cc "") (or subject "") config)
(goto-char (point-min))
(setq gnus-mail-buffer (buffer-name (current-buffer)))
(use-local-map (copy-keymap (current-local-map)))
(local-set-key "\C-c\C-c" 'gnus-mh-mail-send-and-exit)
+ (setq mh-show-buffer gnus-article-copy)
(setq mh-previous-window-config config)))
(defun gnus-mh-mail-send-and-exit (&optional dont-send)
If the function returns nil, the `gnus-signature-file' variable will
be used instead.")
+(defvar gnus-forward-start-separator
+ "------- Start of forwarded message -------\n"
+ "*Delimiter inserted before forwarded messages.")
+
+(defvar gnus-forward-end-separator
+ "------- End of forwarded message -------\n"
+ "*Delimiter inserted after forwarded messages.")
+
+(defvar gnus-signature-before-forwarded-message t
+ "*If non-nil, put the signature before any included forwarded message.")
+
(defvar gnus-required-headers
'(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
"*Headers to be generated or prompted for when posting an article.
(let* ((organization
(or (getenv "ORGANIZATION")
(if gnus-local-organization
- (if (and (symbolp gnus-local-organization)
- (fboundp gnus-local-organization))
+ (if (gnus-functionp gnus-local-organization)
(funcall gnus-local-organization gnus-newsgroup-name)
gnus-local-organization))
gnus-organization-file
(gnus-narrow-to-headers)
(if (not followup)
;; This is a regular reply.
- (if (and (symbolp gnus-reply-to-function)
- (fboundp gnus-reply-to-function))
+ (if (gnus-functionp gnus-reply-to-function)
(setq follow-to (funcall gnus-reply-to-function group)))
;; This is a followup.
- (if (and (symbolp gnus-followup-to-function)
- (fboundp gnus-followup-to-function))
+ (if (gnus-functionp gnus-followup-to-function)
(save-excursion
(setq follow-to
(funcall gnus-followup-to-function group)))))
end)
(if (not (listp yank))
(progn
+ ;; Just a single article being yanked.
(save-excursion
(mail-yank-original nil))
(or mail-yank-hooks mail-citation-hook
(save-excursion
(gnus-copy-article-buffer)
(mail-yank-original nil)
- (setq end (point)))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (goto-char (mark))
+ (let ((news-reply-yank-from
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (or (mail-fetch-field "from") "(nobody)")))
+ (news-reply-yank-message-id
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (or (mail-fetch-field "message-id")
+ "(unknown Message-ID)"))))
+ (or mail-yank-hooks mail-citation-hook
+ (run-hooks 'news-reply-header-hook))
+ (setq end (point-max)))))
(goto-char end)
(setq yank (cdr yank))))
(goto-char last))
(gnus-inews-insert-bfcc)
(gnus-inews-insert-signature)
(and gnus-post-prepare-function
- (symbolp gnus-post-prepare-function)
- (fboundp gnus-post-prepare-function)
+ (gnus-functionp gnus-post-prepare-function)
(funcall gnus-post-prepare-function group))
(goto-char (point-min))
(if group
(save-restriction
(set-buffer gnus-article-copy)
(gnus-narrow-to-headers)
- (if (and (symbolp gnus-followup-to-function)
- (fboundp gnus-followup-to-function))
+ (if (gnus-functionp gnus-followup-to-function)
(save-excursion
(setq follow-to
(funcall gnus-followup-to-function group))))
(gnus-inews-insert-signature)
(and gnus-post-prepare-function
- (symbolp gnus-post-prepare-function)
- (fboundp gnus-post-prepare-function)
+ (gnus-functionp gnus-post-prepare-function)
(funcall gnus-post-prepare-function group))
(run-hooks 'gnus-post-prepare-hook)
(cdr reply)))))
(and winconf (set-window-configuration winconf))))))
-
(defun gnus-forward-make-subject (buffer)
(save-excursion
(set-buffer buffer)
"] " (or (gnus-fetch-field "Subject") ""))))
(defun gnus-forward-insert-buffer (buffer)
- (let ((beg (goto-char (point-max))))
- (insert "------- Start of forwarded message -------\n")
- (insert-buffer-substring buffer)
- (goto-char (point-max))
- (insert "------- End of forwarded message -------\n")
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (goto-char beg)
- (while (setq beg (next-single-property-change (point) 'invisible))
- (goto-char beg)
- (delete-region beg (or (next-single-property-change
- (point) 'invisible)
- (point-max))))))
+ (save-excursion
+ (save-restriction
+ (if gnus-signature-before-forwarded-message
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1))
+ ;; Narrow to the area we are to insert.
+ (narrow-to-region (point) (point))
+ ;; Insert the separators and the forwarded buffer.
+ (insert gnus-forward-start-separator)
+ (insert-buffer-substring buffer)
+ (goto-char (point-max))
+ (insert gnus-forward-end-separator)
+ ;; Delete any invisible text.
+ (goto-char (point-min))
+ (let (beg)
+ (while (setq beg (next-single-property-change (point) 'invisible))
+ (goto-char beg)
+ (delete-region beg (or (next-single-property-change
+ (point) 'invisible)
+ (point-max))))))))
(defun gnus-mail-forward (&optional buffer)
"Forward the current message to another user using mail."
(defun gnus-inews-insert-gcc ()
(let* ((group gnus-outgoing-message-group)
(gcc (cond
- ((and (symbolp group) (fboundp group))
+ ((gnus-functionp group)
(funcall group))
((or (stringp group) (list group))
group))))
(when (cond ((stringp match)
;; Regexp string match on the group name.
(string-match match gnus-newsgroup-name))
- ((symbolp match)
- (cond ((fboundp match)
+ ((or (symbolp match)
+ (gnus-functionp match))
+ (cond ((gnus-functionp match)
;; Function to be called.
(funcall match))
((boundp match)
(setq value-value
(cond ((stringp value)
value)
- ((symbolp value)
- (cond ((fboundp value)
+ ((or (symbolp value)
+ (gnus-functionp value))
+ (cond ((gnus-functionp value)
(funcall value))
((boundp value)
(symbol-value value))))
(defvar gnus-topic-mode nil
"Minor mode for Gnus group buffers.")
-(defvar gnus-topic-line-format "%i[ %(%[%n%]%) -- %a ]%v\n"
+(defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %a ]%v\n"
"Format of topic lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%a Number of unread articles in the groups in the topic.
")
-(defvar gnus-group-topics '(("misc" "." nil))
- "*Alist of newsgroup topics.
-This alist has entries of the form
-
- (TOPIC REGEXP SHOW)
-
-where TOPIC is the name of the topic a group is put in if it matches
-REGEXP. A group can only be in one topic at a time.
-
-If SHOW is nil, newsgroups will be inserted according to
-`gnus-group-topic-topics-only', otherwise that variable is ignored and
-the groups are always shown if SHOW is true or never if SHOW is a
-number.")
-
(defvar gnus-group-topic-topics-only nil
"*If non-nil, only the topics will be shown when typing `l' or `L'.")
(?v visible ?s)
(?i indentation ?s)
(?g number-of-groups ?d)
- (?a (gnus-topic-articles-in-topic groups) ?d)
+ (?a number-of-articles ?d)
(?l level ?d)))
(defvar gnus-topic-line-format-spec nil)
(defun gnus-group-topic-name ()
"The name of the topic on the current line."
- (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
- (and topic (symbol-name topic))))
+ (get-text-property (gnus-point-at-bol) 'gnus-topic))
(defun gnus-group-topic-level ()
"The level of the topic on the current line."
(get-text-property (gnus-point-at-bol) 'gnus-topic-level))
+(defun gnus-topic-init-alist ()
+ (setq gnus-topic-topology
+ (cons (list "Gnus" 'visible)
+ (mapcar (lambda (topic)
+ (list (list (car topic) 'visible)))
+ '(("misc")))))
+ (setq gnus-topic-alist
+ (list (cons "misc"
+ (mapcar (lambda (info) (gnus-info-group info))
+ (cdr gnus-newsrc-alist)))
+ (list "Gnus")))
+ (gnus-topic-enter-dribble))
+
(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic)
"List all newsgroups with unread articles of level LEVEL or lower, and
use the `gnus-group-topics' to sort the groups.
;; Use topics.
(when (< lowest gnus-level-zombie)
- (let ((topics (gnus-topic-find-groups nil level all))
- topic how)
+ (let (topics topic how)
;; The first time we set the topology to whatever we have
;; gotten here, which can be rather random.
- (unless gnus-topic-topology
- (setq gnus-topic-topology
- (list (list "Gnus" 'visible)
- (mapcar (lambda (topic) (list (car topic) 'visible))
- topics)))
- (gnus-topic-enter-dribble))
-
- ;; Check that all topics are in the topology.
- (gnus-topic-check-topology topics)
+ (unless gnus-topic-alist
+ (gnus-topic-init-alist))
+ (gnus-topic-check-topology)
(if list-topic
(let ((top (gnus-topic-find-topology list-topic)))
- (gnus-topic-prepare-topic
- (cdr top) (car top) topics))
- (gnus-topic-prepare-topic gnus-topic-topology 0 topics)))))
+ (gnus-topic-prepare-topic (cdr top) (car top) level all))
+ (gnus-topic-prepare-topic gnus-topic-topology 0 level all)))))
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level all))
(run-hooks 'gnus-group-prepare-hook))
-(defun gnus-topic-prepare-topic (topic level topic-alist)
+(defun gnus-topic-prepare-topic (topic level &optional list-level all)
"Insert TOPIC into the group buffer."
(let* ((type (pop topic))
- (groups (nreverse (cdr (assoc (car type) topic-alist))))
+ (entries (gnus-topic-find-groups (car type) list-level all))
(visiblep (eq (nth 1 type) 'visible))
- info)
+ info entry)
;; Insert the topic line.
(gnus-topic-insert-topic-line
(car type) visiblep
(not (eq (nth 2 type) 'hidden))
- level groups)
+ level entries)
(when visiblep
;; Insert all the groups that belong in this topic.
- (while groups
- (setq info (pop groups))
+ (while entries
+ (setq entry (pop entries)
+ info (nth 2 entry))
(gnus-group-insert-group-line
(gnus-info-group info)
(gnus-info-level info) (gnus-info-marks info)
- (car (gnus-gethash (gnus-info-group info)
- gnus-newsrc-hashtb))
- (gnus-info-method info))))
+ (car entry) (gnus-info-method info))))
;; Insert any sub-topics.
(when (or visiblep
(and (not gnus-topic-hide-subtopics)
(eq (nth 2 type) 'shown)))
(while topic
- (gnus-topic-prepare-topic (pop topic) (1+ level) topic-alist)))))
-
-
-(defun gnus-topic-find-groups (&optional topic level all)
- "Find all topics and all groups in all topics.
-If TOPIC, just find the groups in that topic."
- (let ((newsrc (cdr gnus-newsrc-alist))
- (topics (if topic
- (list (list topic))
- (mapcar (lambda (e) (list (car e)))
- gnus-group-topics)))
- (topic-alist (if topic (list (assoc topic gnus-group-topics))
- gnus-group-topics))
- info clevel unread group w lowest gtopic params)
+ (gnus-topic-prepare-topic (pop topic) (1+ level) list-level all)))))
+
+(defun gnus-topic-find-groups (topic &optional level all)
+ "Return entries for all visible groups in TOPIC."
+ (let ((groups (cdr (assoc topic gnus-topic-alist)))
+ info clevel unread group w lowest gtopic params visible-groups entry)
(setq lowest (or lowest 1))
- (setq all (or all nil))
(setq level (or level 7))
;; We go through the newsrc to look for matches.
- (while newsrc
- (setq info (car newsrc)
+ (while groups
+ (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb)
+ info (nth 2 entry)
group (gnus-info-group info)
params (gnus-info-params info)
- newsrc (cdr newsrc)
- unread (car (gnus-gethash group gnus-newsrc-hashtb)))
+ unread (car entry))
(and
unread ; nil means that the group is dead.
(<= (setq clevel (gnus-info-level info)) level)
(string-match gnus-permanently-visible-groups group))
(memq 'visible params)
(cdr (assq 'visible params)))
- (progn
- ;; So we find out what topic this group belongs to. First we
- ;; check the group parameters.
- (setq gtopic (cdr (assq 'topic (gnus-info-params info))))
- ;; On match, we add it.
- (and (stringp gtopic)
- (or (not topic)
- (string= gtopic topic))
- (if (setq e (assoc gtopic topics))
- (setcdr e (cons info (cdr e)))
- (setq topics (cons (list gtopic info) topics))))
- ;; We look through the topic alist for further matches, if
- ;; needed.
- (if (or (not gnus-topic-unique) (not (stringp gtopic)))
- (let ((ts topic-alist))
- (while ts
- (if (string-match (nth 1 (car ts)) group)
- (progn
- (setcdr (setq e (assoc (car (car ts)) topics))
- (cons info (cdr e)))
- (and gnus-topic-unique (setq ts nil))))
- (setq ts (cdr ts))))))))
- topics))
+ ;; Add this group to the list of visible groups.
+ (push entry visible-groups)))
+ (nreverse visible-groups)))
(defun gnus-topic-remove-topic (&optional insert total-remove hide)
"Remove the current topic."
"Return non-nil if the current topic is visible."
(get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
-(defun gnus-topic-insert-topic-line (name visiblep shownp level groups)
+(defun gnus-topic-insert-topic-line (name visiblep shownp level entries)
(let* ((visible (if (and visiblep shownp) "" "..."))
(indentation (make-string (* 2 level) ? ))
- (number-of-groups (length groups))
- b)
+ (number-of-articles (gnus-topic-articles-in-topic entries))
+ (number-of-groups (length entries)))
(beginning-of-line)
;; Insert the text.
(add-text-properties
(point)
(prog1 (1+ (point))
(eval gnus-topic-line-format-spec))
- (list 'gnus-topic (intern name)
+ (list 'gnus-topic name
'gnus-topic-level level
'gnus-topic-visible visiblep))))
-(defun gnus-topic-check-topology (topic-alist)
- (let ((topics (gnus-topic-list))
- changed)
- (while topic-alist
- (unless (member (car (car topic-alist)) topics)
- (nconc gnus-topic-topology
- (list (list (list (car (car topic-alist)) 'visible))))
- (setq changed t))
- (setq topic-alist (cdr topic-alist)))
- (when changed
- (gnus-topic-enter-dribble))))
-
-(defvar gnus-tmp-topics nil)
-(defun gnus-topic-list (&optional topology)
+(defun gnus-topic-previous-topic (topic)
+ "Return the previous topic on the same level as TOPIC."
+ (let ((top (cdr (cdr (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))))
+ (unless (equal topic (car (car (car top))))
+ (while (and top (not (equal (car (car (car (cdr top)))) topic)))
+ (setq top (cdr top)))
+ (car (car (car top))))))
+
+(defun gnus-topic-parent-topic (topic &optional topology)
+ "Return the parent of TOPIC."
(unless topology
- (setq topology gnus-topic-topology
- gnus-tmp-topics nil))
- (push (car (car topology)) gnus-tmp-topics)
- (mapcar 'gnus-topic-list (cdr topology))
- gnus-tmp-topics)
+ (setq topology gnus-topic-topology))
+ (let ((parent (car (pop topology)))
+ result found)
+ (while (and topology
+ (not (setq found (equal (car (car (car topology))) topic)))
+ (not (setq result (gnus-topic-parent-topic topic
+ (car topology)))))
+ (setq topology (cdr topology)))
+ (or result (and found parent))))
(defun gnus-topic-find-topology (topic &optional topology level remove)
+ "Return the topology of TOPIC."
(unless topology
(setq topology gnus-topic-topology)
(setq level 0))
(setq topology (cdr topology)))
result)))
+(defun gnus-topic-check-topology ()
+ (let ((topics (gnus-topic-list))
+ (alist gnus-topic-alist)
+ changed)
+ (while alist
+ (unless (member (car (car alist)) topics)
+ (nconc gnus-topic-topology
+ (list (list (list (car (car alist)) 'visible))))
+ (setq changed t))
+ (setq alist (cdr alist)))
+ (when changed
+ (gnus-topic-enter-dribble)))
+ (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
+ gnus-topic-alist)))
+ (entry (assoc "Gnus" gnus-topic-alist))
+ (newsrc gnus-newsrc-alist)
+ group)
+ (while newsrc
+ (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
+ (setcdr entry (cons group (cdr entry)))))))
+
+(defvar gnus-tmp-topics nil)
+(defun gnus-topic-list (&optional topology)
+ (unless topology
+ (setq topology gnus-topic-topology
+ gnus-tmp-topics nil))
+ (push (car (car topology)) gnus-tmp-topics)
+ (mapcar 'gnus-topic-list (cdr topology))
+ gnus-tmp-topics)
+
(defun gnus-topic-enter-dribble ()
(gnus-dribble-enter
(format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
-(defun gnus-topic-articles-in-topic (groups)
+(defun gnus-topic-articles-in-topic (entries)
(let ((total 0)
number)
- (while groups
- (when (numberp (setq number (gnus-group-unread
- (gnus-info-group (pop groups)))))
+ (while entries
+ (when (numberp (setq number (car (pop entries))))
(incf total number)))
total))
-(defun gnus-topic-parent-topic ()
- (save-excursion
- (let (topic)
- (while (not (setq topic (gnus-group-topic-name)))
- (forward-line -1))
- topic)))
+(defun gnus-group-parent-topic ()
+ "Return the topic the current group belongs in."
+ (let ((group (gnus-group-group-name)))
+ (if group
+ (gnus-group-topic group)
+ (gnus-group-topic-name))))
+
+(defun gnus-group-topic (group)
+ "Return the topic GROUP is a member of."
+ (let ((alist gnus-topic-alist)
+ out)
+ (while alist
+ (when (member group (cdr (car alist)))
+ (setq out (car (car alist))
+ alist nil))
+ (setq alist (cdr alist)))
+ out))
(defun gnus-topic-goto-topic (topic)
(goto-char (point-min))
(when (and (eq major-mode 'gnus-group-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name)))
- (gnus-topic-goto-topic (gnus-topic-parent-topic))
- (gnus-topic-remove-topic t)
+ (gnus-topic-goto-topic (gnus-group-parent-topic))
+ (gnus-topic-update-topic-line)
(gnus-group-goto-group group)
(gnus-group-position-point))))
+(defun gnus-topic-update-topic-line ()
+ (let* ((buffer-read-only nil)
+ (topic (gnus-group-topic-name))
+ (entry (gnus-topic-find-topology topic))
+ (level (car entry))
+ (type (nth 1 entry))
+ (entries (gnus-topic-find-groups (car type)))
+ (visiblep (eq (nth 1 type) 'visible)))
+ ;; Insert the topic line.
+ (gnus-delete-line)
+ (gnus-topic-insert-topic-line
+ (car type) visiblep (not (eq (nth 2 type) 'hidden)) level entries)))
+
;;; Topic mode, commands and keymap.
(defvar gnus-topic-mode-map nil)
(define-key gnus-topic-mode-map " " 'gnus-topic-read-group)
(define-key gnus-topic-mode-map "\C-k" 'gnus-topic-kill-group)
(define-key gnus-topic-mode-map "\C-y" 'gnus-topic-yank-group)
+ (define-key gnus-topic-mode-map "\M-g" 'gnus-topic-get-new-news-this-topic)
+ (define-key gnus-topic-mode-map "\C-i" 'gnus-topic-indent)
(define-prefix-command 'gnus-group-topic-map)
(define-key gnus-group-mode-map "T" 'gnus-group-topic-map)
- (define-key gnus-group-topic-map "c" 'gnus-topic-create-topic)
- (define-key gnus-group-topic-map "m" 'gnus-topic-move-to-topic)
+ (define-key gnus-group-topic-map "#" 'gnus-topic-mark-topic)
+ (define-key gnus-group-topic-map "n" 'gnus-topic-create-topic)
+ (define-key gnus-group-topic-map "m" 'gnus-topic-move-group)
+ (define-key gnus-group-topic-map "c" 'gnus-topic-copy-group)
(define-key gnus-group-topic-map "h" 'gnus-topic-hide-topic)
(define-key gnus-group-topic-map "s" 'gnus-topic-show-topic)
+ (define-key gnus-group-topic-map "M" 'gnus-topic-move-matching)
+ (define-key gnus-group-topic-map "C" 'gnus-topic-copy-matching)
+ (define-key gnus-group-topic-map "r" 'gnus-topic-rename)
+ (define-key gnus-group-topic-map "\177" 'gnus-topic-delete)
+
+ (define-key gnus-group-topic-map gnus-mouse-2 'gnus-mouse-pick-topic)
)
;;;###autoload
(gnus-topic-fold all))
(gnus-group-select-group all)))
+(defun gnus-mouse-pick-topic (e)
+ "Select the group or topic under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-topic-read-group nil))
+
(defun gnus-topic-read-group (&optional all no-article group)
"Read news in this newsgroup.
If the prefix argument ALL is non-nil, already read articles become
(interactive
(list
(read-string "Create topic: ")
- (completing-read "Parent topic: "
- (mapcar (lambda (l) (list l)) (gnus-topic-list))
- nil t)))
+ (completing-read "Parent topic: " gnus-topic-alist nil t)))
;; Check whether this topic already exists.
(when (gnus-topic-find-topology topic)
(error "Topic aleady exists"))
(let ((top (cdr (gnus-topic-find-topology parent))))
(unless top
(error "No such topic: %s" parent))
- (when previous
- (while (and (cdr top)
- (not (equal (car (car (car top))) previous)))
- (setq top (cdr top))))
- (setcdr top (cons (list (list topic 'visible)) (cdr top))))
+ (if previous
+ (progn
+ (while (and (cdr top)
+ (not (equal (car (car (car (cdr top)))) previous)))
+ (setq top (cdr top)))
+ (setcdr top (cons (list (list topic 'visible)) (cdr top))))
+ (nconc top (list (list (list topic 'visible)))))
+ (unless (assoc topic gnus-topic-alist)
+ (push (list topic) gnus-topic-alist)))
(gnus-topic-enter-dribble)
(gnus-group-list-groups))
-;; Written by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
-(defun gnus-topic-move-to-topic (n topic)
+(defun gnus-topic-move-group (n topic &optional copyp)
"Move the current group to a topic."
(interactive
(list current-prefix-arg
- (completing-read "Move to topic: "
- (mapcar (lambda (l) (list l)) (gnus-topic-list)))))
- (let ((groups (gnus-group-process-prefix n)))
+ (completing-read "Move to topic: " gnus-topic-alist nil t)))
+ (let ((groups (gnus-group-process-prefix n))
+ (topicl (assoc topic gnus-topic-alist))
+ entry)
+ (unless topicl
+ (error "No such topic: %s" topic))
(mapcar (lambda (g)
(gnus-group-remove-mark g)
- (gnus-group-add-parameter g (cons 'topic topic)))
+ (when (and
+ (setq entry (assoc (gnus-group-topic g) gnus-topic-alist))
+ (not copyp))
+ (setcdr entry (delete g (cdr entry))))
+ (nconc topicl (list g)))
groups)
(gnus-group-position-point))
(gnus-topic-enter-dribble)
(gnus-group-list-groups))
+(defun gnus-topic-copy-group (n topic)
+ "Copy the current group to a topic."
+ (interactive
+ (list current-prefix-arg
+ (completing-read "Copy to topic: " gnus-topic-alist nil t)))
+ (gnus-topic-move-group n topic t))
+
(defun gnus-topic-kill-group (&optional n discard)
"Kill the next N groups."
(interactive "P")
gnus-topic-killed-topics))))
(defun gnus-topic-yank-group (&optional arg)
- "Yank the last ARG groups."
+ "Yank the last topic."
(interactive "p")
(if (null gnus-topic-killed-topics)
(gnus-group-yank-group arg)
- (let ((parent (gnus-group-topic-name))
+ (let ((previous (gnus-group-parent-topic))
(item (nth 1 (pop gnus-topic-killed-topics))))
(gnus-topic-create-topic
- (car item) (or parent (car (car gnus-topic-topology)))))))
+ (car item) (gnus-topic-parent-topic previous) previous))))
(defun gnus-topic-hide-topic ()
"Hide all subtopics under the current topic."
(when (gnus-group-topic-p)
(gnus-topic-remove-topic t nil 'shown)))
+(defun gnus-topic-mark-topic (topic)
+ "Mark all groups in the topic with the process mark."
+ (interactive (list (gnus-group-parent-topic)))
+ (let ((groups (gnus-topic-find-groups topic)))
+ (while groups
+ (gnus-group-set-mark (pop groups)))))
+
+(defun gnus-topic-get-new-news-this-topic (&optional n)
+ "Check for new news in the current topic."
+ (interactive "P")
+ (if (not (gnus-group-topic-p))
+ (gnus-group-get-new-news-this-group n)
+ (gnus-topic-mark-topic (gnus-group-topic-name))
+ (gnus-group-get-new-news-this-group)))
+
+(defun gnus-topic-move-matching (regexp topic &optional copyp)
+ "Move all groups that match REGEXP to some topic."
+ (interactive
+ (let (topic)
+ (list
+ (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
+ (read-string (format "Move to %s (regexp): " topic)))))
+ (gnus-group-mark-regexp regexp)
+ (gnus-topic-move-group nil topic copyp))
+
+(defun gnus-topic-copy-matching (regexp topic &optional copyp)
+ "Copy all groups that match REGEXP to some topic."
+ (interactive
+ (let (topic)
+ (list
+ (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
+ (read-string (format "Copy to %s (regexp): " topic)))))
+ (gnus-topic-move-matching regexp topic t))
+
+(defun gnus-topic-delete (topic)
+ "Delete a topic."
+ (interactive (list (gnus-group-topic-name)))
+ (unless topic
+ (error "No topic to be deleted"))
+ (let ((entry (assoc topic gnus-topic-alist))
+ (buffer-read-only nil))
+ (when (cdr entry)
+ (error "Topic not empty"))
+ ;; Delete if visible.
+ (when (gnus-topic-goto-topic topic)
+ (gnus-delete-line))
+ ;; Remove from alist.
+ (setq gnus-topic-alist (delq entry gnus-topic-alist))
+ ;; Remove from topology.
+ (gnus-topic-find-topology topic nil nil 'delete)))
+
+(defun gnus-topic-rename (old-name new-name)
+ "Rename a topic."
+ (interactive
+ (list
+ (completing-read "Rename topic: " gnus-topic-alist nil t)
+ (read-string (format "Rename %s to: "))))
+ (let ((top (gnus-topic-find-topology old-name))
+ (entry (assoc old-name gnus-topic-alist)))
+ (when top
+ (setcar (car (cdr top)) new-name))
+ (when entry
+ (setcar entry new-name))))
+
+(defun gnus-topic-indent (&optional unindent)
+ "Indent a topic -- make it a sub-topic of the previous topic.
+If UNINDENT, remove an indentation."
+ (interactive "P")
+ (if unindent
+ (gnus-topic-unindent)
+ (let* ((topic (gnus-group-parent-topic))
+ (parent (gnus-topic-previous-topic topic)))
+ (unless parent
+ (error "Nothing to indent %s into" topic))
+ (when topic
+ (gnus-topic-goto-topic topic)
+ (gnus-topic-kill-group)
+ (gnus-topic-create-topic topic parent)))))
+
+(defun gnus-topic-unindent ()
+ "Unindent a topic."
+ (interactive)
+ (let* ((topic (gnus-group-parent-topic))
+ (parent (gnus-topic-parent-topic topic))
+ (grandparent (gnus-topic-parent-topic parent)))
+ (unless grandparent
+ (error "Nothing to indent %s into" topic))
+ (when topic
+ (gnus-topic-goto-topic topic)
+ (gnus-topic-kill-group)
+ (gnus-topic-create-topic topic grandparent))))
+
;;; gnus-topic.el ends here
(assq (1+ lines) gnus-cite-attribution-alist)))
gnus-button-message-id 3)
;; This is how URLs _should_ be embedded in text...
- ("<URL:\\([^\n\r>]*\\)>" 0 t ,browse-url-browser-function 1)
+ ("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
;; Next regexp stolen from highlight-headers.el.
;; Modified by Vladimir Alexiev.
- (,gnus-button-url-regexp 0 t ,browse-url-browser-function 0)
+ (,gnus-button-url-regexp 0 t gnus-button-url 0)
("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
- gnus-button-message-id 3))
+ gnus-button-message-id 3)
+ ("\\(<URL: *\\)?mailto: *\\([^ \n\t]+\\)>?" 0 t gnus-button-reply 2)
+ )
"Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0 t gnus-button-mailto 0)
- ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t
- ,browse-url-browser-function 0))
+ ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0))
"Alist of headers and regexps to match buttons in article heads.
This alist is very similar to `gnus-button-alist', except that each
(goto-char end))))
(widen)))
-(defun gnus-netscape-open-url (url)
- "Open URL in netscape, or start new scape with URL."
- (let ((process
- (start-process
- (concat "netscape " url) nil
- "netscape" "-remote" (concat "openUrl(" url ")'"))))
- (set-process-sentinel process
- (` (lambda (process change)
- (or (eq (process-exit-status process) 0)
- (gnus-netscape-start-url (, url))))))))
-
-(defun gnus-netscape-start-url (url)
- "Start netscape with URL."
- (start-process (concat "netscape" url) nil "netscape" url))
+
;;; External functions:
;; Reply to ADDRESS.
(gnus-mail-reply t address))
+(defun gnus-button-url (address)
+ "Browse ADDRESS."
+ (funcall browse-url-browser-function address))
+
;;; Compatibility Functions:
(or (fboundp 'rassoc)
This restriction may disappear in later versions of Gnus.")
-(defvar gnus-summary-dummy-line-format "* : : %S\n"
+(defvar gnus-summary-dummy-line-format
+ "* %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
the third is non-nil, it is a number. No groups with a level lower
than this number should be displayed.
-The only current function implemented are `gnus-group-prepare-flat'
-\(which does the normal boring group display) and
-`gnus-group-prepare-topics' (which does a folding display accoring to
-topics).")
+The only current function implemented is `gnus-group-prepare-flat'.")
(defvar gnus-group-prepare-hook nil
"*A hook called after the group buffer has been generated.
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.16"
+(defconst gnus-version "September Gnus v0.17"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
- gnus-topic-topology)
+ gnus-topic-topology gnus-topic-alist)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-options nil
(defvar gnus-topic-topology nil
"The complete topic hierarchy.")
+(defvar gnus-topic-alist nil
+ "The complete topic-group alist.")
+
(defvar gnus-newsrc-alist nil
"Assoc list of read articles.
gnus-newsrc-hashtb should be kept so that both hold the same information.")
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
`(let ((symbol (intern ,string ,hashtable)))
(or (boundp symbol)
- (setq symbol nil))
+ (set symbol nil))
symbol))
(defmacro gnus-group-unread (group)
(gnus-byte-code 'gnus-summary-line-format-spec))
(defun gnus-summary-dummy-line-format-spec ()
- (insert "* : : " gnus-tmp-subject "\n"))
+ (insert "* ")
+ (put-text-property
+ (point)
+ (progn
+ (insert ": :")
+ (point))
+ gnus-mouse-face-prop gnus-mouse-face)
+ (insert " " gnus-tmp-subject "\n"))
+
(defvar gnus-summary-dummy-line-format-spec
(gnus-byte-code 'gnus-summary-dummy-line-format-spec))
(gnus-update-group-mark-positions)
(gnus-update-summary-mark-positions)
- (if (and (string-match "%D" gnus-group-line-format)
+ (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
(not gnus-description-hashtb)
gnus-read-active-file)
(gnus-read-all-descriptions-files)))
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
(thread nil)
+ (gnus-visual nil)
pos)
(gnus-set-work-buffer)
(gnus-summary-insert-line
;; string. If the FORMAT string contains the specifiers %( and %)
;; the text between them will have the mouse-face text property.
(if (string-match
- "\\`\\(.*\\)%[0-9]?[[(]\\(.*\\)%[0-9]?[])]\\(.*\n?\\)\\'"
+ "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
format)
(gnus-parse-complex-format format spec-alist)
;; This is a simple format.
(replace-match "\\\"" nil t))
(goto-char (point-min))
(insert "(\"")
- (while (re-search-forward "%\\([0-9]+\\)?\\([][()]\\)" nil t)
+ (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
(let ((number (if (match-beginning 1)
(match-string 1) "0"))
(delim (aref (match-string 2) 0)))
- (if (or (= delim ?\() (= delim ?\[))
+ (if (or (= delim ?\() (= delim ?\{))
(replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
" " number " \""))
(replace-match "\")\""))))
;; from `message'.
(apply 'format args)))
+(defun gnus-functionp (form)
+ "Return non-nil if FORM is funcallable."
+ (or (and (symbolp form) (fboundp form))
+ (and (listp form) (eq (car form) 'lambda))))
+
;; Generate a unique new group name.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(define-key gnus-group-mark-map "m" 'gnus-group-mark-group)
(define-key gnus-group-mark-map "u" 'gnus-group-unmark-group)
(define-key gnus-group-mark-map "w" 'gnus-group-mark-region)
+ (define-key gnus-group-mark-map "r" 'gnus-group-mark-regexp)
(define-prefix-command 'gnus-group-group-map)
(define-key gnus-group-mode-map "G" 'gnus-group-group-map)
(run-hooks 'gnus-group-mode-hook))
(defun gnus-mouse-pick-group (e)
+ "Enter the group under the mouse pointer."
(interactive "e")
(mouse-set-point e)
(gnus-group-read-group nil))
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (make-local-variable gnus-group-use-permanent-levels)
+ (make-local-variable 'gnus-group-use-permanent-levels)
(setq gnus-group-use-permanent-levels t)
(gnus (or arg (1- gnus-level-default-subscribed)) t))
(- (1+ (cdr active)) (car active)) 0)
nil))))
-(defalias 'gnus-group-remove-excess-properties (lambda ()))
+;; Dummy function redefined when running under XEmacs.
+(defalias 'gnus-group-remove-excess-properties 'ignore)
(defun gnus-group-insert-group-line
(gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number
gnus-tmp-method)
+ "Insert a group line in the group buffer."
(let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total
(if gnus-tmp-active
(cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
(gnus-tmp-number
- (if (eq gnus-tmp-number t) "*"
- gnus-tmp-number))
+ (cond ((eq gnus-tmp-number t) "*" )
+ ((numberp gnus-tmp-number) (int-to-string gnus-tmp-number))
+ (t gnus-tmp-number)))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
(buffer-read-only nil)
- header ; passed as parameter to user-funcs.
- b)
+ header) ; passed as parameter to user-funcs.
(beginning-of-line)
- (setq b (point))
- ;; Insert the text.
- (eval gnus-group-line-format-spec)
-
- (add-text-properties
- b (1+ b) (list 'gnus-group (gnus-intern-safe
- gnus-tmp-group gnus-active-hashtb)
- 'gnus-unread (if (numberp gnus-tmp-number)
- (string-to-int
- gnus-tmp-number-of-unread)
- t)
- 'gnus-marked gnus-tmp-marked
- 'gnus-level gnus-tmp-level))
+ (add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ ;; Insert the text.
+ (eval gnus-group-line-format-spec))
+ `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
+ gnus-unread ,(if (numberp gnus-tmp-number)
+ (string-to-int gnus-tmp-number-of-unread)
+ t)
+ gnus-marked ,gnus-tmp-marked
+ gnus-level ,gnus-tmp-level))
+ ;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
(defun gnus-group-update-group (group &optional visible-only)
(gnus-tmp-news-server (car (cdr gnus-select-method)))
(gnus-tmp-news-method (car gnus-select-method))
(max-len 60)
+ header ;Dummy binding for user-defined formats
;; Get the resulting string.
(mode-string (eval gformat)))
;; If the line is too long, we chop it off.
(and
(let ((unread
(get-text-property (point) 'gnus-unread)))
- (or (eq unread t) (and unread (> unread 0))))
+ ;(and unread
+ (or (eq unread t)
+ (and unread (> unread 0))));)
(setq lev (get-text-property (point)
'gnus-level))
(<= lev gnus-level-subscribed)))
(goto-char beg)
(- num (gnus-group-mark-group num unmark)))))
-(defun gnus-group-remove-mark (group)
- (and (gnus-group-goto-group group)
- (save-excursion
- (gnus-group-mark-group 1 'unmark t))))
+(defun gnus-group-mark-regexp (regexp)
+ "Mark all groups that match some regexp."
+ (interactive "sMark (regexp): ")
+ (let ((alist (cdr gnus-newsrc-alist))
+ group)
+ (while alist
+ (when (string-match regexp (setq group (gnus-info-group (pop alist))))
+ (gnus-group-set-mark group)))))
+(defun gnus-group-remove-mark (group)
+ (if (gnus-group-goto-group group)
+ (save-excursion
+ (gnus-group-mark-group 1 'unmark t))
+ (setq gnus-group-marked
+ (cons group (delete group gnus-group-marked)))))
+
+(defun gnus-group-set-mark (group)
+ (if (gnus-group-goto-group group)
+ (save-excursion
+ (gnus-group-mark-group 1 nil t))
+ (setq gnus-group-marked
+ (cons group (delete group gnus-group-marked)))))
+
;; Return a list of groups to work on. Take into consideration N (the
;; prefix) and the list of marked groups.
(defun gnus-group-process-prefix (n)
new-name)
;; ... and then yanking it. Magic!
(gnus-group-yank-group)
+ (gnus-set-active new-name (gnus-active group))
(gnus-message 6 "Renaming group %s to %s...done" group new-name)
new-name)
(gnus-group-position-point)))
(defun gnus-group-sort-by-method (info1 info2)
"Sort alphabetically by backend name."
(string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1))))
+ (gnus-info-group info1) info1)))
(symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2))))))
+ (gnus-info-group info2) info2)))))
(defun gnus-group-sort-by-score (info1 info2)
"Sort by group score."
(interactive "P")
(let ((groups (gnus-group-process-prefix n))
group)
- (or groups (error "No groups to expire"))
+ (unless groups
+ (error "No groups to expire"))
(while groups
- (setq group (car groups)
- groups (cdr groups))
+ (setq group (pop groups))
(gnus-group-remove-mark group)
- (if (not (gnus-check-backend-function 'request-expire-articles group))
- ()
+ (when (gnus-check-backend-function 'request-expire-articles group)
(let* ((info (gnus-get-info group))
(expirable (if (gnus-group-total-expirable-p group)
(cons nil (gnus-list-of-read-articles group))
(assq 'expire (gnus-info-marks info)))))
- (and expirable
- (setcdr expirable
- (gnus-request-expire-articles
- (cdr expirable) group))))))))
+ (when expirable
+ (setcdr expirable
+ (gnus-compress-sequence
+ (gnus-request-expire-articles
+ (gnus-uncompress-sequence (cdr expirable)) group)))))))))
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
(while (>= (setq arg (1- arg)) 0)
(if (not (setq info (car gnus-list-of-killed-groups)))
(error "No more newsgroups to yank"))
- (setq group (nth 2 info))
+ (setq group (nth 1 info))
;; Find which newsgroup to insert this one before - search
;; backward until something suitable is found. If there are no
;; other newsgroups in this buffer, just make this newsgroup the
info (nth 2 info) gnus-level-killed
(and prev (gnus-gethash prev gnus-newsrc-hashtb))
t)
- (gnus-group-insert-group-line-info (nth 1 info))
+ (gnus-group-insert-group-line-info group)
(setq gnus-list-of-killed-groups
(cdr gnus-list-of-killed-groups)))
(forward-line -1)
;; Find all possible killed newsgroups if arg.
(when arg
;; First make sure active file has been read.
- (or gnus-have-read-active-file (gnus-read-active-file))
+ (unless gnus-have-read-active-file
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
(or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
;; Go through all newsgroups that are known to Gnus - enlarge kill list
(mapatoms
"List all groups that are available from the server(s)."
(interactive)
;; First we make sure that we have really read the active file.
- (or gnus-have-read-active-file
- (gnus-read-active-file))
+ (unless gnus-have-read-active-file
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
;; Find all groups and sort them.
(let ((groups
(sort
(gnus-message
6
(substitute-command-keys
- "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
+ (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
+ (if group "local" "global")))))
(defun gnus-group-edit-local-kill (article group)
"Edit a local kill file."
(gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
(gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
(buffer-read-only nil))
+ (when (string= gnus-tmp-name "")
+ (setq gnus-tmp-name gnus-tmp-from))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
(put-text-property
(point)
;; article.
(when gnus-tmp-dummy-line
(gnus-summary-insert-dummy-line
- gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)))
+ gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
+ (setq gnus-tmp-dummy-line nil))
;; Compute the mark.
(setq
(cond
((and gnus-thread-ignore-subject
gnus-tmp-prev-subject
- (not
- (inline (gnus-subject-equal
- gnus-tmp-prev-subject subject))))
+ (not (inline (gnus-subject-equal
+ gnus-tmp-prev-subject subject))))
subject)
((zerop gnus-tmp-level)
(if (and (eq gnus-summary-make-false-root 'empty)
- (memq number gnus-tmp-gathered))
+ (memq number gnus-tmp-gathered)
+ gnus-tmp-prev-subject
+ (inline (gnus-subject-equal
+ gnus-tmp-prev-subject subject)))
gnus-summary-same-subject
subject))
(t gnus-summary-same-subject)))
(1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
(t gnus-tmp-from)))
+ (when (string= gnus-tmp-name "")
+ (setq gnus-tmp-name gnus-tmp-from))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
(put-text-property
(point)
(and (not (setq m (assq type (car marked))))
(setcar marked
(cons (cons type (gnus-compress-sequence articles t) )
- (car marked)))
+ (car marked))))
(if force
(setcdr m (gnus-compress-sequence articles t))
(setcdr m (gnus-compress-sequence
(sort (nconc (gnus-uncompress-range m)
- (copy-sequence articles)) '<) t)))))))
+ (copy-sequence articles)) '<) t))))))
(defun gnus-set-mode-line (where)
"This function sets the mode line of the article or summary buffers.
(defvar gnus-newsgroup-none-id 0)
-(defun gnus-get-newsgroup-headers ()
- (setq gnus-article-internal-prepare-hook nil)
+(defun gnus-get-newsgroup-headers (&optional dependencies)
(let ((cur nntp-server-buffer)
- (dependencies (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies))
+ (dependencies
+ (or dependencies
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)))
headers id id-dep ref-dep end ref)
(save-excursion
(set-buffer nntp-server-buffer)
(let* ((article (or article (gnus-summary-article-number)))
(arts (gnus-data-find-list article))
result)
- (unless gnus-summary-check-current
+ (when (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts))))
(setq arts (cdr arts)))
(when (setq result
(if unread
(let* ((article (or article (gnus-summary-article-number)))
(arts (gnus-data-find-list article (gnus-data-list 'rev)))
result)
- (unless gnus-summary-check-current
+ (when (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts))))
(setq arts (cdr arts)))
(if (setq result
(if unread
(articles (gnus-data-list backward))
(arts (gnus-data-find-list article articles))
result)
- (unless gnus-summary-check-current
+ (when (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts))))
(setq arts (cdr arts)))
(while arts
(and (or (not unread)
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing."))
- (gnus-summary-select-article t)
+ (gnus-summary-select-article t nil t)
(gnus-configure-windows 'article)
(select-window (get-buffer-window gnus-article-buffer))
(gnus-message 6 "C-c C-c to end edits")
(when (and (not (eobp))
(or (and (zerop (gnus-summary-next-thread 1 t))
(gnus-summary-find-prev))
- (gnus-summary-goto-subject gnus-newsgroup-end)))
+ (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
(setq end (point))
(prog1
(if (and (> (point) start)
(condition-case ()
(re-search-forward (car method) nil t)
(error nil)))
- ((and (symbolp (car method))
- (fboundp (car method)))
+ ((gnus-functionp (car method))
(funcall (car method)))
((consp (car method))
(eval (car method))))
If ALL-HEADERS is non-nil, no headers are hidden."
(save-excursion
;; Make sure we start in a summary buffer.
- (or (eq major-mode 'gnus-summary-mode)
- (set-buffer gnus-summary-buffer))
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
(setq gnus-summary-buffer (current-buffer))
;; Make sure the connection to the server is alive.
- (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
- (progn
- (gnus-check-server
- (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-request-group gnus-newsgroup-name t)))
+ (unless (gnus-server-opened
+ (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+ (gnus-request-group gnus-newsgroup-name t))
(let* ((article (if header (mail-header-number header) article))
(summary-buffer (current-buffer))
(internal-hook gnus-article-internal-prepare-hook)
(save-excursion
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
+ ;; Deactivate active regions.
+ (when (and (boundp 'transient-mark-mode)
+ transient-mark-mode)
+ (setq mark-active nil))
(if (not (setq result (let ((buffer-read-only nil))
(gnus-request-article-this-buffer
article group))))
;; We display the face.
(if (symbolp gnus-article-x-face-command)
;; The command is a lisp function, so we call it.
- (if (fboundp gnus-article-x-face-command)
+ (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
(gnus-add-current-to-buffer-list)
(erase-buffer)
(setq buffer-file-name dribble-file)
+ (auto-save-mode t)
(buffer-disable-undo (current-buffer))
(bury-buffer (current-buffer))
(set-buffer-modified-p nil)
(gnus-find-method-for-group group)
group)))
(cond
+ ;; If the group-method is nil (which shouldn't happen) we use
+ ;; the default method.
+ ((null group-method)
+ gnus-select-method)
;; We want this group's method.
(force-group-method group-method)
;; Override normal method.
(gnus-method-option-p group-method 'post))
gnus-post-method)
;; Perhaps this is a mail group?
- ((gnus-member-of-valid 'post group)
+ ((not (gnus-member-of-valid 'post group))
group-method)
;; Use the normal select method.
(t gnus-select-method))))
If CONFIRM is non-nil, the user has to confirm the deletion of every
newsgroup."
(let ((newsrc (cdr gnus-newsrc-alist))
- bogus group entry)
+ bogus group entry info)
(gnus-message 5 "Checking bogus newsgroups...")
- (or gnus-have-read-active-file (gnus-read-active-file))
- ;; Find all bogus newsgroup that are subscribed.
- (while newsrc
- (setq group (car (car newsrc)))
- (if (or (gnus-active group) ; Active
- (nth 4 (car newsrc)) ; Foreign
- (and confirm
- (not (gnus-y-or-n-p
- (format "Remove bogus newsgroup: %s " group)))))
- ;; Don't remove.
- ()
- ;; Found a bogus newsgroup.
- (setq bogus (cons group bogus)))
- (setq newsrc (cdr newsrc)))
- ;; Remove all bogus subscribed groups by first killing them, and
- ;; then removing them from the list of killed groups.
- (while bogus
- (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb))
- (progn
- (gnus-group-change-level entry gnus-level-killed)
- (setq gnus-killed-list (delete (car bogus) gnus-killed-list))))
- (setq bogus (cdr bogus)))
- ;; Then we remove all bogus groups from the list of killed and
- ;; zombie groups. They are are removed without confirmation.
- (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
- killed)
- (while dead-lists
- (setq killed (symbol-value (car dead-lists)))
- (while killed
- (setq group (car killed))
- (or (gnus-active group)
+ (unless gnus-have-read-active-file
+ (gnus-read-active-file))
+ (when (member gnus-select-method gnus-have-read-active-file)
+ ;; Find all bogus newsgroup that are subscribed.
+ (while newsrc
+ (setq info (pop newsrc)
+ group (gnus-info-group info))
+ (unless (or (gnus-active group) ; Active
+ (gnus-info-method info) ; Foreign
+ (and confirm
+ (not (gnus-y-or-n-p
+ (format "Remove bogus newsgroup: %s " group)))))
+ ;; Found a bogus newsgroup.
+ (push group bogus)))
+ ;; Remove all bogus subscribed groups by first killing them, and
+ ;; then removing them from the list of killed groups.
+ (while bogus
+ (when (setq entry (gnus-gethash (setq group (pop bogus))
+ gnus-newsrc-hashtb))
+ (gnus-group-change-level entry gnus-level-killed)
+ (setq gnus-killed-list (delete group gnus-killed-list))))
+ ;; Then we remove all bogus groups from the list of killed and
+ ;; zombie groups. They are are removed without confirmation.
+ (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
+ killed)
+ (while dead-lists
+ (setq killed (symbol-value (car dead-lists)))
+ (while killed
+ (unless (gnus-active (setq group (pop killed)))
;; The group is bogus.
+ ;; !!!Slow as hell.
(set (car dead-lists)
- (delete group (symbol-value (car dead-lists)))))
- (setq killed (cdr killed)))
- (setq dead-lists (cdr dead-lists))))
- (gnus-message 5 "Checking bogus newsgroups...done")))
+ (delete group (symbol-value (car dead-lists))))))
+ (setq dead-lists (cdr dead-lists))))
+ (gnus-message 5 "Checking bogus newsgroups...done"))))
(defun gnus-check-duplicate-killed-groups ()
"Remove duplicates from the list of killed groups."
;; unread articles and stuff.
(gnus-set-active group nil)
(setcar (gnus-gethash group gnus-newsrc-hashtb) t))
-
+
(setq newsrc (cdr newsrc)))
(gnus-message 5 "Checking new news...done")))
gnus-newsrc-alist
(cons (list "dummy.group" 0 nil) alist)))))
(while alist
- (gnus-sethash (car (car alist))
- (cons (and ohashtb (car (gnus-gethash
- (car (car alist)) ohashtb)))
- prev) gnus-newsrc-hashtb)
+ (gnus-sethash
+ (car (car alist))
+ (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb)))
+ prev)
+ gnus-newsrc-hashtb)
(setq prev alist
alist (cdr alist)))))
(defun nnmail-process-unix-mail-format (func)
(let ((delim (concat "^" rmail-unix-mail-delimiter))
- start message-id content-length end skip)
+ start message-id content-length end skip head-end)
(if (not (and (re-search-forward delim nil t)
(goto-char (match-beginning 0))))
;; Possibly wrong format?
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
;; Look for a Content-Length header.
(goto-char (point-min))
- (when (re-search-forward "^Content-Length: \\([0-9]+\\)" nil t)
+ (if (not (re-search-forward "^Content-Length: \\([0-9]+\\)" nil t))
+ (setq content-length nil)
(setq content-length (string-to-int (match-string 1)))
;; We destroy the header, since none of the backends ever
;; use it, and we do not want to confuse other mailers by
;; Find the end of this article.
(goto-char (point-max))
(widen)
+ (setq head-end (point))
;; We try the Content-Length value.
(when content-length
(forward-line 1)
(goto-char end)
;; No Content-Length, so we find the beginning of the next
;; article or the end of the buffer.
+ (goto-char head-end)
(if (re-search-forward delim nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))))
;; Find the end of this article.
(goto-char (point-max))
(widen)
- ;; We try the Content-Length value.
(if (re-search-forward delim nil t)
(beginning-of-line)
(goto-char (point-max)))
(not nnmail-resplit-incoming))
(list (list group ""))
nnmail-split-methods))
- start end content-length do-search message-id)
+ start end do-search message-id)
(save-excursion
;; Open the message-id cache.
(nnmail-cache-open)
"Convert HEAD headers into NOV headers."
(save-excursion
(set-buffer nntp-server-buffer)
- (let* ((gnus-newsgroup-dependencies (make-vector 100 0))
- (headers (gnus-get-newsgroup-headers))
+ (let* ((dependencies (make-vector 100 0))
+ (headers (gnus-get-newsgroup-headers dependencies))
header)
(erase-buffer)
(while headers
- (setq header (car headers)
- headers (cdr headers))
+ (setq header (pop headers))
(insert (int-to-string (mail-header-number header)) "\t"
(or (mail-header-subject header) "") "\t"
(or (mail-header-from header) "") "\t"
+Sun Dec 3 00:34:35 1995 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * gnus.texi (Topic Commands): Addition.
+
+Sat Dec 2 00:53:15 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Topic Commands): Addition.
+
+Fri Dec 1 02:24:59 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Mail): Addition.
+
+Wed Nov 29 17:31:53 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Mail): Addition.
+
Fri Nov 24 13:38:25 1995 Lars Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Formatting Variables): Addition.
@kindex M w (Group)
@findex gnus-group-mark-region
Mark all groups between point and mark (@code{gnus-group-mark-region}).
+
+@item M r
+@kindex M r (Group)
+@findex gnus-group-mark-regexp
+Mark all groups that match some regular expression
+(@code{gnus-group-mark-regexp}).
@end table
Also @xref{Process/Prefix}.
the hook for the group mode:
@lisp
-(add-hook 'gnus-group-mode 'gnus-topic-mode)
+(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
@end lisp
There are, in general, two methods for dividing the groups into topics.
@table @kbd
-@item T c
-@kindex T c (Group)
+@item T n
+@kindex T n (Group)
@findex gnus-topic-create-topic
Create a new topic (@code{gnus-topic-create-subtopic}). You will be
prompted for a topic name and the name of the parent topic.
@item T m
@kindex T m (Group)
-@findex gnus-topic-move-to-topic
+@findex gnus-topic-move-group
Move the current group to some other topic
-(@code{gnus-topic-move-to-topic}). This command understands the
+(@code{gnus-topic-move-group}). This command understands the
+process/prefix convention (@pxref{Process/Prefix}).
+
+@item T c
+@kindex T c (Group)
+@findex gnus-topic-copy-group
+Copy the current group to some other topic
+(@code{gnus-topic-copy-group}). This command understands the
process/prefix convention (@pxref{Process/Prefix}).
+@item T M
+@kindex T M (Group)
+@findex gnus-topic-move-matching
+Move all groups that match some regular expression to a topic
+(@code{gnus-topic-move-matching}).
+
+@item T C
+@kindex T C (Group)
+@findex gnus-topic-copy-matching
+Copy all groups that match some regular expression to a topic
+(@code{gnus-topic-copy-matching}).
+
@item RET
@kindex RET (Group)
@findex gnus-topic-select-group
Yank the previosuly killed group or topic (@code{gnus-topic-yank-group}).
Note that all topics will be yanked before all groups.
+@item T r
+@kindex T r (Group)
+@findex gnus-topic-rename
+Rename a topic (@code{gnus-topic-rename}).
+
+@item T DEL
+@kindex T DEL (Group)
+@findex gnus-topic-delete
+Delete an empty topic (@code{gnus-topic-delete}).
+
@end table
The @code{Newsgroups} header is illegal in this list, while @code{To} is
required, and @code{X-Mailer} can be added if you so should want.
+@findex gnus-forward-start-separator
+@item gnus-forward-start-separator
+Delimiter inserted before forwarded messages.
+
+@findex gnus-forward-end-separator
+@item gnus-forward-end-separator
+Delimiter inserted after forwarded messages.
+
+@findex gnus-signature-before-forwarded-message
+@item gnus-signature-before-forwarded-message
+If this variable is @code{t}, which it is by default, your personal
+signature will be inserted before the forwarded message. If not, the
+forwarded message will be inserted first in the new mail.
+
@end table
@kindex C-c C-c (Mail)
will be highlighted (with @code{gnus-mouse-face}) when you put the mouse
pointer over it.
-Text inside the @samp{%[} and @samp{%]} specifiers will have their
+Text inside the @samp{%@{} and @samp{%@}} specifiers will have their
normal faces set using @code{gnus-face-0}, which is @code{bold} by
-default. If you say @samp{%1[} instead, you'll get @code{gnus-face-1}
+default. If you say @samp{%1@{} instead, you'll get @code{gnus-face-1}
instead, and so on. Create as many faces as you wish. The same goes
for the @code{mouse-face} specs---you can say @samp{%3(hello%)} to have
@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
;; Set the new & fancy format.
(setq gnus-group-line-format
- "%M%S%3[%5y%]%2[:%] %(%1[%g%]%)\n")
+ "%M%S%3@{%5y%@}%2[:%] %(%1@{%g%@}%)\n")
@end lisp
I'm sure you'll be able to use this scheme to create totally unreadable
@cindex gnu.emacs.gnus
@cindex ding mailing list
-You can also ask on the ding mailing list---samp{ding@@ifi.uio.no}.
+You can also ask on the ding mailing list---@samp{ding@@ifi.uio.no}.
Write to @samp{ding-request@@ifi.uio.no} to subscribe.
projects / gnus / commitdiff