+Sat Aug 19 16:37:58 1995 Lars Magne Ingebrigtsen <lingebri@sunsci4.cern.ch>
+
+ * nnbabyl.el (nnbabyl-read-mbox): Would create ghost articles.
+
+ * gnus.el (gnus-summary-move-article): Would barf on respooling to
+ (as-yet) non-existant groups.
+ (gnus-summary-best-unread-article): Really go to the best article.
+ (gnus-activate-group): Continue on non-available groups.
+
+ * gnus-score.el (gnus-score-change-score-file): Prompt from dir,
+ not cache.
+
+ * nnfolder.el (nnfolder-read-folder): Ghost articles would be
+ produced when there were more than 1 consecutive "From " line.
+
+ * gnus.el (gnus-update-read-articles): Would display the wrong
+ number of unread articles in the group buffer when updates have
+ been done while the summary buffer was active.
+ (gnus-summary-read-group): `O' old-fetched articles would be
+ improperly inited.
+ (gnus-ignored-newsgroups): Removed again.
+ (gnus-active-to-gnus-format): Understand groups that have strange
+ chars in the names.
+ (gnus-select-newsgroup): Would ignore the first article from all
+ backends that did not support NOV when using
+ `gnus-fetch-old-headers'.
+ (gnus-article-mode-map): Disabled all summary commands in the
+ article buffer.
+ (gnus-get-unread-articles): Make sure that the server connection
+ is up.
+
+Sat Aug 19 16:07:59 1995 Lars Magne Ingebrigtsen <lingebri@sunsci7.cern.ch>
+
+ * gnus.el (gnus-group-catchup): Would bug out on `all' sometimes.
+
+Thu Aug 17 20:19:07 1995 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-cus.el: Added `gnus-summary-highlight'.
+
+Wed Aug 16 16:07:35 1995 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * custom.el: Added support for including values that needs to be
+ evaluated in lists.
+
+Fri Aug 18 15:27:20 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus.el (gnus-ignored-newsgroups): Start ignoring stuff again.
+ (gnus-summary-show-article): Removed interpretation of prefix arg.
+
+Wed Aug 16 08:22:05 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus.el (gnus-summary-mark-same-subject): Update number mode
+ line.
+
+Tue Aug 15 19:21:55 1995 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * custom.el: Allow all field to contain invalid data. Only parse
+ field when point leaves it or when the value is needed, not
+ after each change as previously.
+
+Wed Aug 16 08:11:24 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus-ems.el: Don't destroy the hidden props in 19.28.
+
+Tue Aug 15 09:03:11 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus.el (gnus-offer-save-summaries): Allow ! and q as answers.
+ (gnus-summary-mode-map): Defined date keys in the wrong map.
+
+ * gnus-vis.el (gnus-button-url): Use w3 if it exists.
+
+Mon Aug 14 15:51:08 1995 Lars Magne Ingebrigtsen <lingebri@sunscipw.cern.ch>
+
+ * gnus-vis.el (gnus-group-make-menu-bar): Removed "post" menu.
+
+Mon Aug 14 11:37:39 1995 Lars Magne Ingebrigtsen <lingebri@sunsci7.cern.ch>
+
+ * gnus.el (gnus-summary-edit-article-done): Do the visual hook
+ after returning to the summary buffer.
+
+ * gnus-score.el (gnus-score-save): Ignore score files that can't
+ be saved.
+
Sun Aug 13 17:15:22 1995 Lars Magne Ingebrigtsen <lingebri@sunsci4.cern.ch>
+ * gnus.el: 0.99.11 is released.
+
* gnus.el (gnus-groups-to-gnus-format): Don't skip everything if a
simple error occurs; just ignore the buggy line.
"The value currently displayed for NAME in the customization buffer."
(let* ((field (custom-name-field name))
(custom (custom-field-custom field)))
- (funcall (custom-property custom 'export)
+ (custom-field-parse field)
+ (funcall (custom-property custom 'export) custom
(car (custom-field-extract custom field)))))
;;; Custom Functions:
(defconst custom-type-properties
'((repeat (type . default)
+ (import . custom-repeat-import)
+ (eval . custom-repeat-eval)
+ (quote . custom-repeat-quote)
(accept . custom-repeat-accept)
(extract . custom-repeat-extract)
(validate . custom-repeat-validate)
(del-tag . "[DEL]")
(add-tag . "[INS]"))
(pair (type . group)
+ (accept . custom-pair-accept)
+ (eval . custom-pair-eval)
+ (import . custom-pair-import)
+ (quote . custom-pair-quote)
(valid . (lambda (c d) (consp d)))
(extract . custom-pair-extract))
(list (type . group)
- (valid . (lambda (c d) (listp d)))
(quote . custom-list-quote)
+ (valid . (lambda (c d) (listp d)))
(extract . custom-list-extract))
(group (type . default)
(face-tag . nil)
+ (eval . custom-group-eval)
+ (import . custom-group-import)
(initialize . custom-group-initialize)
(apply . custom-group-apply)
(reset . custom-group-reset)
make the text `bold', `italic', or `underline' respectively. For some
fonts `bold' or `italic' will not make any visible change."))
(face (type . choice)
- (quote . custom-face-quote)
- (export . custom-face-export)
+ (eval . custom-face-eval)
(import . custom-face-import)
(data ((tag . "None")
(default . nil)
((tag . "Customized")
(compact . t)
(face-tag . custom-face-hack)
- (export . custom-face-export)
+ (eval . custom-face-eval)
(data ((hidden . t)
(tag . "")
(doc . "\
(sexp (type . default)
(width . 40)
(default . (__uninitialized__ . "Uninitialized"))
- (valid . custom-sexp-valid)
- (quote . custom-sexp-quote)
(read . custom-sexp-read)
(write . custom-sexp-write))
- (symbol (type . default)
+ (symbol (type . sexp)
(width . 40)
- (valid . (lambda (c d) (symbolp d)))
- (quote . custom-symbol-quote)
- (read . custom-symbol-read)
- (write . custom-symbol-write))
- (integer (type . default)
+ (valid . (lambda (c d) (symbolp d))))
+ (integer (type . sexp)
(width . 10)
- (valid . (lambda (c d) (integerp d)))
- (allow-padding . nil)
- (read . custom-integer-read)
- (write . custom-integer-write))
+ (valid . (lambda (c d) (integerp d))))
(string (type . default)
(width . 40)
(valid . (lambda (c d) (stringp d)))
(doc . nil)
(header . t)
(padding . ? )
- (allow-padding . t)
- (quote . identity)
- (export . identity)
- (import . identity)
+ (quote . custom-default-quote)
+ (eval . (lambda (c v) nil))
+ (export . custom-default-export)
+ (import . (lambda (c v) (list v)))
(synchronize . ignore)
(initialize . custom-default-initialize)
(extract . custom-default-extract)
(defconst custom-nil '__uninitialized__
"Special value representing an uninitialized field.")
+(defconst custom-invalid '__invalid__
+ "Special value representing an invalid field.")
+
(defun custom-property (custom property)
"Extract from CUSTOM property PROPERTY."
(let ((entry (assq property custom)))
(custom-assert 'custom)))
(cdr entry)))
+(defun custom-super (custom property)
+ "Extract from CUSTOM property PROPERTY. Start with CUSTOM's superclass."
+ (let ((entry nil))
+ (while (null entry)
+ ;; Look in superclass.
+ (let ((type (custom-type custom)))
+ (setq custom (cdr (or (assq type custom-local-type-properties)
+ (assq type custom-type-properties)))
+ entry (assq property custom))
+ (custom-assert 'custom)))
+ (cdr entry)))
+
(defun custom-property-set (custom property value)
"Set CUSTOM PROPERY to VALUE by side effect.
CUSTOM must have at least one property already."
"Extract `padding' from CUSTOM."
(custom-property custom 'padding))
-(defun custom-allow-padding (custom)
- "Extract `allow-padding' from CUSTOM."
- (custom-property custom 'allow-padding))
-
(defun custom-valid (custom value)
"Non-nil if CUSTOM may legally be set to VALUE."
- (funcall (custom-property custom 'valid) custom value))
+ (and (not (and (listp value) (eq custom-invalid (car value))))
+ (funcall (custom-property custom 'valid) custom value)))
(defun custom-import (custom value)
"Import CUSTOM VALUE from external variable."
- (funcall (custom-property custom 'import) value))
+ (if (eq custom-nil value)
+ (list custom-nil)
+ (funcall (custom-property custom 'import) custom value)))
+
+(defun custom-eval (custom value)
+ "Return non-nil if CUSTOM's VALUE needs to be evaluated."
+ (funcall (custom-property custom 'eval) custom value))
(defun custom-quote (custom value)
"Quote CUSTOM's VALUE if necessary."
- (funcall (custom-property custom 'quote) value))
+ (funcall (custom-property custom 'quote) custom value))
(defun custom-write (custom value)
"Convert CUSTOM VALUE to a string."
- (if (eq value custom-nil)
- ""
- (funcall (custom-property custom 'write) custom value)))
+ (cond ((eq value custom-nil)
+ "")
+ ((and (listp value) (eq (car value) custom-invalid))
+ (cdr value))
+ (t
+ (funcall (custom-property custom 'write) custom value))))
(defun custom-read (custom string)
"Convert CUSTOM field content STRING into external form."
- (funcall (custom-property custom 'read) custom string))
+ (condition-case nil
+ (funcall (custom-property custom 'read) custom string)
+ (error (cons custom-invalid string))))
(defun custom-match (custom values)
"Match CUSTOM with a list of VALUES.
;;
;; The following functions defines type specific actions.
+(defun custom-repeat-eval (custom value)
+ "Non-nil if CUSTOM's VALUE needs to be evaluated."
+ (if (eq value custom-nil)
+ nil
+ (let ((child (custom-data custom))
+ (found nil))
+ (mapcar (lambda (v) (if (custom-eval child v) (setq found t)))
+ value))))
+
+(defun custom-repeat-quote (custom value)
+ "A list of CUSTOM's VALUEs quoted."
+ (let ((child (custom-data custom)))
+ (apply 'append (mapcar (lambda (v) (custom-quote child v))
+ value))))
+
+
+(defun custom-repeat-import (custom value)
+ "Modify CUSTOM's VALUE to match internal expectations."
+ (let ((child (custom-data custom)))
+ (apply 'append (mapcar (lambda (v) (custom-import child v))
+ value))))
+
(defun custom-repeat-accept (field value &optional original)
"Enter content of editing FIELD."
(let ((values (copy-sequence (custom-field-value field)))
values (cdr values)))
result))
+(defun custom-pair-accept (field value &optional original)
+ "Enter content of editing FIELD with VALUE."
+ (custom-group-accept field (list (car value) (cdr value)) original))
+
+(defun custom-pair-eval (custom value)
+ "Non-nil if CUSTOM's VALUE needs to be evaluated."
+ (custom-group-eval custom (list (car value) (cdr value))))
+
+(defun custom-pair-import (custom value)
+ "Modify CUSTOM's VALUE to match internal expectations."
+ (let ((result (car (custom-group-import custom
+ (list (car value) (cdr value))))))
+ (custom-assert '(eq (length result) 2))
+ (list (cons (nth 0 result) (nth 1 result)))))
+
+(defun custom-pair-quote (custom value)
+ "Quote CUSTOM's VALUE if necessary."
+ (if (custom-eval custom value)
+ (let ((v (car (custom-group-quote custom
+ (list (car value) (cdr value))))))
+ (list (list 'cons (nth 0 v) (nth 1 v))))
+ (custom-default-quote custom value)))
+
(defun custom-pair-extract (custom field)
"Extract cons of childrens values."
(let ((values (custom-field-value field))
(data (custom-data custom))
result)
(custom-assert '(eq (length values) (length data)))
- (custom-assert '(eq (length values) 2))
(while values
(setq result (append result
(custom-field-extract (car data) (car values)))
(custom-assert '(null data))
(list (cons (nth 0 result) (nth 1 result)))))
-(defun custom-list-quote (value)
- "Quote VALUE if necessary."
- (and value
- (list 'quote value)))
+(defun custom-list-quote (custom value)
+ "Quote CUSTOM's VALUE if necessary."
+ (if (custom-eval custom value)
+ (let ((v (car (custom-group-quote custom value))))
+ (list (cons 'list v)))
+ (custom-default-quote custom value)))
(defun custom-list-extract (custom field)
"Extract list of childrens values."
values (cdr values)))
result))
+(defun custom-group-eval (custom value)
+ "Non-nil if CUSTOM's VALUE needs to be evaluated."
+ (let ((found nil))
+ (mapcar (lambda (c)
+ (or (stringp c)
+ (let ((match (custom-match c value)))
+ (if (custom-eval c (car match))
+ (setq found t))
+ (setq value (cdr match)))))
+ (custom-data custom))
+ found))
+
+(defun custom-group-quote (custom value)
+ "A list of CUSTOM's VALUE members, quoted."
+ (list (apply 'append
+ (mapcar (lambda (c)
+ (if (stringp c)
+ ()
+ (let ((match (custom-match c value)))
+ (prog1 (custom-quote c (car match))
+ (setq value (cdr match))))))
+ (custom-data custom)))))
+
+(defun custom-group-import (custom value)
+ "Modify CUSTOM's VALUE to match internal expectations."
+ (list (apply 'append
+ (mapcar (lambda (c)
+ (if (stringp c)
+ ()
+ (let ((match (custom-match c value)))
+ (prog1 (custom-import c (car match))
+ (setq value (cdr match))))))
+ (custom-data custom)))))
+
(defun custom-group-initialize (custom)
"Initialize `doc' and `default' entries in CUSTOM."
(if (custom-name custom)
default nil value)
(read-file-name prompt directory default)))))
-(defun custom-face-quote (value)
- "Quote VALUE if necessary."
- (if (symbolp value)
- (custom-symbol-quote value)
- value))
-
-(defun custom-face-export (value)
- "Modify VALUE to match external expectations."
- (if (symbolp value)
- value
- (eval value)))
+(defun custom-face-eval (custom value)
+ "Return non-nil if CUSTOM's VALUE needs to be evaluated."
+ (not (symbolp value)))
-(defun custom-face-import (value)
- "Modify VALUE to match internal expectations."
+(defun custom-face-import (custom value)
+ "Modify CUSTOM's VALUE to match internal expectations."
(let ((name (symbol-name value)))
- (if (string-match "\
+ (list (if (string-match "\
custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)"
- name)
- (list 'custom-face-lookup
- (match-string 1 name)
- (match-string 2 name)
- (match-string 3 name)
- (intern (match-string 4 name))
- (intern (match-string 5 name))
- (intern (match-string 6 name)))
- value)))
+ name)
+ (list 'custom-face-lookup
+ (match-string 1 name)
+ (match-string 2 name)
+ (match-string 3 name)
+ (intern (match-string 4 name))
+ (intern (match-string 5 name))
+ (intern (match-string 6 name)))
+ value))))
(defun custom-face-lookup (fg bg stipple bold italic underline)
"Lookup or create a face with specified attributes.
(defun custom-face-hack (field value)
"Face that should be used for highlighting FIELD containing VALUE."
- (funcall (custom-property (custom-field-custom field) 'export) value))
+ (eval (funcall (custom-property (custom-field-custom field) 'export) custom value)))
(defun custom-const-insert (custom level)
"Insert field for CUSTOM at nesting LEVEL in customization buffer."
"Face used for a FIELD."
(custom-default (custom-field-custom field)))
-(defun custom-sexp-valid (custom value)
- "Non-nil if CUSTOM can legally have the value VALUE."
- (not (and (listp value) (eq custom-nil (car value)))))
-
-(defun custom-sexp-quote (value)
- "Quote VALUE if necessary."
- (if (or (and (symbolp value)
- value
- (not (eq t value)))
- (and (listp value)
- value
- (not (memq (car value) '(quote function lambda)))))
- (list 'quote value)
- value))
-
(defun custom-sexp-read (custom string)
"Read from CUSTOM an STRING."
(save-match-data
(erase-buffer)
(insert string)
(goto-char (point-min))
- (condition-case signal
- (prog1 (read (current-buffer))
- (or (looking-at
- (concat (regexp-quote (char-to-string
- (custom-padding custom)))
- "*\\'"))
- (error "Junk at end of expression")))
- (error (cons custom-nil string))))))
+ (prog1 (read (current-buffer))
+ (or (looking-at
+ (concat (regexp-quote (char-to-string
+ (custom-padding custom)))
+ "*\\'"))
+ (error "Junk at end of expression"))))))
+
+(autoload 'pp-to-string "pp")
(defun custom-sexp-write (custom sexp)
"Write CUSTOM SEXP as string."
- (if (and (listp sexp) (eq (car sexp) custom-nil))
- (cdr sexp)
- (prin1-to-string sexp)))
-
-(defun custom-symbol-quote (value)
- "Quote VALUE if necessary."
- (if (or (null value) (eq t value))
- value
- (list 'quote value)))
-
-(defun custom-symbol-read (custom symbol)
- "Read from CUSTOM an SYMBOL."
- (intern (save-match-data
- (custom-strip-padding symbol (custom-padding custom)))))
-
-(defun custom-symbol-write (custom symbol)
- "Write CUSTOM SYMBOL as string."
- (symbol-name symbol))
-
-(defun custom-integer-read (custom integer)
- "Read from CUSTOM an INTEGER."
- (string-to-int (save-match-data
- (custom-strip-padding integer (custom-padding custom)))))
-
-(defun custom-integer-write (custom integer)
- "Write CUSTOM INTEGER as string."
- (int-to-string integer))
+ (let ((string (prin1-to-string sexp)))
+ (if (<= (length string) (custom-width custom))
+ string
+ (setq string (pp-to-string sexp))
+ (string-match "[ \t\n]*\\'" string)
+ (concat "\n" (substring string 0 (match-beginning 0))))))
(defun custom-string-read (custom string)
"Read string by ignoring trailing padding characters."
(custom-documentation-insert custom)
nil)
+(defun custom-default-export (custom value)
+ ;; Convert CUSTOM's VALUE to external representation.
+ (if (custom-eval custom value)
+ (eval (car (custom-quote custom value)))
+ value))
+
+(defun custom-default-quote (custom value)
+ "Quote CUSTOM's VALUE if necessary."
+ (list (if (and (not (custom-eval custom value))
+ (or (and (symbolp value)
+ value
+ (not (eq t value)))
+ (and (listp value)
+ value
+ (not (memq (car value) '(quote function lambda))))))
+ (list 'quote value)
+ value)))
+
(defun custom-default-initialize (custom)
"Initialize `doc' and `default' entries in CUSTOM."
(let ((name (custom-name custom)))
(let ((value (custom-field-value field))
(start (custom-field-start field)))
(cond ((eq value custom-nil)
- (cons (custom-field-start field) "Uninitialized field"))
+ (cons start "Uninitialized field"))
+ ((and (consp value) (eq (car value) custom-invalid))
+ (cons start "Unparseable field content"))
((custom-valid custom value)
nil)
(t
- (cons start "Wrong type")))))
+ (cons start "Wrong type of field content")))))
(defun custom-default-face (field)
"Face used for a FIELD."
(save-excursion
(if name
(custom-field-original-set
- field (custom-import custom (custom-external name))))
+ field (car (custom-import custom (custom-external name)))))
(if (not (custom-valid custom (custom-field-original field)))
(error "This field cannot be reset alone")
(funcall (custom-property custom 'reset) field)
(interactive (if custom-modified-list
nil
(error "No changes to apply.")))
+ (custom-field-parse custom-field-last)
(let ((all custom-name-fields)
name field)
(while all
"Apply any changes in FIELD since the last apply."
(interactive (list (or (get-text-property (point) 'custom-field)
(get-text-property (point) 'custom-tag))))
+ (custom-field-parse custom-field-last)
(if (arrayp field)
(let* ((custom (custom-field-custom field))
(error (custom-field-validate custom field)))
(if (equal default value)
(setcdr old (custom-plist-delq name (cdr old)))
(setcdr old (plist-put (cdr old) name
- (custom-quote custom value))))))
+ (car (custom-quote custom value)))))))
(erase-buffer)
(insert ";; " custom-file "\
--- Automatically generated customization information.
(end (custom-field-end field))
(custom (custom-field-custom field))
(padding (custom-padding custom))
- (allow (custom-allow-padding custom))
(before-change-functions nil)
(after-change-functions nil))
- (or (and (eq this-command 'self-insert-command)
- allow)
+ (or (eq this-command 'self-insert-command)
(let ((pos end))
(while (and (< start pos)
(eq (char-after (1- pos)) padding))
(goto-char pos))))
(put-text-property start end 'face custom-field-active-face)))
+(defun custom-field-resize (field)
+ ;; Resize FIELD after change.
+ (let* ((custom (custom-field-custom field))
+ (begin (custom-field-start field))
+ (end (custom-field-end field))
+ (pos (point))
+ (padding (custom-padding custom))
+ (width (custom-width custom))
+ (size (- end begin)))
+ (cond ((< size width)
+ (goto-char end)
+ (insert-before-markers-and-inherit
+ (make-string (- width size) padding))
+ (goto-char pos))
+ ((> size width)
+ (let ((start (if (and (< (+ begin width) pos) (<= pos end))
+ pos
+ (+ begin width))))
+ (goto-char end)
+ (while (and (< start (point)) (= (preceding-char) padding))
+ (backward-delete-char 1))
+ (goto-char pos))))))
+
+(defvar custom-field-changed nil)
+;; List of fields changed on the screen.
+(make-variable-buffer-local 'custom-field-changed)
+
+(defun custom-field-parse (field)
+ ;; Parse FIELD content iff changed.
+ (if (memq field custom-field-changed)
+ (progn
+ (setq custom-field-changed (delq field custom-field-changed))
+ (custom-field-value-set field (custom-field-read field))
+ (custom-field-update field))))
+
(defvar custom-field-last nil)
;; Last field containing point.
(make-variable-buffer-local 'custom-field-last)
+
(defun custom-post-command ()
;; Keep track of their active field.
(if (not (eq major-mode 'custom-mode))
- ;; BUG: Should have been local!
+ (message "Aargh! Why is custom-post-command called here?")
()
(let ((field (custom-field-property (point))))
(if (eq field custom-field-last)
- ()
+ (if (memq field custom-field-changed)
+ (custom-field-resize field))
+ (custom-field-parse custom-field-last)
(if custom-field-last
(custom-field-leave custom-field-last))
(if field
(custom-field-enter field))
(setq custom-field-last field)))
- (set-buffer-modified-p custom-modified-list)))
+ (set-buffer-modified-p (or custom-modified-list custom-field-changed))))
(defvar custom-field-was nil)
;; The custom data before the change.
(let ((field-end (custom-field-end field)))
(if (> end field-end)
(set-marker field-end end))
- (custom-field-value-set field (custom-field-read field))
- (custom-field-update field))
+ (add-to-list 'custom-field-changed field))
;; We deleted the entire field, reinsert it.
(custom-assert '(eq begin end))
(save-excursion
-;;; gnus-cus.el --- User friendly customization of GNUS.
+;; gnus-cus.el --- User friendly customization of Gnus
;; Copyright (C) 1995 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: help, news
-;; Version: 0.0
+;; Version: 0.1
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
;;; Code:
(type . group)
(data ((tag . "Visual")
(doc . "Enable visual features.
-If `visual' is disabled, there will be no menus and no faces. All
+If `visual' is disabled, there will be no menus and few faces. Most of
the visual customization options below will be ignored. GNUS will use
less space and be faster as a result.")
(default . t)
(name . gnus-visual)
(type . toggle))
+ ((tag . "WWW Browser")
+ (doc . "\
+WWW Browser to call when clicking on an URL button in the article buffer.
+
+You can choose between one of the predefined browsers, or `Other'.")
+ (name . gnus-button-url)
+ (default . w3-fetch)
+ (type . choice)
+ (data ((tag . "W3")
+ (type . const)
+ (default . w3-fetch))
+ ((tag . "Netscape")
+ (type . const)
+ (default . gnus-netscape-open-url))
+ ((prompt . "Other")
+ (doc . "\
+You must specify the name of a Lisp function here. The lisp function
+should open a WWW browser when called with an URL (a string).
+")
+ (default . __uninitialized__)
+ (type . symbol))))
+ ((tag . "Mouse Face")
+ (doc . "\
+Face used for group or summary buffer mouse highlighting.
+The line beneath the mouse pointer will be highlighted with this
+face.")
+ (name . gnus-mouse-face)
+ (default . highlight)
+ (type . face))
+ ((tag . "Article Display")
+ (doc . "Controls how the article buffer will look.
+
+The list below contains various filters you can use to change the look
+of the article. If you leave the list empty, the article will appear
+exactly as it is stored on the disk. The list entries will hide or
+highlight various parts of the article, making it easier to find the
+information you want.")
+ (name . gnus-article-display-hook)
+ (type . list)
+ (default . (gnus-article-hide-headers-if-wanted
+ gnus-article-treat-overstrike
+ gnus-article-maybe-highlight))
+ (data ((type . repeat)
+ (header . nil)
+ (data (tag . "Filter")
+ (type . choice)
+ (data ((tag . "Treat Overstrike")
+ (doc . "\
+Convert use of overstrike into bold and underline.
+
+Two identical letters separated by a backspace are displayed as a
+single bold letter, while a letter followed by a backspace and an
+underscore will be displayed as a single underlined letter. This
+technique was developed for old line printers (think about it), and is
+still in use on some newsgroups, in particular the ClariNet
+hierearchy.
+")
+ (type . const)
+ (default .
+ gnus-article-treat-overstrike))
+ ((tag . "Word Wrap")
+ (doc . "\
+Format too long lines.
+")
+ (type . const)
+ (default . gnus-article-word-wrap))
+ ((tag . "Remove CR")
+ (doc . "\
+Remove carriage returns from an article.
+")
+ (type . const)
+ (default . gnus-article-remove-cr))
+ ((tag . "Display X-Face")
+ (doc . "\
+Look for an X-Face header and display it if present.
+
+See also `X Face Command' for a definition of the external command
+used for decoding and displaying the face.
+")
+ (type . const)
+ (default . gnus-article-display-x-face))
+ ((tag . "Unquote Printable")
+ (doc . "\
+Tranform MIME quoted printable into 8-bit characters.
+
+Quoted printable is often seen by strings like `=EF' where you would
+expect a non-English letter.
+")
+ (type . const)
+ (default .
+ gnus-article-de-quoted-unreadable))
+ ((tag . "Universal Time")
+ (doc . "\
+Convert date header to universal time.
+")
+ (type . const)
+ (default . gnus-article-date-ut))
+ ((tag . "Local Time")
+ (doc . "\
+Convert date header to local timezone.
+")
+ (type . const)
+ (default . gnus-article-date-local))
+ ((tag . "Lapsed Time")
+ (doc . "\
+Replace date header with a header showing the articles age.
+")
+ (type . const)
+ (default . gnus-article-date-lapsed))
+ ((tag . "Highlight")
+ (doc . "\
+Highlight headers, citations, signature, and buttons.
+")
+ (type . const)
+ (default . gnus-article-highlight))
+ ((tag . "Maybe Highlight")
+ (doc . "\
+Highlight headers, signature, and buttons if `Visual' is turned on.
+")
+ (type . const)
+ (default .
+ gnus-article-maybe-highlight))
+ ((tag . "Highlight Some")
+ (doc . "\
+Highlight headers, signature, and buttons.
+")
+ (type . const)
+ (default . gnus-article-highlight-some))
+ ((tag . "Highlight Headers")
+ (doc . "\
+Highlight headers as specified by `Article Header Highligting'.
+")
+ (type . const)
+ (default .
+ gnus-article-highlight-headers))
+ ((tag . "Highlight Signature")
+ (doc . "\
+Highlight the signature as specified by `Article Signature Face'.
+")
+ (type . const)
+ (default .
+ gnus-article-highlight-signature))
+ ((tag . "Citation")
+ (doc . "\
+Highlight the citations as specified by `Citation Faces'.
+")
+ (type . const)
+ (default .
+ gnus-article-highlight-citation))
+ ((tag . "Hide")
+ (doc . "\
+Hide unwanted headers, excess citation, and the signature.
+")
+ (type . const)
+ (default . gnus-article-hide))
+ ((tag . "Hide Headers If Wanted")
+ (doc . "\
+Hide headers, but allow user to display them with `t' or `v'.
+")
+ (type . const)
+ (default .
+ gnus-article-hide-headers-if-wanted))
+ ((tag . "Hide Headers")
+ (doc . "\
+Hide unwanted headers and possibly sort them as well.
+Most likely you want to use `Hide Headers If Wanted' instead.
+")
+ (type . const)
+ (default . gnus-article-hide-headers))
+ ((tag . "Hide Signature")
+ (doc . "\
+Hide the signature.
+")
+ (type . const)
+ (default . gnus-article-hide-signature))
+ ((tag . "Hide Excess Citations")
+ (doc . "\
+Hide excess citation.
+
+Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'.
+")
+ (type . const)
+ (default .
+ gnus-article-hide-citation-maybe))
+ ((tag . "Hide Citations")
+ (doc . "\
+Hide all cited text.
+")
+ (type . const)
+ (default . gnus-article-hide-citation))
+ ((tag . "Add Buttons")
+ (doc . "\
+Make URL's into clickable buttons.
+")
+ (type . const)
+ (default . gnus-article-add-buttons))
+ ((prompt . "Other")
+ (doc . "\
+Name of Lisp function to call.
+
+Push the `Filter' button to select one of the predefined filters.
+")
+ (type . symbol)))))))
+ ((tag . "Article Button Face")
+ (doc . "\
+Face used for highlighting buttons in the article buffer.
+
+An article button is a piece of text that you can activate by pressing
+`RET' or `mouse-2' above it.")
+ (name . gnus-article-button-face)
+ (default . bold)
+ (type . face))
+ ((tag . "Article Mouse Face")
+ (doc . "\
+Face used for mouse highlighting in the article buffer.
+
+Article buttons will be displayed in this face when the cursor is
+above them.")
+ (name . gnus-article-mouse-face)
+ (default . highlight)
+ (type . face))
+ ((tag . "Article Signature Face")
+ (doc . "\
+Face used for highlighting a signature in the article buffer.")
+ (name . gnus-signature-face)
+ (default . italic)
+ (type . face))
+ ((tag . "Article Header Highlighting")
+ (doc . "\
+Controls highlighting of article header.
+
+Below is a list of article header names, and the faces used for
+displaying the name and content of the header. The `Header' field
+should contain the name of the header. The field actually contains a
+regular expression that should match the beginning of the header line,
+but if you don't know what a regular expression is, just write the
+name of the header. The second field is the `Name' field, which
+determines how the the header name (i.e. the part of the header left
+of the `:') is displayed. The third field is the `Content' field,
+which determines how the content (i.e. the part of the header right of
+the `:') is displayed.
+
+If you leave the last `Header' field in the list empty, the `Name' and
+`Content' fields will determine how headers not listed above are
+displayed.
+
+If you only want to change the display of the name part for a specific
+header, specify `None' in the `Content' field. Similarly, specify
+`None' in the `Name' field if you only want to leave the name part
+alone.")
+ (name . gnus-header-face-alist)
+ (type . list)
+ (default . (("" bold italic)))
+ (data ((type . repeat)
+ (header . nil)
+ (data (type . list)
+ (compact . t)
+ (data ((type . string)
+ (prompt . "Header")
+ (tag . "Header "))
+ "\n "
+ ((type . face)
+ (prompt . "Name")
+ (tag . "Name "))
+ "\n "
+ ((type . face)
+ (tag . "Content"))
+ "\n")))))
+ ((tag . "Attribution Face")
+ (doc . "\
+Face used for attribution lines.
+It is merged with the face for the cited text belonging to the attribution.")
+ (name . gnus-cite-attribution-face)
+ (default . underline)
+ (type . face))
+ ((tag . "Citation Faces")
+ (doc . "\
+List of faces used for highlighting citations.
+
+When there are citations from multiple articles in the same message,
+Gnus will try to give each citation from each article its own face.
+This should make it easier to see who wrote what.")
+ (name . gnus-cite-face-list)
+ (type . list)
+ (default . (italic))
+ (data ((type . repeat)
+ (header . nil)
+ (data (type . face)
+ (tag . "Face")))))
+ ((tag . "Citation Hide Percentage")
+ (doc . "\
+Only hide excess citation if above this percentage of the body.")
+ (name . gnus-cite-hide-percentage)
+ (default . 50)
+ (type . integer))
+ ((tag . "Citation Hide Absolute")
+ (doc . "\
+Only hide excess citation if above this number of lines in the body.")
+ (name . gnus-cite-hide-absolute)
+ (default . 10)
+ (type . integer))
((tag . "Summary Selected Face")
(doc . "\
Face used for highlighting the current article in the summary buffer.")
(name . gnus-summary-selected-face)
(default . underline)
(type . face))
-;;; gnus-summary-highlight
-;;; need cons and sexp
+ ((tag . "Summary Line Highlighting")
+ (doc . "\
+Controls the higlighting of summary buffer lines.
+
+Below is a list of `Form'/`Face' pairs. When deciding how a a
+particular summary line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used. You can change how those summary lines are displayed, by
+editing the face field.
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions. Hopefully this will
+change in a future release. For now, you can use the following
+variables in the Lisp expression:
+
+score: The article's score
+default: The default article score.
+below: The score below which articles are automatically marked as read.
+mark: The article's mark.")
+ (name . gnus-summary-highlight)
+ (type . list)
+ (default . (((> score default) . bold)
+ ((< score default) . italic)))
+ (data ((type . repeat)
+ (header . nil)
+ (data (type . pair)
+ (compact . t)
+ (data ((type . sexp)
+ (width . 60)
+ (tag . "Form"))
+ "\n "
+ ((type . face)
+ (tag . "Face"))
+ "\n")))))
+ ;; Do not define `gnus-button-alist' before we have
+ ;; some `complexity' attribute so we can hide it from
+ ;; beginners.
)))))
+(defun gnus-custom-import-swap-alist (custom alist)
+ ;; Swap key and value in CUSTOM ALIST.
+ (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist)))
+ (funcall (custom-super custom 'import) custom swap)))
+
+(defun gnus-custom-export-swap-alist (custom alist)
+ ;; Swap key and value in CUSTOM ALIST.
+ (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist)))
+ (funcall (custom-super custom 'export) custom swap)))
+
(provide 'gnus-cus)
;;; gnus-cus.el ends here
+
+
-;;; gnus-edit.el --- Gnus SCORE file editing.
+;;; gnus-edit.el --- Gnus SCORE file editing
;; Copyright (C) 1995 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
((and (not (string-match "28.9" emacs-version))
(not (string-match "29" emacs-version)))
- (setq gnus-hidden-properties '(invisible t))
+ ;; Remove the `intangible' prop.
+ (let ((props gnus-hidden-properties))
+ (while (and props (not (eq (car (cdr props)) 'intangible)))
+ (setq props (cdr props)))
+ (and props (setcdr props (cdr (cdr (cdr props))))))
(or (fboundp 'buffer-substring-no-properties)
(defun buffer-substring-no-properties (beg end)
(format "%s" (buffer-substring beg end)))))
touched: If this alist has been modified.
mark: Automatically mark articles below this.
expunge: Automatically expunge articles below this.
-files: List of other SCORE files to load when loading this one.
+files: List of other score files to load when loading this one.
eval: Sexp to be evaluated when the score file is loaded.
String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
(if (y-or-n-p "Use regexp match? ") 'r 's)
(and current-prefix-arg
(prefix-numeric-value current-prefix-arg))
- (cond ((not (y-or-n-p "Add to SCORE file? "))
+ (cond ((not (y-or-n-p "Add to score file? "))
'now)
((y-or-n-p "Expire kill? ")
(current-time-string))
(defun gnus-score-change-score-file (file)
"Change current score alist."
- (interactive (list (completing-read "Score file: " gnus-score-cache)))
+ (interactive
+ (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
(gnus-score-load-file file)
(gnus-set-mode-line 'summary))
(cons (list 'touched t) (nreverse out))))
(defun gnus-score-save ()
- ;; Save all SCORE information.
+ ;; Save all score information.
(let ((cache gnus-score-cache))
(save-excursion
(setq gnus-score-alist nil)
;; This is a normal score file, so we print it very
;; prettily.
(pp score (current-buffer))))
- (gnus-make-directory (file-name-directory file))
- ;; If the score file is empty, we delete it.
- (if (zerop (buffer-size))
- (delete-file file)
- ;; There are scores, so we write the file.
- (write-region (point-min) (point-max) file nil 'silent)))))
+ (if (not (gnus-make-directory (file-name-directory file)))
+ ()
+ ;; If the score file is empty, we delete it.
+ (if (zerop (buffer-size))
+ (delete-file file)
+ ;; There are scores, so we write the file.
+ (write-region (point-min) (point-max) file nil 'silent))))))
(kill-buffer (current-buffer)))))
(defun gnus-score-headers (score-files &optional trace)
(let (scores)
;; PLM: probably this is not the best place to clear orphan-score
(setq gnus-orphan-score nil)
- ;; Load the SCORE files.
+ ;; Load the score files.
(while score-files
(if (stringp (car score-files))
;; It is a string, which means that it's a score file name,
;;; Summary highlights.
-(defvar gnus-summary-selected-face 'underline
- "*Face used for highlighting the current article in the summary buffer.")
-
(defvar gnus-summary-highlight-properties
'((unread "ForestGreen" "green")
(ticked "Firebrick" "pink")
map)
(while props)))
-
+(defvar gnus-summary-selected-face 'underline
+ "*Face used for highlighting the current article in the summary buffer.")
+
(defvar gnus-summary-highlight
(cond ((not (eq gnus-display-type 'color))
'(((> score default) . bold)
(defvar gnus-button-url
(cond ((boundp 'browse-url-browser-function) browse-url-browser-function)
- ((eq window-system 'x) 'gnus-netscape-open-url)
- ((fboundp 'w3-fetch) 'w3-fetch))
+ ((fboundp 'w3-fetch) 'w3-fetch)
+ ((eq window-system 'x) 'gnus-netscape-open-url))
"*Function to fetch URL.
The function will be called with one argument, the URL to fetch.
Useful values of this function are:
["Best unread group" gnus-group-best-unread-group t]
))
- (easy-menu-define
- gnus-group-post-menu
- gnus-group-mode-map
- ""
- '("Post"
- ["Send a mail" gnus-group-mail t]
- ["Post an article" gnus-group-post-news t]
- ))
-
(easy-menu-define
gnus-group-misc-menu
gnus-group-mode-map
""
'("Misc"
["Send a bug report" gnus-bug t]
+ ["Send a mail" gnus-group-mail t]
+ ["Post an article" gnus-group-post-news t]
["Customize score file" gnus-score-customize t]
["Check for new news" gnus-group-get-new-news t]
["Delete bogus groups" gnus-group-check-bogus-groups 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]
+ ["Increase score" gnus-summary-increase-score t]
+ ["Lower score" gnus-summary-lower-score t]
+ ("Default header"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
+ :style radio
+ :selected (null gnus-score-default-header)]
+ ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
+ :style radio
+ :selected (eq gnus-score-default-header 'a )]
+ ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
+ :style radio
+ :selected (eq gnus-score-default-header 's )]
+ ["Article body"
+ (gnus-score-set-default 'gnus-score-default-header 'b)
+ :style radio
+ :selected (eq gnus-score-default-header 'b )]
+ ["All headers"
+ (gnus-score-set-default 'gnus-score-default-header 'h)
+ :style radio
+ :selected (eq gnus-score-default-header 'h )]
+ ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
+ :style radio
+ :selected (eq gnus-score-default-header 'i )]
+ ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
+ :style radio
+ :selected (eq gnus-score-default-header 't )]
+ ["Crossposting"
+ (gnus-score-set-default 'gnus-score-default-header 'x)
+ :style radio
+ :selected (eq gnus-score-default-header 'x )]
+ ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
+ :style radio
+ :selected (eq gnus-score-default-header 'l )]
+ ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
+ :style radio
+ :selected (eq gnus-score-default-header 'd )]
+ ["Followups to author"
+ (gnus-score-set-default 'gnus-score-default-header 'f)
+ :style radio
+ :selected (eq gnus-score-default-header 'f )])
+ ("Default type"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
+ :style radio
+ :selected (null gnus-score-default-type)]
+ ;; The `:active' key is commented out in the following,
+ ;; because the GNU Emacs hack to support radio buttons use
+ ;; active to indicate which button is selected.
+ ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 's)]
+ ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'r)]
+ ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'e)]
+ ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'f)]
+ ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'b)]
+ ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'n)]
+ ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'a)]
+ ["Less than number"
+ (gnus-score-set-default 'gnus-score-default-type '<)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '<)]
+ ["Equal to number"
+ (gnus-score-set-default 'gnus-score-default-type '=)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '=)]
+ ["Greater than number"
+ (gnus-score-set-default 'gnus-score-default-type '>)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '>)])
+ ["Default fold" gnus-score-default-fold-toggle
+ :style toggle
+ :selected gnus-score-default-fold]
+ ("Default duration"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
+ :style radio
+ :selected (null gnus-score-default-duration)]
+ ["Permanent"
+ (gnus-score-set-default 'gnus-score-default-duration 'p)
+ :style radio
+ :selected (eq gnus-score-default-duration 'p)]
+ ["Temporary"
+ (gnus-score-set-default 'gnus-score-default-duration 't)
+ :style radio
+ :selected (eq gnus-score-default-duration 't)]
+ ["Immediate"
+ (gnus-score-set-default 'gnus-score-default-duration 'i)
+ :style radio
+ :selected (eq gnus-score-default-duration 'i)])
))))
)))
+(defun gnus-score-set-default (var value)
+ ;; A version of set that updates the GNU Emacs menu-bar.
+ (set var value)
+ ;; It is the message that forces the active status to be updated.
+ (message ""))
+
+(defvar gnus-score-default-header nil
+ "Default header when entering new scores.
+
+Should be one of the following symbols.
+
+ a: from
+ s: subject
+ b: body
+ h: head
+ i: message-id
+ t: references
+ x: xref
+ l: lines
+ d: date
+ f: followup
+
+If nil, the user will be asked for a header.")
+
+(defvar gnus-score-default-type nil
+ "Default match type when entering new scores.
+
+Should be one of the following symbols.
+
+ s: substring
+ e: exact string
+ f: fuzzy string
+ r: regexp string
+ b: before date
+ a: at date
+ n: this date
+ <: less than number
+ >: greater than number
+ =: equal to number
+
+If nil, the user will be asked for a match type.")
+
+(defvar gnus-score-default-fold nil
+ "Use case folding for new score file entries iff not nil.")
+
+
+(defun gnus-score-default-fold-toggle ()
+ "Toggle folding for new score file entries."
+ (interactive)
+ (setq gnus-score-default-fold (not gnus-score-default-fold))
+ (if gnus-score-default-fold
+ (message "New score file entries will be case insensitive.")
+ (message "New score file entries will be case sensitive.")))
+
+(defvar gnus-score-default-duration nil
+ "Default duration of effect when entering new scores.
+
+Should be one of the following symbols.
+
+ t: temporary
+ p: permanent
+ i: immediate
+
+If nil, the user will be asked for a duration.")
+
(defun gnus-visual-score-map (type)
(if t
nil
list (cdr list))))
result)))
+(require 'gnus-cus)
(gnus-ems-redefine)
-
(provide 'gnus-vis)
;;; gnus-vis.el ends here
(or (gnus-server-opened (gnus-find-method-for-group
gnus-newsgroup-name))
(progn
- (gnus-check-news-server
+ (gnus-check-server
(gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
(and (stringp article)
-;; gnus.el --- a newsreader for GNU Emacs
+;;; gnus.el --- a newsreader for GNU Emacs
;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
"*Suffix of the adaptive score files.")
(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
- "*Function used to find SCORE files.
+ "*Function used to find score files.
The function will be called with the group name as the argument, and
should return a list of score files to apply to that group. The score
files do not actually have to exist.
Predefined values are:
-gnus-score-find-single: Only apply the group's own SCORE file.
-gnus-score-find-hierarchical: Also apply SCORE files from parent groups.
-gnus-score-find-bnews: Apply SCORE files whose names matches.
+gnus-score-find-single: Only apply the group's own score file.
+gnus-score-find-hierarchical: Also apply score files from parent groups.
+gnus-score-find-bnews: Apply score files whose names matches.
See the documentation to these functions for more information.
(defvar gnus-ignored-headers
"^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
"*All headers that match this regexp will be hidden.
-Also see `gnus-visible-headers'.")
+If `gnus-visible-headers' is non-nil, this variable will be ignored.")
(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:"
"*All headers that do not match this regexp will be hidden.
-Also see `gnus-ignored-headers'.")
+If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
(defvar gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "(ding) Gnus v0.99.11"
+(defconst gnus-version "(ding) Gnus v0.99.12"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
newsgroup))
(defun gnus-newsgroup-saveable-name (group)
+ ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
+ ;; with dots.
(gnus-replace-chars-in-string group ?/ ?.))
(defun gnus-make-directory (dir)
"Make DIRECTORY recursively."
- (let* ((dir (expand-file-name dir default-directory))
- dirs)
+ ;; Why don't we use `(make-directory dir 'parents)'? That's just one
+ ;; of the many mysteries of the universe.
+ (let* ((dir (expand-file-name dir default-directory))
+ dirs err)
(if (string-match "/$" dir)
(setq dir (substring dir 0 (match-beginning 0))))
+ ;; First go down the path until we find a directory that exists.
(while (not (file-exists-p dir))
(setq dirs (cons dir dirs))
(string-match "/[^/]+$" dir)
(setq dir (substring dir 0 (match-beginning 0))))
- (while dirs
- (make-directory (car dirs))
- (setq dirs (cdr dirs)))))
+ ;; Then create all the subdirs.
+ (while (and dirs (not err))
+ (condition-case ()
+ (make-directory (car dirs))
+ (error (setq err t)))
+ (setq dirs (cdr dirs)))
+ ;; We return whether we were successful or not.
+ (not dirs)))
(defun gnus-capitalize-newsgroup (newsgroup)
"Capitalize NEWSGROUP name."
(cons (current-buffer) 'summary)))))))
gnus-newsrc-hashtb)
(set-buffer gnus-group-buffer)
- (or (gnus-server-opened method)
- (gnus-open-server method)
+ (or (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(if activate (or (gnus-request-group group)
(error "Couldn't request group")))
;; ... or insert the line.
(or
(gnus-gethash group gnus-active-hashtb)
- (gnus-activate-newsgroup group)
+ (gnus-activate-group group)
(error "%s error: %s" group (gnus-status-message group)))
(gnus-group-update-group group)
group (and (not all) (append (cdr (assq 'tick marked))
(cdr (assq 'dormant marked))))
nil (and (not all) (cdr (assq 'tick marked))))
- (and all marked
+ (and all
+ (setq marked (nth 3 (nth 2 entry)))
(setcar (nthcdr 3 (nth 2 entry))
(delq (assq 'dormant marked)
(nth 3 (nth 2 entry)))))))
(ding)
(message "%s error: %s" group (gnus-status-message group))
(sit-for 2))))
- ;; !!! I don't know why the buffer scrolls forward when updating
- ;; the first line in the group buffer, but it does. So we set the
- ;; window start forcibly.
-; (set-window-start (get-buffer-window (current-buffer)) w-p)
(gnus-group-next-unread-group 1 t)
(gnus-summary-position-cursor)
ret))
(defun gnus-get-new-news-in-group (group)
(and group
- (gnus-activate-newsgroup group)
+ (gnus-activate-group group)
(progn
(gnus-get-unread-articles-in-group
(nth 2 (gnus-gethash group gnus-newsrc-hashtb))
(gnus-clear-system))))
(defun gnus-offer-save-summaries ()
- (let ((buffers (buffer-list)))
+ (let ((buffers (buffer-list))
+ answer)
(save-excursion
- (while buffers
+ (while (and buffers (not (eq answer ?q)))
(and
;; We look for buffers with "Summary" in the name.
(string-match "Summary" (or (buffer-name (car buffers)) ""))
;; We check that this is, indeed, a summary buffer.
(eq major-mode 'gnus-summary-mode))
;; We ask the user whether she wants to save the info.
- (gnus-y-or-n-p
- (format "Update summary buffer %s? " (buffer-name)))
+ (or (eq answer ?!)
+ (progn
+ (setq answer nil)
+ (while (not (memq answer '(?y ?n ?! ?q)))
+ (message (format "%sUpdate summary buffer %s? (y, n, !, q)"
+ (if answer "Illegal char. " "")
+ (buffer-name)))
+ (setq answer (read-char)))
+ (or (eq answer ?y) (eq answer ?!))))
;; We do it by simply exiting.
(gnus-summary-exit))
(setq buffers (cdr buffers))))))
(let ((gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
- (or (gnus-server-opened method)
- (gnus-open-server method)
+ (or (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(or (gnus-request-list method)
(error "Couldn't request list: %s" (gnus-status-message method)))
(define-prefix-command 'gnus-summary-wash-time-map)
(define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map)
- (define-key gnus-summary-wash-map "u" 'gnus-article-date-ut)
- (define-key gnus-summary-wash-map "l" 'gnus-article-date-local)
- (define-key gnus-summary-wash-map "e" 'gnus-article-date-lapsed)
+ (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut)
+ (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut)
+ (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local)
+ (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed)
(define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
(define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
(gnus-update-format-specifications)
;; Generate the summary buffer.
(gnus-summary-prepare)
+ ;; Create the header hashtb.
+ (gnus-make-headers-hashtable-by-number)
(if (zerop (buffer-size))
(cond (gnus-newsgroup-dormant
(gnus-summary-show-all-dormant))
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
articles)
- (gnus-check-news-server
+ (gnus-check-server
(setq gnus-current-select-method (gnus-find-method-for-group group)))
- (or (gnus-server-opened gnus-current-select-method)
- (gnus-open-server gnus-current-select-method)
+ (or (gnus-check-server gnus-current-select-method)
(error "Couldn't open server"))
(or (and (null entry)
- (gnus-activate-newsgroup group))
+ (gnus-activate-group group))
(and (eq (car entry) t)
- (gnus-activate-newsgroup (car info)))
+ (gnus-activate-group (car info)))
(gnus-request-group group t)
(progn
(kill-buffer (current-buffer))
;; If we were to fetch old headers, but the backend didn't
;; support XOVER, then it is possible we fetched one article
;; that we shouldn't have. If that's the case, we remove it.
- (if (not gnus-fetch-old-headers)
+ (if (or (not gnus-fetch-old-headers)
+ (eq 1 (car articles)))
()
(save-excursion
(set-buffer nntp-server-buffer)
(setq gnus-newsgroup-scored
(copy-sequence (cdr (assq 'score marked))))
(setq gnus-newsgroup-processable nil)))
- ;; Create the header hashtb.
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(or (and (stringp gnus-auto-expirable-newsgroups)
;; score.
(goto-char (point-min))
(while (and (or (not (= (gnus-summary-article-mark) gnus-unread-mark))
- (not (eq (cdr (memq (gnus-summary-article-number)
+ (not (eq (cdr (assq (gnus-summary-article-number)
gnus-newsgroup-scored))
gnus-summary-default-score)))
(zerop (forward-line 1))
(not (eobp))))
- ;; We jump to the article we have finally found.
- (gnus-summary-goto-article (gnus-summary-article-number))))
+ (if (= (gnus-summary-article-mark) gnus-unread-mark)
+ ;; We jump to the article we have finally found.
+ (gnus-summary-goto-article (gnus-summary-article-number))
+ ;; Or there were no default-scored articles.
+ (gnus-summary-goto-article article))))
(gnus-summary-position-cursor)))
(defun gnus-summary-goto-article (article &optional all-headers)
(get-buffer-window gnus-article-buffer)))
number tmp-buf)
(and gnus-refer-article-method
- (or (gnus-server-opened gnus-refer-article-method)
- (gnus-open-server gnus-refer-article-method)))
+ (gnus-check-server gnus-refer-article-method))
;; Save the old article buffer.
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-max))
(and gnus-break-pages (gnus-narrow-to-page))))
-(defun gnus-summary-show-article (&optional no-refetch)
- "Force re-fetching of the current article.
-If the prefix argument NO-REFETCH is non-nil, no actual refetch will
-be performed. The current article will simply be redisplayed."
- (interactive "P")
+(defun gnus-summary-show-article ()
+ "Force re-fetching of the current article."
+ (interactive)
(gnus-set-global-variables)
- (if (not no-refetch)
- (gnus-summary-select-article gnus-have-all-headers t)
- (or gnus-current-article
- (error "There is no current article"))
- (gnus-summary-goto-subject gnus-current-article)
- (gnus-configure-windows 'article)
- (gnus-summary-position-cursor)))
+ (or gnus-current-article
+ (error "There is no current article"))
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-select-article nil 'force)
+ (gnus-configure-windows 'article)
+ (gnus-summary-position-cursor))
(defun gnus-summary-verbose-headers (&optional arg)
"Toggle permanent full header display.
(if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
(setq to-newsgroup (or gnus-current-move-group "")))
(or (gnus-gethash to-newsgroup gnus-active-hashtb)
- (gnus-activate-newsgroup to-newsgroup)
+ (gnus-activate-group to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
(setq to-method (if select-method (list 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)
+ (or (gnus-check-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)
(article (car articles)))
(gnus-summary-goto-subject article)
(beginning-of-line)
- (delete-region (point)
- (progn (forward-line 1) (point)))
- (if (not (memq article gnus-newsgroup-unreads))
- (setcar (cdr (cdr info))
- (gnus-add-to-range (nth 2 info)
- (list (cdr art-group)))))
- ;; Copy any marks over to the new group.
- (let ((marks '((tick . gnus-newsgroup-marked)
- (dormant . gnus-newsgroup-dormant)
- (expire . gnus-newsgroup-expirable)
- (bookmark . gnus-newsgroup-bookmarks)
- ; (score . gnus-newsgroup-scored)
- (reply . gnus-newsgroup-replied)))
- (to-article (cdr art-group)))
- (while marks
- (if (memq article (symbol-value (cdr (car marks))))
- (gnus-add-marked-articles
- (car info) (car (car marks)) (list to-article) info))
- (setq marks (cdr marks))))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ ;; Update the group that has been moved to.
+ (if (not info)
+ () ; This group does not exist yet.
+ (if (not (memq article gnus-newsgroup-unreads))
+ (setcar (cdr (cdr info))
+ (gnus-add-to-range (nth 2 info)
+ (list (cdr art-group)))))
+ ;; Copy any marks over to the new group.
+ (let ((marks '((tick . gnus-newsgroup-marked)
+ (dormant . gnus-newsgroup-dormant)
+ (expire . gnus-newsgroup-expirable)
+ (bookmark . gnus-newsgroup-bookmarks)
+ (reply . gnus-newsgroup-replied)))
+ (to-article (cdr art-group)))
+ (while marks
+ (if (memq article (symbol-value (cdr (car marks))))
+ (gnus-add-marked-articles
+ (car info) (car (car marks)) (list to-article) info))
+ (setq marks (cdr marks)))))
+ ;; Update marks.
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(setq gnus-newsgroup-dormant
(if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
(setq to-newsgroup (or gnus-current-move-group "")))
(or (gnus-gethash to-newsgroup gnus-active-hashtb)
- (gnus-activate-newsgroup to-newsgroup)
+ (gnus-activate-group to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
(setq to-method (if select-method (list 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)
+ (or (gnus-check-server to-method)
(error "Can't open server %s" (car to-method)))
(while articles
(gnus-message 6 "Copying to %s: %s..."
gnus-newsrc-hashtb)))
(info (nth 2 entry))
(article (car articles)))
- (if (not (memq article gnus-newsgroup-unreads))
- (setcar (cdr (cdr info))
- (gnus-add-to-range (nth 2 info)
- (list (cdr art-group)))))
- ;; Copy any marks over to the new group.
- (let ((marks '((tick . gnus-newsgroup-marked)
- (dormant . gnus-newsgroup-dormant)
- (expire . gnus-newsgroup-expirable)
- (bookmark . gnus-newsgroup-bookmarks)
- ; (score . gnus-newsgroup-scored)
- (reply . gnus-newsgroup-replied)))
- (to-article (cdr art-group)))
- (while marks
- (if (memq article (symbol-value (cdr (car marks))))
- (gnus-add-marked-articles
- (car info) (car (car marks)) (list to-article) info))
- (setq marks (cdr marks)))))
+ ;; We copy the info over to the new group.
+ (if (not info)
+ () ; This group does not exist (yet).
+ (if (not (memq article gnus-newsgroup-unreads))
+ (setcar (cdr (cdr info))
+ (gnus-add-to-range (nth 2 info)
+ (list (cdr art-group)))))
+ ;; Copy any marks over to the new group.
+ (let ((marks '((tick . gnus-newsgroup-marked)
+ (dormant . gnus-newsgroup-dormant)
+ (expire . gnus-newsgroup-expirable)
+ (bookmark . gnus-newsgroup-bookmarks)
+ (reply . gnus-newsgroup-replied)))
+ (to-article (cdr art-group)))
+ (while marks
+ (if (memq article (symbol-value (cdr (car marks))))
+ (gnus-add-marked-articles
+ (car info) (car (car marks)) (list to-article) info))
+ (setq marks (cdr marks))))))
(gnus-message 1 "Couldn't copy article %s" (car articles)))
(gnus-summary-remove-process-mark (car articles))
(setq articles (cdr articles)))
(use-local-map gnus-article-mode-map)
(setq buffer-read-only t)
(buffer-disable-undo (current-buffer))
- (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))
- (gnus-configure-windows 'summary))))
+ (gnus-configure-windows 'summary))
+ (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))))
(defun gnus-summary-edit-article-postpone ()
"Postpone changes to the current article."
(use-local-map gnus-article-mode-map)
(setq buffer-read-only t)
(buffer-disable-undo (current-buffer))
- (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))
- (gnus-configure-windows 'summary))
+ (gnus-configure-windows 'summary)
+ (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)))
(defun gnus-summary-fancy-query ()
"Query where the fancy respool algorithm would put this article."
;; select the first unread article.
(gnus-summary-next-article t (and gnus-auto-select-same
(gnus-summary-subject-string)))
- (gnus-message 7 "%d articles are marked as %s"
- count (if unmark "unread" "read"))))
+ (gnus-message 7 "%d article%s marked as %s"
+ count (if (= count 1) " is" "s are")
+ (if unmark "unread" "read"))))
(defun gnus-summary-kill-same-subject (&optional unmark)
"Mark articles which has the same subject as read.
(gnus-summary-show-thread) t)
(gnus-summary-search-forward nil subject))
(setq count (1+ count)))))
+ (gnus-set-mode-line 'summary)
;; Return the number of marked articles.
count)))
b)
(or (gnus-summary-goto-subject article)
(error (format "No such article: %d" article)))
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
(gnus-summary-position-cursor)
;; If all commands are to be bunched up on one line, we collect
;; them here.
;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
)))
- (while commands
+ (while (and nil commands) ; disabled
(define-key gnus-article-mode-map (car commands)
'gnus-article-summary-command)
(setq commands (cdr commands))))
(let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "n" "^" "\M-^")))
- (while commands
+ (while (and nil commands) ; disabled
(define-key gnus-article-mode-map (car commands)
'gnus-article-summary-command-nosave)
(setq commands (cdr commands)))))
(setq group (or group gnus-newsgroup-name))
;; Open server if it has closed.
- (gnus-check-news-server (gnus-find-method-for-group group))
+ (gnus-check-server (gnus-find-method-for-group group))
;; Using `gnus-request-article' directly will insert the article into
;; `nntp-server-buffer' - so we'll save some time by not having to
(defun gnus-read-header (id)
"Read the headers of article ID and enter them into the Gnus system."
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
(let (header)
(if (not (setq header
(car (if (let ((gnus-nov-is-evil t))
;; Make sure the connection to the server is alive.
(or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
(progn
- (gnus-check-news-server
+ (gnus-check-server
(gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
(let* ((article (if header (header-number header) article))
(summary-buffer (current-buffer))
(internal-hook gnus-article-internal-prepare-hook)
(gnus-article-date-ut 'lapsed))
(defun gnus-article-maybe-highlight ()
+ "Do some article highlighting if `gnus-visual' is non-nil."
(if gnus-visual (gnus-article-highlight-some)))
;; Article savers.
(ding)
nil)))))
-(defun gnus-check-news-server (&optional method)
+(defun gnus-check-server (&optional method)
"If the news server is down, start it up again."
(let ((method (if method method gnus-select-method)))
(and (stringp method)
;; Open server.
(gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method))
(run-hooks 'gnus-open-server-hook)
- (or (gnus-server-opened method)
- (gnus-open-server method))
- (message ""))))
+ (prog1
+ (gnus-open-server method)
+ (message "")))))
(defun gnus-nntp-message (&optional message)
"Check the status of the NNTP server.
gnus-valid-select-methods)))
gnus-post-method
(gnus-find-method-for-group gnus-newsgroup-name))))
- (or (gnus-server-opened method)
- (gnus-open-server method)
+ (or (gnus-check-server method)
(error "Can't open server %s:%s" (car method) (nth 1 method)))
(let ((mail-self-blind nil)
(mail-archive-file-name nil))
;; request new newsgroups.
(while methods
(setq method (gnus-server-get-method nil (car methods)))
- (and (or (gnus-server-opened method)
- (gnus-open-server method))
+ (and (gnus-check-server method)
(gnus-request-newgroups date method)
(save-excursion
(setq got-new t)
;; the others, so we just pop them on a list for
;; now.
(setq virtuals (cons info virtuals))
- (and (setq active (gnus-activate-newsgroup (car info)))
+ (and (setq active (gnus-activate-group (car info)))
;; Close the groups as we look at them!
(gnus-close-group group))))
-
+
+ (or gnus-read-active-file (gnus-check-server method))
;; These groups are native or secondary.
(if (and (not gnus-read-active-file)
(<= (nth 1 info) level))
- (setq active (gnus-activate-newsgroup (car info)))))
+ (setq active (gnus-activate-group (car info)))))
(if active
(gnus-get-unread-articles-in-group info active)
;; other groups.
;; !!! If one virtual group contains another virtual group, even
;; doing it this way might cause problems.
- (while virtuals
- (and (setq active (gnus-activate-newsgroup (car (car virtuals))))
+ (while virtuals
+ (and (setq active (gnus-activate-group (car (car virtuals))))
(gnus-get-unread-articles-in-group (car virtuals) active))
(setq virtuals (cdr virtuals)))
(setq marked m))
(setq m (cdr m)))))
-(defun gnus-activate-newsgroup (group)
+(defun gnus-activate-group (group)
+ ;; Check whether a group has been activated or not.
(let ((method (gnus-find-method-for-group group))
active)
- (and (or (gnus-server-opened method) (gnus-open-server method))
- (gnus-request-group group)
+ (and (gnus-check-server method)
+ ;; We escape all bugs and quits here to make it possible to
+ ;; continue if a group is so out-there that it reports bugs
+ ;; and stuff.
+ (condition-case ()
+ (gnus-request-group group)
+ (error nil)
+ (quit nil))
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
+ ;; Parse the result we got from `gnus-request-group'.
(and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
(progn
(goto-char (match-beginning 1))
group (setq active (cons (read (current-buffer))
(read (current-buffer))))
gnus-active-hashtb))
+ ;; Return the new active info.
active)))))
(defun gnus-update-read-articles
(while (and dormant (< (car dormant) (car active)))
(setq dormant (cdr dormant)))
(setq unread (sort (append unselected unread) '<))
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (setcar entry (max 0 (- (length unread) (length ticked)
- (length dormant))))
;; Compute the ranges of read articles by looking at the list of
;; unread articles.
(while unread
(if domarks dormant (cdr (assq 'dormant marked)))
(if domarks bookmark (cdr (assq 'bookmark marked)))
(if domarks score (cdr (assq 'score marked))))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group
+ info (gnus-gethash group gnus-active-hashtb))
t)))
(defun gnus-make-articles-unread (group articles)
;; Get the active file(s) from the backend(s).
(defun gnus-read-active-file ()
(gnus-group-set-mode-line)
- (let ((methods (if (or (gnus-server-opened gnus-select-method)
- (gnus-open-server gnus-select-method))
+ (let ((methods (if (gnus-check-server gnus-select-method)
;; The native server is available.
(cons gnus-select-method gnus-secondary-select-methods)
;; The native server is down, so we just do the
(concat " from " where) "")
(car method))))
(gnus-message 5 mesg)
- (gnus-check-news-server method)
+ (gnus-check-server method)
(cond
((and (eq gnus-read-active-file 'some)
(gnus-check-backend-function 'retrieve-groups (car method)))
(setq groups (cons (gnus-group-real-name
(car (car newsrc))) groups)))
(setq newsrc (cdr newsrc)))
- (or (gnus-server-opened method)
- (gnus-open-server method))
+ (gnus-check-server method)
(setq list-type (gnus-retrieve-groups groups method))
(cond ((not list-type)
(gnus-message
;; We mark this active file as read.
(setq gnus-have-read-active-file
(cons method gnus-have-read-active-file))
- (gnus-message 5 "%sdone" mesg))))
- )
+ (gnus-message 5 "%sdone" mesg)))))
(setq methods (cdr methods))))))
;; Read an active file and place the results in `gnus-active-hashtb'.
(progn
(goto-char (point-min))
(delete-matching-lines gnus-ignored-newsgroups)))
+ ;; Make the group names readable as a lisp expression even if they
+ ;; contain special characters.
+ ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
+ (goto-char (point-max))
+ (while (re-search-backward "[][';?()#]" nil t)
+ (insert ?\\))
;; If these are groups from a foreign select method, we insert the
;; group prefix in front of the group names.
(and method (not (gnus-server-equal
(while (and (not (eobp))
(progn (insert prefix)
(zerop (forward-line 1)))))))
- (goto-char (point-min))
- ;; Store active file in hashtable.
+ ;; Store the active file in a hash table.
(goto-char (point-min))
(if (string-match "%[oO]" gnus-group-line-format)
;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
(set group nil)
(if ignore-errors
()
- (ding)
(gnus-message 3 "Warning - illegal active: %s"
(buffer-substring
(gnus-point-at-bol) (gnus-point-at-eol)))
(gnus-message 5 "Reading descriptions file via %s..." (car method))
(cond
- ((not (or (gnus-server-opened method)
- (gnus-open-server method)))
+ ((not (gnus-check-server method))
(gnus-message 1 "Couldn't open server")
nil)
((not (gnus-request-list-newsgroups method))
(set-buffer-modified-p nil)
(goto-char (point-min))
+ (re-search-forward delim nil t)
+ (setq start (match-beginning 0))
(while (re-search-forward delim nil t)
- (setq start (match-beginning 0))
- (if (not (search-forward
- "\nX-Gnus-Newsgroup: "
- (save-excursion
- (setq end (or (and (re-search-forward delim nil t)
- (match-beginning 0))
- (point-max)))) t))
+ (setq end (match-end 0))
+ (or (search-backward "\nX-Gnus-Newsgroup: " start t)
(progn
(goto-char end)
(save-excursion
(goto-char start)
(narrow-to-region start end)
(nnbabyl-save-mail)
- (setq end (point-max))))
- (goto-char end))))
+ (setq end (point-max))))))
+ (goto-char (setq start end)))
(and (buffer-modified-p (current-buffer)) (save-buffer))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
(if (stringp (car sequence))
'headers
(set-buffer nndoc-current-buffer)
+ (widen)
(goto-char (point-min))
(re-search-forward (or nndoc-first-article
nndoc-article-begin) nil t)
(while (not (= end (point-max)))
(setq start (marker-position end))
(goto-char end)
- (end-of-line)
+ ;; There may be more than one "From " line, so we skip past
+ ;; them.
+ (while (looking-at delim)
+ (forward-line 1))
(set-marker end (or (and (re-search-forward delim nil t)
(match-beginning 0))
(point-max)))
-;;; nnkiboze.el --- select virtual news access for (ding) Gnus
+;;; nnkiboze.el --- select virtual news access for Gnus
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
(run-hooks 'nntp-server-hook)
nntp-server-process)))))
-(defvar nntp-dum-num 5)
-
(defun nntp-open-network-stream (server)
(open-network-stream
"nntpd" nntp-server-buffer server nntp-port-number))
-;;; nnvirtual.el --- virtual newsgroups access for (ding) Gnus
+;;; nnvirtual.el --- virtual newsgroups access for Gnus
;; Copyright (C) 1994,95 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; See if the group has had its active list read this session
;; if not, we do it now.
(if (null active)
- (if (gnus-activate-newsgroup igroup)
+ (if (gnus-activate-group igroup)
(progn
(gnus-get-unread-articles-in-group
info (gnus-gethash igroup gnus-active-hashtb))
Predefined functions available are:
@table @code
+
@item gnus-score-find-single
@findex gnus-score-find-single
Only apply the group's own score file.
+
@item gnus-score-find-bnews
@findex gnus-score-find-bnews
Apply all score files that match, using bnews syntax. For instance, if
@samp{not.alt.all.SCORE} and @samp{gnu.all.SCORE} would all apply. In
short, the instances of @samp{all} in the score file names are
translated into @samp{.*}, and then a regexp match is done.
+
+If @code{gnus-use-long-file-name} is non-@code{nil}, this won't work
+very will. It will find stuff like @file{gnu/all/SCORE}, but will not
+find files like @file{not/gnu/all/SCORE}.
+
@item gnus-score-find-hierarchical
@findex gnus-score-find-hierarchical
Apply all score files from all the parent groups.
projects / gnus / commitdiff