*** pub/sgnus/lisp/gnus-mh.el Sun Nov 26 16:01:46 1995 --- sgnus/lisp/gnus-mh.el Fri Dec 1 04:48:58 1995 *************** *** 80,86 **** (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)) --- 80,85 ---- *************** *** 90,95 **** --- 89,95 ---- (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) *** pub/sgnus/lisp/gnus-msg.el Sun Nov 26 16:01:47 1995 --- sgnus/lisp/gnus-msg.el Fri Dec 1 04:48:54 1995 *************** *** 177,182 **** --- 177,193 ---- 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. *************** *** 1395,1402 **** (let* ((organization (or (getenv "ORGANIZATION") (if gnus-local-organization ! (if (and (symbolp gnus-local-organization) ! (fboundp gnus-local-organization)) (funcall gnus-local-organization gnus-newsgroup-name) gnus-local-organization)) gnus-organization-file --- 1406,1412 ---- (let* ((organization (or (getenv "ORGANIZATION") (if gnus-local-organization ! (if (gnus-functionp gnus-local-organization) (funcall gnus-local-organization gnus-newsgroup-name) gnus-local-organization)) gnus-organization-file *************** *** 1532,1543 **** (gnus-narrow-to-headers) (if (not followup) ;; This is a regular reply. ! (if (and (symbolp gnus-reply-to-function) ! (fboundp 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)) (save-excursion (setq follow-to (funcall gnus-followup-to-function group))))) --- 1542,1551 ---- (gnus-narrow-to-headers) (if (not followup) ;; This is a regular reply. ! (if (gnus-functionp gnus-reply-to-function) (setq follow-to (funcall gnus-reply-to-function group))) ;; This is a followup. ! (if (gnus-functionp gnus-followup-to-function) (save-excursion (setq follow-to (funcall gnus-followup-to-function group))))) *************** *** 1642,1647 **** --- 1650,1656 ---- 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 *************** *** 1654,1662 **** (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)) (goto-char end) (setq yank (cdr yank)))) (goto-char last)) --- 1663,1683 ---- (save-excursion (gnus-copy-article-buffer) (mail-yank-original nil) ! (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)) *************** *** 1689,1696 **** (gnus-inews-insert-bfcc) (gnus-inews-insert-signature) (and gnus-post-prepare-function ! (symbolp gnus-post-prepare-function) ! (fboundp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (goto-char (point-min)) (if group --- 1710,1716 ---- (gnus-inews-insert-bfcc) (gnus-inews-insert-signature) (and gnus-post-prepare-function ! (gnus-functionp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (goto-char (point-min)) (if group *************** *** 1729,1736 **** (save-restriction (set-buffer gnus-article-copy) (gnus-narrow-to-headers) ! (if (and (symbolp gnus-followup-to-function) ! (fboundp gnus-followup-to-function)) (save-excursion (setq follow-to (funcall gnus-followup-to-function group)))) --- 1749,1755 ---- (save-restriction (set-buffer gnus-article-copy) (gnus-narrow-to-headers) ! (if (gnus-functionp gnus-followup-to-function) (save-excursion (setq follow-to (funcall gnus-followup-to-function group)))) *************** *** 1793,1800 **** (gnus-inews-insert-signature) (and gnus-post-prepare-function ! (symbolp gnus-post-prepare-function) ! (fboundp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (run-hooks 'gnus-post-prepare-hook) --- 1812,1818 ---- (gnus-inews-insert-signature) (and gnus-post-prepare-function ! (gnus-functionp gnus-post-prepare-function) (funcall gnus-post-prepare-function group)) (run-hooks 'gnus-post-prepare-hook) *************** *** 1973,1979 **** (cdr reply))))) (and winconf (set-window-configuration winconf)))))) - (defun gnus-forward-make-subject (buffer) (save-excursion (set-buffer buffer) --- 1991,1996 ---- *************** *** 1986,2003 **** "] " (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 . ! (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)))))) (defun gnus-mail-forward (&optional buffer) "Forward the current message to another user using mail." --- 2003,2031 ---- "] " (or (gnus-fetch-field "Subject") "")))) (defun gnus-forward-insert-buffer (buffer) ! (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." *************** *** 2310,2316 **** (defun gnus-inews-insert-gcc () (let* ((group gnus-outgoing-message-group) (gcc (cond ! ((and (symbolp group) (fboundp group)) (funcall group)) ((or (stringp group) (list group)) group)))) --- 2338,2344 ---- (defun gnus-inews-insert-gcc () (let* ((group gnus-outgoing-message-group) (gcc (cond ! ((gnus-functionp group) (funcall group)) ((or (stringp group) (list group)) group)))) *************** *** 2446,2453 **** (when (cond ((stringp match) ;; Regexp string match on the group name. (string-match match gnus-newsgroup-name)) ! ((symbolp match) ! (cond ((fboundp match) ;; Function to be called. (funcall match)) ((boundp match) --- 2474,2482 ---- (when (cond ((stringp match) ;; Regexp string match on the group name. (string-match match gnus-newsgroup-name)) ! ((or (symbolp match) ! (gnus-functionp match)) ! (cond ((gnus-functionp match) ;; Function to be called. (funcall match)) ((boundp match) *************** *** 2469,2476 **** (setq value-value (cond ((stringp value) value) ! ((symbolp value) ! (cond ((fboundp value) (funcall value)) ((boundp value) (symbol-value value)))) --- 2498,2506 ---- (setq value-value (cond ((stringp value) value) ! ((or (symbolp value) ! (gnus-functionp value)) ! (cond ((gnus-functionp value) (funcall value)) ((boundp value) (symbol-value value)))) *** pub/sgnus/lisp/gnus-topic.el Sun Nov 26 16:01:49 1995 --- sgnus/lisp/gnus-topic.el Sun Dec 3 00:49:49 1995 *************** *** 31,37 **** (defvar gnus-topic-mode nil "Minor mode for Gnus group buffers.") ! (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. --- 31,37 ---- (defvar gnus-topic-mode nil "Minor mode for Gnus group buffers.") ! (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. *************** *** 43,62 **** %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'.") --- 43,48 ---- *************** *** 75,81 **** (?v visible ?s) (?i indentation ?s) (?g number-of-groups ?d) ! (?a (gnus-topic-articles-in-topic groups) ?d) (?l level ?d))) (defvar gnus-topic-line-format-spec nil) --- 61,67 ---- (?v visible ?s) (?i indentation ?s) (?g number-of-groups ?d) ! (?a number-of-articles ?d) (?l level ?d))) (defvar gnus-topic-line-format-spec nil) *************** *** 84,96 **** (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)))) (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-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. --- 70,94 ---- (defun gnus-group-topic-name () "The name of the topic on the current line." ! (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. *************** *** 119,198 **** ;; Use topics. (when (< lowest gnus-level-zombie) ! (let ((topics (gnus-topic-find-groups nil level all)) ! 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) (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-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) "Insert TOPIC into the group buffer." (let* ((type (pop topic)) ! (groups (nreverse (cdr (assoc (car type) topic-alist)))) (visiblep (eq (nth 1 type) 'visible)) ! info) ;; Insert the topic line. (gnus-topic-insert-topic-line (car type) visiblep (not (eq (nth 2 type) 'hidden)) ! level groups) (when visiblep ;; Insert all the groups that belong in this topic. ! (while groups ! (setq info (pop groups)) (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)))) ;; 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) (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) group (gnus-info-group info) params (gnus-info-params info) ! newsrc (cdr newsrc) ! unread (car (gnus-gethash group gnus-newsrc-hashtb))) (and unread ; nil means that the group is dead. (<= (setq clevel (gnus-info-level info)) level) --- 117,178 ---- ;; Use topics. (when (< lowest gnus-level-zombie) ! (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-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) 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 &optional list-level all) "Insert TOPIC into the group buffer." (let* ((type (pop topic)) ! (entries (gnus-topic-find-groups (car type) list-level all)) (visiblep (eq (nth 1 type) 'visible)) ! info entry) ;; Insert the topic line. (gnus-topic-insert-topic-line (car type) visiblep (not (eq (nth 2 type) 'hidden)) ! level entries) (when visiblep ;; Insert all the groups that belong in this topic. ! (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 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) 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 level (or level 7)) ;; We go through the newsrc to look for matches. ! (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) ! unread (car entry)) (and unread ; nil means that the group is dead. (<= (setq clevel (gnus-info-level info)) level) *************** *** 206,234 **** (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)) (defun gnus-topic-remove-topic (&optional insert total-remove hide) "Remove the current topic." --- 186,194 ---- (string-match gnus-permanently-visible-groups group)) (memq 'visible params) (cdr (assq 'visible params))) ! ;; 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." *************** *** 269,311 **** "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) (let* ((visible (if (and visiblep shownp) "" "...")) (indentation (make-string (* 2 level) ? )) ! (number-of-groups (length groups)) ! b) (beginning-of-line) ;; Insert the text. (add-text-properties (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec)) ! (list 'gnus-topic (intern 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) (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-find-topology (topic &optional topology level remove) (unless topology (setq topology gnus-topic-topology) (setq level 0)) --- 229,273 ---- "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 entries) (let* ((visible (if (and visiblep shownp) "" "...")) (indentation (make-string (* 2 level) ? )) ! (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 name 'gnus-topic-level level 'gnus-topic-visible visiblep)))) ! (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)) ! (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)) *************** *** 324,348 **** (setq topology (cdr topology))) result))) (defun gnus-topic-enter-dribble () (gnus-dribble-enter (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) ! (defun gnus-topic-articles-in-topic (groups) (let ((total 0) number) ! (while groups ! (when (numberp (setq number (gnus-group-unread ! (gnus-info-group (pop groups))))) (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-topic-goto-topic (topic) (goto-char (point-min)) --- 286,350 ---- (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 (entries) (let ((total 0) number) ! (while entries ! (when (numberp (setq number (car (pop entries)))) (incf total number))) total)) ! (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)) *************** *** 354,364 **** (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-group-goto-group group) (gnus-group-position-point)))) ;;; Topic mode, commands and keymap. (defvar gnus-topic-mode-map nil) --- 356,379 ---- (when (and (eq major-mode 'gnus-group-mode) gnus-topic-mode) (let ((group (gnus-group-group-name))) ! (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) *************** *** 371,383 **** (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-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 "h" 'gnus-topic-hide-topic) (define-key gnus-group-topic-map "s" 'gnus-topic-show-topic) ) ;;;###autoload --- 386,408 ---- (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 "#" '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 *************** *** 419,424 **** --- 444,455 ---- (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 *************** *** 437,475 **** (interactive (list (read-string "Create topic: ") ! (completing-read "Parent topic: " ! (mapcar (lambda (l) (list l)) (gnus-topic-list)) ! 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)))) (gnus-topic-enter-dribble) (gnus-group-list-groups)) ! ;; Written by "jeff (j.d.) sparkes" . ! (defun gnus-topic-move-to-topic (n topic) "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))) (mapcar (lambda (g) (gnus-group-remove-mark g) ! (gnus-group-add-parameter g (cons 'topic topic))) groups) (gnus-group-position-point)) (gnus-topic-enter-dribble) (gnus-group-list-groups)) (defun gnus-topic-kill-group (&optional n discard) "Kill the next N groups." (interactive "P") --- 468,521 ---- (interactive (list (read-string "Create topic: ") ! (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)) ! (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)) ! (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: " 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) ! (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") *************** *** 481,494 **** gnus-topic-killed-topics)))) (defun gnus-topic-yank-group (&optional arg) ! "Yank the last ARG groups." (interactive "p") (if (null gnus-topic-killed-topics) (gnus-group-yank-group arg) ! (let ((parent (gnus-group-topic-name)) (item (nth 1 (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic ! (car item) (or parent (car (car gnus-topic-topology))))))) (defun gnus-topic-hide-topic () "Hide all subtopics under the current topic." --- 527,540 ---- gnus-topic-killed-topics)))) (defun gnus-topic-yank-group (&optional arg) ! "Yank the last topic." (interactive "p") (if (null gnus-topic-killed-topics) (gnus-group-yank-group arg) ! (let ((previous (gnus-group-parent-topic)) (item (nth 1 (pop gnus-topic-killed-topics)))) (gnus-topic-create-topic ! (car item) (gnus-topic-parent-topic previous) previous)))) (defun gnus-topic-hide-topic () "Hide all subtopics under the current topic." *************** *** 501,505 **** --- 547,643 ---- (interactive) (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 *** pub/sgnus/lisp/gnus-vis.el Sun Nov 26 16:01:50 1995 --- sgnus/lisp/gnus-vis.el Wed Nov 29 18:47:42 1995 *************** *** 222,233 **** (assq (1+ lines) gnus-cite-attribution-alist))) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ! ("]*\\)>" 0 t ,browse-url-browser-function 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ! (,gnus-button-url-regexp 0 t ,browse-url-browser-function 0) ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t ! gnus-button-message-id 3)) "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where --- 222,235 ---- (assq (1+ lines) gnus-cite-attribution-alist))) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ! ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ! (,gnus-button-url-regexp 0 t gnus-button-url 0) ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t ! gnus-button-message-id 3) ! ("\\(?" 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 *************** *** 247,254 **** ("^\\(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)) "Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each --- 249,255 ---- ("^\\(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 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 *************** *** 1379,1398 **** (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: --- 1380,1386 ---- (goto-char end)))) (widen))) ! ;;; External functions: *************** *** 1474,1479 **** --- 1462,1471 ---- (defun gnus-button-reply (address) ;; Reply to ADDRESS. (gnus-mail-reply t address)) + + (defun gnus-button-url (address) + "Browse ADDRESS." + (funcall browse-url-browser-function address)) ;;; Compatibility Functions: *** pub/sgnus/lisp/gnus.el Sun Nov 26 16:01:52 1995 --- sgnus/lisp/gnus.el Sun Dec 3 02:03:39 1995 *************** *** 1016,1022 **** This restriction may disappear in later versions of Gnus.") ! (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. --- 1016,1023 ---- This restriction may disappear in later versions of Gnus.") ! (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. *************** *** 1175,1184 **** 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).") (defvar gnus-group-prepare-hook nil "*A hook called after the group buffer has been generated. --- 1176,1182 ---- 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 is `gnus-group-prepare-flat'.") (defvar gnus-group-prepare-hook nil "*A hook called after the group buffer has been generated. *************** *** 1437,1443 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.16" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1435,1441 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.17" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1470,1476 **** gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list ! gnus-topic-topology) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-options nil --- 1468,1474 ---- gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list ! gnus-topic-topology gnus-topic-alist) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-options nil *************** *** 1485,1490 **** --- 1483,1491 ---- (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.") *************** *** 1811,1817 **** "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(let ((symbol (intern ,string ,hashtable))) (or (boundp symbol) ! (setq symbol nil)) symbol)) (defmacro gnus-group-unread (group) --- 1812,1818 ---- "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." `(let ((symbol (intern ,string ,hashtable))) (or (boundp symbol) ! (set symbol nil)) symbol)) (defmacro gnus-group-unread (group) *************** *** 2019,2025 **** (gnus-byte-code 'gnus-summary-line-format-spec)) (defun gnus-summary-dummy-line-format-spec () ! (insert "* : : " gnus-tmp-subject "\n")) (defvar gnus-summary-dummy-line-format-spec (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) --- 2020,2034 ---- (gnus-byte-code 'gnus-summary-line-format-spec)) (defun gnus-summary-dummy-line-format-spec () ! (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)) *************** *** 2176,2182 **** (gnus-update-group-mark-positions) (gnus-update-summary-mark-positions) ! (if (and (string-match "%D" gnus-group-line-format) (not gnus-description-hashtb) gnus-read-active-file) (gnus-read-all-descriptions-files))) --- 2185,2191 ---- (gnus-update-group-mark-positions) (gnus-update-summary-mark-positions) ! (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) (not gnus-description-hashtb) gnus-read-active-file) (gnus-read-all-descriptions-files))) *************** *** 2187,2192 **** --- 2196,2202 ---- (gnus-score-below-mark 130) (gnus-score-over-mark 130) (thread nil) + (gnus-visual nil) pos) (gnus-set-work-buffer) (gnus-summary-insert-line *************** *** 2258,2264 **** ;; 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?\\)\\'" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. --- 2268,2274 ---- ;; 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?\\)\\'" format) (gnus-parse-complex-format format spec-alist) ;; This is a simple format. *************** *** 2273,2283 **** (replace-match "\\\"" nil t)) (goto-char (point-min)) (insert "(\"") ! (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 ?\[)) (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") " " number " \"")) (replace-match "\")\"")))) --- 2283,2293 ---- (replace-match "\\\"" nil t)) (goto-char (point-min)) (insert "(\"") ! (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 ?\{)) (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") " " number " \"")) (replace-match "\")\"")))) *************** *** 3204,3209 **** --- 3214,3224 ---- ;; 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) *************** *** 3565,3570 **** --- 3580,3586 ---- (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) *************** *** 3669,3674 **** --- 3685,3691 ---- (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)) *************** *** 3697,3703 **** 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) (setq gnus-group-use-permanent-levels t) (gnus (or arg (1- gnus-level-default-subscribed)) t)) --- 3714,3720 ---- 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) (setq gnus-group-use-permanent-levels t) (gnus (or arg (1- gnus-level-default-subscribed)) t)) *************** *** 4246,4256 **** (- (1+ (cdr active)) (car active)) 0) nil)))) ! (defalias 'gnus-group-remove-excess-properties (lambda ())) (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number gnus-tmp-method) (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-number-total (if gnus-tmp-active --- 4263,4275 ---- (- (1+ (cdr active)) (car active)) 0) nil)))) ! ;; 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 *************** *** 4291,4318 **** (cdr (assq 'tick gnus-tmp-marked))) ?* ? )) (gnus-tmp-number ! (if (eq 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) (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)) (gnus-group-remove-excess-properties))) (defun gnus-group-update-group (group &optional visible-only) --- 4310,4336 ---- (cdr (assq 'tick gnus-tmp-marked))) ?* ? )) (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. (beginning-of-line) ! (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) *************** *** 4372,4377 **** --- 4390,4396 ---- (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. *************** *** 4416,4422 **** (and (let ((unread (get-text-property (point) 'gnus-unread))) ! (or (eq unread t) (and unread (> unread 0)))) (setq lev (get-text-property (point) 'gnus-level)) (<= lev gnus-level-subscribed))) --- 4435,4443 ---- (and (let ((unread (get-text-property (point) 'gnus-unread))) ! ;(and unread ! (or (eq unread t) ! (and unread (> unread 0))));) (setq lev (get-text-property (point) 'gnus-level)) (<= lev gnus-level-subscribed))) *************** *** 4480,4490 **** (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)))) ;; 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) --- 4501,4529 ---- (goto-char beg) (- num (gnus-group-mark-group num unmark))))) ! (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) *************** *** 4855,4860 **** --- 4894,4900 ---- 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))) *************** *** 5182,5190 **** (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)))) (symbol-name (car (gnus-find-method-for-group ! (gnus-info-group info2)))))) (defun gnus-group-sort-by-score (info1 info2) "Sort by group score." --- 5222,5230 ---- (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) info1))) (symbol-name (car (gnus-find-method-for-group ! (gnus-info-group info2) info2))))) (defun gnus-group-sort-by-score (info1 info2) "Sort by group score." *************** *** 5263,5283 **** (interactive "P") (let ((groups (gnus-group-process-prefix n)) group) ! (or groups (error "No groups to expire")) (while groups ! (setq group (car groups) ! groups (cdr groups)) (gnus-group-remove-mark group) ! (if (not (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)))))))) (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." --- 5303,5323 ---- (interactive "P") (let ((groups (gnus-group-process-prefix n)) group) ! (unless groups ! (error "No groups to expire")) (while groups ! (setq group (pop groups)) (gnus-group-remove-mark 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))))) ! (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." *************** *** 5452,5458 **** (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)) ;; 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 --- 5492,5498 ---- (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 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 *************** *** 5462,5468 **** 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)) (setq gnus-list-of-killed-groups (cdr gnus-list-of-killed-groups))) (forward-line -1) --- 5502,5508 ---- info (nth 2 info) gnus-level-killed (and prev (gnus-gethash prev gnus-newsrc-hashtb)) t) ! (gnus-group-insert-group-line-info group) (setq gnus-list-of-killed-groups (cdr gnus-list-of-killed-groups))) (forward-line -1) *************** *** 5486,5492 **** ;; 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)) (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) ;; Go through all newsgroups that are known to Gnus - enlarge kill list (mapatoms --- 5526,5534 ---- ;; Find all possible killed newsgroups if arg. (when arg ;; First make sure active file has been read. ! (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 *************** *** 5528,5535 **** "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)) ;; Find all groups and sort them. (let ((groups (sort --- 5570,5578 ---- "List all groups that are available from the server(s)." (interactive) ;; First we make sure that we have really read the 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 *************** *** 5773,5779 **** (gnus-message 6 (substitute-command-keys ! "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)"))) (defun gnus-group-edit-local-kill (article group) "Edit a local kill file." --- 5816,5823 ---- (gnus-message 6 (substitute-command-keys ! (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." *************** *** 6862,6867 **** --- 6906,6913 ---- (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) *************** *** 7542,7548 **** ;; article. (when gnus-tmp-dummy-line (gnus-summary-insert-dummy-line ! gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))) ;; Compute the mark. (setq --- 7588,7595 ---- ;; article. (when gnus-tmp-dummy-line (gnus-summary-insert-dummy-line ! gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) ! (setq gnus-tmp-dummy-line nil)) ;; Compute the mark. (setq *************** *** 7565,7577 **** (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-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)) gnus-summary-same-subject subject)) (t gnus-summary-same-subject))) --- 7612,7626 ---- (cond ((and gnus-thread-ignore-subject gnus-tmp-prev-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) ! gnus-tmp-prev-subject ! (inline (gnus-subject-equal ! gnus-tmp-prev-subject subject))) gnus-summary-same-subject subject)) (t gnus-summary-same-subject))) *************** *** 7613,7618 **** --- 7662,7669 ---- (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) *************** *** 7920,7931 **** (and (not (setq m (assq type (car marked)))) (setcar marked (cons (cons type (gnus-compress-sequence articles t) ) ! (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))))))) (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. --- 7971,7982 ---- (and (not (setq m (assq type (car marked)))) (setcar marked (cons (cons type (gnus-compress-sequence articles t) ) ! (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)))))) (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. *************** *** 8117,8127 **** (defvar gnus-newsgroup-none-id 0) ! (defun gnus-get-newsgroup-headers () ! (setq gnus-article-internal-prepare-hook nil) (let ((cur nntp-server-buffer) ! (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) --- 8168,8179 ---- (defvar gnus-newsgroup-none-id 0) ! (defun gnus-get-newsgroup-headers (&optional dependencies) (let ((cur nntp-server-buffer) ! (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) *************** *** 8488,8494 **** (let* ((article (or article (gnus-summary-article-number))) (arts (gnus-data-find-list article)) result) ! (unless gnus-summary-check-current (setq arts (cdr arts))) (when (setq result (if unread --- 8540,8548 ---- (let* ((article (or article (gnus-summary-article-number))) (arts (gnus-data-find-list article)) result) ! (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 *************** *** 8507,8513 **** (let* ((article (or article (gnus-summary-article-number))) (arts (gnus-data-find-list article (gnus-data-list 'rev))) result) ! (unless gnus-summary-check-current (setq arts (cdr arts))) (if (setq result (if unread --- 8561,8569 ---- (let* ((article (or article (gnus-summary-article-number))) (arts (gnus-data-find-list article (gnus-data-list 'rev))) result) ! (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 *************** *** 8528,8534 **** (articles (gnus-data-list backward)) (arts (gnus-data-find-list article articles)) result) ! (unless gnus-summary-check-current (setq arts (cdr arts))) (while arts (and (or (not unread) --- 8584,8592 ---- (articles (gnus-data-list backward)) (arts (gnus-data-find-list article articles)) result) ! (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) *************** *** 10344,10350 **** (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing.")) ! (gnus-summary-select-article t) (gnus-configure-windows 'article) (select-window (get-buffer-window gnus-article-buffer)) (gnus-message 6 "C-c C-c to end edits") --- 10402,10408 ---- (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing.")) ! (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") *************** *** 11162,11168 **** (when (and (not (eobp)) (or (and (zerop (gnus-summary-next-thread 1 t)) (gnus-summary-find-prev)) ! (gnus-summary-goto-subject gnus-newsgroup-end))) (setq end (point)) (prog1 (if (and (> (point) start) --- 11220,11226 ---- (when (and (not (eobp)) (or (and (zerop (gnus-summary-next-thread 1 t)) (gnus-summary-find-prev)) ! (goto-char (gnus-data-pos (car (gnus-data-list 'rev)))))) (setq end (point)) (prog1 (if (and (> (point) start) *************** *** 11524,11531 **** (condition-case () (re-search-forward (car method) nil t) (error nil))) ! ((and (symbolp (car method)) ! (fboundp (car method))) (funcall (car method))) ((consp (car method)) (eval (car method)))) --- 11582,11588 ---- (condition-case () (re-search-forward (car method) nil t) (error nil))) ! ((gnus-functionp (car method)) (funcall (car method))) ((consp (car method)) (eval (car method)))) *************** *** 12108,12122 **** 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)) (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))) (let* ((article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) (internal-hook gnus-article-internal-prepare-hook) --- 12165,12178 ---- If ALL-HEADERS is non-nil, no headers are hidden." (save-excursion ;; Make sure we start in a 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. ! (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) *************** *** 12125,12130 **** --- 12181,12190 ---- (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)))) *************** *** 12383,12389 **** ;; 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) (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 --- 12443,12449 ---- ;; We display the face. (if (symbolp gnus-article-x-face-command) ;; The command is a lisp function, so we call it. ! (if (gnus-functionp gnus-article-x-face-command) (funcall gnus-article-x-face-command beg end) (error "%s is not a function" gnus-article-x-face-command)) ;; The command is a string, so we interpret the command *************** *** 12945,12950 **** --- 13005,13011 ---- (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) *************** *** 13284,13289 **** --- 13345,13354 ---- (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. *************** *** 13291,13297 **** (gnus-method-option-p group-method 'post)) gnus-post-method) ;; Perhaps this is a mail group? ! ((gnus-member-of-valid 'post group) group-method) ;; Use the normal select method. (t gnus-select-method)))) --- 13356,13362 ---- (gnus-method-option-p group-method 'post)) gnus-post-method) ;; Perhaps this is a mail group? ! ((not (gnus-member-of-valid 'post group)) group-method) ;; Use the normal select method. (t gnus-select-method)))) *************** *** 13758,13802 **** If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) ! bogus group entry) (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) ;; The group is bogus. (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"))) (defun gnus-check-duplicate-killed-groups () "Remove duplicates from the list of killed groups." --- 13823,13865 ---- If CONFIRM is non-nil, the user has to confirm the deletion of every newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) ! bogus group entry info) (gnus-message 5 "Checking bogus newsgroups...") ! (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 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." *************** *** 13873,13879 **** ;; 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"))) --- 13936,13942 ---- ;; 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"))) *************** *** 13892,13901 **** 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) (setq prev alist alist (cdr alist))))) --- 13955,13965 ---- 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) (setq prev alist alist (cdr alist))))) *** pub/sgnus/lisp/nnmail.el Sun Nov 26 16:01:52 1995 --- sgnus/lisp/nnmail.el Mon Nov 27 17:57:26 1995 *************** *** 476,482 **** (defun nnmail-process-unix-mail-format (func) (let ((delim (concat "^" rmail-unix-mail-delimiter)) ! start message-id content-length end skip) (if (not (and (re-search-forward delim nil t) (goto-char (match-beginning 0)))) ;; Possibly wrong format? --- 476,482 ---- (defun nnmail-process-unix-mail-format (func) (let ((delim (concat "^" rmail-unix-mail-delimiter)) ! 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? *************** *** 505,511 **** (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) (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 --- 505,512 ---- (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) ;; Look for a Content-Length header. (goto-char (point-min)) ! (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 *************** *** 515,520 **** --- 516,522 ---- ;; 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) *************** *** 528,533 **** --- 530,536 ---- (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)))) *************** *** 575,581 **** ;; 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))) --- 578,583 ---- *************** *** 603,609 **** (not nnmail-resplit-incoming)) (list (list group "")) nnmail-split-methods)) ! start end content-length do-search message-id) (save-excursion ;; Open the message-id cache. (nnmail-cache-open) --- 605,611 ---- (not nnmail-resplit-incoming)) (list (list group "")) nnmail-split-methods)) ! start end do-search message-id) (save-excursion ;; Open the message-id cache. (nnmail-cache-open) *** pub/sgnus/lisp/nnvirtual.el Sun Nov 26 16:01:53 1995 --- sgnus/lisp/nnvirtual.el Wed Nov 29 23:52:43 1995 *************** *** 244,256 **** "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)) header) (erase-buffer) (while headers ! (setq header (car headers) ! headers (cdr headers)) (insert (int-to-string (mail-header-number header)) "\t" (or (mail-header-subject header) "") "\t" (or (mail-header-from header) "") "\t" --- 244,255 ---- "Convert HEAD headers into NOV headers." (save-excursion (set-buffer nntp-server-buffer) ! (let* ((dependencies (make-vector 100 0)) ! (headers (gnus-get-newsgroup-headers dependencies)) header) (erase-buffer) (while 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" *** pub/sgnus/lisp/ChangeLog Sun Nov 26 16:02:00 1995 --- sgnus/lisp/ChangeLog Sun Dec 3 00:49:11 1995 *************** *** 1,4 **** --- 1,130 ---- + Sun Dec 3 00:34:01 1995 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-delete): New command and keystroke. + + Sat Dec 2 00:10:23 1995 Lars Ingebrigtsen + + * gnus.el (gnus-intern-safe): Didn't return the proper symbol. + + * gnus-topic.el (gnus-topic-move-matching): New command and + keystroke. + (gnus-topic-copy-matching): New command and keystroke. + (gnus-topic-change-name): New command and keystroke. + + * gnus.el (gnus-group-mark-regexp): New command and keystroke. + + * gnus-topic.el (gnus-topic-mark-topic): New command and + keystroke. + (gnus-topic-get-new-news-this-topic): New command and keystroke. + + * gnus.el (gnus-group-set-mark): New function. + + Fri Dec 1 01:58:48 1995 Lars Ingebrigtsen + + * gnus-topic.el (gnus-topic-copy-to-topic): New function. + + * gnus-topic.el: Changes throughout. + + * gnus.el (gnus-summary-prepare-threads): Have "name" default more + often to From. + (gnus-summary-insert-line): Ditto. + (gnus-get-unread-articles): Close the group. + (gnus-update-format-specifications): Really read the descriptions + files. + (gnus-post-method): Would return the wrong posting method. + (gnus-summary-dummy-line-format): Set mouse-face. + (gnus-update-summary-mark-positions): Bind `gnus-visual' to nil. + (gnus-get-newsgroup-headers): Don't reset + `gnus-article-internal-prepare-hook'. + (gnus-group-edit-global-kill): Better message. + (gnus-topic-alist): New variable. + + * gnus-msg.el (gnus-signature-before-forwarded-message): New + variable. + (gnus-forward-start-separator): Changed name. + (gnus-forward-end-separator): Ditto. + (gnus-forward-insert-buffer): Use them. + + * gnus.el (gnus-check-bogus-newsgroups): Be a bit more + conservative in removing bogus groups. + + Wed Nov 29 22:02:36 1995 Lars Ingebrigtsen + + * gnus.el (gnus-mouse-pick-group): Doc fix. + (gnus-group-expire-articles): Bugged out on compress sequences. + (gnus-parse-complex-format): Changed %[ specs into %{ specs. + (gnus-group-set-mode-line): Bind `header'. + (gnus-summary-prepare-threads): Don't output lots and lots of + dummy lines. + + * gnus-topic.el (gnus-mouse-pick-topic): New command. + + * gnus.el (gnus-group-insert-group-line): Make sure + `gnus-tmp-number' is a string. + (gnus-summary-find-next): Wouldn't handle + `gnus-summary-check-current'. + + Wed Nov 29 21:56:33 1995 Luc Van Eycken + + * gnus.el (gnus-summary-hide-thread): Didn't hide the last thread. + + Wed Nov 29 16:49:25 1995 Lars Ingebrigtsen + + * gnus.el (gnus-summary-prepare-threads): WOuld possibly print + empty lines when that wasn't required. + + * gnus-topic.el (gnus-group-prepare-topics): Created buggy + topologies. + + * gnus.el (gnus-group-sort-by-method): Didn't sort. + (gnus-article-prepare): Deactivate active regions. + (gnus-add-marked-articles): Bugged out when forcing marks. + (gnus-get-newsgroup-headers): Allow dependencies hashtb as a + parameter. + * nnvirtual.el (nnvirtual-convert-headers): Use it. + + * gnus-vis.el (gnus-button-url): New function. + (gnus-button-alist): Use it. + + * gnus.el (gnus-dribble-read-file): Turn on auto save mode + unconditionally. + + * gnus-msg.el (gnus-forward-start-delimiter): New variable. + (gnus-forward-end-delimiter): Ditto. + (gnus-forward-insert-buffer): Use them. + + * gnus-vis.el (gnus-button-alist): Handle mailto: URLs + internally. + + Sun Nov 26 14:46:55 1995 Steven L. Baur + + * gnus.el (gnus-summary-edit-article): force read of articles + that Gnus thinks are pseudos. + + Sun Nov 26 14:46:55 1995 Steven L. Baur + + * gnus.el (gnus-no-server): typo prevented entry to gnus + + Wed Nov 29 15:03:18 1995 Lars Ingebrigtsen + + * gnus.el (gnus-functionp): New function. + (gnus-group-list-active): Really read the active file first. + (gnus-group-list-killed): Ditto. + + * gnus-msg.el: Used throughout. + (gnus-mail-reply): When yanking multiple articles, didn't cite + right. + + Mon Nov 27 17:39:04 1995 Lars Ingebrigtsen + + * nnmail.el (nnmail-process-unix-mail-format): Might possibly + collate two mails. + (nnmail-process-unix-mail-format): Would become confused when + articles contained Content-Length headers. + Sun Nov 26 15:15:29 1995 Lars Magne Ingebrigtsen + + * gnus.el: 0.16 is released. * gnus.el (gnus-select-newsgroup): Would bug out on dead groups. (gnus-summary-hide-thread): Didn't work at all. *** pub/sgnus/texi/gnus.texi Sun Nov 26 16:02:01 1995 --- sgnus/texi/gnus.texi Sun Dec 3 00:54:47 1995 *************** *** 1602,1607 **** --- 1602,1613 ---- @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}. *************** *** 3447,3453 **** the hook for the group mode: @lisp ! (add-hook 'gnus-group-mode 'gnus-topic-mode) @end lisp There are, in general, two methods for dividing the groups into topics. --- 3453,3459 ---- the hook for the group mode: @lisp ! (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) @end lisp There are, in general, two methods for dividing the groups into topics. *************** *** 3541,3559 **** @table @kbd ! @item T c ! @kindex T c (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 Move the current group to some other topic ! (@code{gnus-topic-move-to-topic}). This command understands the process/prefix convention (@pxref{Process/Prefix}). @item RET @kindex RET (Group) @findex gnus-topic-select-group --- 3547,3584 ---- @table @kbd ! @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-group Move the current group to some other topic ! (@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 *************** *** 3576,3581 **** --- 3601,3616 ---- 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 *************** *** 4314,4319 **** --- 4349,4368 ---- 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) *************** *** 8424,8432 **** 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 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} 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}. --- 8473,8481 ---- 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 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} 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}. *************** *** 8448,8454 **** ;; Set the new & fancy format. (setq gnus-group-line-format ! "%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 --- 8497,8503 ---- ;; Set the new & fancy format. (setq gnus-group-line-format ! "%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 *************** *** 9074,9080 **** @cindex gnu.emacs.gnus @cindex ding mailing list ! You can also ask on the ding mailing list---samp{ding@@ifi.uio.no}. Write to @samp{ding-request@@ifi.uio.no} to subscribe. --- 9123,9129 ---- @cindex gnu.emacs.gnus @cindex ding mailing list ! You can also ask on the ding mailing list---@samp{ding@@ifi.uio.no}. Write to @samp{ding-request@@ifi.uio.no} to subscribe. *** pub/sgnus/texi/ChangeLog Sun Nov 26 16:02:00 1995 --- sgnus/texi/ChangeLog Sun Dec 3 00:49:09 1995 *************** *** 1,3 **** --- 1,19 ---- + Sun Dec 3 00:34:35 1995 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + + Sat Dec 2 00:53:15 1995 Lars Ingebrigtsen + + * gnus.texi (Topic Commands): Addition. + + Fri Dec 1 02:24:59 1995 Lars Ingebrigtsen + + * gnus.texi (Mail): Addition. + + Wed Nov 29 17:31:53 1995 Lars Ingebrigtsen + + * gnus.texi (Mail): Addition. + Fri Nov 24 13:38:25 1995 Lars Ingebrigtsen * gnus.texi (Formatting Variables): Addition.