+Sat Jul 8 16:57:03 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus.el (gnus-summary-fetch-faq): Get the real name.
+ (gnus-summary-fetch-faq): Don't do the config thing unless the
+ fetch is successful.
+ (gnus-group-group-unread): New function.
+
+ * gnus-score.el (gnus-summary-header): Beep on pseudo-articles.
+
+ * gnus.el (gnus-group-expire-all-groups): Don't move the cursor.
+ (gnus-group-remove-mark): Don't be so verbose.
+ (gnus-summary-read-group): Return the the server buffer if
+ quitting a group entry from the server buffer.
+
+ * gnus-score.el (gnus-score-add-followups): Local variable shadows
+ parameter.
+
+ * gnus.el (gnus-summary-exit): Didn't update cache when proceeding
+ to the next group.
+ (gnus-summary-next-group): Didn't respect `gnus-keep-same-level'.
+ (gnus-summary-remove-lines-marked-as-read): Also remove canceled
+ articles.
+
+ * gnus-score.el (gnus-score-insert-help): Make the summary buffer
+ the selected window.
+
+ * gnus-vis.el (gnus-visual-score-map): New function to create a
+ gazillion menu bar entries.
+
+ * gnus.el (gnus-summary-next-group): New implementation.
+
+Fri Jul 7 12:55:47 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus-cache.el (gnus-cache-possibly-remove-article): Don't barf
+ on corrupted .overview files.
+
+ * gnus.el (gnus-summary-copy-article): Make sure to open
+ connection.
+ (gnus-summary-move-article): Ditto.
+ (gnus-group-make-group): Initialized active entry with wrong data.
+ (gnus-summary-mark-article): Don't mark ancients as expirable.
+
+ * nnbabyl.el (nnbabyl-request-create-group): New function.
+
+ * gnus.el (gnus-group-make-group): Did not check to see whether
+ the backend was loaded.
+
+ * gnus-vis.el (gnus-header-face-alist): New colours.
+
+Thu Jul 6 15:30:00 1995 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-vis.el: Use `custom-face-lookup' to create faces for
+ concistency.
+
+Thu Jul 6 14:17:34 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * nntp.el (nntp-async-request-group): New function to save async
+ state between groups that are open at the same time.
+
+ * nnbabyl.el (nnbabyl-retrieve-headers): Possible removal of
+ newlines.
+
+ * nnmbox.el (nnmbox-retrieve-headers): Ditto.
+
+Wed Jul 5 18:21:26 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus.el (gnus-summary-mode): Set the name of the group here.
+
+ * gnus-ems.el: `set-text-properties' doesn't work on strings.
+ (gnus-ems-redefine): Require gnus-msg on startup.
+
+Mon Jul 3 12:04:43 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus.el (gnus-group-startup-message): Tweaked message.
+
Sun Jul 2 14:11:14 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+ * gnus.el: 0.91 and 0.91.1 is released.
+
* nnvirtual.el (nnvirtual-catchup-group): Would kill the group
buffer.
EMACS=emacs
-FLAGS=-batch -l ./dgnushack.el
+FLAGS=-batch -q -no-site-file -l ./dgnushack.el
all:
$(EMACS) $(FLAGS) -f batch-byte-compile *.el
(if custom-mode-map
nil
(setq custom-mode-map (make-sparse-keymap))
- (define-key custom-mode-map [ mouse-2 ] 'custom-push-button)
+ (define-key custom-mode-map (if (string-match "XEmacs" emacs-version) [button2] [mouse-2]) 'custom-push-button)
(define-key custom-mode-map "\t" 'custom-forward-field)
(define-key custom-mode-map "\r" 'custom-enter-value)
(define-key custom-mode-map "\C-k" 'custom-kill-line)
(set-buffer (cdr gnus-cache-buffer))
(goto-char (point-min))
(if (or (looking-at (concat (int-to-string article) "\t"))
- (search-forward (concat "\n" (int-to-string article) "\t")))
+ (search-forward (concat "\n" (int-to-string article) "\t")
+ (point-max) t))
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))))))
(defvar gnus-cite-minimum-match-count 2
"Minimal number of identical prefix'es before we believe it is a citation.")
-(defvar gnus-cite-face-list '(italic)
+(defvar gnus-cite-face-list
+ (if (eq gnus-display-type 'color)
+ (if (eq gnus-background-mode 'dark) 'light 'dark)
+ '(italic))
"Faces used for displaying different citations.
It is either a list of face names, or one of the following special
values:
"Names of light colors.")
(defvar gnus-face-dark-name-list
- '("blue" "dark salmon" "firebrick"
+ '("violetred3" "violetred2" "violetred1" "violetred3" "deepskyblue3" "deepskyblue2" "deepskyblue1" "deepskyblue"
+ "dark salmon" "firebrick"
"dark green" "dark orange" "dark khaki" "dark violet"
"dark turquoise")
"Names of dark colors.")
(funcall 'set-face-underline-p 'underline t))
(or (fboundp 'set-text-properties)
(defun set-text-properties (start end props &optional buffer)
- (if props
- (put-text-property start end (car props) (cdr props) buffer)
- (remove-text-properties start end ()))))
+ (if (or (null buffer) (bufferp buffer))
+ (if props
+ (put-text-property start end (car props) (cdr props) buffer)
+ (remove-text-properties start end ())))))
(or (fboundp 'make-overlay) (fset 'make-overlay 'make-extent))
(or (fboundp 'overlay-put) (fset 'overlay-put 'set-extent-property))
(fset 'gnus-summary-make-display-table (lambda () nil))
- (provide 'gnus)
- (require 'gnus-vis)
-
(defun gnus-highlight-selected-summary ()
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
;; Highlight selected article in summary buffer
(setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer))))
(pop-to-buffer mail-buf) ;; always in the display, so won't have window probs
(switch-to-buffer draft)
- (kill-buffer mail-buf) ;; mh-e don't use it!
)
(save-excursion
(goto-char (point-max))
(require 'gnus)
(require 'sendmail)
+(require 'gnus-ems)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
(interactive)
(let ((winconf (current-window-configuration)))
(delete-other-windows)
- (switch-to-buffer "*Gnus Bug Help*")
+ (switch-to-buffer "*Gnus Help Bug*")
(erase-buffer)
(insert gnus-bug-message)
(goto-char (point-min))
(setq olist (cdr olist)))
(insert "\n\n")))
+(gnus-ems-redefine)
+
(provide 'gnus-msg)
;;; gnus-msg.el ends here
(insert string ":\n\n")
(while alist
(insert (format " %c: %s\n" (car (car alist)) (nth idx (car alist))))
- (setq alist (cdr alist)))))
+ (setq alist (cdr alist)))
+ (select-window (get-buffer-window gnus-summary-buffer))))
(defun gnus-summary-header (header)
;; Return HEADER for current articles, or error.
- (let ((article (gnus-summary-article-number)))
+ (let ((article (gnus-summary-article-number))
+ header)
(if article
- (aref (gnus-get-header-by-number article)
- (nth 1 (assoc header gnus-header-index)))
+ (if (setq header (gnus-get-header-by-number article))
+ (aref header (nth 1 (assoc header gnus-header-index)))
+ (error "Pseudo-articles can't be scored"))
(error "No article on current line"))))
(defun gnus-summary-score-entry
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((id (header-id header))
- (score gnus-score-alist)
dont)
;; Don't enter a score if there already is one.
(while score
(or (null (nth 3 (car score)))
(eq 's (nth 3 (car score))))
(progn
- (or (assoc id (car score))
+ (if (assoc id (car score))
(setq dont t))
(setq score nil)))
(setq score (cdr score)))
(require 'gnus)
(require gnus-easymenu)
-
-;;; summary highligts
+(require 'custom)
+(require 'gnus-ems)
+
+;;; Summary highlights.
(defvar gnus-summary-selected-face 'underline
"*Face used for highlighting the current article in the summary buffer.")
(defvar gnus-summary-highlight
- '(((> score default) . bold)
- ((< score default) . italic))
- "*Alist of `(FORM . FACE)'.
+ (cond ((not (eq gnus-display-type 'color))
+ '(((> score default) . bold)
+ ((< score default) . italic)))
+ ((eq gnus-background-mode 'dark)
+ (list (cons '(= mark gnus-canceled-mark)
+ (custom-face-lookup "yellow" "black" nil nil nil nil))
+ (cons '(and (> score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "red" nil nil t nil nil))
+ (cons '(and (< score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "red" nil nil nil t nil))
+ (cons '(or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark))
+ (custom-face-lookup "red" nil nil nil nil nil))
+
+ (cons '(and (> score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "blue" nil nil t nil nil))
+ (cons '(and (< score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "blue" nil nil nil t nil))
+ (cons '(= mark gnus-ancient-mark)
+ (custom-face-lookup "blue" nil nil nil nil nil))
+
+ (cons '(and (> score default) (= mark gnus-unread-mark))
+ (custom-face-lookup "green" nil nil t nil nil))
+ (cons '(and (< score default) (= mark gnus-unread-mark))
+ (custom-face-lookup "green" nil nil nil t nil))
+ (cons '(= mark gnus-unread-mark)
+ (custom-face-lookup "green" nil nil nil nil nil))
+
+ (cons '(> score default) 'bold)
+ (cons '(< score default) 'italic)))
+ (t
+ (list (cons '(= mark gnus-canceled-mark)
+ (custom-face-lookup "yellow" "black" nil nil nil nil))
+ (cons '(and (> score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "firebrick" nil nil t nil nil))
+ (cons '(and (< score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "firebrick" nil nil nil t nil))
+ (cons '(or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark))
+ (custom-face-lookup "firebrick" nil nil nil nil nil))
+
+ (cons '(and (> score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "RoyalBlue" nil nil t nil nil))
+ (cons '(and (< score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "RoyalBlue" nil nil nil t nil))
+ (cons '(= mark gnus-ancient-mark)
+ (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
+
+ (cons '(and (> score default) (= mark gnus-unread-mark))
+ (custom-face-lookup "DarkGreen" nil nil t nil nil))
+ (cons '(and (< score default) (= mark gnus-unread-mark))
+ (custom-face-lookup "DarkGreen" nil nil nil t nil))
+ (cons '(= mark gnus-unread-mark)
+ (custom-face-lookup "DarkGreen" nil nil nil nil nil))
+
+ (cons '(> score default) 'bold)
+ (cons '(< score default) 'italic))))
+ "*Alist of `(FORM . FACE)'.
Summary lines are highlighted with the FACE for the first FORM which
evaluate to a non-nil value.
score: (gnus-summary-article-score)
default: gnus-summary-default-score
below: gnus-summary-mark-below
+mark: (gnus-summary-article-mark)
-To check for marks, e.g. to underline replied articles, use
-`gnus-summary-article-mark':
-
- ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)")
+The latter can be used like this:
+ ((= mark gnus-replied-mark) . underline)")
;;; article highlights
+(defvar gnus-header-face-alist
+ (cond ((not (eq gnus-display-type 'color))
+ '(("" bold italic)))
+ ((eq gnus-background-mode 'dark)
+ (list (list "From" nil
+ (custom-face-lookup "blue" nil nil t t nil))
+ (list "Subject" nil
+ (custom-face-lookup "red" nil nil t t nil))
+ (list "Newsgroups:.*," nil
+ (custom-face-lookup "firebrick" nil nil t t nil))
+ (list "" 'bold
+ (custom-face-lookup "green" nil nil nil t nil))))
+ (t
+ (list (list "From" nil
+ (custom-face-lookup "red" nil nil t t nil))
+ (list "Subject" nil
+ (custom-face-lookup "firebrick" nil nil t t nil))
+ (list "Newsgroups:.*," nil
+ (custom-face-lookup "firebrick" nil nil t t nil))
+ (list "" 'bold
+ (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
+ "Alist of headers and faces used for highlighting them.
+The entries in the list has the form `(REGEXP NAME CONTENT)', where
+REGEXP is a regular expression matching the beginning of the header,
+NAME is the face used for highlighting the header name and CONTENT is
+the face used for highlighting the header content.
+
+The first non-nil NAME or CONTENT with a matching REGEXP in the list
+will be used.")
+
+
(defvar gnus-make-foreground t
"Non nil means foreground color to highlight citations.")
'highlight)
"Face used when the mouse is over the button.")
-(defvar gnus-header-face-alist '(("" bold italic))
- "Alist of headers and faces used for highlighting them.
-The entries in the list has the form `(REGEXP NAME CONTENT)', where
-REGEXP is a regular expression matching the beginning of the header,
-NAME is the face used for highlighting the header name and CONTENT is
-the face used for highlighting the header content.
+(defvar gnus-summary-highlight
+ '(((> score default) . bold)
+ ((< score default) . italic))
+ "*Alist of `(FORM . FACE)'.
+Summary lines are highlighted with the FACE for the first FORM which
+evaluate to a non-nil value.
-The first non-nil NAME or CONTENT with a matching REGEXP in the list
-will be used.")
+Point will be at the beginning of the line when FORM is evaluated.
+The following can be used for convenience:
+
+score: (gnus-summary-article-score)
+default: gnus-summary-default-score
+below: gnus-summary-mark-below
+
+To check for marks, e.g. to underline replied articles, use
+`gnus-summary-article-mark':
+
+ ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)")
(defvar gnus-signature-face 'italic
"Face used for signature.")
gnus-summary-kill-menu
gnus-summary-mode-map
""
- '("Score"
- ["Enter score" gnus-summary-score-entry t]
- ["Raise score" gnus-summary-increase-score t]
- ["Lower score" gnus-summary-lower-score t]
- ["Current score" gnus-summary-current-score t]
- ["Set score" gnus-summary-set-score t]
- ("Score file"
- ["Customize score file" gnus-score-customize t]
- ["Switch current score file" gnus-score-change-score-file t]
- ["Set mark below" gnus-score-set-mark-below t]
- ["Set expunge below" gnus-score-set-expunge-below t]
- ["Edit current score file" gnus-score-edit-alist t]
- ["Edit score file" gnus-score-edit-file t]
- ["Trace score" gnus-score-find-trace t])
- ))
+ (cons
+ "Score"
+ (nconc
+ (list
+ ["Enter score" gnus-summary-score-entry t])
+ (gnus-visual-score-map 'increase)
+ (gnus-visual-score-map 'lower)
+ '(["Current score" gnus-summary-current-score t]
+ ["Set score" gnus-summary-set-score t]
+ ("Score file"
+ ["Customize score file" gnus-score-customize t]
+ ["Switch current score file" gnus-score-change-score-file t]
+ ["Set mark below" gnus-score-set-mark-below t]
+ ["Set expunge below" gnus-score-set-expunge-below t]
+ ["Edit current score file" gnus-score-edit-alist t]
+ ["Edit score file" gnus-score-edit-file t]
+ ["Trace score" gnus-score-find-trace t])
+ ))))
+
)
+
+(defun gnus-visual-score-map (type)
+ (let ((headers '(("author" "from" string)
+ ("subject" "subject" string)
+ ("article body" "body" string)
+ ("article head" "head" string)
+ ("xref" "xref" string)
+ ("lines" "lines" number)
+ ("followups to author" "followup" string)))
+ (types '((number ("less than" <)
+ ("greater than" >)
+ ("equal" =))
+ (string ("substring" s)
+ ("exact string" e)
+ ("fuzzy string" f)
+ ("regexp" r))))
+ (perms '(("temporary" (current-time-string))
+ ("permanent" nil)
+ ("immediate" now)))
+ header)
+ (list
+ (apply
+ 'nconc
+ (list
+ (if (eq type 'lower)
+ "Lower score"
+ "Increase score"))
+ (let (outh)
+ (while headers
+ (setq header (car headers))
+ (setq outh
+ (cons
+ (apply
+ 'nconc
+ (list (car header))
+ (let ((ts (cdr (assoc (nth 2 header) types)))
+ outt)
+ (while ts
+ (setq outt
+ (cons
+ (apply
+ 'nconc
+ (list (car (car ts)))
+ (let ((ps perms)
+ outp)
+ (while ps
+ (setq outp
+ (cons
+ (vector
+ (car (car ps))
+ (list
+ 'gnus-summary-score-entry
+ (nth 1 header)
+ (if (or (string= (nth 1 header) "head")
+ (string= (nth 1 header) "body"))
+ ""
+ (list 'gnus-summary-header
+ (nth 1 header)))
+ (list 'quote (nth 1 (car ts)))
+ (list 'gnus-score-default nil)
+ (nth 1 (car ps))
+ t)
+ t)
+ outp))
+ (setq ps (cdr ps)))
+ (list (nreverse outp))))
+ outt))
+ (setq ts (cdr ts)))
+ (list (nreverse outt))))
+ outh))
+ (setq headers (cdr headers)))
+ (list (nreverse outh)))))))
;; Article buffer
(defun gnus-article-make-menu-bar ()
(add-text-properties end (point-max) gnus-hidden-properties)))))
(defun gnus-make-face (color)
- ;; Create entry for face with background COLOR.
- (let ((name (intern (concat "gnus " color))))
- (make-face name)
- (if gnus-make-foreground
- (set-face-foreground name color)
- (set-face-background name color))
- name))
+ ;; Create entry for face with COLOR.
+ (if gnus-make-foreground
+ (custom-face-lookup color nil nil nil nil nil)
+ (custom-face-lookup nil color nil nil nil nil)))
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
list (cdr list))))
result)))
+(gnus-ems-redefine)
+
(provide 'gnus-vis)
;;; gnus-vis.el ends here
(defvar gnus-group-default-list-level gnus-level-subscribed
"*Default listing level.
-Ignored if `gnus-group-use-permanent-levels' is nil.")
+Ignored if `gnus-group-use-permanent-levels' is non-nil.")
(defvar gnus-group-use-permanent-levels nil
"*If non-nil, once you set a level, Gnus will use this level.")
(defvar gnus-show-mime nil
- "*If non-ni, do mime processing of articles.
+ "*If non-nil, do mime processing of articles.
The articles will simply be fed to the function given by
`gnus-show-mime-method'.")
[mail 1.0 point]))
(info ([nil 1.0 point]))
(summary-faq ([summary 0.25]
- [article 1.0 point]))
+ [faq 1.0 point]))
(edit-group ([group 0.5]
[edit-group 1.0 point]))
(edit-server ([server 0.5]
(browse-carpal . gnus-carpal-browse-buffer)
(edit-score . gnus-score-edit-buffer)
(mail . gnus-mail-buffer)
- (post . gnus-post-news-buffer))
+ (post . gnus-post-news-buffer)
+ (faq . gnus-faq-buffer))
"Mapping from short symbols to buffer names or buffer variables.")
(defvar gnus-carpal nil
of the modeline intact.")
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+(defvar gnus-display-type
+ (condition-case nil
+ (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
+ (cond (display-resource (intern (downcase display-resource)))
+ ((x-display-color-p) 'color)
+ ((x-display-grayscale-p) 'grayscale)
+ (t 'mono)))
+ (error 'mono))
+ "A symbol indicating the display Emacs is running under.
+The symbol should be one of `color', `grayscale' or `mono'. If Emacs
+guesses this display attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.displayType' in your
+`~/.Xdefaults'. See also `gnus-background-mode'.")
+
+(defvar gnus-background-mode
+ (condition-case nil
+ (let ((bg-resource (x-get-resource ".backgroundMode"
+ "BackgroundMode"))
+ (params (frame-parameters)))
+ (cond (bg-resource (intern (downcase bg-resource)))
+ ((< (apply '+ (x-color-values
+ (cdr (assq 'background-color params))))
+ (/ (apply '+ (x-color-values "white")) 3))
+ 'dark)
+ (t 'light)))
+ (error 'light))
+ "A symbol indicating the Emacs background brightness.
+The symbol should be one of `light' or `dark'.
+If Emacs guesses this frame attribute wrongly, either set this variable in
+your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
+`~/.Xdefaults'.
+See also `gnus-display-type'.")
+
(defvar gnus-mouse-face 'highlight
"*Face used for mouse highlighting in Gnus.
No mouse highlights will be done if `gnus-visual' is nil.")
(defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "(ding) Gnus v0.91.1"
+(defconst gnus-version "(ding) Gnus v0.92"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(erase-buffer)
(insert
(format "
- %s
+ %s
A newsreader
for GNU Emacs
written by
Masanobu UMEDA
- Lars Magne
- Ingebrigtsen
+ A Praxis Release
larsi@ifi.uio.no
"
gnus-version))
(/ (max (- (window-width) (or x 28)) 0) 2))
(goto-char (point-min))
;; +4 is fuzzy factor.
- (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
+ (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))
+
+ ;; Fontify some.
+ (goto-char (point-min))
+ (search-forward "Praxis")
+ (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
+ (goto-char (point-min)))
(defun gnus-group-setup-buffer ()
(or (get-buffer gnus-group-buffer)
nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
(setq active (gnus-gethash group gnus-active-hashtb))
(gnus-group-insert-group-line
- nil group (if (member group gnus-zombie-list) gnus-level-zombie
- gnus-level-killed)
+ nil group
+ (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
nil (if active (- (1+ (cdr active)) (car active)) 0) nil))))
(defun gnus-group-insert-group-line (gformat group level marked number method)
"Get the level of the newsgroup on the current line."
(get-text-property (gnus-point-at-bol) 'gnus-level))
+(defun gnus-group-group-unread ()
+ "Get the number of unread articles of the newsgroup on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-unread))
+
(defun gnus-group-search-forward (&optional backward all level first-too)
"Find the next newsgroup with unread articles.
If BACKWARD is non-nil, find the previous newsgroup instead.
;; Group marking.
-(defun gnus-group-mark-group (n &optional unmark)
+(defun gnus-group-mark-group (n &optional unmark no-advance)
"Mark the current group."
(interactive "p")
(let ((buffer-read-only nil)
(setq gnus-group-marked
(cons group (delete group gnus-group-marked))))
t)
- (zerop (gnus-group-next-group 1)))
+ (or no-advance (zerop (gnus-group-next-group 1))))
(setq n (1- n)))
(gnus-summary-position-cursor)
n))
(defun gnus-group-remove-mark (group)
(and (gnus-group-goto-group group)
(save-excursion
- (gnus-group-mark-group 1 'unmark))))
+ (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.
(gnus-gethash (gnus-group-group-name)
gnus-newsrc-hashtb))
t)
- (gnus-sethash nname '(0 . 0) gnus-active-hashtb)
+ (gnus-sethash nname (cons 1 0) gnus-active-hashtb)
(gnus-dribble-enter
(concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))
(gnus-group-insert-group-line-info nname)
+ (require (intern method))
(and (gnus-check-backend-function 'request-create-group nname)
(gnus-request-create-group nname))))
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
(interactive)
- (gnus-message 5 "Expiring...")
- (let ((gnus-group-marked (mapcar (lambda (info) (car info))
- (cdr gnus-newsrc-alist))))
- (gnus-group-expire-articles nil))
+ (save-excursion
+ (gnus-message 5 "Expiring...")
+ (let ((gnus-group-marked (mapcar (lambda (info) (car info))
+ (cdr gnus-newsrc-alist))))
+ (gnus-group-expire-articles nil)))
+ (gnus-group-position-cursor)
(gnus-message 5 "Expiring...done"))
(defun gnus-group-set-current-level (n level)
\f
-(defun gnus-summary-mode ()
+(defun gnus-summary-mode (&optional group)
"Major mode for reading articles.
All normal editing commands are switched off.
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
(setq buffer-display-table gnus-summary-display-table)
+ (setq gnus-newsgroup-name group)
(run-hooks 'gnus-summary-mode-hook))
(defun gnus-summary-make-display-table ()
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
(setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
(gnus-add-current-to-buffer-list)
- (gnus-summary-mode)
+ (gnus-summary-mode group)
(and gnus-carpal (gnus-carpal-setup-buffer 'summary))
(setq gnus-newsgroup-name group)
t)))
If NO-ARTICLE is non-nil, no article is selected initially."
(gnus-message 5 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
+ (quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group
+ group))))
(did-select (and new-group (gnus-select-newsgroup group show-all))))
(cond
((not new-group)
(not (equal (current-buffer) kill-buffer))
(progn
(kill-buffer (current-buffer))
- (set-buffer gnus-group-buffer)
- (gnus-group-next-unread-group 1)))
+ (if (not quit-config)
+ (progn
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1))
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group)
+ (set-buffer (car quit-config))
+ (and (eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ (gnus-configure-windows (cdr quit-config))))))
(message "Can't select group")
nil)
((eq did-select 'quit)
(not (equal (current-buffer) kill-buffer))
(kill-buffer (current-buffer)))
(gnus-kill-buffer kill-buffer)
- (gnus-configure-windows 'group)
- (gnus-group-next-unread-group 1)
+ (if (not quit-config)
+ (progn
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1))
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group)
+ (set-buffer (car quit-config))
+ (and (eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ (gnus-configure-windows (cdr quit-config))))
(signal 'quit nil))
(t
(gnus-set-global-variables)
(progn
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1)))
+ (and gnus-use-cache (gnus-cache-possibly-remove-articles))
(if temporary
nil ;Nothing to do.
- (and gnus-use-cache (gnus-cache-possibly-remove-articles))
;; We set all buffer-local variables to nil. It is unclear why
;; this is needed, but if we don't, buffer-local variables are
;; not garbage-collected, it seems. This would the lead to en
(defun gnus-summary-exit-no-update (&optional no-questions)
"Quit reading current newsgroup without updating read article info."
(interactive)
+ (gnus-set-global-variables)
(let* ((group gnus-newsgroup-name)
(quit-config (nth 1 (assoc 'quit-config
(gnus-find-method-for-group group)))))
(defun gnus-summary-fetch-faq (group)
"Fetch the FAQ for the current group."
(interactive (list gnus-newsgroup-name))
- (gnus-configure-windows 'summary-faq)
- (find-file (concat gnus-group-faq-directory group)))
+ (let ((gnus-faq-buffer
+ (find-file (concat gnus-group-faq-directory
+ (gnus-group-real-name group)))))
+ (and gnus-faq-buffer (gnus-configure-windows 'summary-faq))))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (force)
;; Walking around group mode buffer from summary mode.
-(defun gnus-summary-next-group (&optional no-article group backward)
+(defun gnus-summary-next-group (&optional no-article target-group backward)
+ "Exit current newsgroup and then select next unread newsgroup.
+If prefix argument NO-ARTICLE is non-nil, no article is selected
+initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+previous group instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((current-group gnus-newsgroup-name)
+ (current-buffer (current-buffer))
+ entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
+ (gnus-summary-exit t)
+ (while (not entered)
+ ;; Then we find what group we are supposed to enter.
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group current-group)
+ (setq target-group
+ (or target-group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ (if (not target-group)
+ ;; There are no further groups, so we return to the group
+ ;; buffer.
+ (progn
+ (gnus-message 5 "Returning to the group buffer")
+ (setq entered t)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
+ ;; We try to enter the target group.
+ (gnus-group-jump-to-group target-group)
+ (if (and (not (zerop (gnus-group-group-unread)))
+ (gnus-summary-read-group
+ target-group nil no-article current-buffer))
+ (setq entered t)
+ (setq current-group target-group
+ target-group nil))))))
+
+(defun gnus-summary-next-group-old (&optional no-article group backward)
"Exit current newsgroup and then select next unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected initially.
If BACKWARD, go to previous group instead."
(gnus-set-global-variables)
(gnus-summary-select-article gnus-have-all-headers t))
-(defun gnus-summary-verbose-header (arg)
+(defun gnus-summary-verbose-headers (arg)
"Toggle permanent full header display.
If ARG is a positive number, turn header display on.
If ARG is a negative number, turn header display off."
(error "The current newsgroup does not support article moving"))
(let ((articles (gnus-summary-work-articles n))
(prefix (gnus-group-real-prefix gnus-newsgroup-name))
- art-group)
+ art-group to-method)
(if (and (not to-newsgroup) (not select-method))
(setq to-newsgroup
(completing-read
(gnus-activate-newsgroup to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
- (or (gnus-check-backend-function 'request-accept-article
- (or select-method to-newsgroup))
- (error "%s does not support article moving" to-newsgroup))
+ (setq to-method (or select-method (gnus-find-method-for-group
+ to-newsgroup)))
+ (or (gnus-check-backend-function 'request-accept-article (car to-method))
+ (error "%s does not support article copying" (car to-method)))
+ (or (gnus-server-opened to-method)
+ (gnus-open-server to-method)
+ (error "Can't open server %s" (car to-method)))
(gnus-message 6 "Moving to %s: %s..."
(or select-method to-newsgroup) articles)
(while articles
(let ((articles (gnus-summary-work-articles n))
(copy-buf (get-buffer-create "*copy work*"))
(prefix (gnus-group-real-prefix gnus-newsgroup-name))
- art-group)
+ art-group to-method)
(buffer-disable-undo copy-buf)
(if (and (not to-newsgroup) (not select-method))
(setq to-newsgroup
(gnus-activate-newsgroup to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
- (or (gnus-check-backend-function 'request-accept-article
- (or select-method to-newsgroup))
- (error "%s does not support article copying" to-newsgroup))
+ (setq to-method (or select-method (gnus-find-method-for-group
+ to-newsgroup)))
+ (or (gnus-check-backend-function 'request-accept-article (car to-method))
+ (error "%s does not support article copying" (car to-method)))
+ (or (gnus-server-opened to-method)
+ (gnus-open-server to-method)
+ (error "Can't open server %s" (car to-method)))
(gnus-message 6 "Copying to %s: %s..."
(or select-method to-newsgroup) articles)
(while articles
(and (numberp mark)
(or (= mark gnus-killed-mark) (= mark gnus-del-mark)
(= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-read-mark) (= mark gnus-ancient-mark))))
+ (= mark gnus-read-mark))))
(setq mark gnus-expirable-mark))
(let* ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark))
(article (or article (gnus-summary-article-number))))
(lambda (char) (char-to-string (symbol-value char)))
'(gnus-del-mark gnus-read-mark gnus-ancient-mark
gnus-killed-mark gnus-kill-file-mark
- gnus-low-score-mark gnus-expirable-mark)
+ gnus-low-score-mark gnus-expirable-mark
+ gnus-canceled-mark)
""))))
(defalias 'gnus-summary-delete-marked-with
(message "nnbabyl: Receiving headers...done"))
;; Fold continuation lines.
+ (set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(replace-match " " t t))
(defun nnbabyl-close-group (group &optional server)
t)
+(defun nnbabyl-request-create-group (group &optional server)
+ (nnbabyl-request-list)
+ (setq nnbabyl-group-alist (nnmail-get-active))
+ (or (assoc group nnbabyl-group-alist)
+ (let (active)
+ (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0)))
+ nnbabyl-group-alist))
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))
+ t)
+
(defun nnbabyl-request-list (&optional server)
(if server (nnbabyl-get-new-mail))
(save-excursion
(message "nnmbox: Receiving headers...done"))
;; Fold continuation lines.
+ (set-buffer nntp-server-buffer)
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(replace-match " " t t))
(defvar nntp-async-buffer nil)
(defvar nntp-async-articles nil)
(defvar nntp-async-fetched nil)
+(defvar nntp-async-group-alist nil)
+
\f
(defvar nntp-current-server nil)
'(nntp-async-buffer nil)
'(nntp-async-articles nil)
'(nntp-async-fetched nil)
+ '(nntp-async-group-alist nil)
'(nntp-server-process nil)
'(nntp-status-string nil)
'(nntp-server-xover try)
(buffer-name proc)
(kill-buffer proc))
(setq nntp-server-alist (cdr nntp-server-alist)))
- (setq nntp-current-server nil)))
+ (setq nntp-current-server nil
+ nntp-async-group-alist nil)))
(defun nntp-server-opened (&optional server)
"Say whether a connection to SERVER has been opened."
(defun nntp-request-group (group &optional server dont-check)
"Select GROUP."
+ (and nntp-async-articles (nntp-async-request-group group))
(nntp-send-command "^.*\r?\n" "GROUP" group)
(save-excursion
(set-buffer nntp-server-buffer)
(error (nntp-status-message)))
(process-send-string nntp-async-process cmd)))
+(defun nntp-async-request-group (group)
+ (if (string= group nntp-current-group)
+ ()
+ (let ((asyncs (assoc group nntp-async-group-alist)))
+ (if (not asyncs)
+ ()
+ ;; A new group has been selected, so we push the current state
+ ;; of async articles on an alist, and pull the old state off.
+ (setq nntp-async-group-alist
+ (cons (list group nntp-async-articles nntp-async-fetched)
+ (delq asyncs nntp-async-group-alist)))
+ (setq nntp-async-articles (nth 1 asyncs))
+ (setq nntp-async-fetched (nth 2 asyncs))))))
+
(provide 'nntp)
;;; nntp.el ends here
\input texinfo @c -*-texinfo-*-
@comment %**start of header (This is for running Texinfo on a region.)
-@setfilename gnus
+@setfilename gnus.info
@settitle (ding) Gnus 0.84 Manual
@synindex fn cp
@synindex vr cp
projects / gnus / commitdiff