+Fri Mar 7 23:33:34 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Gnus v5.4.22 is released.
+
+Fri Mar 7 08:25:20 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Made interactive.
+
+ * gnus-sum.el (gnus-read-move-group-name): Beep on empty names.
+
+ * nnmail.el (nnmail-check-duplication): Don't rename Message-ID.
+ (nnmail-cache-message-id-when-accepting): Removed.
+
+ * gnus-sum.el (gnus-nov-parse-line): Allow showing of multiple
+ articles with the same Message-ID.
+ (gnus-get-newsgroup-headers): Ditto.
+
+ * gnus.el: Removed trailing spaces throughout.
+
+ * gnus-art.el (gnus-header-name-face): Made easier on the eyes.
+ (gnus-article-add-buttons): Make buffer read/write before doing
+ anything.
+
+ * message.el (message-font-lock-keywords): Changed expression and
+ faces.
+
Fri Mar 7 07:36:14 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v5.4.21 is released.
(define-widget-keywords :custom-prefixes :custom-menu :custom-show
:custom-magic :custom-state :custom-level :custom-form
- :custom-set :custom-save :custom-reset-current :custom-reset-saved
+ :custom-set :custom-save :custom-reset-current :custom-reset-saved
:custom-reset-factory)
;;; Customization Groups.
(defgroup customize '((widgets custom-group))
"Customization of the Customization support."
:link '(custom-manual "(custom)Top")
- :link '(url-link :tag "Development Page"
+ :link '(url-link :tag "Development Page"
"http://www.dina.kvl.dk/~abraham/custom/")
:prefix "custom-"
:group 'help
(defun custom-split-regexp-maybe (regexp)
"If REGEXP is a string, split it to a list at `\\|'.
-You can get the original back with from the result with:
+You can get the original back with from the result with:
(mapconcat 'identity result \"\\|\")
IF REGEXP is not a string, return it unchanged."
(while prefixes
(setq prefix (car prefixes))
(if (search-forward prefix (+ (point) (length prefix)) t)
- (progn
+ (progn
(setq prefixes nil)
(delete-region (point-min) (point)))
(setq prefixes (cdr prefixes)))))
(subst-char-in-region (point-min) (point-max) ?- ?\ t)
(capitalize-region (point-min) (point-max))
- (unless no-suffix
+ (unless no-suffix
(goto-char (point-max))
(insert "..."))
(buffer-string)))))
(defvar custom-mode-map nil
"Keymap for `custom-mode'.")
-
+
(unless custom-mode-map
(setq custom-mode-map (make-sparse-keymap))
(set-keymap-parent custom-mode-map widget-keymap)
(define-key custom-mode-map "q" 'bury-buffer))
-(easy-menu-define custom-mode-menu
+(easy-menu-define custom-mode-menu
custom-mode-map
"Menu used in customization buffers."
'("Custom"
\\[widget-button-press] Activate button under point.
\\[custom-set] Set all modifications.
\\[custom-save] Make all modifications default.
-\\[custom-reset-current] Reset all modified options.
+\\[custom-reset-current] Reset all modified options.
\\[custom-reset-saved] Reset all modified or set options.
\\[custom-reset-factory] Reset all options.
children))
(custom-save-all))
-(defvar custom-reset-menu
+(defvar custom-reset-menu
'(("Current" . custom-reset-current)
("Saved" . custom-reset-saved)
("Factory Settings" . custom-reset-factory))
(defun customize (symbol)
"Customize SYMBOL, which must be a customization group."
(interactive (list (completing-read "Customize group: (default emacs) "
- obarray
+ obarray
(lambda (symbol)
(get symbol 'custom-group))
t)))
(let ((v (variable-at-point))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
+ (setq val (completing-read
(if v
(format "Customize variable (default %s): " v)
"Customize variable: ")
(defun customize-face (&optional symbol)
"Customize SYMBOL, which should be a face name or nil.
If SYMBOL is nil, customize all faces."
- (interactive (list (completing-read "Customize face: (default all) "
+ (interactive (list (completing-read "Customize face: (default all) "
obarray 'custom-facep)))
(if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
(let ((found nil))
(boundp symbol)
(setq found
(cons (list symbol 'custom-variable) found)))))
- (if found
+ (if found
(custom-buffer-create found)
(error "No customized user options"))))
(user-variable-p symbol))))
(setq found
(cons (list symbol 'custom-variable) found))))))
- (if found
+ (if found
(custom-buffer-create found)
(error "No matches"))))
(custom-mode)
(widget-insert "This is a customization buffer.
Push RET or click mouse-2 on the word ")
- (widget-create 'info-link
+ (widget-create 'info-link
:tag "help"
:help-echo "Push me for help."
"(custom)The Customization Buffer")
(widget-insert " for more information.\n\n")
- (setq custom-options
+ (setq custom-options
(mapcar (lambda (entry)
- (prog1
+ (prog1
(if (> (length options) 1)
(widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name
(:underline t)))
"Face used when the customize item is not defined for customization.")
-(defface custom-modified-face '((((class color))
+(defface custom-modified-face '((((class color))
(:foreground "white" :background "blue"))
(t
(:italic t :bold)))
"Face used when the customize item has been modified.")
-(defface custom-set-face '((((class color))
+(defface custom-set-face '((((class color))
(:foreground "blue" :background "white"))
(t
(:italic t)))
"Face used when the customize item has been set.")
-(defface custom-changed-face '((((class color))
+(defface custom-changed-face '((((class color))
(:foreground "white" :background "blue"))
(t
(:italic t)))
(factory " " nil "\
this item is unchanged from its factory setting."))
"Alist of customize option states.
-Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where
+Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where
STATE is one of the following symbols:
`unknown'
For internal use, should never occur.
`hidden'
- This item is not being displayed.
+ This item is not being displayed.
`invalid'
This item is modified, but has an invalid form.
`modified'
:type '(list (checklist :inline t
(group (const nil)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const unknown)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const hidden)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const invalid)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const modified)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const set)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const changed)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const saved)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const rogue)
(string :tag "Magic")
- face
+ face
(string :tag "Description"))
(group (const factory)
(string :tag "Magic")
- face
+ face
(string :tag "Description")))
(editable-list :inline t
(group symbol
(lisp (eq (widget-get parent :custom-form) 'lisp))
children)
(when custom-magic-show
- (push (widget-create-child-and-convert widget 'choice-item
+ (push (widget-create-child-and-convert widget 'choice-item
:help-echo "\
Push me to change the state of this item."
:format "%[%t%]"
(if (eq custom-magic-show 'long)
(insert text)
(insert (symbol-name state)))
- (when lisp
+ (when lisp
(insert " (lisp)"))
(insert "\n"))
(when custom-magic-show-button
(let ((indent (widget-get parent :indent)))
(when indent
(insert-char ? indent))))
- (push (widget-create-child-and-convert widget 'choice-item
+ (push (widget-create-child-and-convert widget 'choice-item
:button-face face
:help-echo "\
Push me to change the state."
:format "%[%t%]"
- :tag (if lisp
+ :tag (if lisp
(concat "(" magic ")")
(concat "[" magic "]")))
children)
(defun custom-convert-widget (widget)
;; Initialize :value and :tag from :args in WIDGET.
(let ((args (widget-get widget :args)))
- (when args
+ (when args
(widget-put widget :value (widget-apply widget
:value-to-internal (car args)))
(widget-put widget :tag (custom-unlispify-tag-name (car args)))
(state (widget-get widget :custom-state))
(level (widget-get widget :custom-level)))
(cond ((eq escape ?l)
- (when level
+ (when level
(push (widget-create-child-and-convert
widget 'custom-level (make-string level ?*))
buttons)
(if many
(insert ", and ")
(insert " and ")))
- (t
+ (t
(insert ", "))))
(widget-put widget :buttons buttons))))
- (t
+ (t
(widget-default-format-handler widget escape)))))
(defun custom-notify (widget &rest args)
(defun custom-redraw-magic (widget)
"Redraw WIDGET state with current settings."
- (while widget
+ (while widget
(let ((magic (widget-get widget :custom-magic)))
- (unless magic
+ (unless magic
(debug))
(widget-value-set magic (widget-value magic))
(when (setq widget (widget-get widget :group))
;; Now we can create the child widget.
(cond ((eq state 'hidden)
;; Indicate hidden value.
- (push (widget-create-child-and-convert
+ (push (widget-create-child-and-convert
widget 'item
:format "%{%t%}: ..."
:sample-face 'custom-variable-sample-face
(custom-quote (default-value symbol)))
(t
(custom-quote (widget-get conv :value))))))
- (push (widget-create-child-and-convert
- widget 'sexp
+ (push (widget-create-child-and-convert
+ widget 'sexp
:button-face 'custom-variable-button-face
:tag (symbol-name symbol)
:parent widget
(t
;; Edit mode.
(push (widget-create-child-and-convert
- widget type
+ widget type
:tag tag
:button-face 'custom-variable-button-face
:sample-face 'custom-variable-sample-face
(if (eq state 'hidden)
(widget-put widget :custom-state state)
(custom-variable-state-set widget))
- (widget-put widget :custom-form form)
+ (widget-put widget :custom-form form)
(widget-put widget :buttons buttons)
(widget-put widget :children children)))
(t 'rogue))))
(widget-put widget :custom-state state)))
-(defvar custom-variable-menu
+(defvar custom-variable-menu
'(("Edit" . custom-variable-edit)
("Edit Lisp" . custom-variable-edit-lisp)
("Set" . custom-variable-set)
"Show the menu for `custom-variable' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
+ (progn
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
(defvar custom-face-edit-args
(mapcar (lambda (att)
- (list 'group
+ (list 'group
:inline t
- (list 'const :format "" :value (nth 0 att))
+ (list 'const :format "" :value (nth 0 att))
(nth 1 att)))
custom-face-attributes))
:tag "Attributes"
:extra-offset 12
:args (mapcar (lambda (att)
- (list 'group
+ (list 'group
:inline t
- (list 'const :format "" :value (nth 0 att))
+ (list 'const :format "" :value (nth 0 att))
(nth 1 att)))
custom-face-attributes))
;; XEmacs cannot display initialized faces.
(not (custom-facep symbol))
(copy-face 'custom-face-empty symbol))
- (setq child (widget-create-child-and-convert
+ (setq child (widget-create-child-and-convert
widget 'item
:format "(%{%t%})\n"
:sample-face symbol
:tag "sample")))
- (t
+ (t
(custom-format-handler widget escape)))
(when child
(widget-put widget
(custom-face-state-set widget)
(widget-put widget :children (list edit)))))
-(defvar custom-face-menu
+(defvar custom-face-menu
'(("Set" . custom-face-set)
("Save" . custom-face-save)
("Reset to Saved" . custom-face-reset-saved)
'saved)
((get symbol 'factory-face)
'factory)
- (t
+ (t
'rogue)))))
(defun custom-face-action (widget &optional event)
"Show the menu for `custom-face' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
+ (progn
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
(mapcar (lambda (face)
(list (symbol-name face)))
(face-list))
- nil nil nil
+ nil nil nil
'face-history)))
(unless (zerop (length answer))
(widget-value-set widget (intern answer))
(defun custom-hook-convert-widget (widget)
;; Handle `:custom-options'.
(let* ((options (widget-get widget :options))
- (other `(editable-list :inline t
+ (other `(editable-list :inline t
:entry-format "%i %d%v"
(function :format " %v")))
(args (if options
(widget-put widget :children children)
(custom-group-state-update widget)))))
-(defvar custom-group-menu
+(defvar custom-group-menu
'(("Set" . custom-group-set)
("Save" . custom-group-save)
("Reset to Current" . custom-group-reset-current)
"Show the menu for `custom-group' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
- (progn
+ (progn
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
(defun custom-menu-create (symbol &optional name)
"Create menu for customization group SYMBOL.
-If optional NAME is given, use that as the name of the menu.
+If optional NAME is given, use that as the name of the menu.
Otherwise make up a name from SYMBOL.
The menu is in a format applicable to `easy-menu-define'."
(unless name
If FRAME is omitted or nil, use the selected frame."
(color-instance-rgb-components (make-color-instance color))))
-;; XEmacs and Emacs have different definitions of `facep'.
-;; The Emacs definition is the useful one, so emulate that.
+;; XEmacs and Emacs have different definitions of `facep'.
+;; The Emacs definition is the useful one, so emulate that.
(cond ((not (fboundp 'facep))
- (defun custom-facep (face)
+ (defun custom-facep (face)
"No faces"
nil))
((string-match "XEmacs" emacs-version)
Does nothing when the variable initialize-face-resources is nil."
(when initialize-face-resources
(make-face-x-resource-internal face frame t))))
- (t
+ (t
;; Too hard to do right on XEmacs.
(defalias 'initialize-face-resources 'ignore)))
your background is light, or nil (default) if you want Emacs to
examine the brightness for you."
:group 'customize
- :type '(choice (choice-item dark)
+ :type '(choice (choice-item dark)
(choice-item light)
(choice-item :tag "default" nil)))
'class (frame-property frame 'display-type)
'background (or custom-background-mode
(frame-property frame 'background-mode)
- (custom-background-mode frame))))))
+ (custom-background-mode frame))))))
(defconst custom-face-attributes
'((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
(toggle :format "Underline: %[%v%]\n") set-face-underline-p)
(:foreground (color :tag "Foreground") set-face-foreground)
(:background (color :tag "Background") set-face-background)
- (:reverse (const :format "Reverse Video\n" t)
+ (:reverse (const :format "Reverse Video\n" t)
(lambda (face value &optional frame)
;; We don't use VALUE.
(reverse-face face frame)))
(:stipple (editable-field :format "Stipple: %v") set-face-stipple))
- "Alist of face attributes.
+ "Alist of face attributes.
The elements are of the form (KEY TYPE SET) where KEY is a symbol
identifying the attribute, TYPE is a widget type for editing the
Each keyword should be listed in `custom-face-attributes'.
If FRAME is nil, set the default face."
- (while atts
+ (while atts
(let* ((name (nth 0 atts))
(value (nth 1 atts))
(fun (nth 2 (assq name custom-face-attributes))))
(apply 'set-face-font face fontobj args)))
(nconc custom-face-attributes
- '((:family (editable-field :format "Family: %v")
+ '((:family (editable-field :format "Family: %v")
custom-set-face-font-family)
(:size (editable-field :format "Size: %v")
custom-set-face-font-size))))
Iff optional FRAME is non-nil, set it for that frame only.
See `defface' for information about SPEC."
(when (fboundp 'make-face)
- (while spec
+ (while spec
(let* ((entry (car spec))
(display (nth 0 entry))
(atts (nth 1 entry)))
(defun custom-background-mode (frame)
"Kludge to detect background mode for FRAME."
- (let* ((bg-resource
+ (let* ((bg-resource
(condition-case ()
(x-get-resource ".backgroundMode" "BackgroundMode" 'string)
(error nil)))
(defvar custom-default-frame-properties nil
"The frame properties used for the global faces.
Frames who doesn't match these propertiess should have frame local faces.
-The value should be nil, if uninitialized, or a plist otherwise.
+The value should be nil, if uninitialized, or a plist otherwise.
See `defface' for a list of valid keys and values for the plist.")
(defun custom-get-frame-properties (&optional frame)
;; Oh well, get it then.
(setq cache (custom-extract-frame-properties frame))
;; and cache it...
- (modify-frame-parameters frame
+ (modify-frame-parameters frame
(list (cons 'custom-properties cache))))
cache))
(custom-default-frame-properties)
((eq req 'background)
(memq background options))
(t
- (error "Unknown req `%S' with options `%S'"
+ (error "Unknown req `%S' with options `%S'"
req options)))))
match)))
(mapcar (lambda (symbol)
(let ((spec (or (get symbol 'saved-face)
(get symbol 'factory-face))))
- (when spec
+ (when spec
(custom-face-display-set symbol spec frame)
(initialize-face-resources symbol frame))))
(face-list)))
If FRAME is missing or nil, the first member (frame-list) is used."
(unless frame
(setq frame (car (frame-list))))
- (unless (equal (custom-get-frame-properties)
+ (unless (equal (custom-get-frame-properties)
(custom-get-frame-properties frame))
(custom-initialize-faces frame)))
;;
;; This file only contain the code needed to declare and initialize
;; user options. The code to customize options is autoloaded from
-;; `cus-edit.el'.
+;; `cus-edit.el'.
;; The code implementing face declarations is in `cus-face.el'
(put symbol 'factory-value (list value))
(when doc
(put symbol 'variable-documentation doc))
- (while args
+ (while args
(let ((arg (car args)))
(setq args (cdr args))
(unless (symbolp arg)
If SYMBOL is not already bound, initialize it to VALUE.
The remaining arguments should have the form
- [KEYWORD VALUE]...
+ [KEYWORD VALUE]...
The following KEYWORD's are defined:
:type VALUE should be a widget type.
:options VALUE should be a list of valid members of the widget type.
-:group VALUE should be a customization group.
+:group VALUE should be a customization group.
Add SYMBOL to that group.
Read the section about customization in the emacs lisp manual for more
(put symbol 'custom-group (nconc members (get symbol 'custom-group)))
(when doc
(put symbol 'group-documentation doc))
- (while args
+ (while args
(let ((arg (car args)))
(setq args (cdr args))
(unless (symbolp arg)
The remaining arguments should have the form
- [KEYWORD VALUE]...
+ [KEYWORD VALUE]...
The following KEYWORD's are defined:
(defun custom-handle-all-keywords (symbol args type)
"For customization option SYMBOL, handle keyword arguments ARGS.
Third argument TYPE is the custom option type."
- (while args
+ (while args
(let ((arg (car args)))
(setq args (cdr args))
(unless (symbolp arg)
(unless args
(error "Keyword %s is missing an argument" keyword))
(setq args (cdr args))
- (custom-handle-keyword symbol keyword value type)))))
+ (custom-handle-keyword symbol keyword value type)))))
(defun custom-handle-keyword (symbol keyword value type)
"For customization option SYMBOL, handle KEYWORD with VALUE.
((eq keyword :tag)
(put symbol 'custom-tag value))
(t
- (error "Unknown keyword %s" symbol))))
+ (error "Unknown keyword %s" symbol))))
(defun custom-add-option (symbol option)
"To the variable SYMBOL add OPTION.
;;; Initializing.
(defun custom-set-variables (&rest args)
- "Initialize variables according to user preferences.
+ "Initialize variables according to user preferences.
The arguments should be a list where each entry has the form:
The unevaluated VALUE is stored as the saved value for SYMBOL.
If NOW is present and non-nil, VALUE is also evaluated and bound as
the default value for the SYMBOL."
- (while args
+ (while args
(let ((entry (car args)))
(if (listp entry)
(let ((symbol (nth 0 entry))
(value (nth 1 entry))
(now (nth 2 entry)))
(put symbol 'saved-value (list value))
- (when now
+ (when now
(put symbol 'force-value t)
(set-default symbol (eval value)))
(setq args (cdr args)))
(fset 'x-defined-colors 'ignore)
(fset 'read-color 'ignore)))
-(setq byte-compile-warnings
+(setq byte-compile-warnings
'(free-vars unresolved callargs redefine))
(defun dgnushack-compile ()
(require 'w3-forms)
(error (setq files (delete "nnweb.el" files))))
(while (setq file (pop files))
- (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el"
+ (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el"
"messagexmas.el" "nnheaderxm.el"
"smiley.el")))
xemacs)
(require 'gnus)
(byte-recompile-directory "." 0))
-;;; dgnushack.el ends here
+;;; dgnushack.el ends here
gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to)
'face gnus-article-button-face))
- (gnus-add-text-properties
+ (gnus-add-text-properties
from to
(nconc (and gnus-article-mouse-face
(list gnus-mouse-face-prop gnus-article-mouse-face))
'("^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:")
+ "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
"All headers that match this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
(repeat regexp))
:group 'gnus-article-hiding)
-(defcustom gnus-visible-headers
+(defcustom gnus-visible-headers
"^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From"
"All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
(defcustom gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text."
- :type 'sexp
+ :type 'sexp
:group 'gnus-article-hiding)
(defcustom gnus-article-x-face-command
"Face used for displaying bold italic emphasized text (/*word*/)."
:group 'gnus-article-emphasis)
-(defface gnus-emphasis-underline-bold-italic
+(defface gnus-emphasis-underline-bold-italic
'((t (:bold t :italic t :underline t)))
"Face used for displaying underlined bold italic emphasized text.
Esample: (_/*word*/_)."
:group 'gnus-article-highlight
:group 'gnus-article-signature)
-(defface gnus-header-from-face
+(defface gnus-header-from-face
'((((class color)
(background dark))
- (:foreground "light blue" :bold t :italic t))
+ (:foreground "green1" :bold t :italic t))
(((class color)
(background light))
(:foreground "MidnightBlue" :bold t :italic t))
- (t
+ (t
(:bold t :italic t)))
"Face used for displaying from headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
-(defface gnus-header-subject-face
+(defface gnus-header-subject-face
'((((class color)
(background dark))
- (:foreground "pink" :bold t :italic t))
+ (:foreground "green3" :bold t :italic t))
(((class color)
(background light))
(:foreground "firebrick" :bold t :italic t))
- (t
+ (t
(:bold t :italic t)))
"Face used for displaying subject headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
-(defface gnus-header-newsgroups-face
+(defface gnus-header-newsgroups-face
'((((class color)
(background dark))
(:foreground "yellow" :bold t :italic t))
(((class color)
(background light))
(:foreground "indianred" :bold t :italic t))
- (t
+ (t
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
-(defface gnus-header-name-face
+(defface gnus-header-name-face
'((((class color)
(background dark))
- (:foreground "cyan" :bold t))
+ (:foreground "green4" :bold t))
(((class color)
(background light))
(:foreground "DarkGreen" :bold t))
- (t
+ (t
(:bold t)))
"Face used for displaying header names."
:group 'gnus-article-headers
(((class color)
(background light))
(:foreground "DarkGreen" :italic t))
- (t
+ (t
(:italic t))) "Face used for displaying header content."
:group 'gnus-article-headers
:group 'gnus-article-highlight)
("" gnus-header-name-face gnus-header-content-face))
"Controls highlighting of article header.
-An alist of the form (HEADER NAME CONTENT).
+An alist of the form (HEADER NAME CONTENT).
HEADER is a regular expression which should match the name of an
header header and NAME and CONTENT are either face names or nil.
"Set text PROPS on the B to E region, extending `intangible' 1 past B."
(add-text-properties b e props)
(when (memq 'intangible props)
- (put-text-property
+ (put-text-property
(max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
(while (re-search-forward "^[^ \t]*:" nil t)
(beginning-of-line)
;; Mark the rank of the header.
- (put-text-property
+ (put-text-property
(point) (1+ (point)) 'message-rank
(if (or (and visible (looking-at visible))
(and ignored
(not (looking-at ignored))))
- (gnus-article-header-rank)
+ (gnus-article-header-rank)
(+ 2 max)))
(forward-line 1))
(message-sort-headers-1)
- (when (setq beg (text-property-any
+ (when (setq beg (text-property-any
(point-min) (point-max) 'message-rank (+ 2 max)))
;; We make the unwanted headers invisible.
(if delete
(forward-line -1)
(gnus-article-hide-text-type
(progn (beginning-of-line) (point))
- (progn
+ (progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
(when (and
from reply-to
(ignore-errors
- (equal
+ (equal
(nth 1 (mail-extract-address-components from))
(nth 1 (mail-extract-address-components reply-to)))))
(gnus-article-hide-header "reply-to"))))
(when (re-search-forward (concat "^" header ":") nil t)
(gnus-article-hide-text-type
(progn (beginning-of-line) (point))
- (progn
+ (progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
;; We do the boldification/underlining by hiding the
;; overstrikes and putting the proper text property
;; on the letters.
- (cond
+ (cond
((eq next previous)
(gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
(put-text-property (point) (1+ (point)) 'face 'bold))
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point-max)))
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
(setq string (match-string 1))
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(insert string)
- (article-mime-decode-quoted-printable
+ (article-mime-decode-quoted-printable
(goto-char (point-min)) (point-max))
(subst-char-in-region (point-min) (point-max) ?_ ? )
(goto-char (point-max)))
(defun article-mime-decode-quoted-printable-buffer ()
"Decode Quoted-Printable in the current buffer."
(article-mime-decode-quoted-printable (point-min) (point-max)))
-
+
(defun article-mime-decode-quoted-printable (from to)
"Decode Quoted-Printable in the region between FROM and TO."
(interactive "r")
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "^- " nil t)
- (gnus-article-hide-text-type
+ (gnus-article-hide-text-type
(match-beginning 0) (match-end 0) 'pgp))
(widen))))))
(save-restriction
(let ((buffer-read-only nil))
(when (gnus-article-narrow-to-signature)
- (gnus-article-hide-text-type
+ (gnus-article-hide-text-type
(point-min) (point-max) 'signature)))))))
(defun article-strip-leading-blank-lines ()
(narrow-to-region
(funcall (intern "mime::preview-content-info/point-min") pcinfo)
(point-max)))))
-
+
(when (gnus-article-search-signature)
(forward-line 1)
;; Check whether we have some limits to what we consider
If TYPE is `local', convert to local time; if it is `lapsed', output
how much time has lapsed since DATE."
(interactive (list 'ut t))
- (let* ((header (or header
+ (let* ((header (or header
(mail-header-date gnus-current-headers)
(message-fetch-field "date")
""))
(prog1
(concat (if prev ", " "") (int-to-string
(floor num))
- " " (symbol-name (car unit))
+ " " (symbol-name (car unit))
(if (> num 1) "s" ""))
(setq prev t))))
article-time-units "")
(when (eq gnus-prompt-before-saving t)
num))) ; Magic
(set-buffer gnus-summary-buffer)
- (funcall gnus-default-article-saver filename)))))
+ (funcall gnus-default-article-saver filename)))))
(defun gnus-read-save-file-name (prompt default-name &optional filename)
(cond
(cond ((eq command 'default)
gnus-last-shell-command)
(command command)
- (t (read-string
+ (t (read-string
(format
"Shell command on %s: "
(if (and gnus-number-of-articles-to-be-saved
gfunc (cdr func))
(setq afunc func
gfunc (intern (format "gnus-%s" func))))
- (fset gfunc
+ (fset gfunc
(if (not (fboundp afunc))
nil
`(lambda (&optional interactive &rest args)
(set-buffer gnus-summary-buffer)
(let ((header (gnus-summary-article-header article)))
(when (< article 0)
- (cond
+ (cond
((memq article gnus-newsgroup-sparse)
;; This is a sparse gap article.
(setq do-update-line article)
;; It is an extracted pseudo-article.
(setq article 'pseudo)
(gnus-request-pseudo-article header))))
-
- (let ((method (gnus-find-method-for-group
+
+ (let ((method (gnus-find-method-for-group
gnus-newsgroup-name)))
(if (not (eq (car method) 'nneething))
()
(when (numberp article)
(gnus-async-prefetch-next group article gnus-summary-buffer)
(when gnus-keep-backlog
- (gnus-backlog-enter-article
+ (gnus-backlog-enter-article
group article (current-buffer))))
'article)))
;; It was a pseudo.
(erase-buffer)
(insert-buffer-substring gnus-article-buffer))
(setq gnus-original-article (cons group article))))
-
+
;; Update sparse articles.
(when (and do-update-line
(or (numberp article)
(defvar gnus-article-edit-mode-map nil)
-(unless gnus-article-edit-mode-map
+(unless gnus-article-edit-mode-map
(setq gnus-article-edit-mode-map (copy-keymap text-mode-map))
(gnus-define-keys gnus-article-edit-mode-map
(gnus-article-mode)
;; The cache and backlog have to be flushed somewhat.
(when gnus-use-cache
- (gnus-cache-update-article
+ (gnus-cache-update-article
(car gnus-article-current) (cdr gnus-article-current)))
(when gnus-keep-backlog
- (gnus-backlog-remove-article
+ (gnus-backlog-remove-article
(car gnus-article-current) (cdr gnus-article-current)))
;; Flush original article as well.
(save-excursion
(set-window-start (get-buffer-window (current-buffer)) window-start)
(goto-char p)
(set-buffer buf)))))
-
+
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
(interactive)
(let ((case-fold-search nil))
(query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
-;;;
+;;;
;;; Article highlights
;;;
:group 'gnus-article-buttons
:type 'regexp)
-(defcustom gnus-button-alist
+(defcustom gnus-button-alist
`(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
gnus-button-message-id 2)
("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1)
("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
gnus-button-fetch-group 4)
("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
- ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
+ ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2)
REGEXP: is the string matching text around the button,
BUTTON: is the number of the regexp grouping actually matching the button,
FORM: is a lisp expression which must eval to true for the button to
-be added,
+be added,
CALLBACK: is the function to call when the user push this button, and each
PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
CALLBACK can also be a variable, in that case the value of that
variable it the real callback function."
:group 'gnus-article-buttons
- :type '(repeat (list regexp
+ :type '(repeat (list regexp
(integer :tag "Button")
(sexp :tag "Form")
(function :tag "Callback")
:inline t
(integer :tag "Regexp group")))))
-(defcustom gnus-header-button-alist
+(defcustom gnus-header-button-alist
`(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
0 t gnus-button-message-id 0)
("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
- ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
+ ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0 t gnus-button-mailto 0)
("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
:group 'gnus-article-buttons
:group 'gnus-article-headers
:type '(repeat (list (regexp :tag "Header")
- regexp
+ regexp
(integer :tag "Button")
(sexp :tag "Form")
(function :tag "Callback")
(defun gnus-article-highlight (&optional force)
"Highlight current article.
This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-citation',
+`gnus-article-highlight-citation',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
do the highlighting. See the documentation for those functions."
(interactive (list 'force))
(defun gnus-article-highlight-signature ()
"Highlight the signature in an article.
It does this by highlighting everything after
-`gnus-signature-separator' using `gnus-signature-face'."
+`gnus-signature-separator' using `gnus-signature-face'."
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)
(interactive (list 'force))
(save-excursion
(set-buffer gnus-article-buffer)
- ;; Remove all old markers.
- (let (marker entry)
- (while (setq marker (pop gnus-button-marker-list))
- (goto-char marker)
- (when (setq entry (gnus-button-entry))
- (put-text-property (match-beginning (nth 1 entry))
- (match-end (nth 1 entry))
- 'gnus-callback nil))
- (set-marker marker nil)))
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
(case-fold-search t)
(alist gnus-button-alist)
beg entry regexp)
- (goto-char (point-min))
+ ;; Remove all old markers.
+ (let (marker entry)
+ (while (setq marker (pop gnus-button-marker-list))
+ (goto-char marker)
+ (when (setq entry (gnus-button-entry))
+ (put-text-property (match-beginning (nth 1 entry))
+ (match-end (nth 1 entry))
+ 'gnus-callback nil))
+ (set-marker marker nil)))
;; We skip the headers.
+ (goto-char (point-min))
(unless (search-forward "\n\n" nil t)
(goto-char (point-max)))
(setq beg (point))
start end 'gnus-callback)))
;; That optional form returned non-nil, so we add the
;; button.
- (gnus-article-add-button
- start end 'gnus-button-push
+ (gnus-article-add-button
+ start end 'gnus-button-push
(car (push (set-marker (make-marker) from)
gnus-button-marker-list))))))))))
(form (nth 2 entry)))
(goto-char (match-end 0))
(when (eval form)
- (gnus-article-add-button
+ (gnus-article-add-button
start end (nth 3 entry)
(buffer-substring (match-beginning (nth 4 entry))
(match-end (nth 4 entry)))))))
(when gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to)
'face gnus-article-button-face))
- (gnus-add-text-properties
+ (gnus-add-text-properties
from to
(nconc (and gnus-article-mouse-face
(list gnus-mouse-face-prop gnus-article-mouse-face))
(setq parts (cons (substring string start (match-beginning 0)) parts)
start (match-end 0)))
(nreverse (cons (substring string start) parts))))
-
+
(defun gnus-url-parse-query-string (query &optional downcase)
(let (retval pairs cur key val)
(setq pairs (gnus-split-string query "&"))
(setcdr cur (cons val (cdr cur)))
(setq retval (cons (list key val) retval)))))
retval))
-
+
(defun gnus-url-unhex (x)
(if (> x ?9)
(if (>= x ?a)
(+ 10 (- x ?a))
(+ 10 (- x ?A)))
(- x ?0)))
-
+
(defun gnus-url-unhex-string (str &optional allow-newlines)
"Remove %XXX embedded spaces, etc in a url.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
(ch1 (gnus-url-unhex (elt str (+ start 1))))
(code (+ (* 16 ch1)
(gnus-url-unhex (elt str (+ start 2))))))
- (setq tmp (concat
+ (setq tmp (concat
tmp (substring str 0 start)
(cond
(allow-newlines
str (substring str (match-end 0)))))
(setq tmp (concat tmp str))
tmp))
-
+
(defun gnus-url-mailto (url)
;; Send mail to someone
(when (string-match "mailto:/*\\(.*\\)" url)
(defun gnus-insert-prev-page-button ()
(let ((buffer-read-only nil))
- (gnus-eval-format
+ (gnus-eval-format
gnus-prev-page-line-format nil
`(gnus-prev t local-map ,gnus-prev-page-map
gnus-callback gnus-article-button-prev-page))))
(let ((buffer-read-only nil))
(gnus-eval-format gnus-next-page-line-format nil
`(gnus-next t local-map ,gnus-next-page-map
- gnus-callback
+ gnus-callback
gnus-article-button-next-page))))
(defun gnus-article-button-next-page (arg)
(let ((win (selected-window)))
(select-window (get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
- (select-window win)))
+ (select-window win)))
(gnus-ems-redefine)
(defcustom gnus-prefetched-article-deletion-strategy '(read exit)
"List of symbols that say when to remove articles from the prefetch buffer.
-Possible values in this list are `read', which means that
+Possible values in this list are `read', which means that
articles are removed as they are read, and `exit', which means
that all articles belonging to a group are removed on exit
from that group."
(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
-
+
;;;
;;; Article prefetch
;;;
;; do this, which leads to slightly slower article
;; buffer display.
(gnus-async-prefetch-article group next summary)
- (run-with-idle-timer
+ (run-with-idle-timer
0.1 nil 'gnus-async-prefetch-article group next summary)))))))
(defun gnus-async-prefetch-article (group article summary &optional next)
(when do-fetch
(setq article (car gnus-async-fetch-list))))
-
+
(when (and do-fetch article)
;; We want to fetch some more articles.
(save-excursion
(goto-char (point-max))
(setq mark (point-marker))
(let ((nnheader-callback-function
- (gnus-make-async-article-function
+ (gnus-make-async-article-function
group article mark summary next))
- (nntp-server-buffer
+ (nntp-server-buffer
(get-buffer gnus-async-prefetch-article-buffer)))
(when do-message
(gnus-message 7 "Prefetching article %d in group %s"
(set-marker (cadr entry) nil)
(set-marker (caddr entry) nil))
(gnus-async-with-semaphore
- (setq gnus-async-article-alist
+ (setq gnus-async-article-alist
(delq entry gnus-async-article-alist))))
(defun gnus-async-prefetch-remove-group (group)
(when (equal group (nth 3 (car alist)))
(gnus-async-delete-prefected-entry (car alist)))
(pop alist))))))
-
+
(defun gnus-async-prefetched-article-entry (group article)
"Return the entry for ARTICLE in GROUP iff it has been prefetched."
(let ((entry (assq (intern (format "%s-%d" group article))
(ignore-errors
(set-marker (cadr entry) nil)
(set-marker (caddr entry) nil))
- (setq gnus-async-article-alist
+ (setq gnus-async-article-alist
(delq entry gnus-async-article-alist))
nil)
entry)))
(erase-buffer)
(setq gnus-async-header-prefetched nil)
t)))
-
+
(provide 'gnus-async)
;;; gnus-async.el ends here
:group 'gnus-cache
:type 'directory)
-(defcustom gnus-cache-active-file
+(defcustom gnus-cache-active-file
(concat (file-name-as-directory gnus-cache-directory) "active")
"*The cache active file."
:group 'gnus-cache
(gnus-kill-buffer buffer)
(setq gnus-cache-buffer nil))))
-(defun gnus-cache-possibly-enter-article
+(defun gnus-cache-possibly-enter-article
(group article headers ticked dormant unread &optional force)
(when (and (or force (not (eq gnus-use-cache 'passive)))
(numberp article)
; This might be a dummy article.
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
+ (let ((result (nnvirtual-find-group-art
(gnus-group-real-name group) article)))
(setq group (car result)
headers (copy-sequence headers))
(when (equal group "no.norsk") (error "hie"))
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (and cache-active
+ (and cache-active
(< (car cache-active) (car active))
(setcar active (car cache-active)))
(and cache-active
(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
"Retrieve the headers for ARTICLES in GROUP."
- (let ((cached
+ (let ((cached
(setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
(if (not cached)
;; No cached articles here, so we just retrieve them
articles))
(cache-file (gnus-cache-file-name group ".overview"))
type)
- ;; We first retrieve all the headers that we don't have in
+ ;; We first retrieve all the headers that we don't have in
;; the cache.
(let ((gnus-use-cache nil))
(when uncached-articles
- (setq type (and articles
- (gnus-retrieve-headers
+ (setq type (and articles
+ (gnus-retrieve-headers
uncached-articles group fetch-old)))))
(gnus-cache-save-buffers)
;; Then we insert the cached headers.
;; There are no cached headers.
type)
((null type)
- ;; There were no uncached headers (or retrieval was
+ ;; There were no uncached headers (or retrieval was
;; unsuccessful), so we use the cached headers exclusively.
(set-buffer nntp-server-buffer)
(erase-buffer)
article out)
(while (setq article (pop articles))
(if (natnump article)
- (when (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
+ (when (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
(gnus-summary-article-header article)
nil nil nil t)
(push article out))
(let ((file (gnus-cache-file-name group ".overview")))
(when (file-exists-p file)
(nnheader-insert-file-contents file)))
- ;; We have a fresh (empty/just loaded) buffer,
+ ;; We have a fresh (empty/just loaded) buffer,
;; mark it as unmodified to save a redundant write later.
(set-buffer-modified-p nil))))
"If ARTICLE is in the cache, remove it and re-enter it."
(when (gnus-cache-possibly-remove-article article nil nil nil t)
(let ((gnus-use-cache nil))
- (gnus-cache-possibly-enter-article
+ (gnus-cache-possibly-enter-article
gnus-newsgroup-name article (gnus-summary-article-header article)
nil nil nil t))))
-(defun gnus-cache-possibly-remove-article (article ticked dormant unread
+(defun gnus-cache-possibly-remove-article (article ticked dormant unread
&optional force)
"Possibly remove ARTICLE from the cache."
(let ((group gnus-newsgroup-name)
file)
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
+ (let ((result (nnvirtual-find-group-art
(gnus-group-real-name group) article)))
(setq group (car result)
number (cdr result))))
(gnus)
;; Go through all groups...
(gnus-group-mark-buffer)
- (gnus-group-universal-argument
- nil nil
+ (gnus-group-universal-argument
+ nil nil
(lambda ()
(interactive)
(gnus-summary-read-group (gnus-group-group-name) nil t)
(gnus-set-work-buffer)
(insert-file-contents gnus-cache-active-file)
(gnus-active-to-gnus-format
- nil (setq gnus-cache-active-hashtb
- (gnus-make-hashtable
+ nil (setq gnus-cache-active-hashtb
+ (gnus-make-hashtable
(count-lines (point-min) (point-max)))))
(setq gnus-cache-active-altered nil))))
-
+
(defun gnus-cache-write-active (&optional force)
"Write the active hashtb to the active file."
(when (or force
(let* ((top (null directory))
(directory (expand-file-name (or directory gnus-cache-directory)))
(files (directory-files directory 'full))
- (group
+ (group
(if top
""
- (string-match
+ (string-match
(concat "^" (file-name-as-directory
(expand-file-name gnus-cache-directory)))
(directory-file-name directory))
- (nnheader-replace-chars-in-string
+ (nnheader-replace-chars-in-string
(substring (directory-file-name directory) (match-end 0))
?/ ?.)))
nums alphs)
(rename-file gnus-cache-directory dir))
(provide 'gnus-cache)
-
+
;;; gnus-cache.el ends here
:type '(choice (const :tag "all" nil)
integer))
-(defcustom gnus-cite-prefix-regexp
+(defcustom gnus-cite-prefix-regexp
"^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
"Regexp matching the longest possible citation prefix on a line."
:group 'gnus-cite
:group 'gnus-cite
:type 'integer)
-(defcustom gnus-supercite-regexp
+(defcustom gnus-supercite-regexp
(concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
"Regexp matching normal Supercite attribution lines.
:group 'gnus-cite
:type 'regexp)
-(defface gnus-cite-attribution-face '((t
+(defface gnus-cite-attribution-face '((t
(:underline t)))
"Face used for attribution lines.")
(((class color)
(background light))
(:foreground "MidnightBlue"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "firebrick"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "dark green"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "OrangeRed"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "dark khaki"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "dark violet"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "SteelBlue4"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "magenta"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "violet"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "medium purple"))
- (t
+ (t
(:italic t)))
"Citation face.")
(((class color)
(background light))
(:foreground "turquoise"))
- (t
+ (t
(:italic t)))
"Citation face.")
-(defcustom gnus-cite-face-list
- '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
- gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
+(defcustom gnus-cite-face-list
+ '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4
+ gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8
gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11)
- "List of faces used for highlighting citations.
+ "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.
(defvar gnus-cite-article nil)
(defvar gnus-cite-prefix-alist nil)
-;; Alist of citation prefixes.
+;; Alist of citation prefixes.
;; The cdr is a list of lines with that prefix.
(defvar gnus-cite-attribution-alist nil)
;; PREFIX: Is the citation prefix of the attribution line(s), and
;; TAG: Is a Supercite tag, if any.
-(defvar gnus-cited-text-button-line-format-alist
+(defvar gnus-cited-text-button-line-format-alist
`((?b (marker-position beg) ?d)
(?e (marker-position end) ?d)
(?l (- end beg) ?d)))
corresponding citation merged with `gnus-cite-attribution-face'.
Text is considered cited if at least `gnus-cite-minimum-match-count'
-lines matches `gnus-cite-prefix-regexp' with the same prefix.
+lines matches `gnus-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
face (cdr (assoc prefix face-alist)))
;; Add attribution button.
(goto-line number)
- (when (re-search-forward gnus-cite-attribution-suffix
+ (when (re-search-forward gnus-cite-attribution-suffix
(save-excursion (end-of-line 1) (point))
t)
(gnus-article-add-button (match-beginning 1) (match-end 1)
If given a negative prefix, always show; if given a positive prefix,
always hide."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
- (setq gnus-cited-text-button-line-format-spec
- (gnus-parse-format gnus-cited-text-button-line-format
+ (setq gnus-cited-text-button-line-format-spec
+ (gnus-parse-format gnus-cited-text-button-line-format
gnus-cited-text-button-line-format-alist t))
(save-excursion
(set-buffer gnus-article-buffer)
end nil)
(while (and marks (string= (cdar marks) ""))
(setq marks (cdr marks)))
- (when marks
+ (when marks
(setq beg (caar marks)))
(while (and marks (not (string= (cdar marks) "")))
(setq marks (cdr marks)))
total (cdr total))
(goto-line hiden)
(unless (assq hiden gnus-cite-attribution-alist)
- (gnus-add-text-properties
+ (gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'article-type 'cite)
gnus-hidden-properties))))))))))
(goto-char (point-min))
(unless (search-forward "\n\n" nil t)
(goto-char (point-max)))
- (save-excursion
+ (save-excursion
(gnus-cite-parse-attributions))
;; Try to avoid check citation if there is no reason to believe
;; that article has citations
(defun gnus-cite-parse ()
;; Parse and connect citation prefixes and attribution lines.
-
+
;; Parse current buffer searching for citation prefixes.
(let ((line (1+ (count-lines (point-min) (point))))
(case-fold-search t)
prefix (buffer-substring begin end))
(gnus-set-text-properties 0 (length prefix) nil prefix)
(setq entry (assoc prefix alist))
- (if entry
+ (if entry
(setcdr entry (cons line (cdr entry)))
(push (list prefix line) alist))
(goto-char begin))
;; Too few lines with this prefix. We keep it a bit
;; longer in case it is an exact match for an attribution
;; line, but we don't remove the line from other
- ;; prefixes.
+ ;; prefixes.
(push entry gnus-cite-prefix-alist))
(t
(push entry
(while loop
(setq current (car loop)
loop (cdr loop))
- (setcdr current
+ (setcdr current
(gnus-set-difference (cdr current) numbers)))))))))
(defun gnus-cite-parse-attributions ()
end)))
(if (not (assoc al al-alist))
(progn
- (push (list wrote in prefix tag)
+ (push (list wrote in prefix tag)
gnus-cite-loose-attribution-alist)
(push (cons al t) al-alist))))))))
(gnus-cite-match-attributions 'small nil
(lambda (prefix tag)
(when tag
- (concat "\\`"
- (regexp-quote prefix) "[ \t]*"
+ (concat "\\`"
+ (regexp-quote prefix) "[ \t]*"
(regexp-quote tag) ">"))))
;; Find loose supercite citations after attributions.
(gnus-cite-match-attributions 'small t
;; If FUN is non-nil, it will be called with the arguments (WROTE
;; PREFIX TAG) and expected to return a regular expression. Only
;; citations whose prefix matches the regular expression will be
- ;; considered.
- ;;
+ ;; considered.
+ ;;
;; WROTE is the attribution line number.
;; PREFIX is the attribution line prefix.
;; TAG is the Supercite tag on the attribution line.
((eq sort 'first) nil)
(t (< (length (gnus-cite-find-loose prefix)) 2)))
limit (if after wrote -1)
- smallest 1000000
+ smallest 1000000
best nil)
(let ((cites gnus-cite-loose-prefix-alist)
cite candidate numbers first compare)
gnus-hidden-properties))
((assq number gnus-cite-attribution-alist))
(t
- (gnus-add-text-properties
+ (gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'article-type 'cite)
gnus-hidden-properties))))))))
;;; Widgets:
-;; There should be special validation for this.
+;; There should be special validation for this.
(define-widget 'gnus-email-address 'string
"An email address")
'((to-address (gnus-email-address :tag "To Address") "\
This will be used when doing followups and posts.
-This is primarily useful in mail groups that represent closed
+This is primarily useful in mail groups that represent closed
mailing lists--mailing lists where it's expected that everybody that
writes to the mailing list is subscribed to it. Since using this
parameter ensures that the mail only goes to the mailing list itself,
address instead.")
(to-list (gnus-email-address :tag "To List") "\
-This address will be used when doing a `a' in the group.
+This address will be used when doing a `a' in the group.
It is totally ignored when doing a followup--except that if it is
present in a news group, you'll get mail group semantics when doing
(to-group (string :tag "To Group") "\
All posts will be send to the specified group.")
-
+
(gcc-self (choice :tag "GCC"
:value t
(const t)
(auto-expire (const :tag "Automatic Expire" t) "\
All articles that are read will be marked as expirable.")
-
+
(total-expire (const :tag "Total Expire" t) "\
All read articles will be put through the expiry process
-This happens even if they are not marked as expirable.
+This happens even if they are not marked as expirable.
Use with caution.")
(expiry-wait (choice :tag "Expire Wait"
(const immediate)
(number :hide-front-space t
:format "%v")) "\
-When to expire.
+When to expire.
Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
when expiring expirable messages. The value can either be a number of
(score-file (file :tag "Score File") "\
Make the specified file into the current score file.
This means that all score commands you issue will end up in this file.")
-
+
(adapt-file (file :tag "Adapt File") "\
-Make the specified file into the current adaptive file.
+Make the specified file into the current adaptive file.
All adaptive score entries will be put into this file.")
(admin-address (gnus-email-address :tag "Admin Address") "\
:value default
(const all)
(const default)) "\
-Which articles to display on entering the group.
+Which articles to display on entering the group.
`all'
Display all articles, both read and unread.
(comment (string :tag "Comment") "\
An arbitrary comment on the group."))
- "Alist of valid group parameters.
+ "Alist of valid group parameters.
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
itself (a symbol), TYPE is the parameters type (a sexp widget), and
:tag "Variables"
:format "%t:\n%h%v%i\n\n"
:doc "\
-Set variables local to the group you are entering.
+Set variables local to the group you are entering.
If you want to turn threading off in `news.answers', you could put
`(gnus-show-threads nil)' in the group parameters of that group.
(symbol :tag "Variable")
(sexp :tag
"Value")))
-
+
'(repeat :inline t
:tag "Unknown entries"
sexp)))
(widget-insert "\n\nYou can also edit the ")
- (widget-create 'info-link
+ (widget-create 'info-link
:tag "select method"
:help-echo "Push me to learn more about select methods."
"(gnus)Select Methods")
(widget-insert " for the group.\n")
- (setq gnus-custom-method
- (widget-create 'sexp
+ (setq gnus-custom-method
+ (widget-create 'sexp
:tag "Method"
:value (gnus-info-method info)))
(use-local-map widget-keymap)
(defun gnus-group-customize-done (&rest ignore)
"Apply changes and bury the buffer."
(interactive)
- (gnus-group-edit-group-done 'params gnus-custom-group
+ (gnus-group-edit-group-done 'params gnus-custom-group
(widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'method gnus-custom-group
+ (gnus-group-edit-group-done 'method gnus-custom-group
(widget-value gnus-custom-method))
(bury-buffer))
(defconst gnus-score-parameters
'((mark (number :tag "Mark") "\
-The value of this entry should be a number.
+The value of this entry should be a number.
Any articles with a score lower than this number will be marked as read.")
(expunge (number :tag "Expunge") "\
-The value of this entry should be a number.
+The value of this entry should be a number.
Any articles with a score lower than this number will be removed from
the summary buffer.")
(mark-and-expunge (number :tag "Mark-and-expunge") "\
-The value of this entry should be a number.
+The value of this entry should be a number.
Any articles with a score lower than this number will be marked as
read and removed from the summary buffer.")
(thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\
-The value of this entry should be a number.
+The value of this entry should be a number.
All articles that belong to a thread that has a total score below this
number will be marked as read and removed from the summary buffer.
`gnus-thread-score-function' says how to compute the total score
for a thread.")
(files (repeat :tag "Files" file) "\
-The value of this entry should be any number of file names.
+The value of this entry should be any number of file names.
These files are assumed to be score files as well, and will be loaded
the same way this one was.")
(exclude-files (repeat :tag "Exclude-files" file) "\
-The clue of this entry should be any number of files.
+The clue of this entry should be any number of files.
These files will not be loaded, even though they would normally be so,
for some reason or other.")
(eval (sexp :tag "Eval" :value nil) "\
-The value of this entry will be `eval'el.
+The value of this entry will be `eval'el.
This element will be ignored when handling global score files.")
(read-only (boolean :tag "Read-only" :value t) "\
-Read-only score files will not be updated or saved.
+Read-only score files will not be updated or saved.
Global score files should feature this atom.")
(orphan (number :tag "Orphan") "\
-The value of this entry should be a number.
+The value of this entry should be a number.
Articles that do not have parents will get this number added to their
scores. Imagine you follow some high-volume newsgroup, like
`comp.lang.c'. Most likely you will only follow a few of the threads,
exist a few interesting threads which can't be found automatically
by ordinary scoring rules.")
- (adapt (choice :tag "Adapt"
+ (adapt (choice :tag "Adapt"
(const t)
(const ignore)
(sexp :format "%v"
:hide-front-space t)) "\
-This entry controls the adaptive scoring.
+This entry controls the adaptive scoring.
If it is `t', the default adaptive scoring rules will be used. If it
is `ignore', no adaptive scoring will be performed on this group. If
it is a list, this list will be used as the adaptive scoring rules.
strange, way of setting variables in some groups if you don't like
hooks much.")
(touched (sexp :format "Touched\n") "Internal variable."))
- "Alist of valid symbolic score parameters.
+ "Alist of valid symbolic score parameters.
Each entry has the form (NAME TYPE DOC), where NAME is the parameter
itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a
(const :tag "default" nil)))
(group `(group ,match ,score ,expire ,type))
(doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
+ (concat "Change score based on the " tag
" header.\n"))
"
-You can have an arbitrary number of score entries for this header,
+You can have an arbitrary number of score entries for this header,
each score entry has four elements:
1. The \"match element\". This should be the string to look for in the
- header.
+ header.
2. The \"score element\". This number should be an integer in the
neginf to posinf interval. This number is added to the score
(const <=)))
(group `(group ,match ,score ,expire ,type))
(doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
+ (concat "Change score based on the " tag
" header.")))))
(widget-put widget :args `(,item
(repeat :inline t
(const after)))
(group `(group ,match ,score ,expire ,type))
(doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
+ (concat "Change score based on the " tag
" header."))
"
For the Date header we have three kinda silly match types: `before',
(bury-buffer))
;;; The End:
-
+
(provide 'gnus-cus)
;;; gnus-cus.el ends here
\(FUNCTION TIME IDLE)
-FUNCTION is the function to be called.
-TIME is the number of `gnus-demon-timestep's between each call.
+FUNCTION is the function to be called.
+TIME is the number of `gnus-demon-timestep's between each call.
If nil, never call. If t, call each `gnus-demon-timestep'.
If IDLE is t, only call if Emacs has been idle for a while. If IDLE
is a number, only call when Emacs has been idle more than this number
idleness. If IDLE is a number and TIME is nil, then call once each
time Emacs has been idle for IDLE `gnus-demon-timestep's."
:group 'gnus-demon
- :type '(repeat (list function
- (choice :tag "Time"
+ :type '(repeat (list function
+ (choice :tag "Time"
(const :tag "never" nil)
(const :tag "one" t)
(integer :tag "steps" 1))
(defun gnus-demon-remove-handler (function &optional no-init)
"Remove the handler FUNCTION from the list of handlers."
- (setq gnus-demon-handlers
+ (setq gnus-demon-handlers
(delq (assq function gnus-demon-handlers)
gnus-demon-handlers))
(unless no-init
(if (null gnus-demon-handlers)
() ; Nothing to do.
;; Set up timer.
- (setq gnus-demon-timer
- (nnheader-run-at-time
+ (setq gnus-demon-timer
+ (nnheader-run-at-time
gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
;; Reset control variables.
(setq gnus-demon-handler-state
- (mapcar
+ (mapcar
(lambda (handler)
(list (car handler) (gnus-demon-time-to-step (nth 1 handler))
(nth 2 handler)))
time
(let* ((date (current-time-string))
(dv (timezone-parse-date date))
- (tdate (timezone-make-arpa-date
+ (tdate (timezone-make-arpa-date
(string-to-number (aref dv 0))
(string-to-number (aref dv 1))
(string-to-number (aref dv 2)) time
handler time idle)
(while handlers
(setq handler (pop handlers))
- (cond
+ (cond
((numberp (setq time (nth 1 handler)))
;; These handlers use a regular timeout mechanism. We decrease
;; the timer if it hasn't reached zero yet.
(setcar (nthcdr 1 handler)
(gnus-demon-time-to-step
(nth 1 (assq (car handler) gnus-demon-handlers)))))))
- ;; These are only supposed to be called when Emacs is idle.
+ ;; These are only supposed to be called when Emacs is idle.
((null (setq idle (nth 2 handler)))
;; We do nothing.
)
((not (numberp idle))
;; We want to call this handler each and every time that
- ;; Emacs is idle.
+ ;; Emacs is idle.
(funcall (car handler)))
(t
;; We want to call this handler only if Emacs has been idle
;; Enter all Message-IDs into the hash table.
(let ((list gnus-dup-list)
(obarray gnus-dup-hashtb))
- (while list
+ (while list
(intern (pop list)))))
(defun gnus-dup-read ()
(intern msgid gnus-dup-hashtb))))
;; Chop off excess Message-IDs from the list.
(let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
- (when end
+ (when end
(setcdr end nil))))
(defun gnus-dup-suppress-articles ()
(while (setq header (pop headers))
(when (and (intern-soft (mail-header-id header) gnus-dup-hashtb)
(gnus-summary-article-unread-p (mail-header-number header)))
- (setq gnus-newsgroup-unreads
+ (setq gnus-newsgroup-unreads
(delq (setq number (mail-header-number header))
gnus-newsgroup-unreads))
(push (cons number gnus-duplicate-mark)
(func gnus-edit-form-done-function))
(gnus-edit-form-exit)
(funcall func form)))
-
+
(defun gnus-edit-form-exit ()
"Kill the current buffer."
(interactive)
(defvar gnus-mouse-2 [mouse-2])
(defvar gnus-down-mouse-2 [down-mouse-2])
-(eval-and-compile
+(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(autoload 'gnus-xmas-redefine "gnus-xmas")
(autoload 'appt-select-lowest-window "appt.el"))
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."))
- (cond
+ (cond
((string-match "XEmacs\\|Lucid" emacs-version)
(gnus-xmas-define))
(unless (fboundp 'buffer-substring-no-properties)
(defun buffer-substring-no-properties (beg end)
(format "%s" (buffer-substring beg end)))))
-
+
((boundp 'MULE)
(provide 'gnusutil))))
(defvar gnus-tmp-subject-or-nil)
(defun gnus-ems-redefine ()
- (cond
+ (cond
((string-match "XEmacs\\|Lucid" emacs-version)
(gnus-xmas-redefine))
((featurep 'mule)
;; Mule and new Emacs definitions
-
+
;; [Note] Now there are three kinds of mule implementations,
;; original MULE, XEmacs/mule and beta version of Emacs including
;; some mule features. Unfortunately these API are different. In
;; (boundp 'MULE) is t only if MULE (original; anything older than
;; Mule 2.3) is running.
;; (featurep 'mule) is t when every mule variants are running.
-
+
;; These implementations may be able to share between original
;; MULE and beta version of new Emacs. In addition, it is able to
;; detect XEmacs/mule by (featurep 'mule) and to check variable
;; `emacs-version'. In this case, implementation for XEmacs/mule
;; may be able to share between XEmacs and XEmacs/mule.
-
+
(defalias 'gnus-truncate-string 'truncate-string)
(defvar gnus-summary-display-table nil
"Display table used in summary mode buffers.")
(fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
(fset 'gnus-max-width-function 'gnus-mule-max-width-function)
-
+
(when (boundp 'gnus-check-before-posting)
(setq gnus-check-before-posting
(delq 'long-lines
(delq 'control-chars gnus-check-before-posting))))
(defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
+ (insert gnus-tmp-unread gnus-tmp-replied
gnus-tmp-score-char gnus-tmp-indentation)
(put-text-property
(point)
(progn
- (insert
- gnus-tmp-opening-bracket
- (format "%4d: %-20s"
- gnus-tmp-lines
+ (insert
+ gnus-tmp-opening-bracket
+ (format "%4d: %-20s"
+ gnus-tmp-lines
(if (> (length gnus-tmp-name) 20)
(truncate-string gnus-tmp-name 20)
gnus-tmp-name))
;; The copyright holders request that they be notified of
;; modifications of this code. Please send electronic mail to
;; grouplens@cs.umn.edu for more information or to announce derived
-;; works.
+;; works.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Author: Brad Miller
;;
;;
;; ---------------- For your .emacs or .gnus file ----------------
;;
-;; As of version 2.5, grouplens now works as a minor mode of
+;; As of version 2.5, grouplens now works as a minor mode of
;; gnus-summary-mode. To get make that work you just need a couple of
;; hooks.
;; (setq gnus-use-grouplens t)
;; Please type M-x gnus-gl-submit-bug-report. This will set up a
;; mail buffer with the state of variables and buffers that will help
;; me debug the problem. A short description up front would help too!
-;;
+;;
;; How do I display the prediction for an article:
;; If you set the gnus-summary-line-format as shown above, the score
;; (prediction) will be shown automatically.
;;
-;;
+;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Programmer Notes
+;; Programmer Notes
;; 10/9/95
;; gnus-scores-articles contains the articles
;; When scoring is done, the call tree looks something like:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bugs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
+;;
;;; Code:
"*The line format spec in summary GroupLens mode buffers.")
(defvar grouplens-pseudonym ""
- "User's pseudonym.
+ "User's pseudonym.
This pseudonym is obtained during the registration process")
(defvar grouplens-bbb-host "grouplens.cs.umn.edu"
(defvar grouplens-bbb-port 9000
"Port where the bbbd is listening" )
-(defvar grouplens-newsgroups
+(defvar grouplens-newsgroups
'("comp.groupware" "comp.human-factors" "comp.lang.c++"
"comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy"
"comp.os.linux.announce" "comp.os.linux.answers"
"*Groups that are part of the GroupLens experiment.")
(defvar grouplens-prediction-display 'prediction-spot
- "valid values are:
- prediction-spot -- an * corresponding to the prediction between 1 and 5,
+ "valid values are:
+ prediction-spot -- an * corresponding to the prediction between 1 and 5,
confidence-interval -- a numeric confidence interval
prediction-bar -- |##### | the longer the bar, the better the article,
confidence-bar -- | ----- } the prediction is in the middle of the bar,
confidence-plus-minus -- prediction +/i confidence")
(defvar grouplens-score-offset 0
- "Offset the prediction by this value.
+ "Offset the prediction by this value.
Setting this variable to -2 would have the following effect on
GroupLens scores:
3 --> 0
4 --> 1
5 --> 2
-
+
The reason is that a user might want to do this is to combine
GroupLens predictions with scores calculated by other score methods.")
(defvar grouplens-score-scale-factor 1
- "This variable allows the user to magnify the effect of GroupLens scores.
+ "This variable allows the user to magnify the effect of GroupLens scores.
The scale factor is applied after the offset.")
(defvar gnus-grouplens-override-scoring 'override
- "Tell GroupLens to override the normal Gnus scoring mechanism.
+ "Tell GroupLens to override the normal Gnus scoring mechanism.
GroupLens scores can be combined with gnus scores in one of three ways.
'override -- just use grouplens predictions for grouplens groups
'combine -- combine grouplens scores with gnus scores
;; open the connection to the server
(catch 'done
(condition-case error
- (setq grouplens-bbb-process
+ (setq grouplens-bbb-process
(open-network-stream "BBBD" grouplens-bbb-buffer host port))
(error (gnus-message 3 "Error: Failed to connect to BBB")
nil))
- (and (null grouplens-bbb-process)
+ (and (null grouplens-bbb-process)
(throw 'done nil))
(save-excursion
(set-buffer grouplens-bbb-buffer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bbb-build-mid-scores-alist (groupname)
- "this function can be called as part of the function to return the
+ "this function can be called as part of the function to return the
list of score files to use. See the gnus variable
-gnus-score-find-score-files-function.
+gnus-score-find-score-files-function.
*Note:* If you want to use grouplens scores along with calculated scores,
-you should see the offset and scale variables. At this point, I don't
+you should see the offset and scale variables. At this point, I don't
recommend using both scores and grouplens predictions together."
(setq grouplens-current-group groupname)
(when (member groupname grouplens-newsgroups)
;; around. Where the first parenthesized expression is the
;; message-id, and the second is the prediction, the third and fourth
;; are the confidence interval
-;;
+;;
;; Since gnus assumes that scores are integer values?? we round the
;; prediction.
(defun bbb-get-mid ()
(buffer-substring (match-beginning 1) (match-end 1)))
(defun bbb-get-pred ()
- (let ((tpred (string-to-number (buffer-substring (match-beginning 2)
+ (let ((tpred (string-to-number (buffer-substring (match-beginning 2)
(match-end 2)))))
(if (> tpred 0)
(round (* grouplens-score-scale-factor
(setq high 0))
(if (and (bbb-valid-score iscore)
(not (null mid)))
- (cond
+ (cond
;; prediction-spot
((equal grouplens-prediction-display 'prediction-spot)
(setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
((> pred 5)
(setq pred 5))))
;; If no entry in BBB hash mark rate string as NA and return
- (cond
+ (cond
((null hashent)
(aset rate-string 5 ?N)
(aset rate-string 6 ?A)
((equal grouplens-prediction-display 'prediction-spot)
(bbb-fmt-prediction-spot rate-string pred))
-
+
((equal grouplens-prediction-display 'confidence-interval)
(bbb-fmt-confidence-interval pred low high))
-
+
((equal grouplens-prediction-display 'prediction-bar)
(bbb-fmt-prediction-bar rate-string pred))
((equal grouplens-prediction-display 'confidence-spot)
(format "| %4.2f |" pred))
-
+
((equal grouplens-prediction-display 'prediction-num)
(bbb-fmt-prediction-num pred))
-
+
((equal grouplens-prediction-display 'confidence-plus-minus)
(bbb-fmt-confidence-plus-minus pred low high))
-
- (t
+
+ (t
(gnus-message 3 "Invalid prediction display type")
(aset rate-string 0 ?|)
(aset rate-string 11 ?|)
(defun bbb-put-ratings ()
(if (and grouplens-bbb-token
- grouplens-rating-alist
+ grouplens-rating-alist
(member gnus-newsgroup-name grouplens-newsgroups))
- (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
+ (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
grouplens-bbb-port))
(rate-command (bbb-build-rate-command grouplens-rating-alist)))
(if bbb-process
- (save-excursion
+ (save-excursion
(set-buffer (process-buffer bbb-process))
(gnus-message 5 "Sending Ratings...")
(bbb-send-command bbb-process rate-command)
(if (bbb-read-response bbb-process)
(setq grouplens-rating-alist nil)
- (gnus-message 1
+ (gnus-message 1
"Token timed out: call bbb-login and quit again")
(ding))
(gnus-message 5 "Sending Ratings...Done"))
(interactive "nRating: ")
(when (member gnus-newsgroup-name grouplens-newsgroups)
(let ((mid (or midin (bbb-get-current-id))))
- (if (and rating
+ (if (and rating
(>= rating grplens-minrating)
(<= rating grplens-maxrating)
mid)
(gnus-summary-best-unread-article))
(defun grouplens-summary-catchup-and-exit (rating)
- "Mark all articles not marked as unread in this newsgroup as read,
- then exit. If prefix argument ALL is non-nil, all articles are
+ "Mark all articles not marked as unread in this newsgroup as read,
+ then exit. If prefix argument ALL is non-nil, all articles are
marked as read."
(interactive "P")
(when rating
(gnus-summary-goto-subject article)
(gnus-set-global-variables)
(bbb-summary-rate-article score
- (mail-header-id
+ (mail-header-id
(gnus-summary-article-header article)))))
(setq e (point)))
(let ((gnus-summary-check-current t))
(defun bbb-get-current-id ()
(if gnus-current-headers
- (mail-header-id gnus-current-headers)
+ (mail-header-id gnus-current-headers)
(gnus-message 3 "You must select an article before you rate it")))
(defun bbb-grouplens-group-p (group)
(when (member gnus-newsgroup-name grouplens-newsgroups)
(when grouplens-previous-article
(let ((elapsed-time (grouplens-elapsed-time))
- (oldrating (assoc grouplens-previous-article
+ (oldrating (assoc grouplens-previous-article
grouplens-rating-alist)))
(if (not oldrating)
(push `(,grouplens-previous-article . (0 . ,elapsed-time))
(when (and (eq major-mode 'gnus-summary-mode)
(member gnus-newsgroup-name grouplens-newsgroups))
(make-local-variable 'gnus-grouplens-mode)
- (setq gnus-grouplens-mode
+ (setq gnus-grouplens-mode
(if (null arg) (not gnus-grouplens-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-grouplens-mode
(gnus-add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local)
(make-local-variable 'gnus-score-find-score-files-function)
- (cond
+ (cond
((eq gnus-grouplens-override-scoring 'combine)
;; either add bbb-buld-mid-scores-alist to a list
;; or make a list
(if (listp gnus-score-find-score-files-function)
- (setq gnus-score-find-score-files-function
- (append 'bbb-build-mid-scores-alist
+ (setq gnus-score-find-score-files-function
+ (append 'bbb-build-mid-scores-alist
gnus-score-find-score-files-function))
- (setq gnus-score-find-score-files-function
- (list gnus-score-find-score-files-function
+ (setq gnus-score-find-score-files-function
+ (list gnus-score-find-score-files-function
'bbb-build-mid-scores-alist))))
;; leave the gnus-score-find-score-files variable alone
((eq gnus-grouplens-override-scoring 'separate)
- (add-hook 'gnus-select-group-hook
+ (add-hook 'gnus-select-group-hook
(lambda ()
(bbb-get-predictions (bbb-get-all-mids)
gnus-newsgroup-name))))
;; default is to override
- (t
- (setq gnus-score-find-score-files-function
+ (t
+ (setq gnus-score-find-score-files-function
'bbb-build-mid-scores-alist)))
-
+
;; Change how summary lines look
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
"gnus-help"
(nndoc "gnus-help"
(nndoc-article-type mbox)
- (eval `(nndoc-address
+ (eval `(nndoc-address
,(let ((file (nnheader-find-etc-directory
"gnus-tut.txt" t)))
(unless file
gnus-group-mail-low-empty-face)
(t .
gnus-group-mail-low-face))
- "Controls the highlighting of group buffer lines.
+ "Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
particular group 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 group lines are displayed by
-editing the face field.
+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
["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
["Global kill file" gnus-group-edit-global-kill t])
))
-
+
(easy-menu-define
gnus-group-group-menu gnus-group-mode-map ""
'("Groups"
["Send a bug report" gnus-bug t]
["Send a mail" gnus-group-mail t]
["Post an article..." gnus-group-post-news t]
- ["Check for new news" gnus-group-get-new-news t]
+ ["Check for new news" gnus-group-get-new-news t]
["Activate all groups" gnus-activate-all-groups t]
["Restart Gnus" gnus-group-restart t]
["Read init file" gnus-group-read-init-file t]
;; We have some groups displayed.
(goto-char (point-max))
(when (or (not gnus-group-goto-next-group-function)
- (not (funcall gnus-group-goto-next-group-function
+ (not (funcall gnus-group-goto-next-group-function
group props)))
(cond
(empty
(>= clevel lowest)
(or all ; We list all groups?
(if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups ; We list unactivated
+ gnus-group-list-inactive-groups ; We list unactivated
(> unread 0)) ; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
nil)
nil))))
-(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
+(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
gnus-tmp-method)
"Insert a group line in the group buffer."
(setq list (cdr list)))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
+ (gnus-put-text-property
+ beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(gnus-extent-start-open beg)))
(goto-char p)))
(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
(when (and entry (not (gnus-ephemeral-group-p group)))
(gnus-dribble-enter
- (concat "(gnus-group-set-info '"
+ (concat "(gnus-group-set-info '"
(gnus-prin1-to-string (nth 2 entry))
")"))))
;; Find all group instances. If topics are in use, each group
(max-len 60)
gnus-tmp-header ;Dummy binding for user-defined formats
;; Get the resulting string.
- (modified
+ (modified
(and gnus-dribble-buffer
(buffer-name gnus-dribble-buffer)
(buffer-modified-p gnus-dribble-buffer)
(when (> (length mode-string) max-len)
(setq mode-string (substring mode-string 0 (- max-len 4))))
(prog1
- (setq mode-line-buffer-identification
+ (setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification
(list mode-string)))
(set-buffer-modified-p modified))))))
(- (1+ (cdr active)) (car active)))))
(gnus-summary-read-group
group (or all (and (numberp number)
- (zerop (+ number (gnus-range-length
+ (zerop (+ number (gnus-range-length
(cdr (assq 'tick marked)))
(gnus-range-length
(cdr (assq 'dormant marked)))))))
(defun gnus-group-select-group-ephemerally ()
"Select the current group without doing any processing whatsoever.
You will actually be entered into a group that's a copy of
-the current group; no changes you make while in this group will
+the current group; no changes you make while in this group will
be permanent."
(interactive)
(require 'gnus-score)
`(,(car method) ,(concat (cadr method) "-ephemeral")
(,(intern (format "%s-address" (car method))) ,(cadr method))
,@(cddr method)))
- (gnus-group-read-ephemeral-group
+ (gnus-group-read-ephemeral-group
(gnus-group-prefixed-name group method) method)))
;;;###autoload
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
-(defun gnus-group-read-ephemeral-group (group method &optional activate
+(defun gnus-group-read-ephemeral-group (group method &optional activate
quit-config request-only)
"Read GROUP from METHOD as an ephemeral group.
If ACTIVATE, request the group first.
(gnus-group-prefixed-name group method))))
(gnus-sethash
group
- `(-1 nil (,group
+ `(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
((quit-config .
,(if quit-config quit-config
(when activate
(gnus-activate-group group 'scan)
(unless (gnus-request-group group)
- (error "Couldn't request group: %s"
+ (error "Couldn't request group: %s"
(nnheader-get-report (car method)))))
(if request-only
group
(when group
(if far
(gnus-goto-char
- (text-property-any
+ (text-property-any
(point-min) (point-max)
'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
(beginning-of-line)
(t
;; Search through the entire buffer.
(gnus-goto-char
- (text-property-any
+ (text-property-any
(point-min) (point-max)
'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
(gnus-set-active nname (cons 1 0))
(unless (gnus-ephemeral-group-p name)
(gnus-dribble-enter
- (concat "(gnus-group-set-info '"
+ (concat "(gnus-group-set-info '"
(gnus-prin1-to-string (cdr info)) ")")))
;; Insert the line.
(gnus-group-insert-group-line-info nname)
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This backend does not support renaming groups"))
- (unless group
+ (unless group
(error "No group to rename"))
(when (equal (gnus-group-real-name group) new-name)
(error "Can't rename to the same name"))
0)
'gnus-group-web-type-history))
(search
- (read-string
- "Search string: "
+ (read-string
+ "Search string: "
(cons (or (car gnus-group-web-search-history) "") 0)
'gnus-group-web-search-history))
(method
(gnus-info-clear-data info)))
(gnus-get-unread-articles)
(gnus-dribble-enter "")
- (when (gnus-y-or-n-p
+ (when (gnus-y-or-n-p
"Move the cache away to avoid problems in the future? ")
(call-interactively 'gnus-cache-move-cache)))))
(gnus-compress-sequence
(if expiry-wait
;; We set the expiry variables to the group
- ;; parameter.
+ ;; parameter.
(let ((nnmail-expiry-wait-function nil)
(nnmail-expiry-wait expiry-wait))
(gnus-request-expire-articles
groups (cdr groups))
(gnus-group-remove-mark group)
(gnus-group-unsubscribe-group
- group
+ group
(cond
((eq do-sub 'unsubscribe)
gnus-level-default-unsubscribed)
(list (completing-read
"Group: " gnus-active-hashtb nil
(gnus-read-active-file-p)
- nil
+ nil
'gnus-group-history)))
(let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
(cond
(gnus-master-read-slave-newsrc))
;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
+ (when (and gnus-use-nocem
(null arg))
(gnus-nocem-scan-groups))
;; If ARG is not a number, then we read the active file.
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
(gnus-find-new-newsgroups)))
-
+
(setq arg (gnus-group-default-level arg t))
(if (and gnus-read-active-file (not arg))
(progn
(when (and level
(> (prefix-numeric-value level) gnus-level-killed))
(gnus-get-killed-groups))
- (gnus-group-prepare-flat
+ (gnus-group-prepare-flat
(or level gnus-level-subscribed) all (or lowest 1) regexp)
(goto-char (point-min))
(gnus-group-position-point))
"Quit reading news after updating .newsrc.eld and .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
(interactive)
- (when
+ (when
(or noninteractive ;For gnus-batch-kill
(not gnus-interactive-exit) ;Without confirmation
gnus-expert-user
(let* ((elem (assoc method gnus-opened-servers))
(status (cadr elem)))
;; If this hasn't been opened before, we add it to the list.
- (when (eq status 'denied)
+ (when (eq status 'denied)
;; Set the status of this server.
(setcar (cdr elem) 'closed))))
(goto-char (point-max)))
(insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
(gnus-kill-file-apply-string string))))
-
+
(defun gnus-kill-file-kill-by-subject ()
"Kill by subject."
(interactive)
(gnus-kill-file-enter-kill
- "Subject"
+ "Subject"
(if (vectorp gnus-current-headers)
- (regexp-quote
+ (regexp-quote
(gnus-simplify-subject (mail-header-subject gnus-current-headers)))
"")
t))
-
+
(defun gnus-kill-file-kill-by-author ()
"Kill by author."
(interactive)
(gnus-kill-file-enter-kill
- "From"
+ "From"
(if (vectorp gnus-current-headers)
(regexp-quote (mail-header-from gnus-current-headers))
"") t))
-
+
(defun gnus-kill-file-kill-by-thread ()
"Kill by author."
(interactive)
(gnus-kill-file-enter-kill
- "References"
+ "References"
(if (vectorp gnus-current-headers)
(regexp-quote (mail-header-id gnus-current-headers))
"")))
-
+
(defun gnus-kill-file-kill-by-xref ()
"Kill by Xref."
(interactive)
(if xref
(while (string-match " \\([^ \t]+\\):" xref start)
(setq start (match-end 0))
- (when (not (string=
- (setq group
+ (when (not (string=
+ (setq group
(substring xref (match-beginning 1) (match-end 1)))
gnus-newsgroup-name))
- (gnus-kill-file-enter-kill
+ (gnus-kill-file-enter-kill
"Xref" (concat " " (regexp-quote group) ":") t)))
(gnus-kill-file-enter-kill "Xref" "" t))))
(setq name (read-string (concat "Add " level
" to followup articles to: ")
(regexp-quote name)))
- (setq
+ (setq
string
(format
"(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
"From" name level))
(insert string)
(gnus-kill-file-apply-string string))
- (gnus-message
+ (gnus-message
6 "Added temporary score file entry for followups to %s." name)))
(defun gnus-kill-file-apply-buffer ()
(mapcar (lambda (header) (mail-header-number header))
headers))
(while headers
- (unless (gnus-member-of-range
+ (unless (gnus-member-of-range
(mail-header-number (car headers))
gnus-newsgroup-killed)
(push (mail-header-number (car headers))
(if (consp (ignore-errors (read (current-buffer))))
(gnus-kill-parse-gnus-kill-file)
(gnus-kill-parse-rn-kill-file))
-
- (gnus-message
+
+ (gnus-message
6 "Processing kill file %s...done" (car kill-files)))
(setq kill-files (cdr kill-files)))))
(goto-char (point-min))
(gnus-kill-file-mode)
(let (beg form)
- (while (progn
+ (while (progn
(setq beg (point))
(setq form (ignore-errors (read (current-buffer)))))
(unless (listp form)
;; The "f:+" command marks everything *but* the matches as read,
;; so we simply first match everything as read, and then unmark
- ;; PATTERN later.
+ ;; PATTERN later.
(when (string-match "\\+" commands)
(gnus-kill "from" ".")
(setq commands "m"))
- (gnus-kill
+ (gnus-kill
(or (cdr (assq modifier mod-to-header)) "subject")
- pattern
+ pattern
(if (string-match "m" commands)
'(gnus-summary-mark-as-unread nil " ")
'(gnus-summary-mark-as-read nil "X"))
(forward-line 1))))
;; Kill changes and new format by suggested by JWZ and Sudish Joseph
-;; <joseph@cis.ohio-state.edu>.
+;; <joseph@cis.ohio-state.edu>.
(defun gnus-kill (field regexp &optional exe-command all silent)
"If FIELD of an article matches REGEXP, execute COMMAND.
Optional 1st argument COMMAND is default to
(goto-char (point-min)) ;From the beginning.
(let ((kill-list regexp)
(date (current-time-string))
- (command (or exe-command '(gnus-summary-mark-as-read
+ (command (or exe-command '(gnus-summary-mark-as-read
nil gnus-kill-file-mark)))
kill kdate prev)
(if (listp kill-list)
;; It's a temporary kill.
(progn
(setq kdate (cdr kill))
- (if (zerop (gnus-execute
+ (if (zerop (gnus-execute
field (car kill) command nil (not all)))
(when (> (gnus-days-between date kdate)
gnus-kill-expiry-days)
(switch-to-buffer old-buffer)
(when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
(gnus-pp-gnus-kill
- (nconc (list 'gnus-kill field
+ (nconc (list 'gnus-kill field
(if (consp regexp) (list 'quote regexp) regexp))
(when (or exe-command all)
(list (list 'quote exe-command)))
(setq klist (cdr klist))))
(insert ")")
(and (nth 3 object)
- (insert "\n "
+ (insert "\n "
(if (and (consp (nth 3 object))
(not (eq 'quote (car (nth 3 object)))))
"'" "")
(gnus-last-article nil)
(gnus-break-pages nil) ;No need to break pages.
(gnus-mark-article-hook nil)) ;Inhibit marking as read.
- (gnus-message
+ (gnus-message
6 "Searching for article: %d..." (mail-header-number header))
(gnus-article-setup-buffer)
(gnus-article-prepare (mail-header-number header) t)
(save-excursion
(let ((killed-no 0)
function article header)
- (cond
+ (cond
;; Search body.
((or (null field)
(string-equal field ""))
(setq function nil))
;; Get access function of header field.
((fboundp
- (setq function
- (intern-soft
+ (setq function
+ (intern-soft
(concat "mail-header-" (downcase field)))))
(setq function `(lambda (h) (,function h))))
;; Signal error.
(and (not article)
(setq article (gnus-summary-article-number)))
;; Find later articles.
- (setq article
+ (setq article
(gnus-summary-search-forward unread nil backward)))
(and (or (null gnus-newsgroup-kill-headers)
(memq article gnus-newsgroup-kill-headers))
the comp hierarchy, you'd say \"comp.all\". If you would not like to
score the alt hierarchy, you'd say \"!alt.all\"."
(interactive)
- (let* ((gnus-newsrc-options-n
+ (let* ((gnus-newsrc-options-n
(gnus-newsrc-parse-options
(concat "options -n "
(mapconcat 'identity command-line-args-left " "))))
;;
;;; Code:
-(put 'gnus-visual 'custom-loads '("smiley" "gnus-sum" "gnus-picon" "earcon"))
+(put 'nnmail 'custom-loads '("nnmail"))
+(put 'gnus-article-emphasis 'custom-loads '("gnus-art"))
+(put 'gnus-article-headers 'custom-loads '("gnus-sum" "gnus-art"))
+(put 'gnus-newsrc 'custom-loads '("gnus-start"))
+(put 'nnmail-procmail 'custom-loads '("nnmail"))
+(put 'gnus-score-kill 'custom-loads '("gnus-kill"))
+(put 'gnus-visual 'custom-loads '("smiley" "gnus" "gnus-picon" "gnus-art" "earcon"))
+(put 'gnus-score-expire 'custom-loads '("gnus-score" "gnus-kill"))
+(put 'gnus-exit 'custom-loads '("gnus-group"))
(put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum"))
-(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int"))
-(put 'gnus-extract-view 'custom-loads '("gnus-sum"))
-(put 'article-hiding-headers 'custom-loads '("gnus-sum"))
+(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int" "gnus-group"))
+(put 'gnus-extract-view 'custom-loads '("gnus-uu" "gnus-sum"))
(put 'gnus-various 'custom-loads '("gnus-sum"))
-(put 'gnus-meta 'custom-loads '("gnus"))
+(put 'gnus-article-washing 'custom-loads '("gnus-art"))
+(put 'gnus-score-files 'custom-loads '("gnus-score"))
(put 'message-news 'custom-loads '("message"))
(put 'gnus-thread 'custom-loads '("gnus-sum"))
+(put 'languages 'custom-loads '("cus-edit"))
+(put 'development 'custom-loads '("cus-edit"))
(put 'gnus-treading 'custom-loads '("gnus-sum"))
+(put 'nnmail-various 'custom-loads '("nnmail"))
+(put 'extensions 'custom-loads '("wid-edit"))
(put 'message-various 'custom-loads '("message"))
(put 'gnus-summary-exit 'custom-loads '("gnus-sum"))
-(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-sum" "gnus-group" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art"))
+(put 'news 'custom-loads '("message" "gnus"))
+(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art"))
+(put 'gnus-server 'custom-loads '("gnus"))
(put 'gnus-summary-visual 'custom-loads '("gnus-sum"))
-(put 'gnus-score 'custom-loads '("gnus-sum" "gnus-score" "gnus-nocem" "gnus-kill"))
+(put 'gnus-group-listing 'custom-loads '("gnus-group"))
+(put 'gnus-score 'custom-loads '("gnus" "gnus-nocem"))
(put 'gnus-group-select 'custom-loads '("gnus-sum"))
(put 'message-buffers 'custom-loads '("message"))
(put 'gnus-threading 'custom-loads '("gnus-sum"))
-(put 'article 'custom-loads '("gnus-sum" "gnus-cite" "gnus-art"))
+(put 'gnus-score-decay 'custom-loads '("gnus-score"))
+(put 'help 'custom-loads '("cus-edit"))
(put 'gnus-nocem 'custom-loads '("gnus-nocem"))
+(put 'gnus-group-visual 'custom-loads '("gnus-group"))
(put 'gnus-cite 'custom-loads '("gnus-cite"))
(put 'gnus-demon 'custom-loads '("gnus-demon"))
-(put 'gnus-mail 'custom-loads '("nnmail"))
+(put 'gnus-message 'custom-loads '("message"))
+(put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score"))
+(put 'nnmail-duplicate 'custom-loads '("nnmail"))
(put 'message-interface 'custom-loads '("message"))
+(put 'nnmail-files 'custom-loads '("nnmail"))
(put 'gnus-edit-form 'custom-loads '("gnus-eform"))
-(put 'emacs 'custom-loads '("custom" "widget-edit" "message" "gnus" "custom-opt"))
+(put 'emacs 'custom-loads '("cus-edit"))
(put 'gnus-summary-mail 'custom-loads '("gnus-sum"))
(put 'gnus-topic 'custom-loads '("gnus-topic"))
+(put 'wp 'custom-loads '("cus-edit"))
(put 'gnus-summary-choose 'custom-loads '("gnus-sum"))
+(put 'widget-browse 'custom-loads '("wid-browse"))
+(put 'external 'custom-loads '("cus-edit"))
(put 'message-headers 'custom-loads '("message"))
(put 'message-forwarding 'custom-loads '("message"))
+(put 'environment 'custom-loads '("cus-edit"))
+(put 'gnus-article-mime 'custom-loads '("gnus-sum" "gnus-art"))
(put 'gnus-duplicate 'custom-loads '("gnus-dup"))
-(put 'widgets 'custom-loads '("widget-edit"))
+(put 'nnmail-retrieve 'custom-loads '("nnmail"))
+(put 'widgets 'custom-loads '("wid-edit" "wid-browse"))
(put 'earcon 'custom-loads '("earcon"))
+(put 'hypermedia 'custom-loads '("wid-edit"))
+(put 'gnus-group-levels 'custom-loads '("gnus-start" "gnus-group"))
(put 'gnus-summary-format 'custom-loads '("gnus-sum"))
+(put 'gnus-files 'custom-loads '("nnmail" "gnus"))
(put 'gnus-windows 'custom-loads '("gnus-win"))
-(put 'gnus-summary 'custom-loads '("gnus-sum"))
-(put 'gnus-group 'custom-loads '("gnus-topic" "gnus-sum" "gnus-group"))
+(put 'gnus-article-buttons 'custom-loads '("gnus-art"))
+(put 'gnus-summary 'custom-loads '("gnus" "gnus-sum"))
+(put 'gnus-article-hiding 'custom-loads '("gnus-sum" "gnus-art"))
+(put 'gnus-group 'custom-loads '("gnus" "gnus-topic"))
+(put 'gnus-article-various 'custom-loads '("gnus-sum" "gnus-art"))
(put 'gnus-summary-marks 'custom-loads '("gnus-sum"))
+(put 'gnus-article-saving 'custom-loads '("gnus-art"))
+(put 'nnmail-expire 'custom-loads '("nnmail"))
(put 'message-mail 'custom-loads '("message"))
+(put 'faces 'custom-loads '("wid-edit" "cus-edit" "gnus"))
(put 'gnus-summary-various 'custom-loads '("gnus-sum"))
+(put 'applications 'custom-loads '("cus-edit"))
+(put 'gnus-start-server 'custom-loads '("gnus-start"))
+(put 'gnus-extract-archive 'custom-loads '("gnus-uu"))
(put 'message 'custom-loads '("message"))
(put 'message-sending 'custom-loads '("message"))
+(put 'editing 'custom-loads '("cus-edit"))
+(put 'gnus-score-adapt 'custom-loads '("gnus-score"))
(put 'message-insertion 'custom-loads '("message"))
+(put 'gnus-extract-post 'custom-loads '("gnus-uu"))
+(put 'mail 'custom-loads '("message" "gnus"))
(put 'gnus-summary-sort 'custom-loads '("gnus-sum"))
-(put 'customize 'custom-loads '("custom" "cus-edit"))
+(put 'gnus-group-new 'custom-loads '("gnus-start"))
+(put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit"))
+(put 'nnmail-split 'custom-loads '("nnmail"))
(put 'gnus-asynchronous 'custom-loads '("gnus-async"))
-(put 'article-mime 'custom-loads '("gnus-sum"))
-(put 'gnus-extract 'custom-loads '("gnus-uu" "gnus-sum"))
-(put 'article-various 'custom-loads '("gnus-sum"))
+(put 'gnus-dribble-file 'custom-loads '("gnus-start"))
+(put 'gnus-article-highlight 'custom-loads '("gnus-art"))
+(put 'gnus-extract 'custom-loads '("gnus-uu"))
+(put 'gnus-article 'custom-loads '("gnus-cite" "gnus-art"))
+(put 'gnus-group-foreign 'custom-loads '("gnus-group"))
+(put 'programming 'custom-loads '("cus-edit"))
(put 'mesage-sending 'custom-loads '("message"))
+(put 'nnmail-prepare 'custom-loads '("nnmail"))
(put 'picons 'custom-loads '("gnus-picon"))
+(put 'gnus-article-signature 'custom-loads '("gnus-art"))
+(put 'gnus-group-various 'custom-loads '("gnus-group"))
(provide 'gnus-load)
(require 'gnus-score)
(require 'gnus-util)
-;;; Internal variables.
+;;; Internal variables.
(defvar gnus-advanced-headers nil)
(eval-and-compile
(autoload 'parse-time-string "parse-time"))
-
+
(defun gnus-score-advanced (rule &optional trace)
"Apply advanced scoring RULE to all the articles in the current group."
(let ((headers gnus-newsgroup-headers)
(defun gnus-advanced-score-rule (rule)
"Apply RULE to `gnus-advanced-headers'."
(let ((type (car rule)))
- (cond
+ (cond
;; "And" rule.
((or (eq type '&) (eq type 'and))
(pop rule)
;; This is a `1-'-type redirection rule.
((and (symbolp type)
(string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
- (let ((gnus-advanced-headers
+ (let ((gnus-advanced-headers
(gnus-parent-headers
gnus-advanced-headers
(if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
(let ((date (encode-time (parse-time-string
(aref gnus-advanced-headers index))))
(match (encode-time (parse-time-string match))))
- (cond
+ (cond
((eq type 'at)
(equal date match))
((eq type 'before)
ofunc article)
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
- (unless (gnus-check-backend-function
+ (unless (gnus-check-backend-function
(intern (concat "request-" header))
gnus-newsgroup-name)
(setq ofunc request-func)
(point-max))))
(let* ((case-fold-search (not (eq (downcase (symbol-name type))
(symbol-name type))))
- (search-func
+ (search-func
(cond ((memq type '(r R regexp Regexp))
're-search-forward)
((memq type '(s S string String))
gnus-newsgroup-last-folder)
gnus-newsgroup-last-folder)
(folder folder)
- (t (mh-prompt-for-folder
+ (t (mh-prompt-for-folder
"Save article in"
(funcall gnus-folder-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-folder)
(save-restriction
(widen)
(unwind-protect
- (call-process-region
+ (call-process-region
(point-min) (point-max) "rcvstore" nil errbuf nil folder)
(set-buffer errbuf)
(if (zerop (buffer-size))
Update the .newsrc.eld file to reflect the change of nntp server."
(interactive
(list gnus-select-method (gnus-read-method "Move to method: ")))
-
+
;; First start Gnus.
(let ((gnus-activate-level 0)
(nnmail-spool-file nil))
(goto-char (point-min))
(while (looking-at
"^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
- (gnus-sethash
+ (gnus-sethash
(buffer-substring (match-beginning 1) (match-end 1))
(read (current-buffer))
hashtb)
(when (and (gnus-request-group group nil from-server)
(gnus-active group)
(setq type (gnus-retrieve-headers
- (gnus-uncompress-range
+ (gnus-uncompress-range
(gnus-active group))
group from-server)))
;; Make it easier to map marks.
(goto-char (point-min))
(while (looking-at
"^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
- (setq to-article
- (gnus-gethash
+ (setq to-article
+ (gnus-gethash
(buffer-substring (match-beginning 1) (match-end 1))
hashtb))
;; Add this article to the list of read articles.
;; Now we know what the read articles are and what the
;; article marks are. We transform the information
;; into the Gnus info format.
- (setq to-reads
- (gnus-range-add
+ (setq to-reads
+ (gnus-range-add
(gnus-compress-sequence (sort to-reads '<) t)
(cons 1 (1- (car to-active)))))
(gnus-info-set-read info to-reads)
(interactive
(let ((info (gnus-get-info (gnus-group-group-name))))
(list info (gnus-find-method-for-group (gnus-info-group info))
- (gnus-read-method (format "Move group %s to method: "
+ (gnus-read-method (format "Move group %s to method: "
(gnus-info-group info))))))
(save-excursion
(gnus-move-group-to-server info from-server to-server)
(gnus-info-set-method info to-server t)
;; We also have to change the name of the group and stuff.
(let* ((group (gnus-info-group info))
- (new-name (gnus-group-prefixed-name
+ (new-name (gnus-group-prefixed-name
(gnus-group-real-name group) to-server)))
(gnus-info-set-group info new-name)
(gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb)
"*All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value. This variable
-can also be a list of group names.
+can also be a list of group names.
If you want to have greater control over what group to put each
message in, you can set this variable to a function that checks the
gatewayed to a newsgroup, and you want to followup to an article in
the group.")
-(defvar gnus-sent-message-ids-file
+(defvar gnus-sent-message-ids-file
(nnheader-concat gnus-directory "Sent-Message-IDs")
"File where Gnus saves a cache of sent message ids.")
(make-local-variable 'gnus-newsgroup-name)
(run-hooks 'gnus-message-setup-hook))
(gnus-configure-windows ,config t))))
-
+
(defun gnus-inews-add-send-actions (winconf buffer article)
(make-local-hook 'message-sent-hook)
(gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
If prefix argument YANK is non-nil, original article is yanked automatically."
- (interactive
- (list (and current-prefix-arg
+ (interactive
+ (list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(gnus-set-global-variables)
(when yank
(gnus-newsgroup-name gnus-newsgroup-name))
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
- headers gnus-article-buffer
+ headers gnus-article-buffer
yank nil force-news)))
(defun gnus-summary-followup-with-original (n &optional force-news)
(defun gnus-summary-followup-to-mail (&optional arg)
"Followup to the current mail message via news."
- (interactive
- (list (and current-prefix-arg
+ (interactive
+ (list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(gnus-summary-followup arg t))
(t 'message))
(let* ((group (or group gnus-newsgroup-name))
(pgroup group)
- to-address to-group mailing-list to-list
+ to-address to-group mailing-list to-list
newsgroup-p)
(when group
(setq to-address (gnus-group-find-parameter group 'to-address)
(gnus-news-group-p to-group))
newsgroup-p
force-news
- (and (gnus-news-group-p
+ (and (gnus-news-group-p
(or pgroup gnus-newsgroup-name)
(if header (mail-header-number header)
gnus-current-article))
"Return the posting method based on GROUP and ARG.
If SILENT, don't prompt the user."
(let ((group-method (gnus-find-method-for-group group)))
- (cond
- ;; If the group-method is nil (which shouldn't happen) we use
+ (cond
+ ;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
((null group-method)
(or gnus-post-method gnus-select-method message-post-method))
(push method post-methods)))
;; Create a name-method alist.
(setq method-alist
- (mapcar
+ (mapcar
(lambda (m)
(list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
post-methods))
(widen)
(narrow-to-region
(goto-char (point-min))
- (or (and (re-search-forward
+ (or (and (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(match-beginning 0))
(point-max)))
(load t t t)))
(if (member message-id gnus-inews-sent-ids)
;; Reject this message.
- (not (gnus-yes-or-no-p
+ (not (gnus-yes-or-no-p
(format "Message %s already sent. Send anyway? "
message-id)))
(push message-id gnus-inews-sent-ids)
;; Chop off the last Message-IDs.
- (when (setq end (nthcdr gnus-sent-message-ids-length
+ (when (setq end (nthcdr gnus-sent-message-ids-length
gnus-inews-sent-ids))
(setcdr end nil))
(nnheader-temp-write gnus-sent-message-ids-file
;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
(defun gnus-inews-insert-mime-headers ()
(goto-char (point-min))
- (let ((mail-header-separator
- (progn
+ (let ((mail-header-separator
+ (progn
(goto-char (point-min))
(if (and (search-forward (concat "\n" mail-header-separator "\n")
nil t)
\f
;;;
-;;; Gnus Mail Functions
+;;; Gnus Mail Functions
;;;
;;; Mail reply commands of Gnus summary mode
(defun gnus-summary-reply (&optional yank wide)
"Start composing a reply mail to the current message.
-If prefix argument YANK is non-nil, the original article is yanked
+If prefix argument YANK is non-nil, the original article is yanked
automatically."
- (interactive
- (list (and current-prefix-arg
+ (interactive
+ (list (and current-prefix-arg
(gnus-summary-work-articles 1))))
;; Stripping headers should be specified with mail-yank-ignored-headers.
(gnus-set-global-variables)
- (when yank
+ (when yank
(gnus-summary-goto-subject (car yank)))
(let ((gnus-article-reply t))
(gnus-setup-message (if yank 'reply-yank 'reply)
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
-If prefix argument YANK is non-nil, the original article is yanked
+If prefix argument YANK is non-nil, the original article is yanked
automatically."
- (interactive
- (list (and current-prefix-arg
+ (interactive
+ (list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(gnus-summary-reply yank t))
(interactive "P")
(gnus-summary-mail-forward full-headers t))
-(defvar gnus-nastygram-message
+(defvar gnus-nastygram-message
"The following article was inappropriately posted to %s.\n\n"
"Format string to insert in nastygrams.
The current group name will be inserted at \"%s\".")
"Send a nastygram to the author of the current article."
(interactive "P")
(when (or gnus-expert-user
- (gnus-y-or-n-p
+ (gnus-y-or-n-p
"Really send a nastygram to the author of the current article? "))
(let ((group gnus-newsgroup-name))
(gnus-summary-reply-with-original n)
(setq beg (point))
(skip-chars-forward "^,")
(while (zerop
- (save-excursion
+ (save-excursion
(save-restriction
(let ((i 0))
(narrow-to-region beg (point))
(when (and to-address
(gnus-alive-p))
;; This mail group doesn't have a `to-list', so we add one
- ;; here. Magic!
+ ;; here. Magic!
(gnus-group-add-parameter group (cons 'to-list to-address)))))
(defun gnus-put-message ()
(let ((reply gnus-article-reply)
(winconf gnus-prev-winconf)
(group gnus-newsgroup-name))
-
+
(or (and group (not (gnus-group-read-only-p group)))
(setq group (read-string "Put in group: " nil
(gnus-writable-groups))))
(when (gnus-buffer-exists-p (car-safe reply))
(set-buffer (car reply))
(and (cdr reply)
- (gnus-summary-mark-article-as-replied
+ (gnus-summary-mark-article-as-replied
(cdr reply))))
(when winconf
(set-window-configuration winconf)))))
"Send a reply to the address near point.
If YANK is non-nil, include the original article."
(interactive "P")
- (let ((address
+ (let ((address
(buffer-substring
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(let* ((references (mail-fetch-field "references"))
(parent (and references (gnus-parent-id references))))
(message-bounce)
- ;; If there are references, we fetch the article we answered to.
+ ;; If there are references, we fetch the article we answered to.
(and fetch parent
(gnus-summary-refer-article parent)
(gnus-summary-show-all-headers)))))
;;; Gcc handling.
-;; Do Gcc handling, which copied the message over to some group.
+;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
+ (interactive)
(when (gnus-alive-p)
(save-excursion
(save-restriction
(setq groups (message-tokenize-header gcc " ,"))
;; Copy the article over to some group(s).
(while (setq group (pop groups))
- (gnus-check-server
+ (gnus-check-server
(setq method
(cond ((and (null (gnus-get-info group))
(eq (car gnus-message-archive-method)
- (car
+ (car
(gnus-server-to-method
(gnus-group-method group)))))
;; If the group doesn't exist, we assume
(nnheader-set-temp-buffer " *acc*")
(insert-buffer-substring cur)
(goto-char (point-min))
- (when (re-search-forward
+ (when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")
nil t)
(replace-match "" t t ))
(unless (gnus-request-accept-article group method t)
- (gnus-message 1 "Couldn't store article in group %s: %s"
+ (gnus-message 1 "Couldn't store article in group %s: %s"
group (gnus-status-message method))
(sit-for 2))
(kill-buffer (current-buffer))))))))))
(save-restriction
(gnus-inews-narrow-to-headers)
(let* ((group gnus-outgoing-message-group)
- (gcc (cond
+ (gcc (cond
((gnus-functionp group)
(funcall group))
((or (stringp group) (list group))
result
gcc-self-val
(groups
- (cond
+ (cond
((null gnus-message-archive-method)
;; Ignore.
nil)
(while (and var
(not
(setq result
- (cond
+ (cond
((stringp (caar var))
;; Regexp.
(when (string-match (caar var) group)
(setq gcc-self-val
(gnus-group-find-parameter
gnus-newsgroup-name 'gcc-self)))
- (progn
+ (progn
(insert
(if (stringp gcc-self-val)
gcc-self-val
(while (setq name (pop groups))
(insert (if (string-match ":" name)
name
- (gnus-group-prefixed-name
+ (gnus-group-prefixed-name
name gnus-message-archive-method)))
(when groups
(insert " ")))
(interactive)
(gnus-set-global-variables)
(let (buf)
- (if (not (setq buf (gnus-request-restore-buffer
+ (if (not (setq buf (gnus-request-restore-buffer
(gnus-summary-article-number) gnus-newsgroup-name)))
(error "Couldn't restore the article")
(switch-to-buffer buf)
(let ((gnus-draft-buffer (current-buffer)))
(gnus-configure-windows 'draft t)
(goto-char (point))))))
-
+
(gnus-add-shutdown 'gnus-inews-close 'gnus)
(defun gnus-inews-close ()
(setq gnus-inews-sent-ids nil))
-
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
"NoCeM pseudo-cancellation treatment"
:group 'gnus-score)
-(defcustom gnus-nocem-groups
+(defcustom gnus-nocem-groups
'("news.lists.filters" "news.admin.net-abuse.bulletins"
"alt.nocem.misc" "news.admin.net-abuse.announce")
"List of groups that will be searched for NoCeM messages."
:group 'gnus-nocem
:type '(repeat (string :tag "Group")))
-(defcustom gnus-nocem-issuers
+(defcustom gnus-nocem-issuers
'("AutoMoose-1" "Automoose-1" ; CancelMoose[tm]
"rbraver@ohww.norman.ok.us" ; Robert Braver
"clewis@ferret.ocunix.on.ca;" ; Chris Lewis
:group 'gnus-nocem
:type '(repeat string))
-(defcustom gnus-nocem-directory
+(defcustom gnus-nocem-directory
(nnheader-concat gnus-article-save-directory "NoCeM/")
"*Directory where NoCeM files will be stored."
:group 'gnus-nocem
(ignore-errors
(load (gnus-nocem-active-file) t t t)))
;; Go through all groups and see whether new articles have
- ;; arrived.
+ ;; arrived.
(while (setq group (pop groups))
(if (not (setq gactive (gnus-activate-group group)))
() ; This group doesn't exist.
(nnheader-temp-write nil
(setq headers
(if (eq 'nov
- (gnus-retrieve-headers
+ (gnus-retrieve-headers
(setq articles
(gnus-uncompress-range
- (cons
+ (cons
(if active (1+ (cdr active))
(car gactive))
(cdr gactive))))
group))
- (gnus-get-newsgroup-headers-xover
+ (gnus-get-newsgroup-headers-xover
articles nil dependencies)
(gnus-get-newsgroup-headers dependencies)))
(while (setq header (pop headers))
(let ((date (mail-header-date header))
issuer b e)
(when (or (not date)
- (nnmail-time-less
+ (nnmail-time-less
(nnmail-time-since (nnmail-date-to-time date))
(nnmail-days-to-time gnus-nocem-expiry-wait)))
(gnus-request-article-this-buffer (mail-header-number header) group)
(interactive)
(unless gnus-nocem-alist
;; The buffer doesn't exist, so we create it and load the NoCeM
- ;; cache.
+ ;; cache.
(when (file-exists-p (gnus-nocem-cache-file))
(load (gnus-nocem-cache-file) t t t)
(gnus-nocem-alist-to-hashtb))))
-
+
(defun gnus-nocem-save-cache ()
"Save the NoCeM cache."
(when (and gnus-nocem-alist
:group 'picons)
(defcustom gnus-picons-database "/usr/local/faces"
- "Defines the location of the faces database.
+ "Defines the location of the faces database.
For information on obtaining this database of pretty pictures, please
see http://www.cs.indiana.edu/picons/ftp/index.html"
:type 'directory
:group 'picons)
(defcustom gnus-picons-domain-directories '("domains")
- "List of directories to search for domain faces.
+ "List of directories to search for domain faces.
Some people may want to add \"unknown\" to this list."
:type '(repeat string)
:group 'picons)
:type 'boolean
:group 'picons)
-(defcustom gnus-picons-x-face-file-name
+(defcustom gnus-picons-x-face-file-name
(format "/tmp/picon-xface.%s.xbm" (user-login-name))
"The name of the file in which to store the converted X-face header."
:type 'string
(define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent)
;;; Internal variables.
-
+
(defvar gnus-group-annotations nil)
(defvar gnus-article-annotations nil)
(defvar gnus-x-face-annotations nil)
(sleep-for .1)))
;; display it
(save-excursion
- (set-buffer (get-buffer-create (gnus-get-buffer-name
+ (set-buffer (get-buffer-create (gnus-get-buffer-name
gnus-picons-display-where)))
(gnus-add-current-to-buffer-list)
(goto-char (point-min))
(push (make-annotation "\n" (point) 'text)
gnus-x-face-annotations))
;; append the annotation to gnus-article-annotations for deletion.
- (setq gnus-x-face-annotations
+ (setq gnus-x-face-annotations
(append
(gnus-picons-try-to-find-face gnus-picons-x-face-file-name t)
gnus-x-face-annotations)))
(when (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x))
(setq from (mail-fetch-field "from"))
- (setq from (downcase
+ (setq from (downcase
(or (cadr (mail-extract-address-components from))
"")))
(or (setq at-idx (string-match "@" from))
(nreverse (message-tokenize-header
gnus-local-domain "."))
'(""))
- (nreverse (message-tokenize-header
+ (nreverse (message-tokenize-header
(substring from (1+ at-idx)) ".")))))
(set-buffer (get-buffer-create
(gnus-get-buffer-name gnus-picons-display-where)))
(unless (eolp)
(push (make-annotation "\n" (point) 'text)
gnus-article-annotations)))
-
+
(gnus-picons-remove gnus-article-annotations)
(setq gnus-article-annotations nil)
(nconc (gnus-picons-insert-face-if-exists
(car databases)
addrs
- "unknown" (or gnus-picons-display-as-address
+ "unknown" (or gnus-picons-display-as-address
gnus-article-annotations) t t)
gnus-article-annotations))
(setq databases (cdr databases)))
(when gnus-picons-display-as-address
(setq gnus-article-annotations
(nconc gnus-article-annotations
- (list
+ (list
(make-annotation "@" (point) 'text nil nil nil t)))))
;; then do user directories,
(while databases
(setq found
(nconc (gnus-picons-insert-face-if-exists
- (car databases) addrs username
- (or gnus-picons-display-as-address
+ (car databases) addrs username
+ (or gnus-picons-display-as-address
gnus-article-annotations) nil t)
found))
(setq databases (cdr databases)))
;; add their name if no face exists
(when (and gnus-picons-display-as-address (not found))
(setq found
- (list
+ (list
(make-annotation username (point) 'text nil nil nil t))))
- (setq gnus-article-annotations
+ (setq gnus-article-annotations
(nconc found gnus-article-annotations)))
(add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
(defun gnus-group-display-picons ()
- "Display icons for the group in the gnus-picons-display-where buffer."
+ "Display icons for the group in the gnus-picons-display-where buffer."
(interactive)
;; let display catch up so far
(when gnus-picons-refresh-before-display
;; '(gnus-picons-insert-face-if-exists
;; "Database" '("edu" "indiana" "cs") "Name")
;; looks for:
- ;; 1. edu/indiana/cs/Name
- ;; 2. edu/indiana/Name
+ ;; 1. edu/indiana/cs/Name
+ ;; 2. edu/indiana/Name
;; 3. edu/Name
;; '(gnus-picons-insert-face-if-exists
;; "Database/MISC" '("edu" "indiana" "cs") "Name")
;; picon databases, but otherwise we would always see the MISC/unknown face.
(let ((bar (and (not nobar-p)
(or gnus-picons-display-as-address
- (annotations-in-region
+ (annotations-in-region
(point) (min (point-max) (1+ (point)))
(current-buffer)))))
(path (concat (file-name-as-directory gnus-picons-database)
(file-accessible-directory-p path))
(setq cur (pop addrs)
path (concat path cur "/"))
- (if (setq found
+ (if (setq found
(gnus-picons-try-suffixes (concat path filename "/face.")))
- (progn
+ (progn
(setq picons (nconc (when (and domainp first rightp)
(list (make-annotation
- "." (point) 'text
+ "." (point) 'text
nil nil nil rightp)
picons))
- (gnus-picons-try-to-find-face
+ (gnus-picons-try-to-find-face
found nil (if domainp cur filename) rightp)
(when (and domainp first (not rightp))
(list (make-annotation
- "." (point) 'text
+ "." (point) 'text
nil nil nil rightp)
picons))
picons)))
(when domainp
- (setq picons
- (nconc (list (make-annotation
- (if first (concat (if (not rightp) ".") cur
+ (setq picons
+ (nconc (list (make-annotation
+ (if first (concat (if (not rightp) ".") cur
(if rightp ".")) cur)
(point) 'text nil nil nil rightp))
picons))))
(when (and bar (or domainp found))
- (setq bar-ann (gnus-picons-try-to-find-face
- (concat gnus-xmas-glyph-directory "bar.xbm")
+ (setq bar-ann (gnus-picons-try-to-find-face
+ (concat gnus-xmas-glyph-directory "bar.xbm")
nil nil t))
(when bar-ann
(setq picons (nconc picons bar-ann))
(setq first t))
(when (and addrs domainp)
(let ((it (mapconcat 'downcase (nreverse addrs) ".")))
- (make-annotation
- (if first (concat (if (not rightp) ".") it (if rightp ".")) it)
+ (make-annotation
+ (if first (concat (if (not rightp) ".") it (if rightp ".")) it)
(point) 'text nil nil nil rightp)))
picons))
(defvar gnus-picons-glyph-alist nil)
-
+
(defun gnus-picons-try-to-find-face (path &optional xface-p part rightp)
"If PATH exists, display it as a bitmap. Returns t if succeeded."
(let ((glyph (and (not xface-p)
(defun gnus-range-add (range1 range2)
"Add RANGE2 to RANGE1 destructively."
- (cond
+ (cond
;; If either are nil, then the job is quite easy.
((or (null range1) (null range2))
(or range1 range2))
(save-excursion
(set-buffer gnus-summary-buffer)
gnus-pick-mode))
- (message-add-action
+ (message-add-action
'(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill)))
(defvar gnus-pick-line-number 1)
(when (or catch-up gnus-mark-unpicked-articles-as-read)
(gnus-summary-limit-mark-excluded-as-read))
(gnus-summary-first-article)
- (gnus-configure-windows
+ (gnus-configure-windows
(if gnus-pick-display-summary 'article 'pick) t))
(if gnus-pick-elegant-flow
(progn
(interactive "P")
(when (eq major-mode 'gnus-summary-mode)
(make-local-variable 'gnus-binary-mode)
- (setq gnus-binary-mode
+ (setq gnus-binary-mode
(if (null arg) (not gnus-binary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-binary-mode
;;; Internal variables.
-(defvar gnus-tree-line-format-alist
+(defvar gnus-tree-line-format-alist
`((?n gnus-tmp-name ?s)
(?f gnus-tmp-from ?s)
(?N gnus-tmp-number ?d)
(defun gnus-tree-mode ()
"Major mode for displaying thread trees."
(interactive)
- (setq gnus-tree-mode-line-format-spec
- (gnus-parse-format gnus-tree-mode-line-format
+ (setq gnus-tree-mode-line-format-spec
+ (gnus-parse-format gnus-tree-mode-line-format
gnus-summary-mode-line-format-alist))
- (setq gnus-tree-line-format-spec
- (gnus-parse-format gnus-tree-line-format
+ (setq gnus-tree-line-format-spec
+ (gnus-parse-format gnus-tree-line-format
gnus-tree-line-format-alist t))
(when (gnus-visual-p 'tree-menu 'menu)
(gnus-tree-make-menu-bar))
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- tree-window (min bottom (save-excursion
+ tree-window (min bottom (save-excursion
(forward-line (- top)) (point)))))
(select-window selected))))
(let ((windows 0)
tot-win-height)
(walk-windows (lambda (window) (incf windows)))
- (setq tot-win-height
+ (setq tot-win-height
(- (frame-height)
(* window-min-height (1- windows))
2))
(not (eval (caar list))))
(setq list (cdr list)))))
(unless (eq (setq face (cdar list)) (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
+ (gnus-put-text-property
+ beg end 'face
(if (boundp face) (symbol-value face) face)))))
(defun gnus-tree-indent (level)
(let ((top (save-excursion
(set-buffer gnus-summary-buffer)
(gnus-cut-thread
- (gnus-remove-thread
- (mail-header-id
+ (gnus-remove-thread
+ (mail-header-id
(gnus-summary-article-header article))
t))))
(gnus-tmp-limit gnus-newsgroup-limit)
(setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
'face gnus-selected-tree-face))
;; Move the overlay to the article.
- (gnus-move-overlay
+ (gnus-move-overlay
gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
(gnus-tree-minimize)
(gnus-tree-recenter)
(let (region)
(when (setq region (gnus-tree-article-region article))
(gnus-put-text-property (car region) (cdr region) 'face face)
- (set-window-point
+ (set-window-point
(get-buffer-window (current-buffer) t) (cdr region))))))
;;;
("exit" . gnus-group-exit)))
(defvar gnus-carpal-summary-buffer-buttons
- '("mark"
+ '("mark"
("read" . gnus-summary-mark-as-read-forward)
("tick" . gnus-summary-tick-article-forward)
("clear" . gnus-summary-clear-mark-forward)
("exit" . gnus-summary-exit)
("fed-up" . gnus-summary-catchup-and-goto-next-group)))
-(defvar gnus-carpal-server-buffer-buttons
+(defvar gnus-carpal-server-buffer-buttons
'(("add" . gnus-server-add-server)
("browse" . gnus-server-browse-server)
("list" . gnus-server-list-servers)
(save-excursion
(set-buffer (get-buffer-create buffer))
(gnus-carpal-mode)
- (setq gnus-carpal-attached-buffer
+ (setq gnus-carpal-attached-buffer
(intern (format "gnus-%s-buffer" type)))
(gnus-add-current-to-buffer-list)
- (let ((buttons (symbol-value
+ (let ((buttons (symbol-value
(intern (format "gnus-carpal-%s-buffer-buttons"
type))))
(buffer-read-only nil)
* A function.
If the function returns non-nil, the result will be used
- as the home score file. The function will be passed the
+ as the home score file. The function will be passed the
name of the group as its parameter.
* A string. Use the string as the home score file.
function))
function))
-(defcustom gnus-default-adaptive-score-alist
+(defcustom gnus-default-adaptive-score-alist
'((gnus-kill-file-mark)
(gnus-unread-mark)
(gnus-read-mark (from 3) (subject 30))
:group 'gnus-score-adapt
:type '(repeat string))
-(defcustom gnus-default-adaptive-word-score-alist
+(defcustom gnus-default-adaptive-word-score-alist
`((,gnus-read-mark . 30)
(,gnus-catchup-mark . -10)
(,gnus-killed-mark . -20)
(defvar gnus-score-alist nil
"Alist containing score information.
-The keys can be symbols or strings. The following symbols are defined.
+The keys can be symbols or strings. The following symbols are defined.
touched: If this alist has been modified.
mark: Automatically mark articles below this.
(let* ((nscore (gnus-score-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
- (char-to-header
+ (char-to-header
'((?a "from" nil nil string)
(?s "subject" nil nil string)
(?b "body" "" nil body-string)
(list (list ?t (current-time-string) "temporary")
'(?p perm "permanent") '(?i now "immediate")))
(mimic gnus-score-mimic-keymap)
- (hchar (and gnus-score-default-header
+ (hchar (and gnus-score-default-header
(aref (symbol-name gnus-score-default-header) 0)))
(tchar (and gnus-score-default-type
(aref (symbol-name gnus-score-default-type) 0)))
(pchar (and gnus-score-default-duration
(aref (symbol-name gnus-score-default-duration) 0)))
entry temporary type match)
-
+
(unwind-protect
(progn
;; First we read the header to score.
(while (not hchar)
(if mimic
- (progn
+ (progn
(sit-for 1)
(message "%c-" prefix))
(message "%s header (%s?): " (if increase "Increase" "Lower")
(if mimic (message "%c %c" prefix hchar) (message ""))
(setq tchar (or tchar ?s)
pchar (or pchar ?t)))
-
+
;; We continue reading - the type.
(while (not tchar)
(if mimic
(eq tchar 114)
(eq (- pchar 4) 111))
(error "You rang?"))
- (if mimic
+ (if mimic
(error "%c %c %c %c" prefix hchar tchar pchar)
(error ""))))
;; Always kill the score help buffer.
;; We have all the data, so we enter this score.
(setq match (if (string= (nth 2 entry) "") ""
(gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
-
+
;; Modify the match, perhaps.
- (cond
+ (cond
((equal (nth 1 entry) "xref")
(when (string-match "^Xref: *" match)
(setq match (substring match (match-end 0))))
(when (string-match "^[^:]* +" match)
(setq match (substring match (match-end 0))))))
-
+
(when (memq type '(r R regexp Regexp))
(setq match (regexp-quote match)))
temporary)
(not (nth 3 entry))) ; Prompt
))
-
+
(defun gnus-score-insert-help (string alist idx)
(setq gnus-score-help-winconf (current-window-configuration))
(save-excursion
(setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
(setq n (/ (1- (window-width)) max)) ; items per line
(setq width (/ (1- (window-width)) n)) ; width of each item
- ;; insert `n' items, each in a field of width `width'
+ ;; insert `n' items, each in a field of width `width'
(while alist
(if (< i n)
()
(let ((window-min-height 1))
(shrink-window-if-larger-than-buffer))
(select-window (get-buffer-window gnus-summary-buffer))))
-
+
(defun gnus-summary-header (header &optional no-err)
;; Return HEADER for current articles, or error.
(let ((article (gnus-summary-article-number))
(defun gnus-newsgroup-score-alist ()
(or
- (let ((param-file (gnus-group-find-parameter
+ (let ((param-file (gnus-group-find-parameter
gnus-newsgroup-name 'score-file)))
(when param-file
(gnus-score-load param-file)))
(defsubst gnus-score-get (symbol &optional alist)
;; Get SYMBOL's definition in ALIST.
- (cdr (assoc symbol
- (or alist
+ (cdr (assoc symbol
+ (or alist
gnus-score-alist
(gnus-newsgroup-score-alist)))))
(header (format "%s" (downcase header)))
new)
(when prompt
- (setq match (read-string
- (format "Match %s on %s, %s: "
+ (setq match (read-string
+ (format "Match %s on %s, %s: "
(cond ((eq date 'now)
"now")
((stringp date)
;; Get rid of string props.
(setq match (format "%s" match))
- ;; If this is an integer comparison, we transform from string to int.
+ ;; If this is an integer comparison, we transform from string to int.
(when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
(setq match (string-to-int match)))
(let ((old (gnus-score-get header))
elem)
(setq new
- (cond
+ (cond
(type
(list match score
(and date (if (numberp date) date
match)
((eq type 'e)
(concat "\\`" (regexp-quote match) "\\'"))
- (t
+ (t
(regexp-quote match)))))
(while (not (eobp))
(let ((content (gnus-summary-header header 'noerr))
(error "This article is not crossposted"))
(while (string-match " \\([^ \t]+\\):" xref start)
(setq start (match-end 0))
- (when (not (string=
- (setq group
+ (when (not (string=
+ (setq group
(substring xref (match-beginning 1) (match-end 1)))
gnus-newsgroup-name))
(gnus-summary-score-entry
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-score-set-mark-below (score)
"Automatically mark articles with score below SCORE as read."
- (interactive
+ (interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
(string-to-int (read-string "Mark below: ")))))
(setq score (or score gnus-summary-default-score 0))
(defun gnus-score-set-expunge-below (score)
"Automatically expunge articles with score below SCORE."
- (interactive
+ (interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
(string-to-int (read-string "Set expunge below: ")))))
(setq score (or score gnus-summary-default-score 0))
(defun gnus-score-set (symbol value &optional alist)
;; Set SYMBOL to VALUE in ALIST.
- (let* ((alist
- (or alist
+ (let* ((alist
+ (or alist
gnus-score-alist
(gnus-newsgroup-score-alist)))
(entry (assoc symbol alist)))
(defun gnus-score-change-score-file (file)
"Change current score alist."
- (interactive
+ (interactive
(list (read-file-name "Change to score file: " gnus-kill-files-directory)))
(gnus-score-load-file file)
(gnus-set-mode-line 'summary))
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
+ (gnus-message
+ 4 (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
-
+
(defun gnus-score-edit-file (file)
"Edit a score file."
- (interactive
+ (interactive
(list (read-file-name "Edit score file: " gnus-kill-files-directory)))
(gnus-make-directory (file-name-directory file))
(when (buffer-name gnus-summary-buffer)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
+ (gnus-message
+ 4 (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
-
+
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
- (let* ((file (expand-file-name
+ (let* ((file (expand-file-name
(or (and (string-match
(concat "^" (expand-file-name
gnus-kill-files-directory))
(setq gnus-score-alist nil)
(setq alist (gnus-score-load-score-alist file))
;; We add '(touched) to the alist to signify that it hasn't been
- ;; touched (yet).
+ ;; touched (yet).
(unless (assq 'touched alist)
(push (list 'touched nil) alist))
;; If it is a global score file, we make it read-only.
(eval (car (gnus-score-get 'eval alist))))
;; Perform possible decays.
(when (and gnus-decay-scores
- (gnus-decay-scores
+ (gnus-decay-scores
alist (or decay (gnus-time-to-day (current-time)))))
(gnus-score-set 'touched '(t) alist)
(gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
;; We do not respect eval and files atoms from global score
- ;; files.
+ ;; files.
(and files (not global)
(setq lists (apply 'append lists
(mapcar (lambda (file)
files)))))
(and eval (not global) (eval eval))
;; We then expand any exclude-file directives.
- (setq gnus-scores-exclude-files
- (nconc
- (mapcar
+ (setq gnus-scores-exclude-files
+ (nconc
+ (mapcar
(lambda (sfile)
(expand-file-name sfile (file-name-directory file)))
exclude-files)
(t
;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
gnus-default-adaptive-score-alist)))
- (setq gnus-thread-expunge-below
+ (setq gnus-thread-expunge-below
(or thread-mark-and-expunge gnus-thread-expunge-below))
- (setq gnus-summary-mark-below
+ (setq gnus-summary-mark-below
(or mark mark-and-expunge gnus-summary-mark-below))
- (setq gnus-summary-expunge-below
+ (setq gnus-summary-expunge-below
(or expunge mark-and-expunge gnus-summary-expunge-below))
- (setq gnus-newsgroup-adaptive-score-file
+ (setq gnus-newsgroup-adaptive-score-file
(or adapt-file gnus-newsgroup-adaptive-score-file)))
(setq gnus-current-score-file file)
(setq gnus-score-alist alist)
(push (cons file gnus-score-alist) gnus-score-cache))))
(defun gnus-score-remove-from-cache (file)
- (setq gnus-score-cache
+ (setq gnus-score-cache
(delq (assoc file gnus-score-cache) gnus-score-cache)))
(defun gnus-score-load-score-alist (file)
(setq alist
(condition-case ()
(read (current-buffer))
- (error
+ (error
(gnus-error 3.2 "Problem with score file %s" file))))))
(if (eq (car alist) 'setq)
;; This is an old-style score file.
(defun gnus-score-check-syntax (alist file)
"Check the syntax of the score ALIST."
- (cond
+ (cond
((null alist)
nil)
((not (consp alist))
((not (listp (car a)))
(format "Illegal score element %s in %s" (car a) file))
((stringp (caar a))
- (cond
+ (cond
((not (listp (setq sr (cdar a))))
(format "Illegal header match %s in %s" (nth 1 (car a)) file))
(t
(setq type (caar a))
(while (and sr (not err))
(setq s (pop sr))
- (setq
+ (setq
err
(cond
((if (member (downcase type) '("lines" "chars"))
out))
(setq alist (cdr alist)))
(cons (list 'touched t) (nreverse out))))
-
+
(defun gnus-score-save ()
;; Save all score information.
(let ((cache gnus-score-cache)
(setq score (setcdr entry (delq (assq 'touched score) score)))
(erase-buffer)
(let (emacs-lisp-mode-hook)
- (if (string-match
+ (if (string-match
(concat (regexp-quote gnus-adaptive-file-suffix)
"$")
file)
;; are not meant to be edited by human hands.
(gnus-prin1 score)
;; This is a normal score file, so we print it very
- ;; prettily.
+ ;; 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.
+ ;; There are scores, so we write the file.
(when (file-writable-p file)
(gnus-write-buffer file)
(when gnus-score-after-write-file-function
;; Set the global variant of this variable.
(setq gnus-current-score-file current-score-file)
;; score orphans
- (when gnus-orphan-score
- (setq gnus-score-index
+ (when gnus-orphan-score
+ (setq gnus-score-index
(nth 1 (assoc "references" gnus-header-index)))
(gnus-score-orphans gnus-orphan-score))
;; Run each header through the score process.
(when (listp (caar score))
(gnus-score-advanced (car score) trace))
(pop score))))
-
+
(gnus-message 5 "Scoring...done"))))))
(defun gnus-score-orphans (score)
(let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
alike articles art arts this last this-id)
-
+
(setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
articles gnus-scores-articles)
arts (cdr arts))
(setcdr art (+ score (cdr art))))
(forward-line))))))
-
+
(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
;; matches on numbers that any cleverness will take more
;; time than one would gain.
(while articles
- (when (funcall match-func
+ (when (funcall match-func
(or (aref (caar articles) gnus-score-index) 0)
match)
- (when trace
+ (when trace
(push (cons (car-safe (rassq alist gnus-score-cache)) kill)
gnus-score-trace))
(setq found t)
(setq last (mail-header-number (caar (last articles))))
;; Not all backends support partial fetching. In that case,
;; we just fetch the entire article.
- (unless (gnus-check-backend-function
+ (unless (gnus-check-backend-function
(and (string-match "^gnus-" (symbol-name request-func))
(intern (substring (symbol-name request-func)
(match-end 0))))
gnus-score-interactive-default-score))
(date (nth 2 kill))
(found nil)
- (case-fold-search
+ (case-fold-search
(not (or (eq type 'R) (eq type 'S)
(eq type 'Regexp) (eq type 'String))))
- (search-func
+ (search-func
(cond ((or (eq type 'r) (eq type 'R)
(eq type 'regexp) (eq type 'Regexp))
're-search-forward)
(unless trace
(cond
((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
+ ((and found gnus-update-score-entry-dates)
;; Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
(set-buffer gnus-summary-buffer)
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
- (gnus-score-file-name
+ (gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
(setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
(when last ; Bwadr, duplicate code.
(insert last ?\n)
(put-text-property (1- (point)) (point) 'articles alike))
-
+
;; Find matches.
(while scores
(setq alist (car scores)
(date (nth 2 kill))
(found nil)
(mt (aref (symbol-name type) 0))
- (case-fold-search
+ (case-fold-search
(not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
(dmt (downcase mt))
- (search-func
+ (search-func
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
(t (error "Illegal match type: %s" type))))
(= (progn (end-of-line) (point))
(match-end 0))
(progn
- (setq found (setq arts (get-text-property
+ (setq found (setq arts (get-text-property
(point) 'articles)))
;; Found a match, update scores.
(while arts
(setq art (car arts)
arts (cdr arts))
- (gnus-score-add-followups
+ (gnus-score-add-followups
(car art) score all-scores thread))))
(end-of-line))
(while (funcall search-func match nil t)
(assoc id entry)
(setq dont t)))
(unless dont
- (gnus-summary-score-entry
+ (gnus-summary-score-entry
(if thread "thread" "references")
id 's score (current-time-string) nil t)))))
;; Score ARTICLES according to HEADER in SCORE-LIST.
;; Update matching entries to NOW and remove unmatched entries older
;; than EXPIRE.
-
+
;; Insert the unique article headers in the buffer.
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
;; gnus-score-index is used as a free variable.
- alike last this art entries alist articles
+ alike last this art entries alist articles
fuzzies arts words kill)
;; Sorting the articles costs os O(N*log N) but will allow us to
(mt (aref (symbol-name type) 0))
(case-fold-search (not (memq mt '(?R ?S ?E ?F))))
(dmt (downcase mt))
- (search-func
+ (search-func
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
((= dmt ?w) nil)
(= (gnus-point-at-bol) (match-beginning 0))
;; Yup.
(progn
- (setq found (setq arts (get-text-property
+ (setq found (setq arts (get-text-property
(point) 'articles)))
;; Found a match, update scores.
(if trace
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))
(push
- (cons
+ (cons
(car-safe (rassq alist gnus-score-cache))
kill)
gnus-score-trace))
;; Update expiry date
(if trace
(setq entries (cdr entries))
- (cond
+ (cond
;; Permanent entry.
((null date)
(setq entries (cdr entries)))
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))
(push (cons
- (car-safe (rassq (cdar fuzzies) gnus-score-cache))
+ (car-safe (rassq (cdar fuzzies) gnus-score-cache))
kill)
gnus-score-trace))
;; Found a match, update scores.
(set-syntax-table gnus-adaptive-word-syntax-table)
(while (re-search-forward "\\b\\w+\\b" nil t)
(setq val
- (gnus-gethash
+ (gnus-gethash
(setq word (downcase (buffer-substring
(match-beginning 0) (match-end 0))))
hashtb))
(defun gnus-current-score-file-nondirectory (&optional score-file)
(let ((score-file (or score-file gnus-current-score-file)))
- (if score-file
+ (if score-file
(gnus-short-group-name (file-name-nondirectory score-file))
"none")))
;; We change the score file to the adaptive score file.
(save-excursion
(set-buffer gnus-summary-buffer)
- (gnus-score-load-file
+ (gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
- (gnus-score-file-name
+ (gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
;; Perform ordinary line scoring.
(when (or (not (listp gnus-newsgroup-adaptive))
(cdar elem)))
(setcar (car elem)
`(lambda (h)
- (,(intern
- (concat "mail-header-"
+ (,(intern
+ (concat "mail-header-"
(if (eq (caar elem) 'followup)
"message-id"
(downcase (symbol-name (caar elem))))))
(gnus-data-pseudo-p (car data)))
()
(when (setq headers (gnus-data-header (car data)))
- (while elem
+ (while elem
(setq match (funcall (caar elem) headers))
- (gnus-summary-score-entry
+ (gnus-summary-score-entry
(nth 1 (car elem)) match
(cond
((numberp match)
'a)
(t
;; Whether we use substring or exact matches is
- ;; controlled here.
+ ;; controlled here.
(if (or (not gnus-score-exact-adapt-limit)
(< (length match) gnus-score-exact-adapt-limit))
- 'e
+ 'e
(if (equal (nth 1 (car elem)) "subject")
'f 's))))
(nth 2 (car elem)) date nil t)
(when (and
(not (gnus-data-pseudo-p d))
(setq score
- (cdr (assq
+ (cdr (assq
(gnus-data-mark d)
gnus-adaptive-word-score-alist))))
;; This article has a mark that should lead to
(setq gnus-newsgroup-scored nil)
(gnus-possibly-score-headers)
(gnus-score-update-all-lines))
-
+
(defun gnus-score-flush-cache ()
"Flush the cache of score files."
(interactive)
(interactive "P")
(gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
-;;; Finding score files.
+;;; Finding score files.
(defun gnus-score-score-files (group)
"Return a list of all possible score files."
;; Search and set any global score files.
- (when gnus-global-score-files
+ (when gnus-global-score-files
(unless gnus-internal-global-score-files
(gnus-score-search-global-directories gnus-global-score-files)))
;; Fix the kill-file dir variable.
- (setq gnus-kill-files-directory
+ (setq gnus-kill-files-directory
(file-name-as-directory gnus-kill-files-directory))
;; If we can't read it, there are no score files.
(if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
(setq gnus-score-file-list nil)
(if (not (gnus-use-long-file-name 'not-score))
;; We do not use long file names, so we have to do some
- ;; directory traversing.
- (setq gnus-score-file-list
- (cons nil
+ ;; directory traversing.
+ (setq gnus-score-file-list
+ (cons nil
(or gnus-short-name-score-file-cache
(prog2
(gnus-message 6 "Finding all score files...")
(not (car gnus-score-file-list))
(gnus-file-newer-than gnus-kill-files-directory
(car gnus-score-file-list)))
- (setq gnus-score-file-list
+ (setq gnus-score-file-list
(cons (nth 5 (file-attributes gnus-kill-files-directory))
- (nreverse
- (directory-files
- gnus-kill-files-directory t
+ (nreverse
+ (directory-files
+ gnus-kill-files-directory t
(gnus-score-file-regexp)))))))
(cdr gnus-score-file-list)))
(case-fold-search nil)
seen out file)
(while (setq file (pop files))
- (cond
+ (cond
;; Ignore "." and "..".
((member (file-name-nondirectory file) '("." ".."))
nil)
(or out
;; Return a dummy value.
(list "~/News/this.file.does.not.exist.SCORE"))))
-
+
(defun gnus-score-file-regexp ()
"Return a regexp that match all score files."
(concat "\\(" (regexp-quote gnus-score-file-suffix )
"\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
-
+
(defun gnus-score-find-bnews (group)
"Return a list of score files for GROUP.
The score files are those files in the ~/News/ directory which matches
GROUP using BNews sys file syntax."
(let* ((sfiles (append (gnus-score-score-files group)
gnus-internal-global-score-files))
- (kill-dir (file-name-as-directory
+ (kill-dir (file-name-as-directory
(expand-file-name gnus-kill-files-directory)))
(klen (length kill-dir))
(score-regexp (gnus-score-file-regexp))
(set-buffer (get-buffer-create "*gnus score files*"))
(buffer-disable-undo (current-buffer))
;; Go through all score file names and create regexp with them
- ;; as the source.
+ ;; as the source.
(while sfiles
(erase-buffer)
(insert (car sfiles))
(mapcar 'gnus-score-file-name all)))
(if (equal prefix "")
all
- (mapcar
+ (mapcar
(lambda (file)
(concat (file-name-directory file) prefix
(file-name-nondirectory file)))
(erase-buffer)
(setq elems (delete "all" elems))
(length elems))))
-
+
(defun gnus-sort-score-files (files)
"Sort FILES so that the most general files come first."
(nnheader-temp-write nil
;; progn used just in case ("regexp") has no files
;; and score-files is still nil. -sj
;; this can be construed as a "stop searching here" feature :>
- ;; and used to simplify regexps in the single-alist
+ ;; and used to simplify regexps in the single-alist
(setq score-files
(nconc score-files (copy-sequence (cdar alist))))
(setq alist nil))
(not (listp funcs))
(setq funcs (list funcs)))
;; Get the initial score files for this group.
- (when funcs
+ (when funcs
(setq score-files (nreverse (gnus-score-find-alist group))))
;; Add any home adapt files.
(let ((home (gnus-home-score-file group t)))
;; scores) and add them to a list.
(while funcs
(when (gnus-functionp (car funcs))
- (setq score-files
+ (setq score-files
(nconc score-files (nreverse (funcall (car funcs) group)))))
(setq funcs (cdr funcs)))
;; Add any home score files.
(pop files)))
;; Do the scoring if there are any score files for this group.
score-files))
-
+
(defun gnus-possibly-score-headers (&optional trace)
"Do scoring if scoring is required."
(let ((score-files (gnus-all-score-files)))
((or (null newsgroup)
(string-equal newsgroup ""))
;; The global score file is placed at top of the directory.
- (expand-file-name
+ (expand-file-name
suffix gnus-kill-files-directory))
((gnus-use-long-file-name 'not-score)
;; Append ".SCORE" to newsgroup name.
(let (out)
(while files
(if (string-match "/$" (car files))
- (setq out (nconc (directory-files
+ (setq out (nconc (directory-files
(car files) t
(concat (gnus-score-file-regexp) "$"))))
(push (car files) out))
;; Group name without any dots.
(concat group (if (gnus-use-long-file-name 'not-score) "." "/")
gnus-score-file-suffix)))
-
+
(defun gnus-hierarchial-home-adapt-file (group)
"Return the adapt file of the top-level hierarchy of GROUP."
(if (string-match "^[^.]+\\." group)
(autoload 'gnus-no-server "gnus" "\
Read network news.
If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
+startup level. If ARG is nil, Gnus will be started at level 2.
If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server." t nil)
(when (setq headers (gnus-summary-article-header (car articles)))
;; Put the article in a buffer.
(set-buffer tmp-buf)
- (when (gnus-request-article-this-buffer
+ (when (gnus-request-article-this-buffer
(car articles) gnus-newsgroup-name)
(save-restriction
(message-narrow-to-head)
(message-remove-header gnus-soup-ignored-headers t))
(gnus-soup-store gnus-soup-directory prefix headers
- gnus-soup-encoding-type
+ gnus-soup-encoding-type
gnus-soup-index-type)
- (gnus-soup-area-set-number
+ (gnus-soup-area-set-number
area (1+ (or (gnus-soup-area-number area) 0)))))
- ;; Mark article as read.
+ ;; Mark article as read.
(set-buffer gnus-summary-buffer)
(gnus-summary-remove-process-mark (car articles))
(gnus-summary-mark-as-read (car articles) gnus-souped-mark)
$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
(interactive)
nil)
-
+
;;; Internal Functions:
-;; Store the current buffer.
+;; Store the current buffer.
(defun gnus-soup-store (directory prefix headers format index)
- ;; Create the directory, if needed.
+ ;; Create the directory, if needed.
(gnus-make-directory directory)
(let* ((msg-buf (nnheader-find-file-noselect
(concat directory prefix ".MSG")))
from head-line beg type)
(setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
(buffer-disable-undo msg-buf)
- (when idx-buf
+ (when idx-buf
(push idx-buf gnus-soup-buffers)
(buffer-disable-undo idx-buf))
(save-excursion
(mail-fetch-field "sender"))))
(goto-char (point-min))
;; Depending on what encoding is supposed to be used, we make
- ;; a soup header.
+ ;; a soup header.
(setq head-line
- (cond
+ (cond
((= gnus-soup-encoding-type ?n)
(format "#! rnews %d\n" (buffer-size)))
((= gnus-soup-encoding-type ?m)
(and (car entry)
(> (car entry) 0))
(and (not not-all)
- (gnus-range-length (cdr (assq 'tick (gnus-info-marks
+ (gnus-range-length (cdr (assq 'tick (gnus-info-marks
(nth 2 entry)))))))
(when (gnus-summary-read-group group nil t)
(setq gnus-newsgroup-processable
(or (mail-header-from header) "(nobody)")
(or (mail-header-date header) "")
(or (mail-header-id header)
- (concat "soup-dummy-id-"
- (mapconcat
+ (concat "soup-dummy-id-"
+ (mapconcat
(lambda (time) (int-to-string time))
(current-time) "-")))
(or (mail-header-references header) "")
(string-match "%d" packer))
(format packer files
(string-to-int (gnus-soup-unique-prefix dir)))
- (format packer
+ (format packer
(string-to-int (gnus-soup-unique-prefix dir))
files)))
(dir (expand-file-name dir)))
(setq gnus-soup-areas nil)
(gnus-message 4 "Packing %s..." packer)
(if (zerop (call-process shell-file-name
- nil nil nil shell-command-switch
+ nil nil nil shell-command-switch
(concat "cd " dir " ; " packer)))
(progn
- (call-process shell-file-name nil nil nil shell-command-switch
+ (call-process shell-file-name nil nil nil shell-command-switch
(concat "cd " dir " ; rm " files))
(gnus-message 4 "Packing...done" packer))
(error "Couldn't pack packet."))))
(defun gnus-soup-parse-areas (file)
"Parse soup area file FILE.
The result is a of vectors, each containing one entry from the AREA file.
-The vector contain five strings,
+The vector contain five strings,
[prefix name encoding description number]
though the two last may be nil if they are missing."
(let (areas)
area)
(while (setq area (pop areas))
(insert
- (format
+ (format
"%s\t%s\t%s%s\n"
(gnus-soup-area-prefix area)
(gnus-soup-area-name area)
(concat "\t" (or (gnus-soup-area-description
area) "")
(if (gnus-soup-area-number area)
- (concat "\t" (int-to-string
+ (concat "\t" (int-to-string
(gnus-soup-area-number area)))
"")) ""))))))))
(unless result
(setq result
(vector (gnus-soup-unique-prefix)
- real-group
+ real-group
(format "%c%c%c"
gnus-soup-encoding-type
gnus-soup-index-type
(gnus-message 4 "Unpacking...done")))
(defun gnus-soup-send-packet (packet)
- (gnus-soup-unpack-packet
+ (gnus-soup-unpack-packet
gnus-soup-replies-directory gnus-soup-unpacker packet)
- (let ((replies (gnus-soup-parse-replies
+ (let ((replies (gnus-soup-parse-replies
(concat gnus-soup-replies-directory "REPLIES"))))
(save-excursion
(while replies
(nnheader-find-file-noselect msg-file)))
(tmp-buf (get-buffer-create " *soup send*"))
beg end)
- (cond
- ((/= (gnus-soup-encoding-format
+ (cond
+ ((/= (gnus-soup-encoding-format
(gnus-soup-reply-encoding (car replies)))
?n)
(error "Unsupported encoding"))
(error "Bad header."))
(forward-line 1)
(setq beg (point)
- end (+ (point) (string-to-int
- (buffer-substring
+ end (+ (point) (string-to-int
+ (buffer-substring
(match-beginning 1) (match-end 1)))))
(switch-to-buffer tmp-buf)
(erase-buffer)
(insert mail-header-separator)
(setq message-newsreader (setq message-mailer
(gnus-extended-version)))
- (cond
+ (cond
((string= (gnus-soup-reply-kind (car replies)) "news")
(gnus-message 5 "Sending news message to %s..."
(mail-fetch-field "newsgroups"))
(gnus-message 4 "Sent packet"))))
(setq replies (cdr replies)))
t)))
-
+
(provide 'gnus-soup)
;;; gnus-soup.el ends here
(defvar gnus-group-line-format-spec
(gnus-byte-code 'gnus-group-line-format-spec))
-(defvar gnus-format-specs
+(defvar gnus-format-specs
`((version . ,emacs-version)
(group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
(summary-dummy "* %(: :%) %S\n"
,gnus-summary-dummy-line-format-spec)
- (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
,gnus-summary-line-format-spec))
"Alist of format specs.")
;; Parse this spec fully.
(while
- (cond
+ (cond
((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?")
(setq pad-width (string-to-number (match-string 1)))
(when (match-beginning 2)
(insert elem-type)
(push (car elem) flist))))
(setq fstring (buffer-string)))
-
+
;; Do some postprocessing to increase efficiency.
(setq
result
(?w where ?s)
(?s status ?s)))
-(defvar gnus-server-mode-line-format-alist
+(defvar gnus-server-mode-line-format-alist
`((?S news-server ?s)
(?M news-method ?s)
(?u user-defined ?s)))
All normal editing commands are switched off.
\\<gnus-server-mode-map>
-For more in-depth information on this mode, read the manual
-(`\\[gnus-info-find-node]').
+For more in-depth information on this mode, read the manual
+(`\\[gnus-info-find-node]').
The following commands are available:
(save-excursion
(set-buffer (get-buffer-create gnus-server-buffer))
(gnus-server-mode)
- (when gnus-carpal
+ (when gnus-carpal
(gnus-carpal-setup-buffer 'server)))))
(defun gnus-server-prepare ()
- (setq gnus-server-mode-line-format-spec
- (gnus-parse-format gnus-server-mode-line-format
+ (setq gnus-server-mode-line-format-spec
+ (gnus-parse-format gnus-server-mode-line-format
gnus-server-mode-line-format-alist))
- (setq gnus-server-line-format-spec
- (gnus-parse-format gnus-server-line-format
+ (setq gnus-server-line-format-spec
+ (gnus-parse-format gnus-server-line-format
gnus-server-line-format-alist t))
(let ((alist gnus-server-alist)
(buffer-read-only nil)
(while alist
(unless (member (cdar alist) done)
(push (cdar alist) done)
- (cdr (setq server (pop alist)))
+ (cdr (setq server (pop alist)))
(when (and server (car server) (cdr server))
(gnus-server-insert-server-line (car server) (cdr server)))))
;; Then we insert the list of servers that have been opened in
;; this session.
- (while opened
+ (while opened
(unless (member (caar opened) done)
(push (caar opened) done)
- (gnus-server-insert-server-line
+ (gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
(caar opened))
(push (list op-ser (caar opened)) gnus-inserted-opened-servers))
(oentry (assoc (gnus-server-to-method server)
gnus-opened-servers)))
(when entry
- (gnus-dribble-enter
+ (gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
(prin1-to-string (cdr entry)) ")\n")))
(when (or entry oentry)
(gnus-delete-line))
(if entry
(gnus-server-insert-server-line (car entry) (cdr entry))
- (gnus-server-insert-server-line
+ (gnus-server-insert-server-line
(format "%s:%s" (caar oentry) (nth 1 (car oentry)))
(car oentry)))
(gnus-server-position-point))))))
(defun gnus-server-set-info (server info)
;; Enter a select method into the virtual server alist.
(when (and server info)
- (gnus-dribble-enter
+ (gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
(prin1-to-string info) ")"))
(let* ((server (nth 1 info))
(gnus-server-yank-server)))
(defun gnus-server-add-server (how where)
- (interactive
+ (interactive
(list (intern (completing-read "Server method: "
gnus-valid-select-methods nil t))
(read-string "Server name: ")))
(set-buffer buf)
(gnus-server-update-server (gnus-server-server-name))
(gnus-server-position-point)))))
-
+
(defun gnus-server-pick-server (e)
(interactive "e")
(mouse-set-point e)
"Issue a command to the server to regenerate all its data structures."
(interactive)
(let ((server (gnus-server-server-name)))
- (unless server
+ (unless server
(error "No server on the current line"))
- (if (not (gnus-check-backend-function
+ (if (not (gnus-check-backend-function
'request-regenerate (car (gnus-server-to-method server))))
(error "This backend doesn't support regeneration")
(gnus-message 5 "Requesting regeneration of %s..." server)
(if (gnus-request-regenerate server)
(gnus-message 5 "Requesting regeneration of %s...done" server)
(gnus-message 5 "Couldn't regenerate %s" server)))))
-
+
(provide 'gnus-srvr)
;;; gnus-srvr.el ends here.
(defcustom gnus-site-init-file
(ignore-errors
- (concat (file-name-directory
+ (concat (file-name-directory
(directory-file-name installation-directory))
"site-lisp/gnus-init"))
"The site-wide Gnus elisp startup file.
(const :tag "none" nil)))
(defcustom gnus-modtime-botch nil
- "*Non-nil means .newsrc should be deleted prior to save.
+ "*Non-nil means .newsrc should be deleted prior to save.
Its use is due to the bogus appearance that .newsrc was modified on
disc."
:group 'gnus-newsrc
:group 'gnus-group-new
:type 'hook)
-(defcustom gnus-after-getting-new-news-hook
+(defcustom gnus-after-getting-new-news-hook
(when (gnus-boundp 'display-time-timer)
'(display-time-event-handler))
"A hook run after Gnus checks for new news."
If LEVEL is non-nil, the news will be set up at level LEVEL."
(let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
- (when init
+ (when init
;; Clear some variables to re-initialize news information.
(setq gnus-newsrc-alist nil
gnus-active-hashtb nil)
(gnus-cache-open))
;; Possibly eval the dribble file.
- (and init
- (or gnus-use-dribble-file gnus-slave)
+ (and init
+ (or gnus-use-dribble-file gnus-slave)
(gnus-dribble-eval-file))
;; Slave Gnusii should then clear the dribble buffer.
(gnus-find-new-newsgroups))
;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
+ (when (and gnus-use-nocem
(not level)
(not dont-connect))
(gnus-nocem-scan-groups))
;; Finally we enter (if needed) the list where it is supposed to
;; go, and change the subscription level. If it is to be killed,
;; we enter it into the killed or zombie list.
- (cond
+ (cond
((>= level gnus-level-zombie)
;; Remove from the hash table.
(gnus-sethash group nil gnus-newsrc-hashtb)
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (and cache-active
+ (and cache-active
(< (car cache-active) (car active))
(setcar active (car cache-active)))
(and cache-active
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
;; Allow the backend to update the info in the group.
- (when (and update
+ (when (and update
(gnus-request-update-info
info (gnus-find-method-for-group (gnus-info-group info))))
(gnus-activate-group (gnus-info-group info) nil t))
(num 0))
;; If a cache is present, we may have to alter the active info.
(when (and gnus-use-cache info)
- (inline (gnus-cache-possibly-alter-active
+ (inline (gnus-cache-possibly-alter-active
(gnus-info-group info) active)))
;; Modify the list of read articles according to what articles
;; are available; then tally the unread articles and add the
;; Get the active file(s) from the backend(s).
(defun gnus-read-active-file (&optional force)
(gnus-group-set-mode-line)
- (let ((methods
+ (let ((methods
(append
(if (gnus-check-server gnus-select-method)
;; The native server is available.
groups info)
(while (setq info (pop newsrc))
(when (gnus-server-equal
- (gnus-find-method-for-group
+ (gnus-find-method-for-group
(gnus-info-group info) info)
gmethod)
(push (gnus-group-real-name (gnus-info-group info))
;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)")
(string-match "\\^to\\\\\\.\\($\\|\\\\|\\)"
gnus-ignored-newsgroups))
-
+
;; Read an active file and place the results in `gnus-active-hashtb'.
(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
(unless method
(gnus-newsrc-to-gnus-format)
(kill-buffer (current-buffer))
(gnus-message 5 "Reading %s...done" newsrc-file)))
-
+
;; Convert old to new.
(gnus-convert-old-newsrc))))
(unless (nthcdr 3 info)
(nconc info (list nil)))
(gnus-info-set-marks
- info (list (cons 'tick (gnus-compress-sequence
+ info (list (cons 'tick (gnus-compress-sequence
(sort (cdr m) '<) t))))))
(setq newsrc killed)
(while newsrc
(point)))))
(forward-line -1))
(symbol
- ;; Group names can be just numbers.
+ ;; Group names can be just numbers.
(when (numberp symbol)
(setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
(unless (boundp symbol)
;;;
(defun gnus-read-all-descriptions-files ()
- (let ((methods (cons gnus-select-method
+ (let ((methods (cons gnus-select-method
(nconc
(when (gnus-archive-server-wanted-p)
(list "archive"))
(defun gnus-set-default-directory ()
"Set the default directory in the current buffer to `gnus-default-directory'.
If this variable is nil, don't do anything."
- (setq default-directory
+ (setq default-directory
(if (and gnus-default-directory
(file-exists-p gnus-default-directory))
(file-name-as-directory (expand-file-name gnus-default-directory))
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-parse-headers-hook
+(defcustom gnus-parse-headers-hook
(list 'gnus-decode-rfc1522)
"*A hook called before parsing the headers."
:group 'gnus-various
:group 'gnus-summary-visual
:type 'face)
-(defcustom gnus-summary-highlight
+(defcustom gnus-summary-highlight
'(((= mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
((and (> score default)
. gnus-summary-low-unread-face)
((and (= mark gnus-unread-mark))
. gnus-summary-normal-unread-face)
- ((> score default)
+ ((> score default)
. gnus-summary-high-read-face)
- ((< score default)
+ ((< score default)
. gnus-summary-low-read-face)
- (t
+ (t
. gnus-summary-normal-read-face))
- "Controls the highlighting of summary buffer lines.
+ "Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
summary line should be displayed, each form is evaluated. The content
score: The articles score
default: The default article score.
-below: The score below which articles are automatically marked as read.
+below: The score below which articles are automatically marked as read.
mark: The articles mark."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
(defvar gnus-scores-exclude-files nil)
-(defvar gnus-summary-display-table
+(defvar gnus-summary-display-table
;; Change the display table. Odd characters have a tendency to mess
;; up nicely formatted displays - we make all possible glyphs
;; display only a single character.
"\M-#" gnus-uu-unmark-thread)
(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
- "g" gnus-summary-prepare
+ "g" gnus-summary-prepare
"c" gnus-summary-insert-cached-articles)
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
'(("Default header"
["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
- :style radio
+ :style radio
:selected (null gnus-score-default-header)]
["From" (gnus-score-set-default 'gnus-score-default-header 'a)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'a)]
["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 's)]
["Article body"
(gnus-score-set-default 'gnus-score-default-header 'b)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'b )]
["All headers"
(gnus-score-set-default 'gnus-score-default-header 'h)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'h )]
["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'i )]
["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 't )]
["Crossposting"
(gnus-score-set-default 'gnus-score-default-header 'x)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'x )]
["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'l )]
["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'd )]
["Followups to author"
(gnus-score-set-default 'gnus-score-default-header 'f)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'f )])
("Default type"
["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
- :style radio
+ :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.
+ ;; active to indicate which button is selected.
["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
- :style radio
+ :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)
;; :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
+ :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
+ :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
+ :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
+ :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
+ :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
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '=)]
- ["Greater than number"
+ ["Greater than number"
(gnus-score-set-default 'gnus-score-default-type '>)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '>)])
["Default fold" gnus-score-default-fold-toggle
(gnus-score-set-default 'gnus-score-default-duration 't)
:style radio
:selected (eq gnus-score-default-duration 't)]
- ["Immediate"
+ ["Immediate"
(gnus-score-set-default 'gnus-score-default-duration 'i)
:style radio
:selected (eq gnus-score-default-duration 'i)]))
["Articles" gnus-summary-limit-to-articles t]
["Pop limit" gnus-summary-pop-limit t]
["Show dormant" gnus-summary-limit-include-dormant t]
- ["Hide childless dormant"
+ ["Hide childless dormant"
gnus-summary-limit-exclude-childless-dormant t]
;;["Hide thread" gnus-summary-limit-exclude-thread t]
["Show expunged" gnus-summary-show-all-expunged t])
("permanent" nil)
("immediate" now)))
header)
- (list
- (apply
+ (list
+ (apply
'nconc
(list
(if (eq type 'lower)
(let (outh)
(while headers
(setq header (car headers))
- (setq outh
- (cons
- (apply
+ (setq outh
+ (cons
+ (apply
'nconc
(list (car header))
(let ((ts (cdr (assoc (nth 2 header) types)))
outt)
(while ts
(setq outt
- (cons
- (apply
+ (cons
+ (apply
'nconc
(list (caar ts))
(let ((ps perms)
(string= (nth 1 header)
"body"))
""
- (list 'gnus-summary-header
+ (list 'gnus-summary-header
(nth 1 header)))
(list 'quote (nth 1 (car ts)))
(list 'gnus-score-default nil)
(level (gnus-data-level (car data)))
children)
(setq data (cdr data))
- (while (and data
+ (while (and data
(= (gnus-data-level (car data)) (1+ level)))
(push (gnus-data-number (car data)) children)
(setq data (cdr data)))
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defun gnus-summary-insert-line (gnus-tmp-header
- gnus-tmp-level gnus-tmp-current
- gnus-tmp-unread gnus-tmp-replied
+(defun gnus-summary-insert-line (gnus-tmp-header
+ gnus-tmp-level gnus-tmp-current
+ gnus-tmp-unread gnus-tmp-replied
gnus-tmp-expirable gnus-tmp-subject-or-nil
- &optional gnus-tmp-dummy gnus-tmp-score
+ &optional gnus-tmp-dummy gnus-tmp-score
gnus-tmp-process)
(let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
(defvar gnus-tmp-new-adopts nil)
(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
- "Return the number of articles in THREAD.
+ "Return the number of articles in THREAD.
This may be 0 in some cases -- if none of the articles in
the thread are to be displayed."
(let* ((number
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- (setq gnus-newsgroup-limit
- (mapcar
+ (setq gnus-newsgroup-limit
+ (mapcar
(lambda (header) (mail-header-number header))
gnus-newsgroup-headers)))
;; Generate the summary buffer.
;; Just remove the leading "Re:".
(t
(gnus-simplify-subject-re subject))))
-
+
(if (and gnus-summary-gather-exclude-subject
(string-match gnus-summary-gather-exclude-subject subject))
nil ; This article shouldn't be gathered
subject hthread whole-subject)
(while threads
(setq subject (gnus-general-simplify-subject
- (setq whole-subject (mail-header-subject
+ (setq whole-subject (mail-header-subject
(caar threads)))))
(when subject
(if (setq hthread (gnus-gethash subject hashtb))
;; Deal with self-referencing References loops.
(when (and (car (symbol-value refs))
(not (zerop
- (apply
+ (apply
'+
(mapcar
(lambda (thread)
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
(deps gnus-newsgroup-dependencies)
- header references generation relations
+ header references generation relations
cthread subject child end pthread relation)
- ;; First we create an alist of generations/relations, where
+ ;; First we create an alist of generations/relations, where
;; generations is how much we trust the relation, and the relation
;; is parent/child.
(gnus-message 7 "Making sparse threads...")
(unless (car (symbol-value cthread))
;; Make this article the parent of these threads.
(setcar (symbol-value cthread)
- (vector gnus-reffed-article-number
+ (vector gnus-reffed-article-number
(cadddr relation)
"" ""
(cadr relation)
(condition-case ()
(mail-header-subject
(gnus-data-header
- (cadr
+ (cadr
(gnus-data-find-list
article
(gnus-data-list t)))))
(when length
(gnus-data-update-list
(cdr datal) (- length (- (gnus-data-pos data) (point))))))))
-
+
(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
(references (mail-header-references header))
(parent
(gnus-id-to-thread
- (or (gnus-parent-id
+ (or (gnus-parent-id
(when (and references
(not (equal "" references)))
references))
(defun gnus-parent-headers (headers &optional generation)
"Return the headers of the GENERATIONeth parent of HEADERS."
- (unless generation
+ (unless generation
(setq generation 1))
(let (references parent)
(while (and headers (not (zerop generation)))
(let ((level (gnus-summary-thread-level article))
(refs (mail-header-references (gnus-summary-article-header article)))
particle)
- (cond
+ (cond
((null level) nil)
((zerop level) t)
((null refs) t)
(defun gnus-root-id (id)
"Return the id of the root of the thread where ID appears."
(let (last-id prev)
- (while (and id (setq prev (car (gnus-gethash
+ (while (and id (setq prev (car (gnus-gethash
id gnus-newsgroup-dependencies))))
(setq last-id id
id (gnus-parent-id (mail-header-references prev))))
(gnus-remove-thread-1 (pop thread)))
(when (setq d (gnus-data-find number))
(goto-char (gnus-data-pos d))
- (gnus-data-remove
+ (gnus-data-remove
number
(- (gnus-point-at-bol)
(prog1
(gnus-message 7 "Sorting articles...")
(prog1
(setq gnus-newsgroup-headers
- (sort articles (gnus-make-sort-function
+ (sort articles (gnus-make-sort-function
gnus-article-sort-functions)))
(gnus-message 7 "Sorting articles...done"))))
articles fetched-articles cached)
(unless (gnus-check-server
- (setq gnus-current-select-method
+ (setq gnus-current-select-method
(gnus-find-method-for-group group)))
(error "Couldn't open server"))
(gnus-update-read-articles group gnus-newsgroup-unreads)
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-group-update-group group))
-
+
(setq articles (gnus-articles-to-read group read-all))
(cond
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))))))
- (gnus-get-newsgroup-headers-xover
+ (gnus-get-newsgroup-headers-xover
articles nil nil gnus-newsgroup-name t)
(gnus-get-newsgroup-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
(car type))))))
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence
+ (gnus-compress-sequence
(set symbol (sort list '<)) t)))
newmarked)))
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
;; Update the mode line.
- (setq mode-line-buffer-identification
+ (setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification (list mode-string)))
(set-buffer-modified-p t))))
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already
- ;; been seen, so we ignore this one, except we add
- ;; any additional Xrefs (in case the two articles
- ;; came from different servers).
+ ;; An article with this Message-ID has already been seen,
+ ;; so we rename the Message-ID.
(progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil))
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
(when header
(gnus-nov-read-integer) ; lines
(if (= (following-char) ?\n)
nil
- (gnus-nov-field)) ; misc
- )))
+ (gnus-nov-field))))) ; misc
(widen))
(if (and (car (symbol-value id-dep))
(not force-new))
;; An article with this Message-ID has already been seen,
- ;; so we ignore this one, except we add any additional
- ;; Xrefs (in case the two articles came from different
- ;; servers.
+ ;; so we rename the Message-ID.
(progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil))
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
(when header
header))
;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional
+(defun gnus-get-newsgroup-headers-xover (sequence &optional
force-new dependencies
group also-fetch-heads)
"Parse the news overview data in the server buffer, and return a
old-header)
(when (setq d (gnus-data-find (mail-header-number old-header)))
(goto-char (gnus-data-pos d))
- (gnus-data-remove
+ (gnus-data-remove
number
(- (gnus-point-at-bol)
(prog1
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- window (min bottom (save-excursion
+ window (min bottom (save-excursion
(forward-line (- top)) (point)))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
- ;; We have to adjust the point of group mode buffer because
+ ;; We have to adjust the point of group mode buffer because
;; point was moved to the next unread newsgroup by exiting.
(gnus-summary-jump-to-group group)
(when rescan
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
(interactive)
- (gnus-summary-next-article
+ (gnus-summary-next-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-last-article-p (gnus-summary-article-number)))
(and gnus-auto-select-same
If given a prefix, remove all limits."
(interactive "P")
(gnus-set-global-variables)
- (when total
+ (when total
(setq gnus-newsgroup-limits
(list (mapcar (lambda (h) (mail-header-number h))
gnus-newsgroup-headers))))
(gnus-summary-limit-to-subject from "from"))
(defun gnus-summary-limit-to-age (age &optional younger-p)
- "Limit the summary buffer to articles that are older than (or equal) AGE days.
+ "Limit the summary buffer to articles that are older than (or equal) AGE days.
If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
articles that are younger than AGE days."
(interactive "nTime in days: \nP")
Returns how many articles were removed."
(interactive "sMarks: ")
(gnus-summary-limit-to-marks marks t))
-
+
(defun gnus-summary-limit-to-marks (marks &optional reverse)
"Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
If REVERSE (the prefix), limit the summary buffer to articles that are
;; children.
(while (setq d (pop data))
(when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
- (and (setq children
+ (and (setq children
(gnus-article-children (gnus-data-number d)))
(let (found)
(while children
(gnus-nocem-unwanted-article-p
(mail-header-id (car thread))))
(progn
- (setq gnus-newsgroup-reads
+ (setq gnus-newsgroup-reads
(delq number gnus-newsgroup-unreads))
t))))
;; Nope, invisible article.
(setq message-id (concat message-id ">")))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
- (gnus-summary-article-sparse-p
+ (gnus-summary-article-sparse-p
(mail-header-number header)))))
(if header
(prog1
;; The article is present in the buffer, to we just go to it.
- (gnus-summary-goto-article
+ (gnus-summary-goto-article
(mail-header-number header) nil header)
(when sparse
(gnus-summary-update-article (mail-header-number header))))
;; We fetch the article
- (let ((gnus-override-method
+ (let ((gnus-override-method
(and (gnus-news-group-p gnus-newsgroup-name)
gnus-refer-article-method))
number)
(unwind-protect
(if (gnus-group-read-ephemeral-group
name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (nndoc-article-type
+ (nndoc-article-type
,(if force 'digest 'guess))) t)
;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info name))
(cons (current-buffer) 'summary)))
(t
(error "Couldn't select virtual nndoc group")))))
-
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next)))))
-(defun gnus-summary-move-article (&optional n to-newsgroup
+(defun gnus-summary-move-article (&optional n to-newsgroup
select-method action)
"Move the current article to a different newsgroup.
If N is a positive number, move the N next articles.
(symbol-value (intern (format "gnus-current-%s-group" action)))
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (or select-method
+ (setq to-method (or select-method
(gnus-group-name-to-method to-newsgroup)))
;; Check the method we are to move this article to...
- (unless (gnus-check-backend-function
+ (unless (gnus-check-backend-function
'request-accept-article (car to-method))
(error "%s does not support article copying" (car to-method)))
(unless (gnus-check-server to-method)
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
":" article))
- (unless xref
+ (unless xref
(setq xref (list (system-name))))
(setq new-xref
(concat
- (mapconcat 'identity
+ (mapconcat 'identity
(delete "Xref:" (delete new-xref xref))
" ")
" " new-xref))
(gnus-gethash
(gnus-group-prefixed-name
(car art-group)
- (or select-method
+ (or select-method
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
(info (nth 2 entry))
(push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
(setcdr (gnus-active to-group) to-article)
(setcdr gnus-newsgroup-active to-article))
-
+
(while marks
(when (memq article (symbol-value
(intern (format "gnus-newsgroup-%s"
;; Re-activate all groups that have been moved to.
(while to-groups
(gnus-activate-group (pop to-groups)))
-
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
- "Default method for respooling an article.
+ "Default method for respooling an article.
If nil, use to the current newsgroup method."
:type 'gnus-select-method-name
:group 'gnus-summary-mail)
In the former case, the articles in question will be moved from the
current group into whatever groups they are destined to. In the
latter case, they will be copied into the relevant groups."
- (interactive
+ (interactive
(list current-prefix-arg
(let* ((methods (gnus-methods-using 'respool))
(methname
(car (gnus-find-method-for-group
gnus-newsgroup-name)))))
(method
- (gnus-completing-read
+ (gnus-completing-read
methname "What backend do you want to use when respooling?"
methods nil t nil 'gnus-mail-method-history))
ms)
(cond
- ((zerop (length (setq ms (gnus-servers-using-backend
+ ((zerop (length (setq ms (gnus-servers-using-backend
(intern method)))))
(list (intern method) ""))
((= 1 (length ms))
"Edit the current article.
This will have permanent effect only in mail groups.
If FORCE is non-nil, allow editing of articles even in read-only
-groups."
+groups."
(interactive "P")
(save-excursion
(set-buffer gnus-summary-buffer)
(defun gnus-summary-edit-wash (key)
"Perform editing command in the article buffer."
- (interactive
+ (interactive
(list
(progn
(message "%s" (concat (this-command-keys) "- "))
(save-excursion
(set-buffer gnus-summary-buffer)
(goto-char (point-min))
- (while
+ (while
(progn
(and (< (gnus-summary-article-score) score)
(gnus-summary-mark-article nil mark))
(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
"Mark all unread articles in this newsgroup as read.
-If prefix argument ALL is non-nil, ticked and dormant articles will
+If prefix argument ALL is non-nil, ticked and dormant articles will
also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
If TO-HERE is non-nil, it should be a point in the buffer. All
(error "Beginning of summary buffer."))))))
(unless (not (eq current-article parent-article))
(error "An article may not be self-referential."))
- (let ((message-id (mail-header-id
+ (let ((message-id (mail-header-id
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent."))
(while (and (> n 0)
(gnus-summary-go-to-next-thread backward))
(decf n))
- (unless silent
+ (unless silent
(gnus-summary-position-point))
(when (and (not silent) (/= 0 n))
(gnus-message 7 "No more threads"))
(interactive "P")
(gnus-set-global-variables)
(let* ((articles (gnus-summary-work-articles n))
- (save-buffer (save-excursion
+ (save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
(num (length articles))
header article file)
nil nil
'gnus-group-history))
(t
- (gnus-completing-read nil prom
+ (gnus-completing-read nil prom
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
- (setq to-newsgroup (or default "")))
+ (setq to-newsgroup default))
+ (unless to-newsgroup
+ (error "No group name entered"))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group
+ (or (and (gnus-request-create-group
to-newsgroup (gnus-group-name-to-method to-newsgroup))
(gnus-activate-group to-newsgroup nil nil
(gnus-group-name-to-method
(setq buffer-read-only nil)
(let ((command (if automatic command (read-string "Command: " command)))
;; Just binding this here doesn't help, because there might
- ;; be output from the process after exiting the scope of
+ ;; be output from the process after exiting the scope of
;; this `let'.
;; (buffer-read-only nil)
)
(defun gnus-read-header (id &optional header)
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
- (gnus-override-method
+ (gnus-override-method
(and (gnus-news-group-p gnus-newsgroup-name)
gnus-refer-article-method))
where)
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
- (or (next-single-property-change
+ (or (next-single-property-change
beg gnus-mouse-face-prop nil end)
beg)))
(to
(setq list (cdr list))))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
+ (gnus-put-text-property
+ beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))
(- (1+ (cdr active)) (car active))))
clevel (or (gnus-info-level info)
(if (member group gnus-zombie-list) 8 9))))
- (and
+ (and
unread ; nil means that the group is dead.
(<= clevel level)
(>= clevel lowest) ; Is inside the level we want.
result found)
(while (and topology
(not (setq found (equal (caaar topology) topic)))
- (not (setq result (gnus-topic-parent-topic topic
+ (not (setq result (gnus-topic-parent-topic topic
(car topology)))))
(setq topology (cdr topology)))
(or result (and found parent))))
(defun gnus-topic-next-topic (topic &optional previous)
"Return the next sibling of TOPIC."
- (let ((parentt (cddr (gnus-topic-find-topology
+ (let ((parentt (cddr (gnus-topic-find-topology
(gnus-topic-parent-topic topic))))
prev)
(while (and parentt
(defun gnus-topic-list (&optional topology)
"Return a list of all topics in the topology."
(unless topology
- (setq topology gnus-topic-topology
+ (setq topology gnus-topic-topology
gnus-tmp-topics nil))
(push (caar topology) gnus-tmp-topics)
(mapcar 'gnus-topic-list (cdr topology))
(not gnus-topology-checked-p))
(gnus-topic-check-topology))
- (unless list-topic
+ (unless list-topic
(erase-buffer))
-
+
;; List dead groups?
(when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
- (gnus-group-prepare-flat-list-dead
+ (gnus-group-prepare-flat-list-dead
(setq gnus-zombie-list (sort gnus-zombie-list 'string<))
gnus-level-zombie ?Z
regexp))
-
+
(when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
- (gnus-group-prepare-flat-list-dead
+ (gnus-group-prepare-flat-list-dead
(setq gnus-killed-list (sort gnus-killed-list 'string<))
gnus-level-killed ?K
regexp))
(or topic-level level) all))
(gnus-topic-prepare-topic gnus-topic-topology 0
(or topic-level level) all)))
-
+
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level all))
(run-hooks 'gnus-group-prepare-hook))))
(let* ((type (pop topicl))
(entries (gnus-topic-find-groups (car type) list-level all))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
- (gnus-group-indentation
+ (gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
(beg (progn (beginning-of-line) (point)))
(topicl (reverse topicl))
;; Insert any sub-topics.
(while topicl
(incf unread
- (gnus-topic-prepare-topic
+ (gnus-topic-prepare-topic
(pop topicl) (1+ level) list-level all
(not visiblep))))
(setq end (point))
(goto-char beg)
;; Insert all the groups that belong in this topic.
(while (setq entry (pop entries))
- (when visiblep
+ (when visiblep
(if (stringp entry)
;; Dead groups.
(gnus-group-insert-group-line
nil)
;; Living groups.
(when (setq info (nth 2 entry))
- (gnus-group-insert-group-line
+ (gnus-group-insert-group-line
(gnus-info-group info)
(gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))))
(when (and (not silent)
(or gnus-topic-display-empty-topics ;We want empty topics
(not (zerop unread)) ;Non-empty
- tick ;Ticked articles
+ tick ;Ticked articles
(/= point-max (point-max)))) ;Unactivated groups
(gnus-extent-start-open (point))
- (gnus-topic-insert-topic-line
+ (gnus-topic-insert-topic-line
(car type) visiblep
(not (eq (nth 2 type) 'hidden))
level all-entries unread))
(defun gnus-topic-insert-topic (topic &optional level)
"Insert TOPIC."
- (gnus-group-prepare-topics
+ (gnus-group-prepare-topics
(car gnus-group-list-mode) (cdr gnus-group-list-mode)
nil nil topic level))
-
+
(defun gnus-topic-fold (&optional insert)
"Remove/insert the current topic."
(let ((topic (gnus-group-topic-name)))
(or insert (not (gnus-topic-visible-p))) nil nil 9)
(gnus-topic-enter-dribble)))))))
-(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
+(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
&optional unread)
(let* ((visible (if visiblep "" "..."))
(indentation (make-string (* gnus-topic-indent-level level) ? ))
(active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
(beginning-of-line)
;; Insert the text.
- (gnus-add-text-properties
+ (gnus-add-text-properties
(point)
(prog1 (1+ (point))
(eval gnus-topic-line-format-spec)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
(buffer-read-only nil))
- (when (and group
+ (when (and group
(gnus-get-info group)
(gnus-topic-goto-topic (gnus-current-topic)))
(gnus-topic-update-topic-line (gnus-group-topic-name))
(let* ((top (gnus-topic-find-topology topic-name))
(type (cadr top))
(children (cddr top))
- (entries (gnus-topic-find-groups
+ (entries (gnus-topic-find-groups
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
(parent (gnus-topic-parent-topic topic-name))
(incf unread (car entry)))))
(setq old-unread (gnus-group-topic-unread))
;; Insert the topic line.
- (gnus-topic-insert-topic-line
+ (gnus-topic-insert-topic-line
(car type) (gnus-topic-visible-p)
(not (eq (nth 2 type) 'hidden))
(gnus-group-topic-level) all-entries unread)
unread))
(defun gnus-topic-group-indentation ()
- (make-string
+ (make-string
(* gnus-topic-indent-level
(or (save-excursion
(forward-line -1)
"Run when changing levels to enter/remove groups from topics."
(save-excursion
(set-buffer gnus-group-buffer)
- (when (and gnus-topic-mode
+ (when (and gnus-topic-mode
gnus-topic-alist
(not gnus-topic-inhibit-change-level))
;; Remove the group from the topics.
(let* ((prev (gnus-group-group-name))
(gnus-topic-inhibit-change-level t)
(gnus-group-indentation
- (make-string
+ (make-string
(* gnus-topic-indent-level
(or (save-excursion
(gnus-topic-goto-topic (gnus-current-topic))
(yanked (list group))
alist talist end)
;; Then we enter the yanked groups into the topics they belong
- ;; to.
+ ;; to.
(when (setq alist (assoc (save-excursion
(forward-line -1)
(or
;; Then try to put point on a group before point.
(unless after
(setq after (cdr (member group (reverse (cdr list)))))
- (while (and after
+ (while (and after
(not (gnus-group-goto-group (car after))))
(setq after (cdr after))))
;; Finally, just put point on the topic.
(defun gnus-topic-grok-active (&optional force)
"Parse all active groups and create topic structures for them."
- ;; First we make sure that we have really read the active file.
+ ;; First we make sure that we have really read the active file.
(when (or force
(not gnus-topic-active-alist))
(let (groups)
;; topic.
(push (pop groups) tgroups)
;; New sub-hierarchy, so we add it to the topology.
- (nconc topology (list (setq ntopology
- (list (list (substring
+ (nconc topology (list (setq ntopology
+ (list (list (substring
group 0 (match-end 0))
'invisible)))))
;; Descend the hierarchy.
(interactive (list current-prefix-arg t))
(when (eq major-mode 'gnus-group-mode)
(make-local-variable 'gnus-topic-mode)
- (setq gnus-topic-mode
+ (setq gnus-topic-mode
(if (null arg) (not gnus-topic-mode)
(> (prefix-numeric-value arg) 0)))
;; Infest Gnus with topics.
(when gnus-topic-mode
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
- (setq gnus-topic-line-format-spec
- (gnus-parse-format gnus-topic-line-format
+ (setq gnus-topic-line-format-spec
+ (gnus-parse-format gnus-topic-line-format
gnus-topic-line-format-alist t))
(unless (assq 'gnus-topic-mode minor-mode-alist)
(push '(gnus-topic-mode " Topic") minor-mode-alist))
;; Remove topic infestation.
(unless gnus-topic-mode
(remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
- (remove-hook 'gnus-group-change-level-function
+ (remove-hook 'gnus-group-change-level-function
'gnus-topic-change-level)
(remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
(setq gnus-group-prepare-function 'gnus-group-prepare-flat)
(setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
(when redisplay
(gnus-group-list-groups))))
-
+
(defun gnus-topic-select-group (&optional all)
"Select this newsgroup.
No article is selected automatically.
If performed over a topic line, toggle folding the topic."
(interactive "P")
(if (gnus-group-topic-p)
- (let ((gnus-group-list-mode
+ (let ((gnus-group-list-mode
(if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
(gnus-topic-fold all))
(gnus-group-select-group all)))
If performed over a topic line, toggle folding the topic."
(interactive "P")
(if (gnus-group-topic-p)
- (let ((gnus-group-list-mode
+ (let ((gnus-group-list-mode
(if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
(gnus-topic-fold all))
(gnus-group-read-group all no-article group)))
(defun gnus-topic-create-topic (topic parent &optional previous full-topic)
- (interactive
+ (interactive
(list
(read-string "New topic: ")
(gnus-current-topic)))
(start-group (progn (forward-line 1) (gnus-group-group-name)))
(start-topic (gnus-group-topic-name))
entry)
- (mapcar
+ (mapcar
(lambda (g)
(gnus-group-remove-mark g)
(when (and
(defun gnus-topic-remove-group (&optional arg)
"Remove the current group from the topic."
(interactive "P")
- (gnus-group-iterate arg
+ (gnus-group-iterate arg
(lambda (group)
(let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
(buffer-read-only nil))
(interactive "P")
(if (gnus-group-topic-p)
(let ((topic (gnus-group-topic-name)))
- (push (cons
+ (push (cons
(gnus-topic-find-topology topic)
(assoc topic gnus-topic-alist))
gnus-topic-killed-topics)
(gnus-topic-enter-dribble))
(gnus-group-kill-group n discard)
(gnus-topic-update-topic)))
-
+
(defun gnus-topic-yank-group (&optional arg)
"Yank the last topic."
(interactive "p")
(if gnus-topic-killed-topics
- (let* ((previous
+ (let* ((previous
(or (gnus-group-topic-name)
(gnus-topic-next-topic (gnus-current-topic))))
(data (pop gnus-topic-killed-topics))
(let* ((prev (gnus-group-group-name))
(gnus-topic-inhibit-change-level t)
(gnus-group-indentation
- (make-string
+ (make-string
(* gnus-topic-indent-level
(or (save-excursion
(gnus-topic-goto-topic (gnus-current-topic))
;; We first yank the groups the normal way...
(setq yanked (gnus-group-yank-group arg))
;; Then we enter the yanked groups into the topics they belong
- ;; to.
+ ;; to.
(setq alist (assoc (save-excursion
(forward-line -1)
(gnus-current-topic))
(entry (assoc old-name gnus-topic-alist)))
(when top
(setcar (cadr top) new-name))
- (when entry
+ (when entry
(setcar entry new-name))
(forward-line -1)
(gnus-dribble-touch)
(defun gnus-completing-read (default prompt &rest args)
;; Like `completing-read', except that DEFAULT is the default argument.
- (let* ((prompt (if default
+ (let* ((prompt (if default
(concat prompt " (default " default ") ")
(concat prompt " ")))
(answer (apply 'completing-read prompt args)))
(defsubst gnus-time-iso8601 (time)
"Return a string of TIME in YYMMDDTHHMMSS format."
(format-time-string "%Y%m%dT%H%M%S" time))
-
+
(defun gnus-date-iso8601 (header)
"Convert the date field in HEADER to YYMMDDTHHMMSS"
(condition-case ()
(goto-char orig)
;; Scroll horizontally to center (sort of) the point.
(if (> max (window-width))
- (set-window-hscroll
+ (set-window-hscroll
(get-buffer-window (current-buffer) t)
(min (- (current-column) (/ (window-width) 3))
(+ 2 (- max (window-width)))))
Timezone package is used."
(condition-case ()
(progn
- (setq date (inline (timezone-fix-time
- date nil
+ (setq date (inline (timezone-fix-time
+ date nil
(aref (inline (timezone-parse-date date)) 4))))
(inline
(timezone-make-sortable-date
(timezone-make-time-string
(aref date 3) (aref date 4) (aref date 5))))))
(error "")))
-
+
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
(interactive
(defun gnus-make-sort-function (funs)
"Return a composite sort condition based on the functions in FUNC."
- (cond
+ (cond
((not (listp funs)) funs)
((null funs) funs)
((cdr funs)
;;; Commentary:
-;;; Code:
+;;; Code:
(require 'gnus)
(require 'gnus-art)
;; Default viewing action rules
-(defcustom gnus-uu-default-view-rules
+(defcustom gnus-uu-default-view-rules
'(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
("\\.pas$" "cat %s | sed s/\r//g")
("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
("\\.tga$" "tgatoppm %s | xv -")
- ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
+ ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
"sox -v .5 %s -t .au -u - > /dev/audio")
("\\.au$" "cat %s > /dev/audio")
("\\.midi?$" "playmidi -f")
("\\.html$" "xmosaic")
("\\.mpe?g$" "mpeg_play")
("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
- ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
+ ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
"gnus-uu-archive"))
- "Default actions to be taken when the user asks to view a file.
+ "Default actions to be taken when the user asks to view a file.
To change the behaviour, you can either edit this variable or set
`gnus-uu-user-view-rules' to something useful.
:group 'gnus-extract-view
:type '(repeat (group regexp (string :tag "Command"))))
-(defcustom gnus-uu-user-view-rules nil
+(defcustom gnus-uu-user-view-rules nil
"What actions are to be taken to view a file.
-See the documentation on the `gnus-uu-default-view-rules' variable for
+See the documentation on the `gnus-uu-default-view-rules' variable for
details."
:group 'gnus-extract-view
:type '(repeat (group regexp (string :tag "Command"))))
-(defcustom gnus-uu-user-view-rules-end
+(defcustom gnus-uu-user-view-rules-end
'(("" "file"))
"What actions are to be taken if no rule matched the file name.
-See the documentation on the `gnus-uu-default-view-rules' variable for
+See the documentation on the `gnus-uu-default-view-rules' variable for
details."
:group 'gnus-extract-view
:type '(repeat (group regexp (string :tag "Command"))))
;; Default unpacking commands
-(defcustom gnus-uu-default-archive-rules
+(defcustom gnus-uu-default-archive-rules
'(("\\.tar$" "tar xf")
("\\.zip$" "unzip -o")
("\\.ar$" "ar x")
:group 'gnus-extract-archive
:type '(repeat (group regexp (string :tag "Command"))))
-(defvar gnus-uu-destructive-archivers
+(defvar gnus-uu-destructive-archivers
(list "uncompress" "gunzip"))
(defcustom gnus-uu-user-archive-rules nil
"A list that can be set to override the default archive unpacking commands.
To use, for instance, 'untar' to unpack tar files and 'zip -x' to
unpack zip files, say the following:
- (setq gnus-uu-user-archive-rules
+ (setq gnus-uu-user-archive-rules
'((\"\\\\.tar$\" \"untar\")
(\"\\\\.zip$\" \"zip -x\")))"
:group 'gnus-extract-archive
(defcustom gnus-uu-ignore-files-by-name nil
"*A regular expression saying what files should not be viewed based on name.
-If, for instance, you want gnus-uu to ignore all .au and .wav files,
+If, for instance, you want gnus-uu to ignore all .au and .wav files,
you could say something like
(setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
(defcustom gnus-uu-ignore-files-by-type nil
"*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
-If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
+If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
you could say something like
(setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
("\\.rsrc$" "video/rsrc")
("\\..*$" "unknown/unknown")))
-;; Various variables users may set
+;; Various variables users may set
-(defcustom gnus-uu-tmp-dir "/tmp/"
+(defcustom gnus-uu-tmp-dir "/tmp/"
"*Variable saying where gnus-uu is to do its work.
Default is \"/tmp/\"."
:group 'gnus-extract
:type 'directory)
-(defcustom gnus-uu-do-not-unpack-archives nil
- "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
+(defcustom gnus-uu-do-not-unpack-archives nil
+ "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
Default is nil."
:group 'gnus-extract-archive
:type 'boolean)
(defcustom gnus-uu-grabbed-file-functions nil
"Functions run on each file after successful decoding.
They will be called with the name of the file as the argument.
-Likely functions you can use in this list are `gnus-uu-grab-view'
+Likely functions you can use in this list are `gnus-uu-grab-view'
and `gnus-uu-grab-move'."
:group 'gnus-extract
:options '(gnus-uu-grab-view gnus-uu-grab-move)
:type 'hook)
-(defcustom gnus-uu-ignore-default-archive-rules nil
- "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
+(defcustom gnus-uu-ignore-default-archive-rules nil
+ "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
Only the user unpacking commands will be consulted. Default is nil."
:group 'gnus-extract-archive
:type 'boolean)
:type 'boolean)
(defcustom gnus-uu-unmark-articles-not-decoded nil
- "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
+ "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
Default is nil."
:group 'gnus-extract
:type 'boolean)
(defcustom gnus-uu-correct-stripped-uucode nil
- "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
+ "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
Default is nil."
:group 'gnus-extract
:type 'boolean)
(defcustom gnus-uu-save-in-digest nil
"*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
-If this variable is nil, gnus-uu will just save everything in a
+If this variable is nil, gnus-uu will just save everything in a
file without any embellishments. The digesting almost conforms to RFC1153 -
-no easy way to specify any meaningful volume and issue numbers were found,
+no easy way to specify any meaningful volume and issue numbers were found,
so I simply dropped them."
:group 'gnus-extract
:type 'boolean)
-(defcustom gnus-uu-digest-headers
+(defcustom gnus-uu-digest-headers
'("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
"^Summary:" "^References:")
"List of regexps to match headers included in digested messages.
"p" gnus-uu-decode-postscript
"P" gnus-uu-decode-postscript-and-save)
-(gnus-define-keys
+(gnus-define-keys
(gnus-uu-extract-view-map "v" gnus-uu-extract-map)
"u" gnus-uu-decode-uu-view
"U" gnus-uu-decode-uu-and-save-view
"Saves the current article."
(interactive
(list current-prefix-arg
- (read-file-name
+ (read-file-name
(if gnus-uu-save-separate-articles
"Save articles is dir: "
"Save articles in file: ")
(read-file-name "Unbinhex and save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir))))
- (setq gnus-uu-binhex-article-name
+ (setq gnus-uu-binhex-article-name
(make-temp-name (concat gnus-uu-work-dir "binhex")))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
(defun gnus-uu-decode-uu-view (&optional n)
- "Uudecodes and views the current article."
+ "Uudecodes and views the current article."
(interactive "P")
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu n)))
(list current-prefix-arg
(read-file-name "Unbinhex, view and save in dir: "
gnus-uu-default-dir gnus-uu-default-dir)))
- (setq gnus-uu-binhex-article-name
+ (setq gnus-uu-binhex-article-name
(make-temp-name (concat gnus-uu-work-dir "binhex")))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-binhex n file)))
(setq fs (cdr fs))))
(unless subject
(setq subject "Digested Articles"))
- (unless from
+ (unless from
(setq from
(if (gnus-news-group-p gnus-newsgroup-name)
gnus-newsgroup-name
"Set the process mark on all articles in the buffer."
(interactive)
(gnus-uu-mark-region (point-min) (point-max)))
-
+
(defun gnus-uu-unmark-buffer ()
"Remove the process mark on all articles in the buffer."
(interactive)
(gnus-uu-mark-region (point-min) (point-max) t))
-
+
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
(interactive)
(setq gnus-newsgroup-processable nil)
(save-excursion
(while marked
- (and (vectorp (setq headers
+ (and (vectorp (setq headers
(gnus-summary-article-header (car marked))))
(setq subject (mail-header-subject headers)
- articles (gnus-uu-find-articles-matching
+ articles (gnus-uu-find-articles-matching
(gnus-uu-reginize-string subject))
total (nconc total articles)))
(while articles
(setq data (cdr data)))))
(gnus-summary-position-point))
-;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
+;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
(defun gnus-uu-decode-postscript (&optional n)
"Gets postscript of the current article."
(read-file-name "Save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
+ (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
n dir nil nil t))
(defun gnus-uu-decode-postscript-and-save-view (n dir)
;; Internal functions.
-(defun gnus-uu-decode-with-method (method n &optional save not-insert
+(defun gnus-uu-decode-with-method (method n &optional save not-insert
scan cdir)
(gnus-uu-initialize scan)
(when save
out)
(when (file-directory-p file)
(setq out (nconc (gnus-uu-scan-directory file t) out)))))
- (if rec
+ (if rec
out
(nreverse out))))
;; Function called by gnus-uu-grab-articles to treat each article.
(defun gnus-uu-save-article (buffer in-state)
- (cond
+ (cond
(gnus-uu-save-separate-articles
(save-excursion
(set-buffer buffer)
(gnus-write-buffer
(concat gnus-uu-saved-article-name gnus-current-article))
(cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
- ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
+ ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
'begin 'end))
((eq in-state 'last) (list 'end))
(t (list 'middle)))))
(set-buffer buffer)
(write-region (point-min) (point-max) gnus-uu-saved-article-name t)
(cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
- ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
+ ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
'begin 'end))
((eq in-state 'last) (list 'end))
(t (list 'middle)))))
beg subj headers headline sorthead body end-string state)
(if (or (eq in-state 'first)
(eq in-state 'first-and-last))
- (progn
+ (progn
(setq state (list 'begin))
(save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
(erase-buffer))
- (save-excursion
+ (save-excursion
(set-buffer (get-buffer-create "*gnus-uu-pre*"))
(erase-buffer)
- (insert (format
+ (insert (format
"Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
(current-time-string) name name))))
(when (not (eq in-state 'end))
(setq headers (cdr headers))
(goto-char (point-min))
(while (re-search-forward headline nil t)
- (setq sorthead
+ (setq sorthead
(concat sorthead
- (buffer-substring
+ (buffer-substring
(match-beginning 0)
(or (and (re-search-forward "^[^ \t]" nil t)
(1- (point)))
(goto-char beg)
(when (re-search-forward "^Subject: \\(.*\\)$" nil t)
(setq subj (buffer-substring (match-beginning 1) (match-end 1)))
- (save-excursion
+ (save-excursion
(set-buffer (get-buffer "*gnus-uu-pre*"))
(insert (format " %s\n" subj)))))
(when (or (eq in-state 'last)
(save-excursion
(set-buffer (get-buffer "*gnus-uu-body*"))
(goto-char (point-max))
- (insert
+ (insert
(concat (setq end-string (format "End of %s Digest" name))
"\n"))
(insert (concat (make-string (length end-string) ?*) "\n"))
(cons gnus-uu-saved-article-name state)
state)))))
-;; Binhex treatment - not very advanced.
+;; Binhex treatment - not very advanced.
-(defconst gnus-uu-binhex-body-line
+(defconst gnus-uu-binhex-body-line
"^[^:]...............................................................$")
-(defconst gnus-uu-binhex-begin-line
+(defconst gnus-uu-binhex-begin-line
"^:...............................................................$")
(defconst gnus-uu-binhex-end-line
":$")
(write-region 1 1 gnus-uu-binhex-article-name))
(setq state (list 'middle)))
(goto-char (point-max))
- (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
+ (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
gnus-uu-binhex-end-line)
nil t)
(when (looking-at gnus-uu-binhex-end-line)
(write-region (point-min) (point-max) file-name)
(setq state (list file-name 'begin 'end)))))
state))
-
+
;; Find actions.
action name)
(while files
(setq name (cdr (assq 'name (car files))))
- (and
+ (and
(setq action (gnus-uu-get-action name))
(setcar files (nconc (list (if (string= action "gnus-uu-archive")
(cons 'action "file")
(defun gnus-uu-get-action (file-name)
(let (action)
- (setq action
- (gnus-uu-choose-action
+ (setq action
+ (gnus-uu-choose-action
file-name
- (append
+ (append
gnus-uu-user-view-rules
- (if gnus-uu-ignore-default-view-rules
- nil
+ (if gnus-uu-ignore-default-view-rules
+ nil
gnus-uu-default-view-rules)
gnus-uu-user-view-rules-end)))
(when (and (not (string= (or action "") "gnus-uu-archive"))
gnus-uu-view-with-metamail)
- (when (setq action
+ (when (setq action
(gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
(setq action (format "metamail -d -b -c \"%s\"" action))))
action))
(if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+"
nil t)
(replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
-
+
(goto-char beg)
(while (re-search-forward "[ \t]+" nil t)
(replace-match "[ \t]*" t t))
;; If N is non-nil, the article numbers of the N next articles
;; will be returned.
;; If any articles have been marked as processable, they will be
- ;; returned.
+ ;; returned.
;; Failing that, articles that have subjects that are part of the
;; same "series" as the current will be returned.
(let (articles)
- (cond
+ (cond
(n
(setq n (prefix-numeric-value n))
(let ((backward (< n 0))
(defun gnus-uu-string< (l1 l2)
(string< (car l1) (car l2)))
-(defun gnus-uu-find-articles-matching
+(defun gnus-uu-find-articles-matching
(&optional subject only-unread do-not-translate)
;; Finds all articles that matches the regexp SUBJECT. If it is
;; nil, the current article name will be used. If ONLY-UNREAD is
;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
;; non-nil, article names are not equalized before sorting.
- (let ((subject (or subject
+ (let ((subject (or subject
(gnus-uu-reginize-string (gnus-summary-article-subject))))
list-of-subjects)
(save-excursion
;; Expand numbers, sort, and return the list of article
;; numbers.
(mapcar (lambda (sub) (cdr sub))
- (sort (gnus-uu-expand-numbers
+ (sort (gnus-uu-expand-numbers
list-of-subjects
(not do-not-translate))
'gnus-uu-string<))))))
(replace-match " "))
;; Translate all characters to "a".
(goto-char (point-min))
- (when translate
+ (when translate
(while (re-search-forward "[A-Za-z]" nil t)
(replace-match "a" t t)))
;; Expand numbers.
(goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
- (replace-match
- (format "%06d"
- (string-to-int (buffer-substring
+ (replace-match
+ (format "%06d"
+ (string-to-int (buffer-substring
(match-beginning 0) (match-end 0))))))
(setq string (buffer-substring 1 (point-max)))
(setcar (car string-list) string)
(setq gnus-uu-has-been-grabbed (list art))))))
;; This function takes a list of articles and a function to apply to
-;; each article grabbed.
-;;
+;; each article grabbed.
+;;
;; This function returns a list of files decoded if the grabbing and
;; the process-function has been successful and nil otherwise.
-(defun gnus-uu-grab-articles (articles process-function
+(defun gnus-uu-grab-articles (articles process-function
&optional sloppy limit no-errors)
(let ((state 'first)
(gnus-asynchronous nil)
gnus-summary-display-article-function
gnus-article-display-hook gnus-article-prepare-hook
article-series files)
-
- (while (and articles
+
+ (while (and articles
(not (memq 'error process-state))
(or sloppy
(not (memq 'end process-state))))
(setq article (pop articles))
(push article article-series)
- (unless articles
+ (unless articles
(if (eq state 'first)
(setq state 'first-and-last)
(setq state 'last)))
(let ((part (gnus-uu-part-number article)))
- (gnus-message 6 "Getting article %d%s..."
+ (gnus-message 6 "Getting article %d%s..."
article (if (string= part "") "" (concat ", " part))))
(gnus-summary-display-article article)
-
+
;; Push the article to the processing function.
(save-excursion
(set-buffer gnus-original-article-buffer)
(let ((buffer-read-only nil))
(save-excursion
(set-buffer gnus-summary-buffer)
- (setq process-state
+ (setq process-state
(funcall process-function
gnus-original-article-buffer state)))))
(gnus-summary-remove-process-mark article)
- ;; If this is the beginning of a decoded file, we push it
+ ;; If this is the beginning of a decoded file, we push it
;; on to a list.
(when (or (memq 'begin process-state)
(and (or (eq state 'first)
(when has-been-begin
;; If there is a `result-file' here, that means that the
;; file was unsuccessfully decoded, so we delete it.
- (when (and result-file
+ (when (and result-file
(file-exists-p result-file)
(not gnus-uu-be-dangerous)
(or (eq gnus-uu-be-dangerous t)
;; the partially decoded file.
(and (or (eq state 'last) (eq state 'first-and-last))
(not (memq 'end process-state))
- result-file
+ result-file
(file-exists-p result-file)
(not gnus-uu-be-dangerous)
(or (eq gnus-uu-be-dangerous t)
(gnus-y-or-n-p (format "Delete incomplete file %s? " result-file)))
(delete-file result-file))
- ;; If this was a file of the wrong sort, then
+ ;; If this was a file of the wrong sort, then
(when (and (or (memq 'wrong-type process-state)
(memq 'error process-state))
gnus-uu-unmark-articles-not-decoded)
(defun gnus-uu-part-number (article)
(let* ((header (gnus-summary-article-header article))
(subject (and header (mail-header-subject header))))
- (if (and subject
+ (if (and subject
(string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject))
(match-string 0 subject)
"")))
(save-excursion
(set-buffer process-buffer)
(let ((state (list 'wrong-type))
- process-connection-type case-fold-search buffer-read-only
+ process-connection-type case-fold-search buffer-read-only
files start-char)
(goto-char (point-min))
(setq state (list 'middle))
;; This is the beginning of an uuencoded article.
;; We replace certain characters that could make things messy.
- (setq gnus-uu-file-name
+ (setq gnus-uu-file-name
(let ((nnheader-file-name-translation-alist
'((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
(nnheader-translate-file-chars (match-string 1))))
(progn
(cd gnus-uu-work-dir)
(setq gnus-uu-uudecode-process
- (start-process
- "*uudecode*"
+ (start-process
+ "*uudecode*"
(get-buffer-create gnus-uu-output-buffer-name)
shell-file-name shell-command-switch
(format "cd %s %s uudecode" gnus-uu-work-dir
gnus-shell-command-separator))))
(cd cdir)))
- (set-process-sentinel
+ (set-process-sentinel
gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
(setq state (list 'begin))
(push (concat gnus-uu-work-dir gnus-uu-file-name) files))
-
+
;; We look for the end of the thing to be decoded.
(if (re-search-forward gnus-uu-end-string nil t)
(push 'end state)
(goto-char (point-max))
(re-search-backward gnus-uu-body-line nil t))
-
+
(forward-line 1)
(when gnus-uu-uudecode-process
(condition-case nil
(process-send-region
gnus-uu-uudecode-process start-char (point))
- (error
- (progn
+ (error
+ (progn
(delete-process gnus-uu-uudecode-process)
(gnus-message 2 "gnus-uu: Couldn't uudecode")
(setq state (list 'wrong-type)))))
(setq state (list 'wrong-type))
(beginning-of-line)
(setq start-char (point))
- (call-process-region
- start-char (point-max) shell-file-name nil
- (get-buffer-create gnus-uu-output-buffer-name) nil
- shell-command-switch
- (concat "cd " gnus-uu-work-dir " "
+ (call-process-region
+ start-char (point-max) shell-file-name nil
+ (get-buffer-create gnus-uu-output-buffer-name) nil
+ shell-command-switch
+ (concat "cd " gnus-uu-work-dir " "
gnus-shell-command-separator " sh"))))
state))
(let ((action-list (copy-sequence file-action-list))
(case-fold-search t)
rule action)
- (and
- (unless no-ignore
- (and (not
+ (and
+ (unless no-ignore
+ (and (not
(and gnus-uu-ignore-files-by-name
(string-match gnus-uu-ignore-files-by-name file-name)))
- (not
+ (not
(and gnus-uu-ignore-files-by-type
- (string-match gnus-uu-ignore-files-by-type
- (or (gnus-uu-choose-action
+ (string-match gnus-uu-ignore-files-by-type
+ (or (gnus-uu-choose-action
file-name gnus-uu-ext-to-mime-list t)
""))))))
(while (not (or (eq action-list ()) action))
;; Unpacks an archive. Returns t if unpacking is successful.
(let ((did-unpack t)
action command dir)
- (setq action (gnus-uu-choose-action
+ (setq action (gnus-uu-choose-action
file-path (append gnus-uu-user-archive-rules
(if gnus-uu-ignore-default-archive-rules
nil
(gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
- (if (= 0 (call-process shell-file-name nil
+ (if (= 0 (call-process shell-file-name nil
(get-buffer-create gnus-uu-output-buffer-name)
nil shell-command-switch command))
(message "")
files))
(defun gnus-uu-unpack-files (files &optional ignore)
- ;; Go through FILES and look for files to unpack.
+ ;; Go through FILES and look for files to unpack.
(let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
(ofiles files)
file did-unpack)
(setq nfiles (cdr nfiles)))
(setq totfiles newfiles)))
(setq files (cdr files)))
- (if did-unpack
+ (if did-unpack
(gnus-uu-unpack-files ofiles (append did-unpack ignore))
ofiles)))
(when (looking-at "\n")
(replace-match ""))
(forward-line 1))))
-
+
(while (not (eobp))
- (if (looking-at (concat gnus-uu-begin-string "\\|"
+ (if (looking-at (concat gnus-uu-begin-string "\\|"
gnus-uu-end-string))
()
(when (not found)
(setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
nil)))
t
- (setq gnus-uu-tmp-dir (file-name-as-directory
+ (setq gnus-uu-tmp-dir (file-name-as-directory
(expand-file-name gnus-uu-tmp-dir)))
(if (not (file-directory-p gnus-uu-tmp-dir))
(error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
(when (not (file-writable-p gnus-uu-tmp-dir))
- (error "Temp directory %s can't be written to"
+ (error "Temp directory %s can't be written to"
gnus-uu-tmp-dir)))
- (setq gnus-uu-work-dir
+ (setq gnus-uu-work-dir
(make-temp-name (concat gnus-uu-tmp-dir "gnus")))
(gnus-make-directory gnus-uu-work-dir)
(set-file-modes gnus-uu-work-dir 448)
"Function used for encoding binary files.
There are three functions supplied with gnus-uu for encoding files:
`gnus-uu-post-encode-uuencode', which does straight uuencoding;
-`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
-headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
+`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
+headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
uuencode and adds MIME headers."
:group 'gnus-extract-post
:type '(radio (function-item gnus-uu-post-encode-uuencode)
"Non-nil means that gnus-uu will post the encoded file in a thread.
This may not be smart, as no other decoder I have seen are able to
follow threads when collecting uuencoded articles. (Well, I have seen
-one package that does that - gnus-uu, but somehow, I don't think that
+one package that does that - gnus-uu, but somehow, I don't think that
counts...) Default is nil."
:group 'gnus-extract-post
:type 'boolean)
(defcustom gnus-uu-post-separate-description t
"Non-nil means that the description will be posted in a separate article.
The first article will typically be numbered (0/x). If this variable
-is nil, the description the user enters will be included at the
-beginning of the first article, which will be numbered (1/x). Default
+is nil, the description the user enters will be included at the
+beginning of the first article, which will be numbered (1/x). Default
is t."
:group 'gnus-extract-post
:type 'boolean)
(local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
-
+
(when gnus-uu-post-include-before-composing
- (save-excursion (setq gnus-uu-post-inserted-file-name
+ (save-excursion (setq gnus-uu-post-inserted-file-name
(gnus-uu-post-insert-binary)))))
(defun gnus-uu-post-insert-binary-in-article ()
"Inserts an encoded file in the buffer.
The user will be asked for a file name."
(interactive)
- (save-excursion
+ (save-excursion
(setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
;; Encodes with uuencode and substitutes all spaces with backticks.
;; Adds MIME headers.
(defun gnus-uu-post-make-mime (file-name encoding)
(goto-char (point-min))
- (insert (format "Content-Type: %s; name=\"%s\"\n"
+ (insert (format "Content-Type: %s; name=\"%s\"\n"
(gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
file-name))
(insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
;; Encodes a file PATH with COMMAND, leaving the result in the
;; current buffer.
(defun gnus-uu-post-encode-file (command path file-name)
- (= 0 (call-process shell-file-name nil t nil shell-command-switch
+ (= 0 (call-process shell-file-name nil t nil shell-command-switch
(format "%s %s %s" command path file-name))))
(defun gnus-uu-post-news-inews ()
(if gnus-uu-post-inserted-file-name
(setq file-name gnus-uu-post-inserted-file-name)
(setq file-name (gnus-uu-post-insert-binary)))
-
+
(if gnus-uu-post-threaded
- (let ((message-required-news-headers
+ (let ((message-required-news-headers
(if (memq 'Message-ID message-required-news-headers)
message-required-news-headers
(cons 'Message-ID message-required-news-headers)))
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
- (setq gnus-uu-post-message-id
- (buffer-substring
+ (setq gnus-uu-post-message-id
+ (buffer-substring
(match-beginning 1) (match-end 1)))
(setq gnus-uu-post-message-id nil))))
gnus-inews-article-hook)
(setq gnus-uu-post-inserted-file-name nil)
(when gnus-uu-winconf-post-news
(set-window-configuration gnus-uu-winconf-post-news)))
-
+
;; Asks for a file to encode, encodes it and inserts the result in
;; the current buffer. Returns the file name the user gave.
(defun gnus-uu-post-insert-binary ()
(let ((uuencode-buffer-name "*uuencode buffer*")
file-path uubuf file-name)
- (setq file-path (read-file-name
+ (setq file-path (read-file-name
"What file do you want to encode? "))
(when (not (file-exists-p file-path))
(error "%s: No such file" file-path))
(goto-char (point-max))
(insert (format "\n%s\n" gnus-uu-post-binary-separator))
-
+
(when (string-match "^~/" file-path)
(setq file-path (concat "$HOME" (substring file-path 1))))
(if (string-match "/[^/]*$" file-path)
(unwind-protect
(if (save-excursion
- (set-buffer (setq uubuf
+ (set-buffer (setq uubuf
(get-buffer-create uuencode-buffer-name)))
(erase-buffer)
(funcall gnus-uu-post-encode-method file-path file-name))
(setq post-buf (current-buffer))
(goto-char (point-min))
- (when (not (re-search-forward
- (if gnus-uu-post-separate-description
+ (when (not (re-search-forward
+ (if gnus-uu-post-separate-description
(concat "^" (regexp-quote gnus-uu-post-binary-separator)
"$")
(concat "^" (regexp-quote mail-header-separator) "$"))
(setq beg-binary (point))
(setq end-binary (point-max))
- (save-excursion
+ (save-excursion
(set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
(erase-buffer)
(insert-buffer-substring post-buf beg-binary end-binary)
(kill-region (point) (point-max))
(goto-char (point-min))
- (re-search-forward
+ (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(beginning-of-line)
(setq header (buffer-substring 1 (point)))
(- 62 (length (format top-string "" file-name i parts ""))))
(when (> 1 (setq minlen (/ whole-len 2)))
(setq minlen 1))
- (setq
- beg-line
+ (setq
+ beg-line
(format top-string
(make-string minlen ?-)
file-name i parts
- (make-string
+ (make-string
(if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
(goto-char (point-min))
(when (or (and (= i 2) gnus-uu-post-separate-description)
(and (= i 1) (not gnus-uu-post-separate-description)))
(replace-match "Subject: Re: "))))
-
+
(goto-char (point-max))
(save-excursion
(set-buffer uubuf)
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(beginning-of-line)
(forward-line 2)
- (when (re-search-forward
+ (when (re-search-forward
(concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
nil t)
(replace-match "")
;;; Commentary:
-;; Major contributors:
+;; Major contributors:
;; Christian Limpach <Christian.Limpach@nice.ch>
-;; Some code stolen from:
+;; Some code stolen from:
;; Rick Sladkey <jrs@world.std.com>
;;; Code:
(insert "\n")
(vm-mode)
tmp-folder))
-
+
(defun gnus-summary-save-article-vm (&optional arg)
"Append the current article to a vm folder.
If N is a positive number, save the N next articles.
(setq folder
(cond ((eq folder 'default) default-name)
(folder folder)
- (t (gnus-read-save-file-name
+ (t (gnus-read-save-file-name
"Save %s in VM folder:" default-name))))
(gnus-make-directory (file-name-directory folder))
(set-buffer gnus-original-article-buffer)
(summary 1.0 point)
(if gnus-carpal '(summary-carpal 4))))
(article
- (cond
- ((and gnus-use-picons
+ (cond
+ ((and gnus-use-picons
(eq gnus-picons-display-where 'picons))
'(frame 1.0
(vertical 1.0
"Kill all frames Gnus has created."
(while gnus-created-frames
(when (frame-live-p (car gnus-created-frames))
- ;; We slap a condition-case around this `delete-frame' to ensure
+ ;; We slap a condition-case around this `delete-frame' to ensure
;; against errors if we try do delete the single frame that's left.
(ignore-errors
(delete-frame (car gnus-created-frames))))
(memq setting '(group summary article)))))
setting
(let* ((elem
- (cond
+ (cond
((eq setting 'group)
(gnus-window-configuration-element
'(group newsgroups ExitNewsgroup)))
;; We want to remove all other windows.
(if (not gnus-frame-split-p)
;; This is not a `frame' split, so we ignore the
- ;; other frames.
+ ;; other frames.
(delete-other-windows)
;; This is a `frame' split, so we delete all windows
;; on all frames.
(when (and (boundp (cdr elem))
(symbol-value (cdr elem)))
(get-buffer (symbol-value (cdr elem))))
- (when (cdr elem)
+ (when (cdr elem)
(get-buffer (cdr elem)))))
gnus-window-to-buffer)))
- (mapcar
+ (mapcar
(lambda (frame)
(unless (eq (cdr (assq 'minibuffer
(frame-parameters frame)))
(if (stringp buffer)
nil
(map-extents (lambda (extent ignored)
- (remove-text-properties
+ (remove-text-properties
start end
(list (extent-property extent 'text-prop) nil)
buffer))
(when gnus-summary-selected-face
(when gnus-newsgroup-selected-overlay
(delete-extent gnus-newsgroup-selected-overlay))
- (setq gnus-newsgroup-selected-overlay
+ (setq gnus-newsgroup-selected-overlay
(make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
(set-extent-face gnus-newsgroup-selected-overlay
gnus-summary-selected-face)))
(map-extents (lambda (extent arg)
(set-extent-property extent 'start-open t))
nil point (min (1+ (point)) (point-max))))
-
+
(defun gnus-xmas-article-push-button (event)
"Check text under the mouse pointer for a callback function.
If the text under the mouse pointer has a `gnus-callback' property,
(when gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to)
'face gnus-article-button-face))
- (gnus-add-text-properties
+ (gnus-add-text-properties
from to
(nconc
(and gnus-article-mouse-face
(window-search t))
(while window-search
(let* ((this-window (next-window))
- (next-bottom-edge (car (cdr (cdr (cdr
- (window-pixel-edges
+ (next-bottom-edge (car (cdr (cdr (cdr
+ (window-pixel-edges
this-window)))))))
(when (< bottom-edge next-bottom-edge)
(setq bottom-edge next-bottom-edge)
(button-press-event-p event)))
(dispatch-event event)
(setq event (next-command-event)))
- (cons (and (key-press-event-p event)
- (event-to-character event))
+ (cons (and (key-press-event-p event)
+ (event-to-character event))
event)))
(defun gnus-xmas-group-remove-excess-properties ()
(let ((end (point))
(beg (progn (forward-line -1) (point))))
(remove-text-properties (1+ beg) end '(gnus-group nil))
- (remove-text-properties
- beg end
+ (remove-text-properties
+ beg end
'(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil))
(goto-char end)
- (map-extents
+ (map-extents
(lambda (e ma)
(set-extent-property e 'start-closed t))
(current-buffer) beg end)))
-
+
(defun gnus-xmas-topic-remove-excess-properties ()
(let ((end (point))
(beg (progn (forward-line -1) (point))))
(aref (timezone-parse-date date) 3))))
(edate (mapcar (lambda (ti) (and ti (string-to-int ti)))
(timezone-parse-date "Jan 1 12:00:00 1970")))
- (tday (- (timezone-absolute-from-gregorian
+ (tday (- (timezone-absolute-from-gregorian
(nth 1 tdate) (nth 2 tdate) (nth 0 tdate))
- (timezone-absolute-from-gregorian
+ (timezone-absolute-from-gregorian
(nth 1 edate) (nth 2 edate) (nth 0 edate)))))
(+ (nth 2 ttime)
(* (nth 1 ttime) 60)
(fset 'gnus-extent-detached-p 'extent-detached-p)
(fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties)
(fset 'gnus-put-text-property 'gnus-xmas-put-text-property)
-
+
(require 'text-props)
(if (and (<= emacs-major-version 19)
(< emacs-minor-version 14))
(defun encode-time (sec minute hour day month year &optional zone)
(let ((seconds
(gnus-xmas-seconds-since-epoch
- (timezone-make-arpa-date
+ (timezone-make-arpa-date
year month day (timezone-make-time-string hour minute sec)
zone))))
(list (floor (/ seconds (expt 2 16)))
(round (mod seconds (expt 2 16)))))))
-
+
(defun gnus-byte-code (func)
"Return a form that can be `eval'ed based on FUNC."
(let ((fval (symbol-function func)))
(list 'funcall fval)
(cons 'progn (cdr (cdr fval))))))
- (fset 'gnus-x-color-values
+ (fset 'gnus-x-color-values
(if (fboundp 'x-color-values)
'x-color-values
(lambda (color)
(fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
(fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
(fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
- (fset 'gnus-appt-select-lowest-window
+ (fset 'gnus-appt-select-lowest-window
'gnus-xmas-appt-select-lowest-window)
(fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
(fset 'gnus-add-hook 'gnus-xmas-add-hook)
'gnus-xmas-mode-line-buffer-identification)
(fset 'gnus-key-press-event-p 'key-press-event-p)
(fset 'gnus-region-active-p 'region-active-p)
-
+
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
(add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)
(setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
(erase-buffer)
(let ((logo (and gnus-xmas-glyph-directory
- (concat
+ (concat
(file-name-as-directory gnus-xmas-glyph-directory)
"gnus."
(if (featurep 'xpm) "xpm" "xbm"))))
- (xpm-color-symbols
+ (xpm-color-symbols
(and (featurep 'xpm)
(append `(("thing" ,(car gnus-xmas-logo-colors))
("shadow" ,(cadr gnus-xmas-logo-colors)))
(insert
(format " %s
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
-
-"
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
+
+"
""))
;; And then hack it.
(gnus-indent-rigidly (point-min) (point-max)
(goto-char (point-min))
(put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
(goto-char (point-min))
- (setq modeline-buffer-identification
+ (setq modeline-buffer-identification
(list (concat gnus-version ": *Group*")))
(set-buffer-modified-p t)))
`default-toolbar', `top-toolbar', `bottom-toolbar',
`right-toolbar', and `left-toolbar'.")
-(defvar gnus-group-toolbar
+(defvar gnus-group-toolbar
'([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"]
- [gnus-group-get-new-news-this-group
+ [gnus-group-get-new-news-this-group
gnus-group-get-new-news-this-group t "Get new news in this group"]
- [gnus-group-catchup-current
+ [gnus-group-catchup-current
gnus-group-catchup-current t "Catchup group"]
- [gnus-group-describe-group
+ [gnus-group-describe-group
gnus-group-describe-group t "Describe group"]
[gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
[gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
)
"The group buffer toolbar.")
-(defvar gnus-summary-toolbar
- '([gnus-summary-prev-unread
+(defvar gnus-summary-toolbar
+ '([gnus-summary-prev-unread
gnus-summary-prev-unread-article t "Prev unread article"]
- [gnus-summary-next-unread
+ [gnus-summary-next-unread
gnus-summary-next-unread-article t "Next unread article"]
- [gnus-summary-post-news
+ [gnus-summary-post-news
gnus-summary-post-news t "Post an article"]
[gnus-summary-followup-with-original
- gnus-summary-followup-with-original t
+ gnus-summary-followup-with-original t
"Post a followup and yank the original"]
- [gnus-summary-followup
+ [gnus-summary-followup
gnus-summary-followup t "Post a followup"]
[gnus-summary-reply-with-original
gnus-summary-reply-with-original t "Mail a reply and yank the original"]
- [gnus-summary-reply
+ [gnus-summary-reply
gnus-summary-reply t "Mail a reply"]
[gnus-summary-caesar-message
gnus-summary-caesar-message t "Rot 13"]
gnus-summary-save-article-file t "Save article in file"]
[gnus-summary-save-article
gnus-summary-save-article t "Save article"]
- [gnus-uu-post-news
+ [gnus-uu-post-news
gnus-uu-post-news t "Post an uuencoded article"]
[gnus-summary-cancel-article
gnus-summary-cancel-article t "Cancel article"]
(defvar gnus-summary-mail-toolbar
'(
- [gnus-summary-prev-unread
+ [gnus-summary-prev-unread
gnus-summary-prev-unread-article t "Prev unread article"]
- [gnus-summary-next-unread
+ [gnus-summary-next-unread
gnus-summary-next-unread-article t "Next unread article"]
[gnus-summary-mail-reply gnus-summary-reply t "Reply"]
; [gnus-summary-mail-get gnus-mail-get t "Message get"]
(let (xface-glyph)
(if (featurep 'xface)
(setq xface-glyph
- (make-glyph (vector 'xface :data
+ (make-glyph (vector 'xface :data
(concat "X-Face: "
(buffer-substring beg end)))))
(let ((cur (current-buffer)))
(set-glyph-face xface-glyph 'gnus-x-face)
(goto-char (point-min))
(re-search-forward "^From:" nil t)
- (set-extent-begin-glyph
+ (set-extent-begin-glyph
(make-extent (point) (1+ (point))) xface-glyph))))
-(defvar gnus-xmas-pointer-glyph
+(defvar gnus-xmas-pointer-glyph
(progn
(setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus"))
(make-pointer-glyph (concat gnus-xmas-glyph-directory "gnus-pointer."
(if (featurep 'xpm) "xpm" "xbm")))))
-(defvar gnus-xmas-modeline-left-extent
+(defvar gnus-xmas-modeline-left-extent
(let ((ext (copy-extent modeline-buffer-id-left-extent)))
;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
ext))
-
-(defvar gnus-xmas-modeline-right-extent
+
+(defvar gnus-xmas-modeline-right-extent
(let ((ext (copy-extent modeline-buffer-id-right-extent)))
;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
ext))
;; We have a standard line, so we colorize and glyphize it a bit.
(t
(setq chop (match-end 0))
- (list
+ (list
(if gnus-xmas-modeline-glyph
(cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph)
(cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.21"
+(defconst gnus-version-number "5.4.22"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
-(defface gnus-group-news-1-face
+(defface gnus-group-news-1-face
'((((class color)
(background dark))
(:foreground "PaleTurquoise" :bold t))
()))
"Level 1 empty newsgroup face.")
-(defface gnus-group-news-2-face
+(defface gnus-group-news-2-face
'((((class color)
(background dark))
(:foreground "turquoise" :bold t))
()))
"Level 2 empty newsgroup face.")
-(defface gnus-group-news-3-face
+(defface gnus-group-news-3-face
'((((class color)
(background dark))
(:bold t))
()))
"Level 3 empty newsgroup face.")
-(defface gnus-group-news-low-face
+(defface gnus-group-news-low-face
'((((class color)
(background dark))
(:foreground "DarkTurquoise" :bold t))
()))
"Low level empty newsgroup face.")
-(defface gnus-group-mail-1-face
+(defface gnus-group-mail-1-face
'((((class color)
(background dark))
(:foreground "aquamarine1" :bold t))
(:italic t :bold t)))
"Level 1 empty mailgroup face.")
-(defface gnus-group-mail-2-face
+(defface gnus-group-mail-2-face
'((((class color)
(background dark))
(:foreground "aquamarine2" :bold t))
(:bold t)))
"Level 2 empty mailgroup face.")
-(defface gnus-group-mail-3-face
+(defface gnus-group-mail-3-face
'((((class color)
(background dark))
(:foreground "aquamarine3" :bold t))
()))
"Level 3 empty mailgroup face.")
-(defface gnus-group-mail-low-face
+(defface gnus-group-mail-low-face
'((((class color)
(background dark))
(:foreground "aquamarine4" :bold t))
;; Summary mode faces.
-(defface gnus-summary-selected-face '((t
+(defface gnus-summary-selected-face '((t
(:underline t)))
"Face used for selected articles.")
-(defface gnus-summary-cancelled-face
+(defface gnus-summary-cancelled-face
'((((class color))
(:foreground "yellow" :background "black")))
"Face used for cancelled articles.")
(((class color)
(background light))
(:foreground "firebrick" :bold t))
- (t
+ (t
(:bold t)))
"Face used for high interest ticked articles.")
(((class color)
(background light))
(:foreground "firebrick" :italic t))
- (t
+ (t
(:italic t)))
"Face used for low interest ticked articles.")
(((class color)
(background light))
(:foreground "firebrick"))
- (t
+ (t
()))
"Face used for normal interest ticked articles.")
-
+
(defface gnus-summary-high-ancient-face
'((((class color)
(background dark))
(((class color)
(background light))
(:foreground "RoyalBlue" :bold t))
- (t
+ (t
(:bold t)))
"Face used for high interest ancient articles.")
(((class color)
(background light))
(:foreground "RoyalBlue" :italic t))
- (t
+ (t
(:italic t)))
"Face used for low interest ancient articles.")
(((class color)
(background light))
(:foreground "RoyalBlue"))
- (t
+ (t
()))
"Face used for normal interest ancient articles.")
-
+
(defface gnus-summary-high-unread-face
- '((t
+ '((t
(:bold t)))
"Face used for high interest unread articles.")
(defface gnus-summary-low-unread-face
- '((t
+ '((t
(:italic t)))
"Face used for low interest unread articles.")
(defface gnus-summary-normal-unread-face
- '((t
+ '((t
()))
"Face used for normal interest unread articles.")
-
+
(defface gnus-summary-high-read-face
'((((class color)
(background dark))
(background light))
(:foreground "DarkGreen"
:bold t))
- (t
+ (t
(:bold t)))
"Face used for high interest read articles.")
(background light))
(:foreground "DarkGreen"
:italic t))
- (t
+ (t
(:italic t)))
"Face used for low interest read articles.")
(((class color)
(background light))
(:foreground "DarkGreen"))
- (t
+ (t
()))
"Face used for normal interest read articles.")
(eval-and-compile
(autoload 'gnus-play-jingle "gnus-audio"))
-(defface gnus-splash-face
+(defface gnus-splash-face
'((((class color)
(background dark))
(:foreground "red"))
:group 'gnus-server
:type 'gnus-select-method)
-(defcustom gnus-message-archive-method
+(defcustom gnus-message-archive-method
`(nnfolder
"archive"
(nnfolder-directory ,(nnheader-concat message-directory "archive"))
- (nnfolder-active-file
+ (nnfolder-active-file
,(nnheader-concat message-directory "archive/active"))
(nnfolder-get-new-mail nil)
(nnfolder-inhibit-expiry t))
If you want to save your mail in one group and the news articles you
write in another group, you could say something like:
- \(setq gnus-message-archive-group
+ \(setq gnus-message-archive-group
'((if (message-news-p)
- \"misc-news\"
+ \"misc-news\"
\"misc-mail\")))
Normally the group names returned by this variable should be
:group 'gnus-meta
:type '(choice (const :tag "off" nil)
integer
- (sexp :format "all"
+ (sexp :format "all"
:value t)))
(defcustom gnus-use-nocem nil
:group 'gnus-meta
:type 'boolean)
-(defcustom gnus-summary-prepare-exit-hook
+(defcustom gnus-summary-prepare-exit-hook
'(gnus-summary-expire-articles)
"A hook called when preparing to exit from the summary buffer.
It calls `gnus-summary-expire-articles' by default."
(string :tag "Address")
(editable-list :inline t
(list :format "%v"
- variable
+ variable
(sexp :tag "Value")))))
(defcustom gnus-updated-mode-lines '(group article summary tree)
;;; Face thingies.
-(defcustom gnus-visual
- '(summary-highlight group-highlight article-highlight
+(defcustom gnus-visual
+ '(summary-highlight group-highlight article-highlight
mouse-face
summary-menu group-menu article-menu
tree-highlight menu highlight
("gnus-picon" :interactive t gnus-article-display-picons
gnus-group-display-picons gnus-picons-article-display-x-face
gnus-picons-display-x-face)
- ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
+ ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
gnus-grouplens-mode)
("smiley" :interactive t gnus-smiley-display)
("gnus-win" gnus-configure-windows gnus-add-configuration)
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
- gnus-article-show-all-headers
+ gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522)
("gnus-int" gnus-request-type)
(defun gnus-suppress-keymap (keymap)
(suppress-keymap keymap)
- (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
(while keys
(define-key keymap (pop keys) 'undefined))))
(let ((keymap (make-keymap)))
(gnus-suppress-keymap keymap)
keymap))
-(defvar gnus-summary-mode-map
+(defvar gnus-summary-mode-map
(let ((keymap (make-keymap)))
(gnus-suppress-keymap keymap)
keymap))
(string-to-number
(if (zerop major)
(format "%s00%02d%02d"
- (cond
+ (cond
((member alpha '("(ding)" "d")) "4.99")
((member alpha '("September" "s")) "5.01")
((member alpha '("Red" "r")) "5.03"))
(let ((method-name (symbol-name (car method))))
(if (and (memq 'address (assoc method-name gnus-valid-select-methods))
(not (assq (intern (concat method-name "-address")) method))
- (memq 'physical-address (assq (car method)
+ (memq 'physical-address (assq (car method)
gnus-valid-select-methods)))
(append method (list (list (intern (concat method-name "-address"))
(nth 1 method))))
(defun gnus-server-to-method (server)
"Map virtual server names to select methods."
- (or
+ (or
;; Is this a method, perhaps?
(and server (listp server) server)
;; Perhaps this is the native server?
(defun gnus-archive-server-wanted-p ()
"Say whether the user wants to use the archive server."
- (cond
+ (cond
((or (not gnus-message-archive-method)
(not gnus-message-archive-group))
nil)
(defun gnus-newsgroup-kill-file (newsgroup)
"Return the name of a kill file name for NEWSGROUP.
If NEWSGROUP is nil, return the global kill file name instead."
- (cond
+ (cond
;; The global KILL file is placed at top of the directory.
((or (null newsgroup)
(string-equal newsgroup ""))
prompt (append gnus-valid-select-methods gnus-predefined-server-alist
gnus-server-alist)
nil t nil 'gnus-method-history)))
- (cond
+ (cond
((equal method "")
(setq method gnus-select-method))
((assoc method gnus-valid-select-methods)
(defvar byte-compile-default-warnings)
(defun maybe-fbind (args)
- (while args
+ (while args
(or (fboundp (car args))
(fset (car args) 'ignore))
(setq args (cdr args))))
(mapcar (lambda (var) (unless (boundp var) (set var nil))) args))
(if (string-match "XEmacs" emacs-version)
- (progn
+ (progn
(defvar track-mouse nil)
(maybe-fbind '(posn-point
event-start x-popup-menu
make-char-table set-char-table-range font-create-object
x-color-values widget-make-intangible error-message-string
w3-form-encode-xwfu
- ))
+ ))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
font-lock-defaults user-full-name user-login-name
- gnus-newsgroup-name gnus-article-x-face-too-ugly))
- ;; XEmacs thinks writting compatible code is obsolete.
- (require 'bytecomp)
- (setq byte-compile-default-warnings
- (delq 'obsolete byte-compile-default-warnings)))
+ gnus-newsgroup-name gnus-article-x-face-too-ugly)))
(defvar browse-url-browser-function nil)
(maybe-fbind '(color-instance-rgb-components
make-color-instance color-instance-name specifier-instance
(> (skip-chars-forward "^\0- :") 0)
(= (following-char) ?:)
(setq end (point))
- (progn (forward-char)
+ (progn (forward-char)
(> (skip-chars-forward " \t") 0)))
(let ((header (intern (downcase (buffer-substring start end))))
(value (list (buffer-substring
:group 'message-news)
(defcustom message-required-news-headers
- '(From Newsgroups Subject Date Message-ID
- (optional . Organization) Lines
+ '(From Newsgroups Subject Date Message-ID
+ (optional . Organization) Lines
(optional . X-Newsreader))
"Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
:group 'message-headers
:type '(repeat sexp))
-(defcustom message-required-mail-headers
+(defcustom message-required-mail-headers
'(From Subject Date (optional . In-Reply-To) Message-ID Lines
(optional . X-Mailer))
"Headers to be generated or prompted for when mailing a message.
:group 'message-headers
:type 'sexp)
-(defcustom message-ignored-news-headers
+(defcustom message-ignored-news-headers
"^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
(defcustom message-elide-elipsis "\n[...]\n\n"
"*The string which is inserted for elided text.")
-(defcustom message-interactive nil
+(defcustom message-interactive nil
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors."
:group 'message-sending
:type 'boolean)
(defvar gnus-local-organization)
-(defcustom message-user-organization
+(defcustom message-user-organization
(or (and (boundp 'gnus-local-organization)
(stringp gnus-local-organization)
gnus-local-organization)
:group 'message-buffers
:type 'directory)
-(defcustom message-forward-start-separator
+(defcustom message-forward-start-separator
"------- Start of forwarded message -------\n"
"*Delimiter inserted before forwarded messages."
:group 'message-forwarding
:group 'message-forwarding
:type 'boolean)
-(defcustom message-included-forward-headers
+(defcustom message-included-forward-headers
"^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:"
"*Regexp matching headers to be included in forwarded messages."
:group 'message-forwarding
(defvar gnus-post-method)
(defvar gnus-select-method)
-(defcustom message-post-method
+(defcustom message-post-method
(cond ((and (boundp 'gnus-post-method)
gnus-post-method)
gnus-post-method)
(defcustom message-signature-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
-It is run after the headers have been inserted and before
+It is run after the headers have been inserted and before
the signature is inserted."
:group 'message-various
:type 'hook)
;; Note: could use /usr/ucb/mail instead of sendmail;
;; options -t, and -v if not interactive.
(defcustom message-mailer-swallows-blank-line
- (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
+ (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
system-configuration)
(file-readable-p "/etc/sendmail.cf")
(let ((buffer (get-buffer-create " *temp*")))
(ignore-errors
(define-mail-user-agent 'message-user-agent
- 'message-mail 'message-send-and-exit
+ 'message-mail 'message-send-and-exit
'message-kill-buffer 'message-send-hook))
(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
;;; Internal variables.
;;; Well, not really internal.
-(defvar message-mode-syntax-table
+(defvar message-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?% ". " table)
table)
:link '(custom-manual "(message)Variables")
:group 'message)
-(defface message-header-to-face
+(defface message-header-to-face
'((((class color)
(background dark))
- (:foreground "light blue" :bold t :italic t))
+ (:foreground "green2" :italic t))
(((class color)
(background light))
- (:foreground "MidnightBlue" :bold t :italic t))
- (t
+ (:foreground "MidnightBlue" :bold t))
+ (t
(:bold t :italic t)))
- "Face used for displaying from headers."
+ "Face used for displaying From headers."
:group 'message-headers)
-(defface message-header-subject-face
+(defface message-header-cc-face
'((((class color)
(background dark))
- (:foreground "pink" :bold t :italic t))
+ (:foreground "green4" :bold t))
(((class color)
(background light))
- (:foreground "firebrick" :bold t :italic t))
- (t
- (:bold t :italic t)))
+ (:foreground "blue4"))
+ (t
+ (:bold t)))
+ "Face used for displaying Cc headers."
+ :group 'message-headers)
+
+(defface message-header-subject-face
+ '((((class color)
+ (background dark))
+ (:foreground "green3"))
+ (((class color)
+ (background light))
+ (:foreground "firebrick" :bold t))
+ (t
+ (:bold t)))
"Face used for displaying subject headers."
:group 'message-headers)
-(defface message-header-newsgroups-face
+(defface message-header-newsgroups-face
'((((class color)
(background dark))
(:foreground "yellow" :bold t :italic t))
(((class color)
(background light))
(:foreground "indianred" :bold t :italic t))
- (t
+ (t
+ (:bold t :italic t)))
+ "Face used for displaying newsgroups headers."
+ :group 'message-headers)
+
+(defface message-header-other-face
+ '((((class color)
+ (background dark))
+ (:foreground "red4"))
+ (((class color)
+ (background light))
+ (:foreground "red3"))
+ (t
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-headers)
-(defface message-header-name-face
+(defface message-header-name-face
'((((class color)
(background dark))
- (:foreground "cyan" :bold t))
+ (:foreground "DarkGreen"))
(((class color)
(background light))
- (:foreground "DarkGreen" :bold t))
- (t
+ (:foreground "red4"))
+ (t
(:bold t)))
"Face used for displaying header names."
:group 'message-headers)
-(defface message-header-xheader-face
+(defface message-header-xheader-face
'((((class color)
(background dark))
- (:foreground "blue" :bold t))
+ (:foreground "blue"))
(((class color)
(background light))
- (:foreground "blue" :bold t))
- (t
+ (:foreground "blue"))
+ (t
(:bold t)))
"Face used for displaying X-Header headers."
:group 'message-headers)
-(defface message-separator-face
+(defface message-separator-face
'((((class color)
(background dark))
- (:foreground "red" :bold t))
+ (:foreground "blue4"))
(((class color)
(background light))
- (:foreground "brown" :bold t))
- (t
+ (:foreground "brown"))
+ (t
(:bold t)))
"Face used for displaying the separator."
:group 'message-headers)
-(defface message-cited-text-face
+(defface message-cited-text-face
'((((class color)
(background dark))
- (:foreground "LightBlue" :bold t))
+ (:foreground "red"))
(((class color)
(background light))
- (:foreground "DarkGreen" :bold t))
- (t
+ (:foreground "DarkGreen"))
+ (t
(:bold t)))
"Face used for displaying cited text names."
:group 'message-headers)
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-")))
- (list '("^To:" . message-header-to-face)
- '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
+ (list '("^\\(To:\\)[ \t]*\\(.+\\)?"
+ (1 'message-header-name-face)
+ (2 'message-header-to-face nil t))
+ '("^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)[ \t]*\\(.+\\)?"
+ (1 'message-header-name-face)
+ (2 'message-header-cc-face nil t))
'("^\\(Subject:\\)[ \t]*\\(.+\\)?"
- (1 message-header-name-face) (2 message-header-subject-face nil t))
+ (1 'message-header-name-face)
+ (2 'message-header-subject-face nil t))
'("^\\(Newsgroups:\\|Followup-to:\\)[ \t]*\\(.+\\)?"
- (1 message-header-name-face)
- (2 message-header-newsgroups-face nil t))
+ (1 'message-header-name-face)
+ (2 'message-header-newsgroups-face nil t))
+ '("^\\([^: \n\t]+:\\)[ \t]*\\(.+\\)?"
+ (1 'message-header-name-face)
+ (2 'message-header-other-face nil t))
(list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
- 1 'message-separator-face)
- (cons (concat "^[ \t]*"
- "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
- "[>|}].*")
- 'message-cited-text-face)
+ 1 '(quote message-separator-face))
+ `(,(concat "^[ \t]*"
+ "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
+ "[>|}].*")
+ (0 'message-cited-text-face))
'("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*"
- . message-header-xheader-face)))
+ (0 'message-header-xheader-face))))
"Additional expressions to highlight in Message mode.")
(defvar message-face-alist
'((bold . bold-region)
(underline . underline-region)
- (default . (lambda (b e)
+ (default . (lambda (b e)
(unbold-region b e)
(ununderline-region b e))))
"Alist of mail and news faces for facemenu.
(defvar gnus-read-active-file)
;;; Regexp matching the delimiter of messages in UNIX mail format
-;;; (UNIX From lines), minus the initial ^.
+;;; (UNIX From lines), minus the initial ^.
(defvar message-unix-mail-delimiter
(let ((time-zone-regexp
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
"^|? *---+ +Message text follows: +---+ *|?$")
"A regexp that matches the separator before the text of a failed message.")
-(defvar message-header-format-alist
+(defvar message-header-format-alist
`((Newsgroups)
- (To . message-fill-address)
+ (To . message-fill-address)
(Cc . message-fill-address)
(Subject)
(In-Reply-To)
\f
-;;;
+;;;
;;; Utility functions.
;;;
(not (if (re-search-forward "^[^ \t]" nil t)
(beginning-of-line)
(goto-char (point-max)))))
-
+
(defun message-sort-headers-1 ()
"Sort the buffer as headers using `message-rank' text props."
(goto-char (point-min))
- (sort-subr
- nil 'message-next-header
+ (sort-subr
+ nil 'message-next-header
(lambda ()
(message-next-header)
(unless (bobp)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
-
+
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\t" 'message-tab))
-(easy-menu-define
+(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
'("Message"
["Sort Headers" message-sort-headers t]
["Send Message" message-send-and-exit t]
["Abort Message" message-dont-send t]))
-(easy-menu-define
+(easy-menu-define
message-mode-field-menu message-mode-map ""
'("Field"
["Fetch To" message-insert-to t]
"Insert a To header that points to the author of the article being replied to."
(interactive)
(let ((co (message-fetch-field "courtesy-copies-to")))
- (when (and co
+ (when (and co
(equal (downcase co) "never"))
(error "The user has requested not to have copies sent via mail")))
(when (and (message-position-on-field "To")
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
(interactive (list 0))
- (let* ((signature
+ (let* ((signature
(cond
((and (null message-signature)
(eq force 0))
(/= (aref message-caesar-translation-table ?a) (+ ?a n)))
(setq message-caesar-translation-table
(message-make-caesar-translation-table n)))
- ;; Then we translate the region. Do it this way to retain
+ ;; Then we translate the region. Do it this way to retain
;; text properties.
(while (< b e)
- (subst-char-in-region
+ (subst-char-in-region
b (1+ b) (char-after b)
(aref message-caesar-translation-table (char-after b)))
(incf b))))
(defun message-make-caesar-translation-table (n)
"Create a rot table with offset N."
- (let ((i -1)
+ (let ((i -1)
(table (make-string 256 0)))
(while (< (incf i) 256)
(aset table i i))
(message "%s failed." program))))))
(defun message-rename-buffer (&optional enter-string)
- "Rename the *message* buffer to \"*message* RECIPIENT\".
+ "Rename the *message* buffer to \"*message* RECIPIENT\".
If the function is run with a prefix, it will ask for a new buffer
name, rather than giving an automatic name."
(interactive "Pbuffer name: ")
(save-excursion
(save-restriction
(goto-char (point-min))
- (narrow-to-region (point)
+ (narrow-to-region (point)
(search-forward mail-header-separator nil 'end))
(let* ((mail-to (or
(if (message-news-p) (message-fetch-field "Newsgroups")
;; Remove unwanted headers.
(when message-ignored-cited-headers
(save-restriction
- (narrow-to-region
+ (narrow-to-region
(goto-char start)
(if (search-forward "\n\n" nil t)
(1- (point))
(defun message-cite-original ()
"Cite function in the standard Message manner."
(let ((start (point))
- (functions
+ (functions
(when message-indent-citation-function
(if (listp message-indent-citation-function)
message-indent-citation-function
(narrow-to-region
(goto-char (point-min))
(progn
- (re-search-forward
+ (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(match-beginning 0)))
(goto-char (point-min))
(skip-chars-backward "\n")
t)
(while (and afters
- (not (re-search-forward
+ (not (re-search-forward
(concat "^" (regexp-quote (car afters)) ":")
nil t)))
(pop afters))
;; Now perform actions on successful sending.
(while actions
(ignore-errors
- (cond
+ (cond
;; A simple function.
((message-functionp (car actions))
(funcall (car actions)))
(set-buffer tembuf)
(erase-buffer)
;; Avoid copying text props.
- (insert (format
+ (insert (format
"%s" (save-excursion
(set-buffer mailbuf)
(buffer-string))))
;;
;; qmail also has the advantage of not having been raped by
;; various vendors, so we don't have to allow for that, either --
- ;; compare this with message-send-mail-with-sendmail and weep
+ ;; compare this with message-send-mail-with-sendmail and weep
;; for sendmail's lost innocence.
;;
;; all this is way cool coz it lets us keep the arguments entirely
"Send the prepared message buffer with mh."
(let ((mh-previous-window-config nil)
(name (make-temp-name
- (concat (file-name-as-directory
+ (concat (file-name-as-directory
(expand-file-name message-autosave-directory))
"msg."))))
(setq buffer-file-name name)
(when message-mh-deletable-headers
(let ((headers message-mh-deletable-headers))
(while headers
- (goto-char (point-min))
- (and (re-search-forward
+ (goto-char (point-min))
+ (and (re-search-forward
(concat "^" (symbol-name (car headers)) ": *") nil t)
(message-delete-line))
(pop headers))))
(save-excursion
(set-buffer tembuf)
(buffer-disable-undo (current-buffer))
- (erase-buffer)
+ (erase-buffer)
;; Avoid copying text props.
- (insert (format
+ (insert (format
"%s" (save-excursion
(set-buffer messbuf)
(buffer-string))))
(save-excursion
(save-restriction
(widen)
- (and
+ (and
;; We narrow to the headers and check them first.
(save-excursion
(save-restriction
(message-check-news-body-syntax)))))
(defun message-check-news-header-syntax ()
- (and
+ (and
;; Check for commands in Subject.
(message-check 'subject-cmsg
(if (string-match "^cmsg " (message-fetch-field "subject"))
;; Check for multiple identical headers.
(message-check 'multiple-headers
(let (found)
- (while (and (not found)
+ (while (and (not found)
(re-search-forward "^[^ \t:]+: " nil t))
(save-excursion
- (or (re-search-forward
- (concat "^"
+ (or (re-search-forward
+ (concat "^"
(regexp-quote
(setq found
(buffer-substring
(if (re-search-forward "^Sendsys:\\|^Version:" nil t)
(y-or-n-p
(format "The article contains a %s command. Really post? "
- (buffer-substring (match-beginning 0)
+ (buffer-substring (match-beginning 0)
(1- (match-end 0)))))
t))
;; See whether we can shorten Followup-To.
(not
(zerop
(length
- (setq to (completing-read
- "Followups to: (default all groups) "
+ (setq to (completing-read
+ "Followups to: (default all groups) "
(mapcar (lambda (g) (list g))
- (cons "poster"
- (message-tokenize-header
+ (cons "poster"
+ (message-tokenize-header
newsgroups)))))))))
(goto-char (point-min))
(insert "Followup-To: " to "\n"))
(and subject
(not (string-match "\\`[ \t]*\\'" subject)))
(ignore
- (message
+ (message
"The subject field is empty or missing. Posting is denied.")))))
;; Check the Newsgroups & Followup-To headers.
(message-check 'existing-newsgroups
(while (and headers (not error))
(when (setq header (mail-fetch-field (car headers)))
(if (or
- (not
+ (not
(string-match
"\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
header))
- (memq
- nil (mapcar
+ (memq
+ nil (mapcar
(lambda (g)
(not (string-match "\\.\\'\\|\\.\\." g)))
(message-tokenize-header header ","))))
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
- (y-or-n-p
+ (y-or-n-p
"The article contains control characters. Really post? ")
t))
;; Check excessive size.
(rmail-output file 1 nil t)
(let ((mail-use-rfc822 t))
(rmail-output file 1 t t))))))
-
+
(kill-buffer (current-buffer)))))
(defun message-output (filename)
(defun message-make-date ()
"Make a valid data header."
(let ((now (current-time)))
- (timezone-make-date-arpa-standard
+ (timezone-make-date-arpa-standard
(current-time-string now) (current-time-zone now))))
(defun message-make-message-id ()
"Make a unique Message-ID."
- (concat "<" (message-unique-id)
+ (concat "<" (message-unique-id)
(let ((psubject (save-excursion (message-fetch-field "subject"))))
(if (and message-reply-headers
(mail-header-references message-reply-headers)
(mail-header-subject message-reply-headers)
psubject
(mail-header-subject message-reply-headers)
- (not (string=
+ (not (string=
(message-strip-subject-re
(mail-header-subject message-reply-headers))
(message-strip-subject-re psubject))))
(aset user (match-beginning 0) ?_))
user)
(message-number-base36 (user-uid) -1))
- (message-number-base36 (+ (car tm)
+ (message-number-base36 (+ (car tm)
(lsh (% message-unique-id-char 25) 16)) 4)
(message-number-base36 (+ (nth 1 tm)
(lsh (/ message-unique-id-char 25) 16)) 4)
(defun message-make-organization ()
"Make an Organization header."
- (let* ((organization
+ (let* ((organization
(or (getenv "ORGANIZATION")
(when message-user-organization
(if (message-functionp message-user-organization)
(save-restriction
(widen)
(goto-char (point-min))
- (re-search-forward
+ (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(int-to-string (count-lines (point) (point-max))))))
(let ((from (mail-header-from message-reply-headers))
(date (mail-header-date message-reply-headers)))
(when from
- (let ((stop-pos
+ (let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
(concat (if stop-pos (substring from 0 stop-pos) from)
- "'s message of "
+ "'s message of "
(if (or (not date) (string= date ""))
"(unknown date)" date)))))))
(setcar current (+ (car current) (round (/ future (expt 2 16)))))
(setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
;; Return the date in the future in UT.
- (timezone-make-date-arpa-standard
+ (timezone-make-date-arpa-standard
(current-time-string current) (current-time-zone current) '(0 "UT"))))
(defun message-make-path ()
(defun message-make-from ()
"Make a From header."
(let* ((login (message-make-address))
- (fullname
+ (fullname
(or (and (boundp 'user-full-name)
user-full-name)
(user-full-name))))
(setq fullname (user-login-name)))
(save-excursion
(message-set-work-buffer)
- (cond
+ (cond
((or (null message-from-style)
(equal fullname ""))
(insert login))
;; ... then undo escaping of matching parentheses,
;; including matching nested parentheses.
(goto-char fullname-start)
- (while (re-search-forward
+ (while (re-search-forward
"\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
nil 1)
(replace-match "\\1(\\3)" t)
(defun message-make-sender ()
"Return the \"real\" user address.
-This function tries to ignore all user modifications, and
+This function tries to ignore all user modifications, and
give as trustworthy answer as possible."
(concat (user-login-name) "@" (system-name)))
"Return user's fully qualified domain name."
(let ((system-name (system-name))
(user-mail (message-user-mail-address)))
- (cond
+ (cond
((string-match "[^.]\\.[^.]" system-name)
;; `system-name' returned the right result.
system-name)
(let ((headers message-deletable-headers))
(while headers
(goto-char (point-min))
- (and (re-search-forward
+ (and (re-search-forward
(concat "^" (symbol-name (car headers)) ": *") nil t)
(get-text-property (1+ (match-beginning 0)) 'message-deletable)
(message-delete-line))
;; Go through all the required headers and see if they are in the
;; articles already. If they are not, or are empty, they are
;; inserted automatically - except for Subject, Newsgroups and
- ;; Distribution.
+ ;; Distribution.
(while headers
(goto-char (point-min))
(setq elem (pop headers))
(setq header (cdr elem))
(setq header (car elem)))
(setq header elem))
- (when (or (not (re-search-forward
- (concat "^" (downcase (symbol-name header)) ":")
+ (when (or (not (re-search-forward
+ (concat "^" (downcase (symbol-name header)) ":")
nil t))
(progn
;; The header was found. We insert a space after the
(looking-at "[ \t]*$")))
;; So we find out what value we should insert.
(setq value
- (cond
+ (cond
((and (consp elem) (eq (car elem) 'optional))
;; This is an optional header. If the cdr of this
;; is something that is nil, then we do not insert
(read-from-minibuffer
(format "Empty header for %s; enter value: " header)))))
;; Finally insert the header.
- (when (and value
+ (when (and value
(not (equal value "")))
(save-excursion
(if (bolp)
;; Add the deletable property to the headers that require it.
(and (memq header message-deletable-headers)
(progn (beginning-of-line) (looking-at "[^:]+: "))
- (add-text-properties
+ (add-text-properties
(point) (match-end 0)
'(message-deletable t face italic) (current-buffer)))))))
- ;; Insert new Sender if the From is strange.
+ ;; Insert new Sender if the From is strange.
(let ((from (message-fetch-field "from"))
(sender (message-fetch-field "sender"))
(secure-sender (message-make-sender)))
- (when (and from
+ (when (and from
(not (message-check-element 'sender))
(not (string=
(downcase
(cadr (mail-extract-address-components from)))
(downcase secure-sender)))
(or (null sender)
- (not
+ (not
(string=
(downcase
(cadr (mail-extract-address-components sender)))
(downcase secure-sender)))))
- (goto-char (point-min))
+ (goto-char (point-min))
;; Rename any old Sender headers to Original-Sender.
(when (re-search-forward "^\\(Original-\\)*Sender:" nil t)
(beginning-of-line)
(insert (format message-courtesy-message newsgroups)))
(t
(insert message-courtesy-message)))))))
-
+
;;;
;;; Setting up a message buffer
;;;
(defun message-position-point ()
"Move point to where the user probably wants to find it."
(message-narrow-to-headers)
- (cond
+ (cond
((re-search-forward "^[^:]+:[ \t]*$" nil t)
(search-backward ":" )
(widen)
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(cond
- ;; Check whether `message-generate-new-buffers' is a function,
+ ;; Check whether `message-generate-new-buffers' is a function,
;; and if so, call it.
((message-functionp message-generate-new-buffers)
(funcall message-generate-new-buffers type to group))
(if message-send-rename-function
(funcall message-send-rename-function)
(when (string-match "\\`\\*" (buffer-name))
- (rename-buffer
+ (rename-buffer
(concat "*sent " (substring (buffer-name) (match-end 0))) t)))
;; Push the current buffer onto the list.
(when message-max-buffers
- (setq message-buffer-list
+ (setq message-buffer-list
(nconc message-buffer-list (list (current-buffer))))))
(defvar mc-modes-alist)
(setq message-reply-buffer replybuffer)
(goto-char (point-min))
;; Insert all the headers.
- (mail-header-format
+ (mail-header-format
(let ((h headers)
(alist message-header-format-alist))
(while h
(interactive)
(let ((message-this-is-mail t))
(message-pop-to-buffer (message-buffer-name "mail" to))
- (message-setup
+ (message-setup
(nconc
`((To . ,(or to "")) (Subject . ,(or subject "")))
(when other-headers other-headers)))))
(interactive)
(let ((message-this-is-news t))
(message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
- (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
;;;###autoload
(interactive)
(let ((cur (current-buffer))
from subject date reply-to to cc
- references message-id follow-to
+ references message-id follow-to
(inhibit-point-motion-hooks t)
mct never-mct gnus-warning)
(save-restriction
(funcall message-wide-reply-to-function)))))
;; Find all relevant headers we need.
(setq from (message-fetch-field "from")
- date (message-fetch-field "date")
+ date (message-fetch-field "date")
subject (or (message-fetch-field "subject") "none")
to (message-fetch-field "to")
cc (message-fetch-field "cc")
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(string-match "<[^>]+>" gnus-warning))
(setq message-id (match-string 0 gnus-warning)))
-
+
;; Handle special values of Mail-Copies-To.
(when mct
(cond ((equal (downcase mct) "never")
(insert (if (bolp) "" ", ") (or to ""))
(insert (if mct (concat (if (bolp) "" ", ") mct) ""))
(insert (if cc (concat (if (bolp) "" ", ") cc) ""))
- ;; Remove addresses that match `rmail-dont-reply-to-names'.
+ ;; Remove addresses that match `rmail-dont-reply-to-names'.
(insert (prog1 (rmail-dont-reply-to (buffer-string))
(erase-buffer)))
(goto-char (point-min))
(setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
(setq follow-to (list (cons 'To (cdr (pop ccalist)))))
(when ccalist
- (let ((ccs (cons 'Cc (mapconcat
+ (let ((ccs (cons 'Cc (mapconcat
(lambda (addr) (cdr addr)) ccalist ", "))))
(when (string-match "^ +" (cdr ccs))
(setcdr ccs (substring (cdr ccs) (match-end 0))))
(message-setup
`((Subject . ,subject)
- ,@follow-to
+ ,@follow-to
,@(if (or references message-id)
`((References . ,(concat (or references "") (and references " ")
(or message-id ""))))
(interactive)
(let ((cur (current-buffer))
from subject date reply-to mct
- references message-id follow-to
+ references message-id follow-to
(inhibit-point-motion-hooks t)
(message-this-is-news t)
followup-to distribution newsgroups gnus-warning posted-to)
(setq follow-to
(funcall message-followup-to-function)))
(setq from (message-fetch-field "from")
- date (message-fetch-field "date")
+ date (message-fetch-field "date")
subject (or (message-fetch-field "subject") "none")
references (message-fetch-field "references")
message-id (message-fetch-field "message-id" t)
(message-setup
`((Subject . ,subject)
- ,@(cond
+ ,@(cond
(to-newsgroups
(list (cons 'Newsgroups to-newsgroups)))
(follow-to follow-to)
((and followup-to message-use-followup-to)
(list
- (cond
+ (cond
((equal (downcase followup-to) "poster")
(if (or (eq message-use-followup-to 'use)
(message-y-or-n-p "Obey Followup-To: poster? " t "\
header line with the old Message-ID."
(interactive)
(let ((cur (current-buffer)))
- ;; Check whether the user owns the article that is to be superseded.
+ ;; Check whether the user owns the article that is to be superseded.
(unless (string-equal
(downcase (cadr (mail-extract-address-components
(message-fetch-field "from"))))
(save-restriction
(current-buffer)
(message-narrow-to-head)
- (concat "[" (or (message-fetch-field
+ (concat "[" (or (message-fetch-field
(if (message-news-p) "newsgroups" "from"))
"(nowhere)")
"] " (or (message-fetch-field "Subject") "")))))
;;;###autoload
(defun message-forward (&optional news)
- "Forward the current message via mail.
+ "Forward the current message via mail.
Optional NEWS will use news to forward instead of mail."
(interactive "P")
(let ((cur (current-buffer))
art-beg)
(if news (message-news nil subject) (message-mail nil subject))
;; Put point where we want it before inserting the forwarded
- ;; message.
+ ;; message.
(if message-signature-before-forwarded-message
(goto-char (point-max))
(message-goto-body))
(and (search-forward "\n\n" nil t)
(re-search-forward "^Return-Path:.*\n" nil t)))
;; We remove everything before the bounced mail.
- (delete-region
+ (delete-region
(point-min)
(if (re-search-forward "^[^ \n\t]+:" nil t)
(match-beginning 0)
(same-window-buffer-names nil)
(same-window-regexps nil))
(message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
- (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject "")))))
;;;###autoload
(same-window-buffer-names nil)
(same-window-regexps nil))
(message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
- (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject "")))))
;;; underline.el
-;; This code should be moved to underline.el (from which it is stolen).
+;; This code should be moved to underline.el (from which it is stolen).
;;;###autoload
(defun bold-region (start end)
(save-excursion
(let ((end1 (make-marker)))
(move-marker end1 (max start end))
- (goto-char (min start end))
+ (goto-char (min start end))
(while (re-search-forward "\b" end1 t)
(if (eq (following-char) (char-after (- (point) 2)))
(delete-char -2))))))
(defvar gnus-active-hashtb)
(defun message-expand-group ()
- (let* ((b (save-excursion
+ (let* ((b (save-excursion
(save-restriction
- (narrow-to-region
+ (narrow-to-region
(save-excursion
(beginning-of-line)
(skip-chars-forward "^:")
(cur (current-buffer))
comp)
(delete-region b (point))
- (cond
+ (cond
((= (length completions) 1)
(if (string= (car completions) string)
(progn
;;; Help stuff.
(defun message-talkative-question (ask question show &rest text)
- "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.
+ "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.
The following arguments may contain lists of values."
(if (and show
(setq text (message-flatten-list text)))
\(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
=> (1 2 3 4 5 6 7)"
- (cond ((consp list)
+ (cond ((consp list)
(apply 'append (mapcar 'message-flatten-list list)))
(list
(list list))))
`default-toolbar', `top-toolbar', `bottom-toolbar',
`right-toolbar', and `left-toolbar'.")
-(defvar message-toolbar
+(defvar message-toolbar
'([message-spell ispell-message t "Spell"]
[message-help (Info-goto-node "(Message)Top") t "Message help"])
"The message buffer toolbar.")
(defun message-xmas-make-caesar-translation-table (n)
"Create a rot table with offset N."
- (let ((i -1)
+ (let ((i -1)
(table (make-string 256 0))
(a (char-int ?a))
(A (char-int ?A)))
;;; Commentary:
;; This file tries to provide backward compatability with sendmail.el
-;; for Message mode. It should be used by simply adding
+;; for Message mode. It should be used by simply adding
;;
;; (require 'messcompat)
;;
(defvar message-mode-hook mail-mode-hook
"Hook run in message mode buffers.")
-(defvar message-indentation-spaces mail-indentation-spaces
+(defvar message-indentation-spaces mail-indentation-spaces
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'.")
;;; Commentary:
;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.
;;; Code:
(deffoo nnbabyl-open-server (server &optional defs)
(nnoo-change-server 'nnbabyl server defs)
(nnbabyl-create-mbox)
- (cond
+ (cond
((not (file-exists-p nnbabyl-mbox-file))
(nnbabyl-close-server)
(nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
(while (and (not (looking-at ".+:"))
(zerop (forward-line 1))))
(setq start (point))
- (or (when (re-search-forward
+ (or (when (re-search-forward
(concat "^" nnbabyl-mail-delimiter) nil t)
(beginning-of-line)
t)
(insert-buffer-substring nnbabyl-mbox-buffer start stop)
(goto-char (point-min))
;; If there is an EOOH header, then we have to remove some
- ;; duplicated headers.
+ ;; duplicated headers.
(setq summary-line (looking-at "Summary-line:"))
(when (search-forward "\n*** EOOH ***" nil t)
(if summary-line
(deffoo nnbabyl-request-group (group &optional server dont-check)
(let ((active (cadr (assoc group nnbabyl-group-alist))))
(save-excursion
- (cond
+ (cond
((or (null active)
(null (nnbabyl-possibly-change-newsgroup group server)))
(nnheader-report 'nnbabyl "No such group: %s" group))
(nnheader-insert ""))
(t
(nnheader-report 'nnbabyl "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
+ (nnheader-insert "211 %d %d %d %s\n"
(1+ (- (cdr active) (car active)))
(car active) (cdr active) group))))))
(deffoo nnbabyl-request-scan (&optional group server)
(nnbabyl-possibly-change-newsgroup group server)
(nnbabyl-read-mbox)
- (nnmail-get-new-mail
- 'nnbabyl
+ (nnmail-get-new-mail
+ 'nnbabyl
(lambda ()
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
rest)
(nnmail-activate 'nnbabyl)
- (save-excursion
+ (save-excursion
(set-buffer nnbabyl-mbox-buffer)
(gnus-set-text-properties (point-min) (point-max) nil)
(while (and articles is-old)
(if (setq is-old
(nnmail-expired-article-p
newsgroup
- (buffer-substring
+ (buffer-substring
(point) (progn (end-of-line) (point))) force))
(progn
- (nnheader-message 5 "Deleting article %d in %s..."
+ (nnheader-message 5 "Deleting article %d in %s..."
(car articles) newsgroup)
(nnbabyl-delete-mail))
(push (car articles) rest)))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
(nconc rest articles))))
-(deffoo nnbabyl-request-move-article
+(deffoo nnbabyl-request-move-article
(article group server accept-form &optional last)
(let ((buf (get-buffer-create " *nnbabyl move*"))
result)
- (and
+ (and
(nnbabyl-request-article article group server)
(save-excursion
(set-buffer buf)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
- (while (re-search-forward
- "^X-Gnus-Newsgroup:"
+ (while (re-search-forward
+ "^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t)
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))
(nnmail-check-syntax)
(let ((buf (current-buffer))
result beg)
- (and
+ (and
(nnmail-activate 'nnbabyl)
(save-excursion
(goto-char (point-min))
(save-excursion
(while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
(delete-region (point) (progn (forward-line 1) (point)))))
- (when nnmail-cache-message-id-when-accepting
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id"))
(setq result (car (nnbabyl-save-mail
(if (stringp group)
(list (cons group (nnbabyl-active-number group)))
(when found
(save-buffer)))))
;; Remove the group from all structures.
- (setq nnbabyl-group-alist
+ (setq nnbabyl-group-alist
(delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
nnbabyl-current-group nil)
;; Save the active file.
(delete-region (point-min) (point-max))))))
(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
- (when (and server
+ (when (and server
(not (nnbabyl-server-opened server)))
(nnbabyl-open-server server))
(when (or (not nnbabyl-mbox-buffer)
(defun nnbabyl-article-string (article)
(if (numberp article)
- (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
+ (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
(int-to-string article) " ")
(concat "\nMessage-ID: " article)))
(search-forward "\n\n" nil t))
(setq chars (- (point-max) (point))
lines (max (- (count-lines (point) (point-max)) 1) 0))
- ;; Move back to the end of the headers.
+ ;; Move back to the end of the headers.
(goto-char (point-min))
(search-forward "\n\n" nil t)
(forward-char -1)
(when (search-forward "\n\n" nil t)
(forward-char -1)
(while group-art
- (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
+ (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
(caar group-art) (cdar group-art)
(current-time-string)))
(setq group-art (cdr group-art))))
(let ((delim (concat "^" nnbabyl-mail-delimiter))
(alist nnbabyl-group-alist)
start end number)
- (set-buffer (setq nnbabyl-mbox-buffer
- (nnheader-find-file-noselect
+ (set-buffer (setq nnbabyl-mbox-buffer
+ (nnheader-find-file-noselect
nnbabyl-mbox-file nil 'raw)))
;; Save previous buffer mode.
- (setq nnbabyl-previous-buffer-mode
+ (setq nnbabyl-previous-buffer-mode
(cons (cons (point-min) (point-max))
major-mode))
(caar alist))
nil t)
(> (setq number
- (string-to-number
+ (string-to-number
(buffer-substring
(match-beginning 1) (match-end 1))))
(cdadar alist)))
(setcdr (cadar alist) number))
(setq alist (cdr alist)))
-
- ;; We go through the mbox and make sure that each and
+
+ ;; We go through the mbox and make sure that each and
;; every mail belongs to some group or other.
(goto-char (point-min))
(if (looking-at "\^L")
(save-excursion
(save-restriction
(narrow-to-region (goto-char start) end)
- (nnbabyl-save-mail
+ (nnbabyl-save-mail
(nnmail-article-group 'nnbabyl-active-number))
(setq end (point-max)))))
(goto-char (setq start end)))
server
t))
result))
-
+
(deffoo nndb-request-accept-article (group server &optional last)
"The article in the current buffer is put into GROUP."
(nntp-possibly-change-group group server) ;;-
(list art))))
(deffoo nndb-request-replace-article (article group buffer)
- "ARTICLE is the number of the article in GROUP to be replaced
+ "ARTICLE is the number of the article in GROUP to be replaced
with the contents of the BUFFER."
(set-buffer buffer)
(let (art statmsg)
defs)
(nnoo-change-server 'nndir server defs)
(let (err)
- (cond
+ (cond
((not (condition-case arg
(file-exists-p nndir-directory)
(ftp-error (setq err (format "%s" arg)))))
(nndir-close-server)
- (nnheader-report
+ (nnheader-report
'nndir (or err "No such file or directory: %s" nndir-directory)))
((not (file-directory-p (file-truename nndir-directory)))
(nndir-close-server)
(defvoo nndoc-post-type 'mail
"*Whether the nndoc group is `mail' or `post'.")
-(defvar nndoc-type-alist
- `((mmdf
+(defvar nndoc-type-alist
+ `((mmdf
(article-begin . "^\^A\^A\^A\^A\n")
(body-end . "^\^A\^A\^A\^A\n"))
(news
(rnews
(article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
(body-end-function . nndoc-rnews-body-end))
- (mbox
+ (mbox
(article-begin-function . nndoc-mbox-article-begin)
(body-end-function . nndoc-mbox-body-end))
- (babyl
+ (babyl
(article-begin . "\^_\^L *\n")
(body-end . "\^_")
(body-begin-function . nndoc-babyl-body-begin)
(generate-head-function . nndoc-generate-lanl-gov-head)
(article-transform-function . nndoc-transform-lanl-gov-announce)
(subtype preprints guess))
- (guess
+ (guess
(guess . t)
(subtype nil))
(digest
(when entry
(if (stringp article)
nil
- (insert-buffer-substring
+ (insert-buffer-substring
nndoc-current-buffer (car entry) (nth 1 entry))
(insert "\n")
(setq beg (point))
- (insert-buffer-substring
+ (insert-buffer-substring
nndoc-current-buffer (nth 2 entry) (nth 3 entry))
(goto-char beg)
(when nndoc-prepare-body-function
(deffoo nndoc-request-group (group &optional server dont-check)
"Select news GROUP."
(let (number)
- (cond
+ (cond
((not (nndoc-possibly-change-buffer group server))
(nnheader-report 'nndoc "No such file or buffer: %s"
nndoc-address))
(defun nndoc-possibly-change-buffer (group source)
(let (buf)
- (cond
+ (cond
;; The current buffer is this group's buffer.
((and nndoc-current-buffer
(buffer-name nndoc-current-buffer)
- (eq nndoc-current-buffer
+ (eq nndoc-current-buffer
(setq buf (cdr (assoc group nndoc-group-alist))))))
;; We change buffers by taking an old from the group alist.
- ;; `source' is either a string (a file name) or a buffer object.
+ ;; `source' is either a string (a file name) or a buffer object.
(buf
(setq nndoc-current-buffer buf))
- ;; It's a totally new group.
+ ;; It's a totally new group.
((or (and (bufferp nndoc-address)
(buffer-name nndoc-address))
(and (stringp nndoc-address)
(file-exists-p nndoc-address)
(not (file-directory-p nndoc-address))))
- (push (cons group (setq nndoc-current-buffer
- (get-buffer-create
+ (push (cons group (setq nndoc-current-buffer
+ (get-buffer-create
(concat " *nndoc " group "*"))))
nndoc-group-alist)
(setq nndoc-dissection-alist nil)
(defun nndoc-set-delims ()
"Set the nndoc delimiter variables according to the type of the document."
- (let ((vars '(nndoc-file-begin
- nndoc-first-article
+ (let ((vars '(nndoc-file-begin
+ nndoc-first-article
nndoc-article-end nndoc-head-begin nndoc-head-end
nndoc-file-end nndoc-article-begin
nndoc-body-begin nndoc-body-end-function nndoc-body-end
(set (pop vars) nil)))
(let (defs)
;; Guess away until we find the real file type.
- (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
+ (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
nndoc-type-alist))))
(setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
;; Set the nndoc variables.
(when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
(goto-char (point-min))
(when (numberp (setq result (funcall (intern
- (format "nndoc-%s-type-p"
+ (format "nndoc-%s-type-p"
(car entry))))))
(push (cons result entry) results)
(setq result nil))))
(car entry)
(cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
-;;;
+;;;
;;; Built-in type predicates and functions
;;;
len end)
(when
(save-excursion
- (and (re-search-backward
+ (and (re-search-backward
(concat "^" message-unix-mail-delimiter) nil t)
(setq end (point))
(search-forward "\n\n" beg t)
(defun nndoc-standard-digest-type-p ()
(when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
- (re-search-forward
+ (re-search-forward
(concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
t))
;; (when (re-search-backward "^\\\\\\\\$" nil t)
;; (replace-match "" t t))
)
-
+
(defun nndoc-generate-lanl-gov-head (article)
(let ((entry (cdr (assq article nndoc-dissection-alist)))
(e-mail "no address given")
(setq from (replace-match "" t t from)))
(insert "From: " (or from "unknown")
"\nSubject: " (or subject "(no subject)") "\n")))
-
+
;;;
(setq first nil)
(cond (nndoc-head-begin-function
(funcall nndoc-head-begin-function))
- (nndoc-head-begin
+ (nndoc-head-begin
(nndoc-search nndoc-head-begin)))
(if (or (>= (point) (point-max))
(and nndoc-file-end
'headers
(while articles
(set-buffer buf)
- (when (nndraft-request-article
+ (when (nndraft-request-article
(setq article (pop articles)) group server (current-buffer))
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
(nnoo-change-server 'nndraft server defs)
(unless (assq 'nndraft-directory defs)
(setq nndraft-directory server))
- (cond
+ (cond
((not (file-exists-p nndraft-directory))
(nndraft-close-server)
(nnheader-report 'nndraft "No such file or directory: %s"
(deffoo nndraft-request-article (id &optional group server buffer)
(when (numberp id)
- ;; We get the newest file of the auto-saved file and the
+ ;; We get the newest file of the auto-saved file and the
;; "real" file.
(let* ((file (nndraft-article-filename id))
(auto (nndraft-auto-save-file-name file))
(nntp-server-buffer (or buffer nntp-server-buffer)))
(when (and (file-exists-p newest)
(nnmail-find-file newest))
- (save-excursion
+ (save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
- ;; If there's a mail header separator in this file,
+ ;; If there's a mail header separator in this file,
;; we remove it.
(when (re-search-forward
(concat "^" mail-header-separator "$") nil t)
(nndraft-execute-nnmh-command
`(nnmh-request-newgroups ,date ,server)))
-(deffoo nndraft-request-expire-articles
+(deffoo nndraft-request-expire-articles
(articles group &optional server force)
(let ((res (nndraft-execute-nnmh-command
`(nnmh-request-expire-articles
;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.
;;; Code:
\f
-;;; Internal variables.
+;;; Internal variables.
(defconst nneething-version "nneething 1.0"
"nneething version.")
(if (> (car nneething-active) (cdr nneething-active))
(nnheader-insert "211 0 1 0 %s\n" group)
(nnheader-insert
- "211 %d %d %d %s\n"
+ "211 %d %d %d %s\n"
(- (1+ (cdr nneething-active)) (car nneething-active))
(car nneething-active) (cdr nneething-active)
group)))
nneething-group-alist))))))
(defun nneething-map-file ()
- ;; We make sure that the .nneething directory exists.
+ ;; We make sure that the .nneething directory exists.
(gnus-make-directory nneething-map-file-directory)
;; We store it in a special directory under the user's home dir.
(concat (file-name-as-directory nneething-map-file-directory)
(setq nneething-map
(mapcar (lambda (n)
(list (cdr n) (car n)
- (nth 5 (file-attributes
+ (nth 5 (file-attributes
(nneething-file-name (car n))))))
nneething-map)))
;; Remove files matching the exclusion regexp.
(nneething-file-name (car files)))))
nneething-map))
(setq files (cdr files)))
- (when (and touched
+ (when (and touched
(not nneething-read-only))
(nnheader-temp-write map-file
(insert "(setq nneething-map '")
(defun nneething-make-head (file &optional buffer)
"Create a head by looking at the file attributes of FILE."
(let ((atts (file-attributes file)))
- (insert
+ (insert
"Subject: " (file-name-nondirectory file) "\n"
- "Message-ID: <nneething-"
+ "Message-ID: <nneething-"
(int-to-string (incf nneething-message-id-number))
"@" (system-name) ">\n"
(if (equal '(0 0) (nth 5 atts)) ""
(concat "Date: " (current-time-string (nth 5 atts)) "\n"))
(or (when buffer
- (save-excursion
+ (save-excursion
(set-buffer buffer)
(when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
(concat "From: " (match-string 0) "\n"))))
(if (> (string-to-int (int-to-string (nth 7 atts))) 0)
(concat "Chars: " (int-to-string (nth 7 atts)) "\n")
"")
- (if buffer
+ (if buffer
(save-excursion
(set-buffer buffer)
- (concat "Lines: " (int-to-string
+ (concat "Lines: " (int-to-string
(count-lines (point-min) (point-max)))
"\n"))
"")
(defun nneething-from-line (uid &optional file)
"Return a From header based of UID."
- (let* ((login (condition-case nil
+ (let* ((login (condition-case nil
(user-login-name uid)
- (error
+ (error
(cond ((= uid (user-uid)) (user-login-name))
((zerop uid) "root")
(t (int-to-string uid))))))
- (name (condition-case nil
+ (name (condition-case nil
(user-full-name uid)
- (error
+ (error
(cond ((= uid (user-uid)) (user-full-name))
((zerop uid) "Ms. Root")))))
(host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file)
(prog1
- (substring file
+ (substring file
(match-beginning 1)
(match-end 1))
(when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file)
(match-end 2))
name nil)))
(system-name))))
- (concat "From: " login "@" host
+ (concat "From: " login "@" host
(if name (concat " (" name ")") "") "\n")))
(defun nneething-get-head (file)
(setq case-fold-search nil)
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (cond
+ (cond
((not (file-exists-p file))
- ;; The file do not exist.
+ ;; The file do not exist.
nil)
((or (file-directory-p file)
(file-symlink-p file))
;; It's a dir, so we fudge a head.
(nneething-make-head file) t)
- (t
+ (t
;; We examine the file.
(nnheader-insert-head file)
(if (nnheader-article-p)
- (delete-region
+ (delete-region
(progn
(goto-char (point-min))
(or (and (search-forward "\n\n" nil t)
(defvoo nnfolder-directory (expand-file-name message-directory)
"The name of the nnfolder directory.")
-(defvoo nnfolder-active-file
+(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
"The name of the active file.")
(defvoo nnfolder-ignore-active-file nil
"If non-nil, causes nnfolder to do some extra work in order to determine
the true active ranges of an mbox file. Note that the active file is still
-saved, but it's values are not used. This costs some extra time when
+saved, but it's values are not used. This costs some extra time when
scanning an mbox when opening it.")
(defvoo nnfolder-distrust-mbox nil
When nil, scans occur forward from the last marked message, a huge
time saver for large mailboxes.")
-(defvoo nnfolder-newsgroups-file
+(defvoo nnfolder-newsgroups-file
(concat (file-name-as-directory nnfolder-directory) "newsgroups")
"Mail newsgroups description file.")
(nnoo-change-server 'nnfolder server defs)
(nnmail-activate 'nnfolder t)
(gnus-make-directory nnfolder-directory)
- (cond
+ (cond
((not (file-exists-p nnfolder-directory))
(nnfolder-close-server)
(nnheader-report 'nnfolder "Couldn't create directory: %s"
(goto-char (point-min))
(search-forward (concat "\n" nnfolder-article-marker))
(cons nnfolder-current-group
- (string-to-int
- (buffer-substring
+ (string-to-int
+ (buffer-substring
(point) (progn (end-of-line) (point)))))))))))
(deffoo nnfolder-request-group (group &optional server dont-check)
(if (not (assoc group nnfolder-group-alist))
(nnheader-report 'nnfolder "No such group: %s" group)
(if dont-check
- (progn
+ (progn
(nnheader-report 'nnfolder "Selected group %s" group)
t)
(let* ((active (assoc group nnfolder-group-alist))
(group (car active))
(range (cadr active)))
- (cond
+ (cond
((null active)
(nnheader-report 'nnfolder "No such group: %s" group))
((null nnfolder-current-group)
(nnheader-report 'nnfolder "Empty group: %s" group))
(t
(nnheader-report 'nnfolder "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
+ (nnheader-insert "211 %d %d %d %s\n"
(1+ (- (cdr range) (car range)))
(car range) (cdr range) group))))))))
(deffoo nnfolder-request-scan (&optional group server)
(nnfolder-possibly-change-group group server t)
(nnmail-get-new-mail
- 'nnfolder
+ 'nnfolder
(lambda ()
(let ((bufs nnfolder-buffer-alist))
(save-excursion
(while bufs
(if (not (buffer-name (nth 1 (car bufs))))
- (setq nnfolder-buffer-alist
+ (setq nnfolder-buffer-alist
(delq (car bufs) nnfolder-buffer-alist))
(set-buffer (nth 1 (car bufs)))
(nnfolder-save-buffer)
(deffoo nnfolder-request-create-group (group &optional server args)
(nnfolder-possibly-change-group nil server)
(nnmail-activate 'nnfolder)
- (when group
+ (when group
(unless (assoc group nnfolder-group-alist)
(push (list group (cons 1 0)) nnfolder-group-alist)
(nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
(save-excursion
(nnmail-find-file nnfolder-newsgroups-file)))
-(deffoo nnfolder-request-expire-articles
+(deffoo nnfolder-request-expire-articles
(articles newsgroup &optional server force)
(nnfolder-possibly-change-group newsgroup server)
(let* ((is-old t)
rest)
(nnmail-activate 'nnfolder)
- (save-excursion
+ (save-excursion
(set-buffer nnfolder-current-buffer)
(while (and articles is-old)
(goto-char (point-min))
(when (search-forward (nnfolder-article-string (car articles)) nil t)
(if (setq is-old
- (nnmail-expired-article-p
+ (nnmail-expired-article-p
newsgroup
- (buffer-substring
+ (buffer-substring
(point) (progn (end-of-line) (point)))
force nnfolder-inhibit-expiry))
(progn
- (nnheader-message 5 "Deleting article %d..."
+ (nnheader-message 5 "Deleting article %d..."
(car articles) newsgroup)
(nnfolder-delete-mail))
(push (car articles) rest)))
(article group server accept-form &optional last)
(let ((buf (get-buffer-create " *nnfolder move*"))
result)
- (and
+ (and
(nnfolder-request-article article group server)
(save-excursion
(set-buffer buf)
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
(concat "^" nnfolder-article-marker)
(save-excursion (search-forward "\n\n" nil t) (point)) t)
(delete-region (progn (beginning-of-line) (point))
(goto-char (point-min))
(when (looking-at "X-From-Line: ")
(replace-match "From "))
- (and
+ (and
(nnfolder-request-list)
(save-excursion
(set-buffer buf)
(forward-line -1)
(while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
(delete-region (point) (progn (forward-line 1) (point))))
- (when nnmail-cache-message-id-when-accepting
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id"))
(setq result
(car (nnfolder-save-mail
(if (stringp group)
(ignore-errors
(delete-file (nnfolder-group-pathname group))))
;; Remove the group from all structures.
- (setq nnfolder-group-alist
+ (setq nnfolder-group-alist
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
nnfolder-current-group nil
nnfolder-current-buffer nil)
(set-buffer nnfolder-current-buffer)
(and (file-writable-p buffer-file-name)
(ignore-errors
- (rename-file
+ (rename-file
buffer-file-name
(nnfolder-group-pathname new-name))
t)
;; The group doesn't exist, so we create a new entry for it.
(push (list group (cons 1 0)) nnfolder-group-alist)
(nnmail-save-active nnfolder-group-alist nnfolder-active-file))
-
+
(let (inf file)
;; If we have to change groups, see if we don't already have the
;; folder in memory. If we do, verify the modtime and destroy
nnfolder-current-buffer nil))
(setq nnfolder-current-group group)
-
+
(when (or (not nnfolder-current-buffer)
(not (verify-visited-file-modtime nnfolder-current-buffer)))
(save-excursion
;; The From line may have been quoted by movemail.
(when (looking-at (concat ">" message-unix-mail-delimiter))
(delete-char 1))
- ;; This might come from somewhere else.
+ ;; This might come from somewhere else.
(unless (looking-at message-unix-mail-delimiter)
(insert "From nobody " (current-time-string) "\n")
(goto-char (point-min)))
(setq start (marker-position end))
(goto-char end)
;; There may be more than one "From " line, so we skip past
- ;; them.
+ ;; them.
(while (looking-at delim)
(forward-line 1))
(set-marker end (if (nnmail-search-unix-mail-delim)
"Make pathname for GROUP."
(let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
;; If this file exists, we use it directly.
- (if (or nnmail-use-long-file-names
+ (if (or nnmail-use-long-file-names
(file-exists-p (concat dir group)))
(concat dir group)
;; If not, we translate dots into slashes.
"@" gateway "\n")))
(nnoo-define-skeleton nngateway)
-
+
(provide 'nngateway)
;;; nngateway.el ends here
references chars lines xref)
"Create a new mail header structure initialized with the parameters given."
(vector number subject from date id references chars lines xref))
-
+
;; fake message-ids: generation and detection
(defvar nnheader-fake-message-id 1)
(defun nnheader-insert-nov (header)
(princ (mail-header-number header) (current-buffer))
- (insert
+ (insert
"\t"
(or (mail-header-subject header) "(none)") "\t"
(or (mail-header-from header) "(nobody)") "\t"
;; First we find the first wanted line.
(nnheader-find-nov-line beg)
(delete-region (point-min) (point))
- ;; Then we find the last wanted line.
+ ;; Then we find the last wanted line.
(when (nnheader-find-nov-line end)
(forward-line 1))
(delete-region (point) (point-max)))
(defvar jka-compr-compression-info-list)
(defvar nnheader-numerical-files
(if (boundp 'jka-compr-compression-info-list)
- (concat "\\([0-9]+\\)\\("
+ (concat "\\([0-9]+\\)\\("
(mapconcat (lambda (i) (aref i 0))
jka-compr-compression-info-list "\\|")
"\\)?")
(defun nnheader-directory-files-safe (&rest args)
;; It has been reported numerous times that `directory-files'
;; fails with an alarming frequency on NFS mounted file systems.
- ;; This function executes that function twice and returns
+ ;; This function executes that function twice and returns
;; the longest result.
(let ((first (apply 'directory-files args))
(second (apply 'directory-files args)))
(defun nnheader-translate-file-chars (file)
(if (null nnheader-file-name-translation-alist)
;; No translation is necessary.
- file
+ file
;; We translate -- but only the file name. We leave the directory
;; alone.
(let* ((i 0)
(defun nnheader-file-to-group (file &optional top)
"Return a group name based on FILE and TOP."
- (nnheader-replace-chars-in-string
+ (nnheader-replace-chars-in-string
(if (not top)
file
(condition-case ()
(substring (expand-file-name file)
- (length
+ (length
(expand-file-name
(file-name-as-directory top))))
(error "")))
(setq dir (concat
(file-name-directory
(directory-file-name (car path)))
- "etc/" package
+ "etc/" package
(if file "" "/"))))
(or file (file-directory-p dir)))
(setq result dir
(goto-char (point-min))
(while (,(if regexp 're-search-forward 'search-forward)
,from nil t)
- (insert-buffer-substring
+ (insert-buffer-substring
cur start (prog1 (match-beginning 0) (set-buffer new)))
(goto-char (point-max))
,(when to `(insert ,to))
(set-buffer cur)
(setq start (point)))
- (insert-buffer-substring
+ (insert-buffer-substring
cur start (prog1 (point-max) (set-buffer new)))
(copy-to-buffer cur (point-min) (point-max))
(kill-buffer (current-buffer))
(while (setq info (pop newsrc))
(when (string-match "nnkiboze" (gnus-info-group info))
;; For each kiboze group, we call this function to generate
- ;; it.
+ ;; it.
(nnkiboze-generate-group (gnus-info-group info))))))
(defun nnkiboze-score-file (group)
(gnus-large-newsgroup nil)
(gnus-score-find-score-files-function 'nnkiboze-score-file)
(gnus-verbose (min gnus-verbose 3))
- gnus-select-group-hook gnus-summary-prepare-hook
- gnus-thread-sort-functions gnus-show-threads
+ gnus-select-group-hook gnus-summary-prepare-hook
+ gnus-thread-sort-functions gnus-show-threads
gnus-visual gnus-suppress-duplicates)
(unless info
(error "No such group: %s" group))
(when (file-exists-p nov-file)
(insert-file-contents nov-file))
(setq nov-buffer (current-buffer))
- ;; Go through the active hashtb and add new all groups that match the
+ ;; Go through the active hashtb and add new all groups that match the
;; kiboze regexp.
(mapatoms
(lambda (group)
;; number that has been kibozed in GROUP in this kiboze group.
(setq newsrc nnkiboze-newsrc)
(while newsrc
- (if (not (setq active (gnus-gethash
+ (if (not (setq active (gnus-gethash
(caar newsrc) gnus-active-hashtb)))
;; This group isn't active after all, so we remove it from
;; the list of component groups.
(setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
(setq lowest (cdar newsrc))
- ;; Ok, we have a valid component group, so we jump to it.
+ ;; Ok, we have a valid component group, so we jump to it.
(switch-to-buffer gnus-group-buffer)
(gnus-group-jump-to-group (caar newsrc))
(gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
(when (nth 3 ginfo)
(setcar (nthcdr 3 ginfo) nil))
;; We set the list of read articles to be what we expect for
- ;; this kiboze group -- either nil or `(1 . LOWEST)'.
+ ;; this kiboze group -- either nil or `(1 . LOWEST)'.
(when ginfo
(setcar (nthcdr 2 ginfo)
(and (not (= lowest 1)) (cons 1 lowest))))
(when (and (or (not ginfo)
- (> (length (gnus-list-of-unread-articles
+ (> (length (gnus-list-of-unread-articles
(car ginfo)))
0))
(progn
(gnus-group-select-group nil)
(eq major-mode 'gnus-summary-mode)))
;; We are now in the group where we want to be.
- (setq method (gnus-find-method-for-group
+ (setq method (gnus-find-method-for-group
gnus-newsgroup-name))
(when (eq method gnus-select-method)
(setq method nil))
(when (> (caar gnus-newsgroup-scored) lowest)
;; If it has a good score, then we enter this article
;; into the kiboze group.
- (nnkiboze-enter-nov
+ (nnkiboze-enter-nov
nov-buffer
- (gnus-summary-article-header
+ (gnus-summary-article-header
(caar gnus-newsgroup-scored))
gnus-newsgroup-name))
(setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
(gnus-prin1 nnkiboze-newsrc)
(insert ")\n"))
t))
-
+
(defun nnkiboze-enter-nov (buffer header group)
(save-excursion
(set-buffer buffer)
;; The first Xref has to be the group this article
;; really came for - this is the article nnkiboze
;; will request when it is asked for the article.
- (insert group ":"
+ (insert group ":"
(int-to-string (mail-header-number header)) " ")
(while (re-search-forward " [^ ]+:[0-9]+" nil t)
(goto-char (1+ (match-beginning 0)))
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
(defcustom nnmail-keep-last-article nil
- "If non-nil, nnmail will never delete the last expired article in a directory.
+ "If non-nil, nnmail will never delete the last expired article in a directory.
You may need to set this variable if other programs are putting
new mail into folder numbers that Gnus has marked as expired."
:group 'nnmail-procmail
:type '(choice (const :tag "nnmail-expiry-wait" nil)
(function :format "%v" nnmail-)))
-(defcustom nnmail-spool-file
+(defcustom nnmail-spool-file
(or (getenv "MAIL")
(concat "/usr/spool/mail/" (user-login-name)))
"Where the mail backends will look for incoming mail.
:group 'nnmail-retrieve
:type 'boolean)
-(defcustom nnmail-read-incoming-hook
+(defcustom nnmail-read-incoming-hook
(if (eq system-type 'windows-nt)
'(nnheader-ms-strip-cr)
nil)
Eg.
-\(add-hook 'nnmail-read-incoming-hook
+\(add-hook 'nnmail-read-incoming-hook
(lambda ()
- (start-process \"mailsend\" nil
+ (start-process \"mailsend\" nil
\"/local/bin/mailsend\" \"read\" \"mbox\")))
If you have xwatch running, this will alert it that mail has been
-read.
+read.
If you use `display-time', you could use something like this:
The format is this variable is SPLIT, where SPLIT can be one of
the following:
-GROUP: Mail will be stored in GROUP (a string).
+GROUP: Mail will be stored in GROUP (a string).
\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
VALUE (a regexp), store the messages as specified by SPLIT.
\(| SPLIT...): Process each SPLIT expression until one of them matches.
A SPLIT expression is said to match if it will cause the mail
- message to be stored in one or more groups.
+ message to be stored in one or more groups.
\(& SPLIT...): Process each SPLIT expression.
(const warn)
(const delete)))
-(defvar nnmail-cache-message-id-when-accepting nil
- "If non-nil put the Message-ID: of incoming messages in the message ID cache.
-Not doing so is dangerous, but it is how Gnus used to work for a long
-time.")
-
;;; Internal variables.
(defvar nnmail-split-history nil
(concat
(let ((dir (file-name-as-directory (expand-file-name dir))))
;; If this directory exists, we use it directly.
- (if (or nnmail-use-long-file-names
+ (if (or nnmail-use-long-file-names
(file-directory-p (concat dir group)))
(concat dir group "/")
;; If not, we translate dots into slashes.
(message "Getting mail from %s..." inbox)))
;; Set TOFILE if have not already done so, and
;; rename or copy the file INBOX to TOFILE if and as appropriate.
- (cond
+ (cond
((file-exists-p tofile)
;; The crash box exists already.
t)
(insert (prin1-to-string err))
(setq result 255))))
(setq result
- (apply
+ (apply
'call-process
(append
(list
- (expand-file-name
+ (expand-file-name
nnmail-movemail-program exec-directory)
nil errors nil inbox tofile)
(when nnmail-internal-password
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
;; We create an alist with `(GROUP (LOW . HIGH))' elements.
(push (list (match-string 1)
(let ((procmail-group (substring (expand-file-name file)
(match-beginning 1)
(match-end 1))))
- (if group
+ (if group
(if (string-equal group procmail-group)
group
nil)
"\n")))
;; Look for a Content-Length header.
(if (not (save-excursion
- (and (re-search-backward
+ (and (re-search-backward
"^Content-Length:[ \t]*\\([0-9]+\\)" start t)
(setq content-length (string-to-int
- (buffer-substring
+ (buffer-substring
(match-beginning 1)
(match-end 1))))
;; We destroy the header, since none of
(setq do-search t)))
(widen)
;; Go to the beginning of the next article - or to the end
- ;; of the buffer.
+ ;; of the buffer.
(when do-search
(if (re-search-forward "^\1f" nil t)
(goto-char (match-beginning 0))
end nil)
;; Find the end of the head.
(narrow-to-region
- start
+ start
(if (search-forward "\n\n" nil t)
(1- (point))
;; This will never happen, but just to be on the safe side --
"^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
(setq content-length nil)
(setq content-length (string-to-int (match-string 1)))
- ;; We destroy the header, since none of the backends ever
+ ;; We destroy the header, since none of the backends ever
;; use it, and we do not want to confuse other mailers by
;; having a (possibly) faulty header.
(beginning-of-line)
(t (setq end nil))))
(if end
(goto-char end)
- ;; No Content-Length, so we find the beginning of the next
+ ;; No Content-Length, so we find the beginning of the next
;; article or the end of the buffer.
(goto-char head-end)
(or (nnmail-search-unix-mail-delim)
(setq start (point))
;; Find the end of the head.
(narrow-to-region
- start
+ start
(if (search-forward "\n\n" nil t)
(1- (point))
;; This will never happen, but just to be on the safe side --
(funcall exit-func))
(kill-buffer (current-buffer)))))
-;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
+;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
(defun nnmail-article-group (func)
"Look at the headers and return an alist of groups that match.
FUNC will be called with the group name to determine the article number."
(or (funcall nnmail-split-methods)
'("bogus"))
(error
- (message
+ (message
"Error in `nnmail-split-methods'; using `bogus' mail group")
(sit-for 1)
'("bogus")))))
(unless (equal split '(junk))
- ;; `nnmail-split-methods' is a function, so we just call
+ ;; `nnmail-split-methods' is a function, so we just call
;; this function here and use the result.
(setq group-art
(mapcar
(re-search-backward (cadr method) nil t)
;; Function to say whether this is a match.
(funcall (nth 1 method) (car method))))
- ;; Don't enter the article into the same
+ ;; Don't enter the article into the same
;; group twice.
(not (assoc (car method) group-art)))
(push (cons (car method) (funcall func (car method)))
group-art))
- ;; This is the final group, which is used as a
+ ;; This is the final group, which is used as a
;; catch-all.
(unless group-art
- (setq group-art
+ (setq group-art
(list (cons (car method)
(funcall func (car method)))))))))
;; See whether the split methods returned `junk'.
(if (null nnmail-spool-file)
;; No spool file whatsoever.
nil
- (let* ((procmails
+ (let* ((procmails
;; If procmail is used to get incoming mail, the files
;; are stored in this directory.
(and (file-exists-p nnmail-procmail-directory)
(or (eq nnmail-spool-file 'procmail)
nnmail-use-procmail)
- (directory-files
- nnmail-procmail-directory
+ (directory-files
+ nnmail-procmail-directory
t (concat (if group (concat "^" group) "")
nnmail-procmail-suffix "$"))))
(p procmails)
0))
(list nnmail-crash-box))))
;; Remove any directories that inadvertently match the procmail
- ;; suffix, which might happen if the suffix is "".
+ ;; suffix, which might happen if the suffix is "".
(while p
(when (file-directory-p (car p))
(setq procmails (delete (car p) procmails)))
(setq p (cdr p)))
;; Return the list of spools.
- (append
+ (append
crash
(cond ((and group
(or (eq nnmail-spool-file 'procmail)
nil)
((listp nnmail-spool-file)
(nconc
- (apply
+ (apply
'nconc
- (mapcar
+ (mapcar
(lambda (file)
(if (and (not (string-match "^po:" file))
(file-directory-p file))
((stringp nnmail-spool-file)
(if (and (not (string-match "^po:" nnmail-spool-file))
(file-directory-p nnmail-spool-file))
- (nconc
+ (nconc
(nnheader-directory-regular-files nnmail-spool-file)
procmails)
(cons nnmail-spool-file procmails)))
(t
procmails))))))
-;; Activate a backend only if it isn't already activated.
-;; If FORCE, re-read the active file even if the backend is
+;; Activate a backend only if it isn't already activated.
+;; If FORCE, re-read the active file even if the backend is
;; already activated.
(defun nnmail-activate (backend &optional force)
(let (file timestamp file-time)
(if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
force
(and (setq file (ignore-errors
- (symbol-value (intern (format "%s-active-file"
+ (symbol-value (intern (format "%s-active-file"
backend)))))
(setq file-time (nth 5 (file-attributes file)))
(or (not
(setq timestamp
(condition-case ()
(symbol-value (intern
- (format "%s-active-timestamp"
+ (format "%s-active-timestamp"
backend)))
(error 'none))))
(not (consp timestamp))
(> (nth 1 file-time) (nth 1 timestamp))))))
(save-excursion
(or (eq timestamp 'none)
- (set (intern (format "%s-active-timestamp" backend))
+ (set (intern (format "%s-active-timestamp" backend))
file-time))
(funcall (intern (format "%s-request-list" backend)))))
t))
(buffer-name nnmail-cache-buffer)))
() ; The buffer is open.
(save-excursion
- (set-buffer
- (setq nnmail-cache-buffer
+ (set-buffer
+ (setq nnmail-cache-buffer
(get-buffer-create " *nnmail message-id cache*")))
(buffer-disable-undo (current-buffer))
(when (file-exists-p nnmail-message-id-cache-file)
(setq group-art nil))
((eq action 'warn)
;; We insert a warning.
- (let ((case-fold-search t)
- (newid (concat "<" (message-unique-id)
- "@duplicate-message-id>")))
+ (let ((case-fold-search t))
(goto-char (point-min))
- (when (re-search-forward "^message-id[ \t]*:" nil t)
- (beginning-of-line)
- (insert "Original-"))
+ (re-search-forward "^message-id[ \t]*:" nil t)
(beginning-of-line)
- (insert
- "Message-ID: " newid "\n"
+ (insert
"Gnus-Warning: This is a duplicate of message " message-id "\n")
- (nnmail-cache-insert newid)
(funcall func (setq group-art
(nreverse (nnmail-article-group artnum-func))))))
(t
;; is supposed to go to some specific group.
(setq group (nnmail-get-split-group spool group-in))
;; We split the mail
- (nnmail-split-incoming
+ (nnmail-split-incoming
nnmail-crash-box (intern (format "%s-save-mail" method))
spool-func group (intern (format "%s-active-number" method)))
- ;; Check whether the inbox is to be moved to the special tmp dir.
+ ;; Check whether the inbox is to be moved to the special tmp dir.
(setq incoming
- (nnmail-make-complex-temp-name
- (expand-file-name
+ (nnmail-make-complex-temp-name
+ (expand-file-name
(if nnmail-tmp-directory
- (concat
+ (concat
(file-name-as-directory nnmail-tmp-directory)
(file-name-nondirectory
(concat (file-name-as-directory temp) "Incoming")))
(concat (file-name-as-directory temp) "Incoming")))))
(rename-file nnmail-crash-box incoming t)
(push incoming incomings))))
- ;; If we did indeed read any incoming spools, we save all info.
+ ;; If we did indeed read any incoming spools, we save all info.
(when incomings
- (nnmail-save-active
+ (nnmail-save-active
(nnmail-get-value "%s-group-alist" method)
(nnmail-get-value "%s-active-file" method))
(when exit-func
(pop3-movemail crashbox)))
(run-hooks 'nnmail-load-hook)
-
+
(provide 'nnmail)
;;; nnmail.el ends here
;;; Commentary:
;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.
;;; Code:
(when (or (search-forward art-string nil t)
(progn (goto-char (point-min))
(search-forward art-string nil t)))
- (setq start
+ (setq start
(save-excursion
- (re-search-backward
+ (re-search-backward
(concat "^" message-unix-mail-delimiter) nil t)
(point)))
(search-forward "\n\n" nil t)
(deffoo nnmbox-open-server (server &optional defs)
(nnoo-change-server 'nnmbox server defs)
(nnmbox-create-mbox)
- (cond
+ (cond
((not (file-exists-p nnmbox-mbox-file))
(nnmbox-close-server)
(nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file))
(re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
(setq start (point))
(forward-line 1)
- (or (and (re-search-forward
+ (or (and (re-search-forward
(concat "^" message-unix-mail-delimiter) nil t)
(forward-line -1))
(goto-char (point-max)))
(deffoo nnmbox-request-group (group &optional server dont-check)
(let ((active (cadr (assoc group nnmbox-group-alist))))
- (cond
+ (cond
((or (null active)
(null (nnmbox-possibly-change-newsgroup group server)))
(nnheader-report 'nnmbox "No such group: %s" group))
(nnheader-insert ""))
(t
(nnheader-report 'nnmbox "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
+ (nnheader-insert "211 %d %d %d %s\n"
(1+ (- (cdr active) (car active)))
(car active) (cdr active) group)))))
(deffoo nnmbox-request-scan (&optional group server)
(nnmbox-possibly-change-newsgroup group server)
(nnmbox-read-mbox)
- (nnmail-get-new-mail
- 'nnmbox
+ (nnmail-get-new-mail
+ 'nnmbox
(lambda ()
(save-excursion
(set-buffer nnmbox-mbox-buffer)
(deffoo nnmbox-request-list-newsgroups (&optional server)
(nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
-(deffoo nnmbox-request-expire-articles
+(deffoo nnmbox-request-expire-articles
(articles newsgroup &optional server force)
(nnmbox-possibly-change-newsgroup newsgroup server)
(let* ((is-old t)
rest)
(nnmail-activate 'nnmbox)
- (save-excursion
+ (save-excursion
(set-buffer nnmbox-mbox-buffer)
(while (and articles is-old)
(goto-char (point-min))
(if (setq is-old
(nnmail-expired-article-p
newsgroup
- (buffer-substring
+ (buffer-substring
(point) (progn (end-of-line) (point))) force))
(progn
(nnheader-message 5 "Deleting article %d in %s..."
(article group server accept-form &optional last)
(let ((buf (get-buffer-create " *nnmbox move*"))
result)
- (and
+ (and
(nnmbox-request-article article group server)
(save-excursion
(set-buffer buf)
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
- (while (re-search-forward
- "^X-Gnus-Newsgroup:"
+ (while (re-search-forward
+ "^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t)
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))
(if (looking-at "X-From-Line: ")
(replace-match "From ")
(insert "From nobody " (current-time-string) "\n"))
- (and
+ (and
(nnmail-activate 'nnmbox)
(progn
(set-buffer buf)
(forward-line -1)
(while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
(delete-region (point) (progn (forward-line 1) (point))))
- (when nnmail-cache-message-id-when-accepting
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id"))
(setq result (nnmbox-save-mail
(if (stringp group)
(list (cons group (nnmbox-active-number group)))
(when found
(save-buffer)))))
;; Remove the group from all structures.
- (setq nnmbox-group-alist
+ (setq nnmbox-group-alist
(delq (assoc group nnmbox-group-alist) nnmbox-group-alist)
nnmbox-current-group nil)
;; Save the active file.
(delete-region (point-min) (point-max))))))
(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
- (when (and server
+ (when (and server
(not (nnmbox-server-opened server)))
(nnmbox-open-server server))
(when (or (not nnmbox-mbox-buffer)
(not (buffer-name nnmbox-mbox-buffer)))
(save-excursion
- (set-buffer (setq nnmbox-mbox-buffer
+ (set-buffer (setq nnmbox-mbox-buffer
(nnheader-find-file-noselect
nnmbox-mbox-file nil 'raw)))
(buffer-disable-undo (current-buffer))))
(defun nnmbox-article-string (article)
(if (numberp article)
- (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"
+ (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"
(int-to-string article) " ")
(concat "\nMessage-ID: " article)))
(when (search-forward "\n\n" nil t)
(forward-char -1)
(while group-art
- (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
+ (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
(caar group-art) (cdar group-art)
(current-time-string)))
(setq group-art (cdr group-art))))
(let ((delim (concat "^" message-unix-mail-delimiter))
(alist nnmbox-group-alist)
start end number)
- (set-buffer (setq nnmbox-mbox-buffer
+ (set-buffer (setq nnmbox-mbox-buffer
(nnheader-find-file-noselect
nnmbox-mbox-file nil 'raw)))
(buffer-disable-undo (current-buffer))
(format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
(caar alist)) nil t)
(>= (setq number
- (string-to-number
+ (string-to-number
(buffer-substring
(match-beginning 1) (match-end 1))))
(cdadar alist)))
(setcdr (cadar alist) (1+ number)))
(setq alist (cdr alist)))
-
+
(goto-char (point-min))
(while (re-search-forward delim nil t)
(setq start (match-beginning 0))
- (when (not (search-forward "\nX-Gnus-Newsgroup: "
- (save-excursion
+ (when (not (search-forward "\nX-Gnus-Newsgroup: "
+ (save-excursion
(setq end
(or
(and
(save-excursion
(save-restriction
(narrow-to-region start end)
- (nnmbox-save-mail
+ (nnmbox-save-mail
(nnmail-article-group 'nnmbox-active-number)))))
(goto-char end))))))
;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.
;;; Code:
(if (stringp (car articles))
'headers
(while articles
- (when (and (file-exists-p
- (setq file (concat (file-name-as-directory
+ (when (and (file-exists-p
+ (setq file (concat (file-name-as-directory
nnmh-current-directory)
(int-to-string
(setq article (pop articles))))))
(condition-case ()
(make-directory nnmh-directory t)
(error t)))
- (cond
+ (cond
((not (file-exists-p nnmh-directory))
(nnmh-close-server)
(nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory))
(deffoo nnmh-request-group (group &optional server dont-check)
(let ((pathname (nnmail-group-pathname group nnmh-directory))
dir)
- (cond
+ (cond
((not (file-directory-p pathname))
- (nnheader-report
+ (nnheader-report
'nnmh "Can't select group (no such directory): %s" group))
(t
(setq nnmh-current-directory pathname)
- (and nnmh-get-new-mail
+ (and nnmh-get-new-mail
nnmh-be-safe
(nnmh-update-gnus-unreads group))
(cond
(t
;; Re-scan the directory if it's on a foreign system.
(nnheader-re-read-dir pathname)
- (setq dir
+ (setq dir
(sort
(mapcar (lambda (name) (string-to-int name))
(directory-files pathname nil "^[0-9]+$" t))
'<))
- (cond
+ (cond
(dir
(nnheader-report 'nnmh "Selected group %s" group)
(nnheader-insert
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-max))
- (insert
- (format
- "%s %d %d y\n"
+ (insert
+ (format
+ "%s %d %d y\n"
(progn
- (string-match
+ (string-match
(regexp-quote
- (file-truename (file-name-as-directory
+ (file-truename (file-name-as-directory
(expand-file-name nnmh-toplev))))
dir)
(nnheader-replace-chars-in-string
(deffoo nnmh-request-expire-articles (articles newsgroup
&optional server force)
(nnmh-possibly-change-directory newsgroup server)
- (let* ((active-articles
+ (let* ((active-articles
(mapcar
(function
(lambda (name)
(nnmail-activate 'nnmh)
(while (and articles is-old)
- (setq article (concat nnmh-current-directory
+ (setq article (concat nnmh-current-directory
(int-to-string (car articles))))
(when (setq mod-time (nth 5 (file-attributes article)))
(if (and (nnmh-deletable-article-p newsgroup (car articles))
(setq is-old
(nnmail-expired-article-p newsgroup mod-time force)))
(progn
- (nnheader-message 5 "Deleting article %s in %s..."
+ (nnheader-message 5 "Deleting article %s in %s..."
article newsgroup)
(condition-case ()
(funcall nnmail-delete-file-function article)
(deffoo nnmh-close-group (group &optional server)
t)
-(deffoo nnmh-request-move-article
+(deffoo nnmh-request-move-article
(article group server accept-form &optional last)
(let ((buf (get-buffer-create " *nnmh move*"))
result)
- (and
+ (and
(nnmh-deletable-article-p group article)
(nnmh-request-article article group server)
(save-excursion
(deffoo nnmh-request-accept-article (group &optional server last noinsert)
(nnmh-possibly-change-directory group server)
(nnmail-check-syntax)
- (when nnmail-cache-message-id-when-accepting
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id"))
(if (stringp group)
- (and
+ (and
(nnmail-activate 'nnmh)
- (car (nnmh-save-mail
+ (car (nnmh-save-mail
(list (cons group (nnmh-active-number group)))
noinsert)))
(and
(set-buffer buffer)
(nnmh-possibly-create-directory group)
(ignore-errors
- (nnmail-write-region
+ (nnmail-write-region
(point-min) (point-max)
(concat nnmh-current-directory (int-to-string article))
nil (if (nnheader-be-verbose 5) nil 'nomesg))
(let ((articles (mapcar
(lambda (file)
(string-to-int file))
- (directory-files
+ (directory-files
nnmh-current-directory nil "^[0-9]+$"))))
(when articles
(setcar active (apply 'min articles))
(if (not force)
() ; Don't delete the articles.
(let ((articles (directory-files nnmh-current-directory t "^[0-9]+$")))
- (while articles
+ (while articles
(when (file-writable-p (car articles))
(nnheader-message 5 "Deleting article %s in %s..."
(car articles) group)
(ignore-errors
(delete-directory nnmh-current-directory)))
;; Remove the group from all structures.
- (setq nnmh-group-alist
+ (setq nnmh-group-alist
(delq (assoc group nnmh-group-alist) nnmh-group-alist)
nnmh-current-directory nil)
t)
;; One might be more clever, I guess.
(let ((files (nnheader-article-to-file-alist old-dir)))
(while files
- (rename-file
+ (rename-file
(concat old-dir (cdar files))
(concat new-dir (cdar files)))
(pop files)))
;;; Internal functions.
(defun nnmh-possibly-change-directory (newsgroup &optional server)
- (when (and server
+ (when (and server
(not (nnmh-server-opened server)))
(nnmh-open-server server))
(when newsgroup
(error "Could not create directory %s" (car dirs)))
(nnheader-message 5 "Creating mail directory %s" (car dirs))
(setq dirs (cdr dirs)))))
-
+
(defun nnmh-save-mail (group-art &optional noinsert)
"Called narrowed to an article."
(unless noinsert
first)
(while ga
(nnmh-possibly-create-directory (caar ga))
- (let ((file (concat (nnmail-group-pathname
+ (let ((file (concat (nnmail-group-pathname
(caar ga) nnmh-directory)
(int-to-string (cdar ga)))))
(if first
(let ((active (cadr (assoc group nnmh-group-alist))))
(unless active
;; The group wasn't known to nnmh, so we just create an active
- ;; entry for it.
+ ;; entry for it.
(setq active (cons 1 0))
(push (list group active) nnmh-group-alist)
;; Find the highest number in the group.
;; marked as unread by Gnus.
(let* ((dir nnmh-current-directory)
(files (sort (mapcar (function (lambda (name) (string-to-int name)))
- (directory-files nnmh-current-directory
+ (directory-files nnmh-current-directory
nil "^[0-9]+$" t))
'<))
(nnmh-file (concat dir ".nnmh-articles"))
new articles)
;; Load the .nnmh-articles file.
(when (file-exists-p nnmh-file)
- (setq articles
+ (setq articles
(let (nnmh-newsgroup-articles)
(ignore-errors (load nnmh-file nil t t))
nnmh-newsgroup-articles)))
art)
(while (setq art (pop arts))
(when (not (equal
- (nth 5 (file-attributes
+ (nth 5 (file-attributes
(concat dir (int-to-string (car art)))))
(cdr art)))
(setq articles (delq art articles))
new)))
;; Make Gnus mark all new articles as unread.
(when new
- (gnus-make-articles-unread
+ (gnus-make-articles-unread
(gnus-group-prefixed-name group (list 'nnmh ""))
(setq new (sort new '<))))
;; Sort the article list with highest numbers first.
"Say whether ARTICLE in GROUP can be deleted."
(let ((path (concat nnmh-current-directory (int-to-string article))))
;; Writable.
- (and (file-writable-p path)
+ (and (file-writable-p path)
;; We can never delete the last article in the group.
(not (eq (cdr (nth 1 (assoc group nnmh-group-alist)))
article)))))
;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
+;; Gnus sources.
;;; Code:
(defvoo nnml-directory message-directory
"Mail spool directory.")
-(defvoo nnml-active-file
+(defvoo nnml-active-file
(concat (file-name-as-directory nnml-directory) "active")
"Mail active file.")
-(defvoo nnml-newsgroups-file
+(defvoo nnml-newsgroups-file
(concat (file-name-as-directory nnml-directory) "newsgroups")
"Mail newsgroups description file.")
(condition-case ()
(make-directory nnml-directory t)
(error)))
- (cond
+ (cond
((not (file-exists-p nnml-directory))
(nnml-close-server)
(nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
nnml-directory))))))
(setq path (concat gpath (int-to-string (cdr group-num)))))
(setq path (nnml-article-to-file id)))
- (cond
+ (cond
((not path)
(nnheader-report 'nnml "No such article: %s" id))
((not (file-exists-p path))
(string-to-int (file-name-nondirectory path)))))))
(deffoo nnml-request-group (group &optional server dont-check)
- (cond
+ (cond
((not (nnml-possibly-change-directory group server))
(nnheader-report 'nnml "Invalid group (no such directory)"))
((not (file-exists-p nnml-current-directory))
nnml-current-directory))
((not (file-directory-p nnml-current-directory))
(nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
- (dont-check
+ (dont-check
(nnheader-report 'nnml "Group %s selected" group)
t)
(t
(if (not active)
(nnheader-report 'nnml "No such group: %s" group)
(nnheader-report 'nnml "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
+ (nnheader-insert "211 %d %d %d %s\n"
(max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group))))))
(deffoo nnml-request-expire-articles (articles group
&optional server force)
(nnml-possibly-change-directory group server)
- (let* ((active-articles
+ (let* ((active-articles
(nnheader-directory-articles nnml-current-directory))
(is-old t)
article rest mod-time number)
(when (setq article (nnml-article-to-file (setq number (pop articles))))
(when (setq mod-time (nth 5 (file-attributes article)))
(if (and (nnml-deletable-article-p group number)
- (setq is-old
+ (setq is-old
(nnmail-expired-article-p group mod-time force
nnml-inhibit-expiry)))
(progn
(nnml-save-nov)
(nconc rest articles)))
-(deffoo nnml-request-move-article
+(deffoo nnml-request-move-article
(article group server accept-form &optional last)
(let ((buf (get-buffer-create " *nnml move*"))
result)
(nnml-possibly-change-directory group server)
(nnml-update-file-alist)
- (and
+ (and
(nnml-deletable-article-p group article)
(nnml-request-article article group server)
(save-excursion
(nnml-possibly-change-directory group server)
(nnmail-check-syntax)
(let (result)
- (when nnmail-cache-message-id-when-accepting
- (nnmail-cache-insert (nnmail-fetch-field "message-id")))
+ (nnmail-cache-insert (nnmail-fetch-field "message-id"))
(if (stringp group)
- (and
+ (and
(nnmail-activate 'nnml)
- (setq result (car (nnml-save-mail
+ (setq result (car (nnml-save-mail
(list (cons group (nnml-active-number group))))))
(progn
(nnmail-save-active nnml-group-alist nnml-active-file)
headers)
(when (condition-case ()
(progn
- (nnmail-write-region
+ (nnmail-write-region
(point-min) (point-max)
(or (nnml-article-to-file article)
(concat nnml-current-directory
(error nil))
(setq headers (nnml-parse-head chars article))
;; Replace the NOV line in the NOV file.
- (save-excursion
+ (save-excursion
(set-buffer (nnml-open-nov group))
(goto-char (point-min))
(if (or (looking-at art)
;; we should insert it. (This situation should never
;; occur, but one likes to make sure...)
(while (and (looking-at "[0-9]+\t")
- (< (string-to-int
- (buffer-substring
+ (< (string-to-int
+ (buffer-substring
(match-beginning 0) (match-end 0)))
article)
(zerop (forward-line 1)))))
(nnml-possibly-change-directory group server)
(when force
;; Delete all articles in GROUP.
- (let ((articles
- (directory-files
+ (let ((articles
+ (directory-files
nnml-current-directory t
(concat nnheader-numerical-short-files
"\\|" (regexp-quote nnml-nov-file-name) "$")))
article)
- (while articles
+ (while articles
(setq article (pop articles))
(when (file-writable-p article)
(nnheader-message 5 "Deleting article %s in %s..." article group)
(delete-directory nnml-current-directory)
(error nil)))
;; Remove the group from all structures.
- (setq nnml-group-alist
+ (setq nnml-group-alist
(delq (assoc group nnml-group-alist) nnml-group-alist)
nnml-current-group nil
nnml-current-directory nil)
;; One might be more clever, I guess.
(let ((files (nnheader-article-to-file-alist old-dir)))
(while files
- (rename-file
+ (rename-file
(concat old-dir (cdar files))
(concat new-dir (cdar files)))
(pop files)))
(not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
article)))))))
-;; Find an article number in the current group given the Message-ID.
+;; Find an article number in the current group given the Message-ID.
(defun nnml-find-group-number (id)
(save-excursion
(set-buffer (get-buffer-create " *nnml id*"))
number)
;; We want to look through all .overview files, but we want to
;; start with the one in the current directory. It seems most
- ;; likely that the article we are looking for is in that group.
+ ;; likely that the article we are looking for is in that group.
(if (setq number (nnml-find-id nnml-current-group id))
(cons nnml-current-group number)
;; It wasn't there, so we look through the other groups as well.
(make-directory (directory-file-name (car dirs)))
(nnheader-message 5 "Creating mail directory %s" (car dirs))
(setq dirs (cdr dirs)))))
-
+
(defun nnml-save-mail (group-art)
"Called narrowed to an article."
(let (chars headers)
first)
(while ga
(nnml-possibly-create-directory (caar ga))
- (let ((file (concat (nnmail-group-pathname
+ (let ((file (concat (nnmail-group-pathname
(caar ga) nnml-directory)
(int-to-string (cdar ga)))))
(if first
;; It was already saved, so we just make a hard link.
(funcall nnmail-crosspost-link-function first file t)
;; Save the article.
- (nnmail-write-region (point-min) (point-max) file nil
+ (nnmail-write-region (point-min) (point-max) file nil
(if (nnheader-be-verbose 5) nil 'nomesg))
(setq first file)))
(setq ga (cdr ga))))
;; Generate a nov line for this article. We generate the nov
;; line after saving, because nov generation destroys the
- ;; header.
+ ;; header.
(setq headers (nnml-parse-head chars))
;; Output the nov line to all nov databases that should have it.
(let ((ga group-art))
"Compute the next article number in GROUP."
(let ((active (cadr (assoc group nnml-group-alist))))
;; The group wasn't known to nnml, so we just create an active
- ;; entry for it.
+ ;; entry for it.
(unless active
;; Perhaps the active file was corrupt? See whether
;; there are any articles in this group.
(defun nnml-add-nov (group article headers)
"Add a nov line for the GROUP base."
- (save-excursion
+ (save-excursion
(set-buffer (nnml-open-nov group))
(goto-char (point-max))
(mail-header-set-number headers article)
(save-excursion
(save-restriction
(goto-char (point-min))
- (narrow-to-region
+ (narrow-to-region
(point)
(1- (or (search-forward "\n\n" nil t) (point-max))))
;; Fold continuation lines.
(defun nnml-open-nov (group)
(or (cdr (assoc group nnml-nov-buffer-alist))
- (let ((buffer (nnheader-find-file-noselect
+ (let ((buffer (nnheader-find-file-noselect
(concat (nnmail-group-pathname group nnml-directory)
nnml-nov-file-name))))
(save-excursion
(defun nnml-generate-nov-databases ()
"Generate nov databases in all nnml directories."
(interactive)
- ;; Read the active file to make sure we don't re-use articles
+ ;; Read the active file to make sure we don't re-use articles
;; numbers in empty groups.
(nnmail-activate 'nnml)
(nnml-open-server (or (nnoo-current-server 'nnml) ""))
(defvar files)
(defun nnml-generate-active-info (dir)
;; Update the active info for this group.
- (let ((group (nnheader-file-to-group
+ (let ((group (nnheader-file-to-group
(directory-file-name dir) nnml-directory)))
(setq nnml-group-alist
(delq (assoc group nnml-group-alist) nnml-group-alist))
(unless (file-directory-p (setq file (concat dir (cdar files))))
(erase-buffer)
(nnheader-insert-file-contents file)
- (narrow-to-region
+ (narrow-to-region
(goto-char (point-min))
(progn
(search-forward "\n\n" nil t)
(defmacro nnoo-declare (backend &rest parents)
`(eval-and-compile
- (push (list ',backend
+ (push (list ',backend
(mapcar (lambda (p) (list p)) ',parents)
nil nil)
nnoo-definition-alist)
(&rest args)
(nnoo-parent-function ',backend ',(car m)
,(cons 'list (nreverse margs))))))))
-
+
(defun nnoo-backend (symbol)
(string-match "^[^-]+-" (symbol-name symbol))
(intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
(symbol-value (car def)))))))
(set (car def) (cadr def))))
(while parents
- (nnoo-change-server
- (caar parents) server
+ (nnoo-change-server
+ (caar parents) server
(mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
(cdar parents)))
(pop parents))))
(defs (nnoo-variables backend)))
;; Remove the old definition.
(setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
- ;; If this is the first time we push the server (i. e., this is
+ ;; If this is the first time we push the server (i. e., this is
;; the nil server), then we update the default values of
;; all the variables to reflect the current values.
(when (equal current "*internal-non-initialized-backend*")
(setq this-area-seq nil)
;; We take note whether this MSG has a corresponding IDX
;; for later use.
- (when (or (= (gnus-soup-encoding-index
+ (when (or (= (gnus-soup-encoding-index
(gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
(not (file-exists-p
(nnsoup-file
(car useful-areas)))))
;; We now have a list of article numbers and corresponding
- ;; areas.
+ ;; areas.
(setq useful-areas (nreverse useful-areas))
;; Two different approaches depending on whether all the MSG
useful-areas (cdr useful-areas))
(while articles
(when (setq msg-buf
- (nnsoup-narrow-to-article
+ (nnsoup-narrow-to-article
(car articles) (cdar useful-areas) 'head))
(goto-char (point-max))
(insert (format "221 %d Article retrieved.\n" (car articles)))
(condition-case ()
(make-directory nnsoup-directory t)
(error t)))
- (cond
+ (cond
((not (file-exists-p nnsoup-directory))
(nnsoup-close-server)
(nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
(deffoo nnsoup-request-group (group &optional server dont-check)
(nnsoup-possibly-change-group group)
- (if dont-check
+ (if dont-check
t
(let ((active (cadr (assoc group nnsoup-group-alist))))
(if (not active)
(nnheader-report 'nnsoup "No such group: %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n"
+ (nnheader-insert
+ "211 %d %d %d %s\n"
(max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group)))))
(cdaar (cddr (assoc group nnsoup-group-alist)))))
(if (not article)
'unknown
- (let ((kind (gnus-soup-encoding-kind
+ (let ((kind (gnus-soup-encoding-kind
(gnus-soup-area-encoding
(nth 1 (nnsoup-article-to-area
article nnsoup-current-group))))))
(setq mod-time (nth 5 (file-attributes
(nnsoup-file prefix t)))))
(gnus-sublist-p articles range-list)
- ;; This file is old enough.
+ ;; This file is old enough.
(nnmail-expired-article-p group mod-time force))
;; Ok, we delete this file.
(when (ignore-errors
- (nnheader-message
+ (nnheader-message
5 "Deleting %s in group %s..." (nnsoup-file prefix)
group)
(when (file-exists-p (nnsoup-file prefix))
(delete-file (nnsoup-file prefix)))
- (nnheader-message
+ (nnheader-message
5 "Deleting %s in group %s..." (nnsoup-file prefix t)
group)
(when (file-exists-p (nnsoup-file prefix t))
(defun nnsoup-write-active-file (&optional force)
(when (and nnsoup-group-alist
- (or force
+ (or force
nnsoup-group-alist-touched))
(setq nnsoup-group-alist-touched nil)
(nnheader-temp-write nnsoup-active-file
(defun nnsoup-next-prefix ()
"Return the next free prefix."
(let (prefix)
- (while (or (file-exists-p
+ (while (or (file-exists-p
(nnsoup-file (setq prefix (int-to-string
nnsoup-current-prefix))))
(file-exists-p (nnsoup-file prefix t)))
;; Change the name to the permanent name and move the files.
(setq cur-prefix (nnsoup-next-prefix))
(message "Incorporating file %s..." cur-prefix)
- (when (file-exists-p
+ (when (file-exists-p
(setq file (concat nnsoup-tmp-directory
(gnus-soup-area-prefix area) ".IDX")))
(rename-file file (nnsoup-file cur-prefix)))
- (when (file-exists-p
- (setq file (concat nnsoup-tmp-directory
+ (when (file-exists-p
+ (setq file (concat nnsoup-tmp-directory
(gnus-soup-area-prefix area) ".MSG")))
(rename-file file (nnsoup-file cur-prefix t))
(gnus-soup-set-area-prefix area cur-prefix)
(if (not (setq entry (assoc (gnus-soup-area-name area)
nnsoup-group-alist)))
;; If this is a new area (group), we just add this info to
- ;; the group alist.
+ ;; the group alist.
(push (list (gnus-soup-area-name area)
(cons 1 number)
(list (cons 1 number) area))
(defun nnsoup-number-of-articles (area)
(save-excursion
- (cond
+ (cond
;; If the number is in the area info, we just return it.
((gnus-soup-area-number area)
(gnus-soup-area-number area))
(set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
(count-lines (point-min) (point-max)))
;; We do it the hard way - re-searching through the message
- ;; buffer.
+ ;; buffer.
(t
(set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
(unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
(nnsoup-dissect-buffer area))
- (length (cdr (assoc (gnus-soup-area-prefix area)
+ (length (cdr (assoc (gnus-soup-area-prefix area)
nnsoup-article-alist)))))))
(defun nnsoup-dissect-buffer (area)
(i 0)
alist len)
(goto-char (point-min))
- (cond
+ (cond
;; rnews batch format
((= format ?n)
(while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
((= format ?m)
(while (looking-at mbox-delim)
(forward-line 1)
- (push (list
+ (push (list
(incf i) (point)
(progn
(if (re-search-forward mbox-delim nil t)
((= format ?M)
(while (looking-at "\^A\^A\^A\^A\n")
(forward-line 1)
- (push (list
+ (push (list
(incf i) (point)
(progn
(if (search-forward "\n\^A\^A\^A\^A\n" nil t)
packet)
(while (setq packet (pop packets))
(message "nnsoup: unpacking %s..." packet)
- (if (not (gnus-soup-unpack-packet
+ (if (not (gnus-soup-unpack-packet
nnsoup-tmp-directory nnsoup-unpacker packet))
(message "Couldn't unpack %s" packet)
(delete-file packet)
;; There is no MSG file.
((null msg-buf)
nil)
- ;; We use the index file to find out where the article
- ;; begins and ends.
- ((and (= (gnus-soup-encoding-index
+ ;; We use the index file to find out where the article
+ ;; begins and ends.
+ ((and (= (gnus-soup-encoding-index
(gnus-soup-area-encoding (nth 1 area)))
?c)
(file-exists-p (nnsoup-file prefix)))
(when (eval message-mailer-swallows-blank-line)
(newline))
(let ((msg-buf
- (gnus-soup-store
- nnsoup-replies-directory
+ (gnus-soup-store
+ nnsoup-replies-directory
(nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
nnsoup-replies-index-type))
(num 0))
(defun nnsoup-kind-to-prefix (kind)
(unless nnsoup-replies-list
(setq nnsoup-replies-list
- (gnus-soup-parse-replies
+ (gnus-soup-parse-replies
(concat nnsoup-replies-directory "REPLIES"))))
(let ((replies nnsoup-replies-list))
- (while (and replies
+ (while (and replies
(not (string= kind (gnus-soup-reply-kind (car replies)))))
(setq replies (cdr replies)))
(if replies
(gnus-soup-reply-prefix (car replies))
(push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
- kind
+ kind
(format "%c%c%c"
nnsoup-replies-format-type
nnsoup-replies-index-type
(setq lines (count-lines (point-min) (point-max)))
(setq ident (progn (string-match
"/\\([0-9]+\\)\\." (car files))
- (substring
+ (substring
(car files) (match-beginning 1)
(match-end 1))))
(if (not (setq elem (assoc group active)))
(defun nnsoup-delete-unreferenced-message-files ()
"Delete any *.MSG and *.IDX files that aren't known by nnsoup."
(interactive)
- (let* ((known (apply 'nconc (mapcar
+ (let* ((known (apply 'nconc (mapcar
(lambda (ga)
(mapcar
(lambda (area)
(if (stringp article)
;; This is a Message-ID.
(setq ag (nnspool-find-id article)
- file (and ag (nnspool-article-pathname
+ file (and ag (nnspool-article-pathname
(car ag) (cdr ag)))
article (cdr ag))
;; This is an article in the current group.
(forward-char -1)
(insert ".\n")
(delete-region (point) (point-max)))
-
+
(and do-message
(zerop (% (incf count) 20))
(message "nnspool: Receiving headers... %d%%"
(/ (* count 100) number))))
-
+
(when do-message
(message "nnspool: Receiving headers...done"))
-
+
;; Fold continuation lines.
(nnheader-fold-continuation-lines)
'headers)))))
(deffoo nnspool-open-server (server &optional defs)
(nnoo-change-server 'nnspool server defs)
- (cond
+ (cond
((not (file-exists-p nnspool-spool-directory))
(nnspool-close-server)
(nnheader-report 'nnspool "Spool directory doesn't exist: %s"
(nnspool-close-server)
(nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory))
((not (file-exists-p nnspool-active-file))
- (nnheader-report 'nnspool "The active file doesn't exist: %s"
+ (nnheader-report 'nnspool "The active file doesn't exist: %s"
nnspool-active-file))
(t
(nnheader-report 'nnspool "Opened server %s using directory %s"
(let ((nntp-server-buffer (or buffer nntp-server-buffer))
file ag)
(if (stringp id)
- ;; This is a Message-ID.
+ ;; This is a Message-ID.
(when (setq ag (nnspool-find-id id))
(setq file (nnspool-article-pathname (car ag) (cdr ag))))
(setq file (nnspool-article-pathname nnspool-current-group id)))
(if (numberp id)
(cons nnspool-current-group id)
ag))))
-
+
(deffoo nnspool-request-body (id &optional group server)
"Select article body by message ID (or number)."
(nnspool-possibly-change-directory group)
(let ((pathname (nnspool-article-pathname group))
dir)
(if (not (file-directory-p pathname))
- (nnheader-report
+ (nnheader-report
'nnspool "Invalid group name (no such directory): %s" group)
(setq nnspool-current-directory pathname)
(nnheader-report 'nnspool "Selected group %s" group)
;; Yes, completely empty spool directories *are* possible.
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
(when (setq dir (directory-files pathname nil "^[0-9]+$" t))
- (setq dir
+ (setq dir
(sort (mapcar (lambda (name) (string-to-int name)) dir) '<)))
(if dir
(nnheader-insert
"List newsgroups (defined in NNTP2)."
(save-excursion
(or (nnspool-find-file nnspool-newsgroups-file)
- (nnheader-report 'nnspool (nnheader-file-error
+ (nnheader-report 'nnspool (nnheader-file-error
nnspool-newsgroups-file)))))
(deffoo nnspool-request-list-distributions (&optional server)
"List distributions (defined in NNTP2)."
(save-excursion
(or (nnspool-find-file nnspool-distributions-file)
- (nnheader-report 'nnspool (nnheader-file-error
+ (nnheader-report 'nnspool (nnheader-file-error
nnspool-distributions-file)))))
;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(save-excursion
;; Find the last valid line.
(goto-char (point-max))
- (while (and (not (looking-at
+ (while (and (not (looking-at
"\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
(zerop (forward-line -1))))
(let ((seconds (nnspool-seconds-since-epoch date))
(progn
;; We insert a .0 to make the list reader
;; interpret the number as a float. It is far
- ;; too big to be stored in a lisp integer.
+ ;; too big to be stored in a lisp integer.
(goto-char (1- (match-end 0)))
(insert ".0")
(> (progn
(save-excursion
(let* ((process-connection-type nil) ; t bugs out on Solaris
(inews-buffer (generate-new-buffer " *nnspool post*"))
- (proc
+ (proc
(condition-case err
(apply 'start-process "*nnspool inews*" inews-buffer
nnspool-inews-program nnspool-inews-switches)
(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old)
(if (or gnus-nov-is-evil nnspool-nov-is-evil)
nil
- (let ((nov (nnheader-group-pathname
+ (let ((nov (nnheader-group-pathname
nnspool-current-group nnspool-nov-directory ".overview"))
(arts articles)
last)
(car (last articles)))
;; If the buffer is empty, this wasn't very successful.
(unless (zerop (buffer-size))
- ;; We check what the last article number was.
+ ;; We check what the last article number was.
;; The NOV file may be out of sync with the articles
;; in the group.
(forward-line -1)
(let ((first (car articles))
(last (progn (while (cdr articles) (setq articles (cdr articles)))
(car articles))))
- (call-process "awk" nil t nil
+ (call-process "awk" nil t nil
(format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
(1- first) (1+ last))
file)))
-;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle).
+;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle).
;; Find out what group an article identified by a Message-ID is in.
(defun nnspool-find-id (id)
(save-excursion
"Port number on the physical nntp server.")
(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
- "*Hook used for sending commands to the server at startup.
+ "*Hook used for sending commands to the server at startup.
The default value is `nntp-send-mode-reader', which makes an innd
server spawn an nnrpd server. Another useful function to put in this
hook might be `nntp-send-authinfo', which will prompt for a password
(defvoo nntp-authinfo-function 'nntp-send-authinfo
"Function used to send AUTHINFO to the server.")
-(defvoo nntp-server-action-alist
- '(("nntpd 1\\.5\\.11t"
+(defvoo nntp-server-action-alist
+ '(("nntpd 1\\.5\\.11t"
(remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
- ("NNRP server Netscape"
+ ("NNRP server Netscape"
(setq nntp-server-list-active-group nil)))
"Alist of regexps to match on server types and actions to be taken.
For instance, if you want Gnus to beep every time you connect
;; We successfully retrieved the headers via XOVER.
'nov
;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
+ ;; way.
(let ((number (length articles))
(count 0)
(received 0)
(nntp-inhibit-erase t))
;; Send HEAD command.
(while articles
- (nntp-send-command
+ (nntp-send-command
nil
"HEAD" (if (numberp (car articles))
(int-to-string (car articles))
(save-excursion
(set-buffer (nntp-find-connection-buffer nntp-server-buffer))
;; The first time this is run, this variable is `try'. So we
- ;; try.
+ ;; try.
(when (eq nntp-server-list-active-group 'try)
(nntp-try-list-active (car groups)))
(erase-buffer)
(erase-buffer)
;; Send HEAD command.
(while (setq article (pop articles))
- (nntp-send-command
+ (nntp-send-command
nil
"ARTICLE" (if (numberp article)
(int-to-string article)
(defun nntp-next-result-arrived-p ()
(let ((point (point)))
- (cond
+ (cond
((looking-at "2")
(if (re-search-forward "\n.\r?\n" nil t)
t
(format "%s%02d%02d %s%s%s"
(substring (aref date 0) 2) (string-to-int (aref date 1))
(string-to-int (aref date 2)) (substring (aref date 3) 0 2)
- (substring
+ (substring
(aref date 3) 3 5) (substring (aref date 3) 6 8))))
(prog1
(nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
(deffoo nntp-request-type (group article)
'news)
-
+
(deffoo nntp-asynchronous-p ()
t)
"Send the AUTHINFO to the nntp server.
This function is supposed to be called from `nntp-server-opened-hook'.
It will prompt for a password."
- (nntp-send-command
+ (nntp-send-command
"^.*\r?\n" "AUTHINFO USER"
(read-string (format "NNTP (%s) user name: " nntp-address)))
- (nntp-send-command
- "^.*\r?\n" "AUTHINFO PASS"
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
(nnmail-read-passwd "NNTP (%s) password: " nntp-address)))
(defun nntp-send-authinfo ()
It will prompt for a password."
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
- "^.*\r?\n" "AUTHINFO PASS"
+ "^.*\r?\n" "AUTHINFO PASS"
(nnmail-read-passwd (format "NNTP (%s) password: " nntp-address))))
(defun nntp-send-authinfo-from-file ()
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command
- "^.*\r?\n" "AUTHINFO PASS"
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
(buffer-substring (point) (progn (end-of-line) (point)))))))
;;; Internal functions.
(defun nntp-make-process-buffer (buffer)
"Create a new, fresh buffer usable for nntp process connections."
(save-excursion
- (set-buffer
+ (set-buffer
(generate-new-buffer
(format " *server %s %s %s*"
nntp-address nntp-port-number
(erase-buffer)))
(when command
(nntp-send-string process command))
- (cond
+ (cond
((eq callback 'ignore)
t)
((and callback wait-for)
(save-excursion
(set-buffer (process-buffer process))
- (unless nntp-inside-change-function
+ (unless nntp-inside-change-function
(erase-buffer))
(setq nntp-process-decode decode
nntp-process-to-buffer buffer
nntp-process-wait-for wait-for
nntp-process-callback callback
nntp-process-start-point (point-max)
- after-change-functions
+ after-change-functions
(list 'nntp-after-change-function-callback)))
t)
- (wait-for
+ (wait-for
(nntp-wait-for process wait-for buffer decode))
(t t)))))
(goto-char (point-max))
(let ((limit (point-min)))
(while (not (re-search-backward wait-for limit t))
- ;; We assume that whatever we wait for is less than 1000
+ ;; We assume that whatever we wait for is less than 1000
;; characters long.
(setq limit (max (- (point-max) 1000) (point-min)))
(nntp-accept-process-output process)
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
(set-buffer nntp-server-buffer)
(erase-buffer)
- (cond
+ (cond
;; This server does not talk NOV.
((not nntp-server-xover)
;; We don't care about gaps.
((or (not nntp-nov-gap)
fetch-old)
- (nntp-send-xover-command
+ (nntp-send-xover-command
(if fetch-old
(if (numberp fetch-old)
(max 1 (- (car articles) fetch-old))
(while (and nntp-server-xover articles)
(setq first (car articles))
;; Search forward until we find a gap, or until we run out of
- ;; articles.
+ ;; articles.
(while (and (cdr articles)
(< (- (nth 1 articles) (car articles)) nntp-nov-gap))
(setq articles (cdr articles)))
;; On some Emacs versions the preceding function has
;; a tendency to change the buffer. Perhaps. It's
;; quite difficult to reproduce, because it only
- ;; seems to happen once in a blue moon.
+ ;; seems to happen once in a blue moon.
(set-buffer buf)
(while (progn
(goto-char last-point)
(forward-line -1)
(not (looking-at "^\\.\r?\n")))
(nntp-accept-response)))
-
+
;; We remove any "." lines and status lines.
(goto-char (point-min))
(while (search-forward "\r" nil t)
;; If `nntp-server-xover' is a string, then we just send this
;; command.
(if wait-for-reply
- (nntp-send-command-nodelete
+ (nntp-send-command-nodelete
"\r?\n\\.\r?\n" nntp-server-xover range)
;; We do not wait for the reply.
(nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range))
(let ((commands nntp-xover-commands))
;; `nntp-xover-commands' is a list of possible XOVER commands.
- ;; We try them all until we get at positive response.
+ ;; We try them all until we get at positive response.
(while (and commands (eq nntp-server-xover 'try))
(nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
(save-excursion
(and number (zerop number) (setq number nil))
;; Then we find the group name.
(setq group
- (cond
+ (cond
;; If there is only one group in the Newsgroups header,
;; then it seems quite likely that this article comes
;; from that group, I'd say.
;; article number in the Xref header is the one we are
;; looking for. This might very well be wrong if this
;; article happens to have the same number in several
- ;; groups, but that's life.
+ ;; groups, but that's life.
((and (setq xref (mail-fetch-field "xref"))
number
(string-match (format "\\([^ :]+\\):%d" number) xref))
(erase-buffer)
(if (stringp (car articles))
'headers
- (let ((vbuf (nnheader-set-temp-buffer
+ (let ((vbuf (nnheader-set-temp-buffer
(get-buffer-create " *virtual headers*")))
(carticles (nnvirtual-partition-sequence articles))
(system-name (system-name))
;; component group below. They should be coming up
;; generally in order, so this shouldn't be slow.
(setq articles (delq carticle articles))
-
+
(setq article (nnvirtual-reverse-map-article cgroup carticle))
(if (null article)
;; This line has no reverse mapping, that means it
prefix system-name)
(forward-line 1))
)
-
+
(set-buffer vbuf)
(goto-char (point-max))
(insert-buffer-substring nntp-server-buffer))
'nnvirtual "Don't know what server to request from"))
(t
(save-excursion
- (when buffer
+ (when buffer
(set-buffer buffer))
(let ((method (gnus-find-method-for-group
nnvirtual-last-accessed-component-group)))
(nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
(t
(setq nnvirtual-last-accessed-component-group cgroup)
- (if buffer
+ (if buffer
(save-excursion
(set-buffer buffer)
(gnus-request-article-this-buffer (cdr amap) cgroup))
nnvirtual-always-rescan)
(nnvirtual-create-mapping))
(setq nnvirtual-current-group group)
- (nnheader-insert "211 %d 1 %d %s\n"
+ (nnheader-insert "211 %d 1 %d %s\n"
nnvirtual-mapping-len nnvirtual-mapping-len group))))
(setq mark gnus-expirable-mark)))
mark)
-
+
(deffoo nnvirtual-close-group (group &optional server)
(when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
(nnvirtual-update-read-and-marked t t))
t)
-
+
(deffoo nnvirtual-request-list (&optional server)
(nnheader-report 'nnvirtual "LIST is not implemented."))
(setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
(setq nnvirtual-info-installed t))
t))
-
+
(deffoo nnvirtual-catchup-group (group &optional server all)
(when (and (nnvirtual-possibly-change-server server)
If UPDATE-P is not nil, call gnus-group-update-group on the components."
(when nnvirtual-current-group
(let ((unreads (and read-p
- (nnvirtual-partition-sequence
- (gnus-list-of-unread-articles
+ (nnvirtual-partition-sequence
+ (gnus-list-of-unread-articles
(nnvirtual-current-group)))))
(type-marks (mapcar (lambda (ml)
(cons (car ml)
(when (and (setq info (gnus-get-info (pop groups)))
(gnus-info-marks info))
(gnus-info-set-marks info nil)))
-
+
;; Ok, currently type-marks is an assq list with keys of a mark type,
;; with data of an assq list with keys of component group names
;; and the articles which correspond to that key/group pair.
(setq type (car mark))
(setq groups (cdr mark))
(while (setq carticles (pop groups))
- (gnus-add-marked-articles (car carticles) type (cdr carticles)
+ (gnus-add-marked-articles (car carticles) type (cdr carticles)
nil t))))
-
+
;; possibly update the display, it is really slow
(when update-p
(setq groups nnvirtual-component-groups)
(defun nnvirtual-create-mapping ()
- "Build the tables necessary to map between component (group, article) to virtual article.
+ "Build the tables necessary to map between component (group, article) to virtual article.
Generate the set of read messages and marks for the virtual group
based on the marks on the component groups."
(let ((cnt 0)
;; We want the actives list sorted by size, to build the tables.
(setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
-
+
;; Build the offset table. Largest sized groups are at the front.
(setq nnvirtual-mapping-offsets
(vconcat
(cons (nth 0 entry)
(- (nth 2 entry) M)))
actives))))
-
+
;; Build the mapping table.
(setq nnvirtual-mapping-table nil)
(setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
(deffoo nnweb-request-group (group &optional server dont-check)
(nnweb-possibly-change-server nil server)
- (when (and group
+ (when (and group
(not (equal group nnweb-group))
(not nnweb-ephemeral-p))
(let ((info (assoc group nnweb-group-alist)))
(gnus-delete-assoc group nnweb-group-alist)
(gnus-delete-file (nnweb-overview-file group))
t)
-
+
(nnoo-define-skeleton nnweb)
;;; Internal functions
(defun nnweb-read-active ()
"Read the active file."
(load (nnheader-concat nnweb-directory "active") t t t))
-
+
(defun nnweb-definition (type &optional noerror)
"Return the definition of TYPE."
(let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
(defun nnweb-encode-www-form-urlencoded (pairs)
"Return PAIRS encoded for forms."
- (mapconcat
+ (mapconcat
(function
(lambda (data)
(concat (w3-form-encode-xwfu (car data)) "="
(defun nnweb-fetch-form (url pairs)
(let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
(url-request-method "POST")
- (url-request-extra-headers
+ (url-request-extra-headers
'(("Content-type" . "application/x-www-form-urlencoded"))))
(url-insert-file-contents url)
(setq buffer-file-name nil))
(nnweb-decode-entities)
(goto-char (point-min))
(while (re-search-forward "^ +[0-9]+\\." nil t)
- (narrow-to-region
+ (narrow-to-region
(point)
(cond ((re-search-forward "^ +[0-9]+\\." nil t)
(match-beginning 0))
(replace-match "\n" t t))))
(defun nnweb-dejanews-search (search)
- (nnweb-fetch-form
+ (nnweb-fetch-form
(nnweb-definition 'address)
`(("query" . ,search)
("defaultOp" . "AND")
;(nnweb-decode-entities)
(goto-char (point-min))
(while (re-search-forward "^ +[0-9]+\\." nil t)
- (narrow-to-region
+ (narrow-to-region
(point)
(if (re-search-forward "^$" nil t)
(match-beginning 0)
(defun nnweb-reference-search (search)
(prog1
(url-insert-file-contents
- (concat
+ (concat
(nnweb-definition 'address)
"?"
- (nnweb-encode-www-form-urlencoded
+ (nnweb-encode-www-form-urlencoded
`(("search" . "advanced")
("querytext" . ,search)
("subj" . "")
(defun nnweb-altavista-search (search &optional part)
(prog1
(url-insert-file-contents
- (concat
+ (concat
(nnweb-definition 'address)
"?"
- (nnweb-encode-www-form-urlencoded
+ (nnweb-encode-www-form-urlencoded
`(("pg" . "aq")
("what" . "news")
,@(when part `(("stq" . ,(int-to-string (* part 30)))))
,#'(lambda () (car val))
,#'(lambda () (cadr val)))
((8)
- ,#'(lambda ()
+ ,#'(lambda ()
(and (stringp elt)
(= 5 (length elt))
(or (= (aref elt 0) ?+) (= (aref elt 0) ?-))))
;; (require 'smiley)
;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
-;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
+;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
(require 'annotations)
(require 'messagexmas)
'(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
+ ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
("\\(:-*p\\)\\W" 1 "FaceTalking.xpm")
("\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
+ ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm"))
"Normal and deformed faces for smilies."
- :type '(repeat (list regexp
+ :type '(repeat (list regexp
(integer :tag "Match")
(string :tag "Image")))
:group 'smiley)
("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))
"Smileys with noses. These get less false matches."
- :type '(repeat (list regexp
+ :type '(repeat (list regexp
(integer :tag "Match")
(string :tag "Image")))
:group 'smiley)
If this is a symbol, take its value."
:type '(radio (variable-item smiley-deformed-regexp-alist)
(variable-item smiley-nosey-regexp-alist)
- symbol
- (repeat (list regexp
+ symbol
+ (repeat (list regexp
(integer :tag "Match")
(string :tag "Image"))))
:group 'smiley)
smiley-running-xemacs
(or
(cdr-safe (assoc pixmap smiley-glyph-cache))
- (let* ((xpm-color-symbols
+ (let* ((xpm-color-symbols
(and (featurep 'xpm)
(append `(("flesh" ,smiley-flesh-color)
("features" ,smiley-features-color)
(hide-annotation ant))
(when pt
(while (setq ext (extent-at pt (event-buffer event) nil ext 'at))
- (when (annotationp (setq ant
+ (when (annotationp (setq ant
(extent-property ext 'smiley-annotation)))
(reveal-annotation ant)
(set-extent-property ext 'invisible t)))))))
t)))
(defvar gnus-article-buffer)
-;;;###autoload
+;;;###autoload
(defun gnus-smiley-display ()
(interactive)
(save-excursion
(defvar widget-browse-mode-map nil
"Keymap for `widget-browse-mode'.")
-
+
(unless widget-browse-mode-map
(setq widget-browse-mode-map (make-sparse-keymap))
(set-keymap-parent widget-browse-mode-map widget-keymap))
-(easy-menu-define widget-browse-mode-menu
+(easy-menu-define widget-browse-mode-menu
widget-browse-mode-map
"Menu used in widget browser buffers."
'("Widget"
(defun widget-browse (widget)
"Create a widget browser for WIDGET."
- (interactive (list (completing-read "Widget: "
+ (interactive (list (completing-read "Widget: "
obarray
(lambda (symbol)
(get symbol 'widget-type))
(kill-buffer (get-buffer-create "*Browse Widget*"))
(switch-to-buffer (get-buffer-create "*Browse Widget*")))
(widget-browse-mode)
-
+
;; Quick way to get out.
(widget-create 'push-button
:action (lambda (widget &optional event)
:action 'widget-browse-action)
(defun widget-browse-action (widget &optional event)
- ;; Create widget browser for WIDGET's :value.
+ ;; Create widget browser for WIDGET's :value.
(widget-browse (widget-get widget :value)))
(defun widget-browse-value-create (widget)
(require 'atomic-extents)
(let ((ext (make-extent from to)))
;; XEmacs doesn't understant different kinds of read-only, so
- ;; we have to use extents instead.
+ ;; we have to use extents instead.
(put-text-property from to 'read-only nil)
(set-extent-property ext 'read-only t)
(set-extent-property ext 'start-open nil)
(defun widget-make-intangible (from to size)
"Make text between FROM and TO intangible."
(put-text-property from to 'intangible 'front)))
-
+
;; The following should go away when bundled with Emacs.
(eval-and-compile
(condition-case ()
(unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
;; We have the old custom-library, hack around it!
(defmacro defgroup (&rest args) nil)
- (defmacro defcustom (var value doc &rest args)
+ (defmacro defcustom (var value doc &rest args)
`(defvar ,var ,value ,doc))
(defmacro defface (&rest args) nil)
(define-widget-keywords :prefix :tag :load :link :options :type :group)
(defgroup widgets nil
"Customization support for the Widget Library."
:link '(custom-manual "(widget)Top")
- :link '(url-link :tag "Development Page"
+ :link '(url-link :tag "Development Page"
"http://www.dina.kvl.dk/~abraham/custom/")
:prefix "widget-"
:group 'extensions
(((class grayscale color)
(background dark))
(:background "dark gray"))
- (t
+ (t
(:italic t)))
"Face used for editable fields."
:group 'widgets)
nil)))
;;; Widget text specifications.
-;;
-;; These functions are for specifying text properties.
+;;
+;; These functions are for specifying text properties.
(defun widget-specify-none (from to)
;; Clear all text properties between FROM and TO.
;; choice widget). We try to compensate by checking the format
;; string, and hope the user hasn't changed the :create method.
(widget-make-intangible (- from 2) from 'end-open))
-
+
;; Make it possible to edit back end of the field.
(add-text-properties to (1+ to) (list 'front-sticky nil
'read-only t
;; I tried putting an invisible intangible read-only space
;; before the newline, which gave really weird effects.
;; So for now, we just have trust the user not to delete the
- ;; newline.
+ ;; newline.
(put-text-property to (1+ to) 'read-only nil))))
(defun widget-specify-field-update (widget from to)
(face (or (widget-get widget :value-face)
'widget-field-face)))
- (when secret
+ (when secret
(while (and size
(not (zerop size))
(> secret-to from)
'local-map map
'face face))
- (when secret
+ (when secret
(save-excursion
(goto-char from)
(while (< (point) secret-to)
missing nil))
((setq tmp (car widget))
(setq widget (get tmp 'widget-type)))
- (t
+ (t
(setq missing nil))))
value))
(widget-glyph-insert-glyph widget tag image))
(t
;; A string. Look it up in.
- (let ((file (concat widget-glyph-directory
+ (let ((file (concat widget-glyph-directory
(if (string-match "/\\'" widget-glyph-directory)
""
"/")
(set-glyph-image glyph (cons 'tty tag))
(set-glyph-property glyph 'widget widget)
(insert "*")
- (add-text-properties (1- (point)) (point)
+ (add-text-properties (1- (point)) (point)
(list 'invisible t
'end-glyph glyph)))
;;;###autoload
(defun widget-create (type &rest args)
- "Create widget of TYPE.
+ "Create widget of TYPE.
The optional ARGS are additional keyword arguments."
(let ((widget (apply 'widget-convert type args)))
(widget-apply widget :create)
(widget-apply widget :delete))
(defun widget-convert (type &rest args)
- "Convert TYPE to a widget without inserting it in the buffer.
+ "Convert TYPE to a widget without inserting it in the buffer.
The optional ARGS are additional keyword arguments."
;; Don't touch the type.
- (let* ((widget (if (symbolp type)
+ (let* ((widget (if (symbolp type)
(list type)
(copy-list type)))
(current widget)
(setq widget (funcall convert-widget widget))))
(setq type (get (car type) 'widget-type)))
;; Finally set the keyword args.
- (while keys
+ (while keys
(let ((next (nth 0 keys)))
(if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:))
- (progn
+ (progn
(widget-put widget next (nth 1 keys))
(setq keys (nthcdr 2 keys)))
(setq keys nil))))
"Keymap containing useful binding for buffers containing widgets.
Recommended as a parent keymap for modes using widgets.")
-(unless widget-keymap
+(unless widget-keymap
(setq widget-keymap (make-sparse-keymap))
(define-key widget-keymap "\C-k" 'widget-kill-line)
(define-key widget-keymap "\t" 'widget-forward)
(define-key widget-keymap [(shift tab)] 'widget-backward)
(define-key widget-keymap [backtab] 'widget-backward)
(if (string-match "XEmacs" (emacs-version))
- (progn
+ (progn
(define-key widget-keymap [button2] 'widget-button-click)
(define-key widget-keymap [button1] 'widget-button1-click))
(define-key widget-keymap [mouse-2] 'ignore)
(defvar widget-field-keymap nil
"Keymap used inside an editable field.")
-(unless widget-field-keymap
+(unless widget-field-keymap
(setq widget-field-keymap (copy-keymap widget-keymap))
(unless (string-match "XEmacs" (emacs-version))
(define-key widget-field-keymap [menu-bar] 'nil))
(defvar widget-text-keymap nil
"Keymap used inside a text field.")
-(unless widget-text-keymap
+(unless widget-text-keymap
(setq widget-text-keymap (copy-keymap widget-keymap))
(unless (string-match "XEmacs" (emacs-version))
(define-key widget-text-keymap [menu-bar] 'nil))
(let ((button (get-text-property (event-point event) 'button)))
(if button
(widget-apply button :action event)
- (call-interactively
+ (call-interactively
(or (lookup-key widget-global-map [ button2 ])
(lookup-key widget-global-map [ down-mouse-2 ])
(lookup-key widget-global-map [ mouse-2]))))))
(defun widget-field-find (pos)
;; Find widget whose editing field is located at POS.
;; Return nil if POS is not inside and editing field.
- ;;
+ ;;
;; This is only used in `widget-field-modified', since ordinarily
;; you would just test the field property.
(let ((fields widget-field-list)
(message "Error: `widget-after-change' called on two fields"))
(t
(let ((size (widget-get field :size)))
- (if size
+ (if size
(let ((begin (1+ (widget-get field :value-from)))
(end (1- (widget-get field :value-to))))
(widget-specify-field-update field begin end)
(save-excursion
(goto-char end)
(insert-char ?\ (- (+ begin size) end))
- (widget-specify-field-update field
+ (widget-specify-field-update field
begin
(+ begin size))))
((> (- end begin) size)
;;; Widget Functions
;;
-;; These functions are used in the definition of multiple widgets.
+;; These functions are used in the definition of multiple widgets.
(defun widget-children-value-delete (widget)
"Delete all :children and :buttons in WIDGET."
:indent nil
:offset 0
:format-handler 'widget-default-format-handler
- :button-face-get 'widget-default-button-face-get
- :sample-face-get 'widget-default-sample-face-get
+ :button-face-get 'widget-default-button-face-get
+ :sample-face-get 'widget-default-sample-face-get
:delete 'widget-default-delete
:value-set 'widget-default-value-set
:value-inline 'widget-default-value-inline
(insert "\n")
(insert-char ? (widget-get widget :indent))))
((eq escape ?t)
- (cond (glyph
+ (cond (glyph
(widget-glyph-insert widget (or tag "image") glyph))
(tag
(insert tag))
(if (and button-begin (not button-end))
(widget-apply widget :value-create)
(setq value-pos (point))))
- (t
+ (t
(widget-apply widget :format-handler escape)))))
;; Specify button, sample, and doc, and insert value.
(and button-begin button-end
(push (if (string-match "\n." doc-text)
;; Allow multiline doc to be hiden.
(widget-create-child-and-convert
- widget 'widget-help
+ widget 'widget-help
:doc (progn
(string-match "\\`.*" doc-text)
(match-string 0 doc-text))
(widget-create-child-and-convert
widget 'item :format "%d" :doc doc-text nil))
buttons)))
- (t
+ (t
(error "Unknown escape `%c'" escape)))
(widget-put widget :buttons buttons)))
(defun widget-item-convert-widget (widget)
;; Initialize :value from :args in WIDGET.
(let ((args (widget-get widget :args)))
- (when args
+ (when args
(widget-put widget :value (widget-apply widget
:value-to-internal (car args)))
(widget-put widget :args nil)))
(fboundp 'device-on-window-system-p)
(device-on-window-system-p)
(string-match "XEmacs" emacs-version))
- (progn
+ (progn
(unless gui
(setq gui (make-gui-button tag 'widget-gui-action widget))
(push (cons tag gui) widget-push-button-cache))
(invalid (widget-apply widget :validate)))
(when invalid
(error (widget-get invalid :error)))
- (widget-value-set widget
- (widget-apply widget
+ (widget-value-set widget
+ (widget-apply widget
:value-to-external
- (read-string (concat tag ": ")
- (widget-apply
+ (read-string (concat tag ": ")
+ (widget-apply
widget
:value-to-internal
(widget-value widget))
(secret (widget-get widget :secret))
(old (current-buffer)))
(if (and from to)
- (progn
+ (progn
(set-buffer (marker-buffer from))
(setq from (1+ from)
to (1- to))
choices)))
(widget-choose tag (reverse choices) event))))
(when current
- (widget-value-set widget
+ (widget-value-set widget
(widget-apply current :value-to-external
(widget-get current :value)))
(widget-apply widget :notify widget event)
(defun widget-toggle-value-create (widget)
;; Insert text representing the `on' and `off' states.
(if (widget-value widget)
- (widget-glyph-insert widget
- (widget-get widget :on)
+ (widget-glyph-insert widget
+ (widget-get widget :on)
(widget-get widget :on-glyph))
(widget-glyph-insert widget
(widget-get widget :off)
;; Toggle value.
(widget-value-set widget (not (widget-value widget)))
(widget-apply widget :notify widget event))
-
+
;;; The `checkbox' Widget.
(define-widget 'checkbox 'toggle
;; Insert all values
(let ((alist (widget-checklist-match-find widget (widget-get widget :value)))
(args (widget-get widget :args)))
- (while args
+ (while args
(widget-checklist-add-item widget (car args) (assq (car args) alist))
(setq args (cdr args)))
(widget-put widget :children (nreverse (widget-get widget :children)))))
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
- (widget-specify-insert
+ (widget-specify-insert
(let* ((children (widget-get widget :children))
(buttons (widget-get widget :buttons))
(from (point))
(t
(widget-create-child-value
widget type (car (cdr chosen)))))))
- (t
+ (t
(error "Unknown escape `%c'" escape)))))
;; Update properties.
(and button child (widget-put child :button button))
found rest)
(while values
(let ((answer (widget-checklist-match-up args values)))
- (cond (answer
+ (cond (answer
(let ((vals (widget-match-inline answer values)))
(setq found (append found (car vals))
values (cdr vals)
(greedy
(setq rest (append rest (list (car values)))
values (cdr values)))
- (t
+ (t
(setq rest (append rest values)
values nil)))))
(cons found rest)))
found)
(while vals
(let ((answer (widget-checklist-match-up args vals)))
- (cond (answer
+ (cond (answer
(let ((match (widget-match-inline answer vals)))
(setq found (cons (cons answer (car match)) found)
vals (cdr match)
args (delq answer args))))
(greedy
(setq vals (cdr vals)))
- (t
+ (t
(setq vals nil)))))
found))
;; The values of all selected items.
(let ((children (widget-get widget :children))
child result)
- (while children
+ (while children
(setq child (car children)
children (cdr children))
(if (widget-value (widget-get child :button))
;; Insert all values
(let ((args (widget-get widget :args))
arg)
- (while args
+ (while args
(setq arg (car args)
args (cdr args))
(widget-radio-add-item widget arg))))
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
- (widget-specify-insert
+ (widget-specify-insert
(let* ((value (widget-get widget :value))
(children (widget-get widget :children))
(buttons (widget-get widget :buttons))
(insert "%"))
((eq escape ?b)
(setq button (widget-create-child-and-convert
- widget 'radio-button
+ widget 'radio-button
:value (not (null chosen)))))
((eq escape ?v)
(setq child (if chosen
(widget-create-child-value
widget type value)
(widget-create-child widget type))))
- (t
+ (t
(error "Unknown escape `%c'" escape)))))
;; Update properties.
(when chosen
(widget-put widget :choice type))
- (when button
+ (when button
(widget-put child :button button)
(widget-put widget :buttons (nconc buttons (list button))))
(when child
(match (and (not found)
(widget-apply current :match value))))
(widget-value-set button match)
- (if match
+ (if match
(widget-value-set current value))
(setq found (or found match))))))
(defun widget-insert-button-action (widget &optional event)
;; Ask the parent to insert a new item.
- (widget-apply (widget-get widget :parent)
+ (widget-apply (widget-get widget :parent)
:insert-before (widget-get widget :widget)))
;;; The `delete-button' Widget.
(defun widget-delete-button-action (widget &optional event)
;; Ask the parent to insert a new item.
- (widget-apply (widget-get widget :parent)
+ (widget-apply (widget-get widget :parent)
:delete-at (widget-get widget :widget)))
;;; The `editable-list' Widget.
(and (widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
(widget-create-child-and-convert widget 'insert-button))
- (t
+ (t
(widget-default-format-handler widget escape)))))
(defun widget-editable-list-value-create (widget)
found)
(while (and value ok)
(let ((answer (widget-match-inline type value)))
- (if answer
+ (if answer
(setq found (append found (car answer))
value (cdr answer))
(setq ok nil))))
(let ((children (widget-get widget :children))
(inhibit-read-only t)
after-change-functions)
- (cond (before
+ (cond (before
(goto-char (widget-get before :entry-from)))
(t
(goto-char (widget-get widget :value-pos))))
- (let ((child (widget-editable-list-entry-create
+ (let ((child (widget-editable-list-entry-create
widget nil nil)))
(when (< (widget-get child :entry-from) (widget-get widget :from))
(set-marker (widget-get widget :from)
(let ((type (nth 0 (widget-get widget :args)))
(widget-push-button-gui widget-editable-list-gui)
child delete insert)
- (widget-specify-insert
+ (widget-specify-insert
(save-excursion
(and (widget-get widget :indent)
(insert-char ? (widget-get widget :indent)))
widget 'delete-button)))
((eq escape ?v)
(if conv
- (setq child (widget-create-child-value
+ (setq child (widget-create-child-value
widget type value))
(setq child (widget-create-child widget type))))
- (t
+ (t
(error "Unknown escape `%c'" escape)))))
- (widget-put widget
- :buttons (cons delete
+ (widget-put widget
+ :buttons (cons delete
(cons insert
(widget-get widget :buttons))))
(let ((entry-from (copy-marker (point-min)))
(setq argument (car args)
args (cdr args)
answer (widget-match-inline argument vals))
- (if answer
+ (if answer
(setq vals (cdr answer)
found (append found (car answer)))
(setq vals nil
:tag "Regexp")
(define-widget 'file 'string
- "A file widget.
+ "A file widget.
It will read a file name from the minibuffer when activated."
:format "%[%t%]: %v"
:tag "File"
(widget-setup)))
(define-widget 'directory 'file
- "A directory widget.
+ "A directory widget.
It will read a directory name from the minibuffer when activated."
:tag "Directory")
:value 0
:type-error "This field should contain an integer"
:value-to-internal (lambda (widget value)
- (if (integerp value)
+ (if (integerp value)
(prin1-to-string value)
value))
:match (lambda (widget value) (integerp value)))
"An character."
:tag "Character"
:value 0
- :size 1
+ :size 1
:format "%{%t%}: %v\n"
:type-error "This field should contain a character"
:value-to-internal (lambda (widget value)
- (if (integerp value)
+ (if (integerp value)
(char-to-string value)
value))
:value-to-external (lambda (widget value)
:value-to-internal (lambda (widget value) (append value nil))
:value-to-external (lambda (widget value) (apply 'vector value)))
-(defun widget-vector-match (widget value)
+(defun widget-vector-match (widget value)
(and (vectorp value)
(widget-group-match widget
(widget-apply :value-to-internal widget value))))
:value-to-external (lambda (widget value)
(cons (nth 0 value) (nth 1 value))))
-(defun widget-cons-match (widget value)
+(defun widget-cons-match (widget value)
(and (consp value)
(widget-group-match widget
(widget-apply widget :value-to-internal value))))
(defun widget-color-choice-list ()
(unless widget-color-choice-list
- (setq widget-color-choice-list
+ (setq widget-color-choice-list
(mapcar '(lambda (color) (list color))
(x-defined-colors))))
widget-color-choice-list)
(read-color prompt))
((fboundp 'x-defined-colors)
(completing-read (concat tag ": ")
- (widget-color-choice-list)
+ (widget-color-choice-list)
nil nil nil 'widget-color-history))
(t
(read-string prompt (widget-value widget))))))
(setq keywords (cdr keywords)))))))
(define-widget-keywords :tag-glyph :off-glyph :on-glyph :valid-regexp
- :secret :sample-face :sample-face-get :case-fold :widget-doc
+ :secret :sample-face :sample-face-get :case-fold :widget-doc
:create :convert-widget :format :value-create :offset :extra-offset
:tag :doc :from :to :args :value :value-from :value-to :action
:value-set :value-delete :match :parent :delete :menu-tag-get
:must-match :type-error :value-inline :inline :match-inline :greedy
:button-face-get :button-face :value-face :keymap :entry-from
:entry-to :help-echo :documentation-property :hide-front-space
- :hide-rear-space)
+ :hide-rear-space)
;; These autoloads should be deleted when the file is added to Emacs.
(unless (fboundp 'load-gc)
+Fri Mar 7 10:49:43 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * Makefile: New "install" target.
+
Thu Mar 6 08:01:37 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.texi (Mail and Procmail): Fix.
LATEX=latex
DVIPS=dvips
PERL=perl
+INFODIR=/usr/local/info
all: gnus message custom widget
make clean
rm -f *.orig *.rej *.elc *~ gnus gnus-[0-9] gnus-[0-9][0-9]
rm -f message message-[0-9] widget custom
+
+install:
+ cp gnus gnus-[0-9] gnus-[0-9][0-9] $(INFODIR)
+ cp message message-[0-9] $(INFODIR)
+ cp widget widget-[0-9] $(INFODIR)
+ cp custom custom-[0-9] $(INFODIR)
the header
* cache the newsgroups file locally to avoid reloading it all the time.
+
+* a command to import a buffer into a group.
projects / gnus / commitdiff