+Sun Feb 16 18:12:01 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Gnus v5.4.13 is released.
+
+Sun Feb 16 16:20:33 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-nocem.el (gnus-nocem-scan-groups): Allow NULL references.
+
+ * message.el (message-make-caesar-translation-table): New function.
+ (message-caesar-region): Use it.
+
+ * messagexmas.el (message-xmas-make-caesar-translation-table): New
+ function.
+
+ * gnus-art.el (gnus-article-add-buttons): Respect previous
+ buttons.
+ (gnus-button-in-region-p): New function.
+ (gnus-article-add-buttons): Use it.
+
+ * nnweb.el (nnweb-max-hits): Fixed default.
+
+Tue Feb 11 20:25:42 1997 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-srvr.el (gnus-server-regenerate-server): Typo.
+
+Sun Feb 16 15:24:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.el: Removed `message-point-at-bol' and `eol'.
+
+ * gnus-start.el (gnus-read-active-file): Allow FORCE argument.
+ (gnus-check-bogus-newsgroups): Use it.
+
+ * gnus-srvr.el (gnus-server-copy-server): Allow copying of
+ unreadable servers.
+
+Thu Feb 13 19:44:33 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * gnus-util.el (gnus-output-to-mail): Make sure `From ' lines in
+ saved messages are preceded by a newline.
+
+Wed Feb 12 05:28:32 1997 Zlatko Calusic <zcalusic@srce.hr>
+
+ * gnus-sum.el (gnus-summary-copy-article): Use TO-NEWSGROUP.
+
+Sat Feb 15 21:48:23 1997 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * nnmail.el: Organized customization options.
+ * gnus.el: Updated.
+
+Wed Feb 12 18:06:11 1997 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-kill.el: Reorganized customization
+ options.
+ * gnus-sum.el: Ditto.
+ * gnus-score.el: Ditto.
+ * gnus-start.el: Ditto.
+ * gnus.el: Ditto.
+
+Fri Feb 14 09:30:42 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-art.el (article-strip-multiple-blank-lines): Inhibit
+ point-motion hooks.
+ (article-hide-pgp): Don't hide the leading newline.
+
+ * gnus-group.el (gnus-group-quick-select-group): Bind
+ gnus-home-score-file to nil.
+
+ * gnus-start.el (gnus-dribble-read-file): Changed prompt.
+
+Wed Feb 12 09:39:53 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nnmail.el (nnmail-get-new-mail): Make sure we're using directory
+ file names.
+
+Tue Feb 11 14:00:56 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * message.el (message-followup): Respect Posted-To.
+
+Tue Feb 11 08:15:38 1997 Rich Pieri <rich.pieri@prescienttech.com>
+
+ * nnmail.el (nnmail-pop3-movemail): New function.
+
+Tue Feb 11 03:44:43 1997 Karl Kleinpaste <karl@jprc.com>
+
+ * gnus-art.el (gnus-emphasis-alist): Made compounds available
+ again.
+
+Mon Feb 10 08:54:09 1997 Steven L Baur <steve@altair.xemacs.org>
+
+ * dgnushack.el (dgnushack-compile): XEmacs doesn't complain about
+ portability variables any more.
+
Mon Feb 10 14:19:55 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v5.4.12 is released.
;;; custom-edit.el --- Tools for customization Emacs.
;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.24
+;; Version: 1.38
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(setq major-mode 'custom-mode
mode-name "Custom")
(use-local-map custom-mode-map)
+ (easy-menu-add custom-mode-menu)
(make-local-variable 'custom-options)
(run-hooks 'custom-mode-hook))
(widget-insert " ")
(widget-create 'push-button
:tag "Reset"
- :help-echo "Push me to undo all modifications.."
+ :help-echo "Push me to undo all modifications."
:action (lambda (widget &optional event)
(custom-reset event)))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Done"
+ :help-echo "Push me to bury the buffer."
+ :action (lambda (widget &optional event)
+ (bury-buffer)))
(widget-insert "\n")
(widget-setup))
(defun custom-redraw (widget)
"Redraw WIDGET with current settings."
- (widget-value-set widget (widget-value widget))
- (custom-redraw-magic widget))
+ (let ((pos (point))
+ (from (marker-position (widget-get widget :from)))
+ (to (marker-position (widget-get widget :to))))
+ (save-excursion
+ (widget-value-set widget (widget-value widget))
+ (custom-redraw-magic widget))
+ (when (and (>= pos from) (<= pos to))
+ (goto-char pos))))
(defun custom-redraw-magic (widget)
"Redraw WIDGET state with current settings."
(default-value symbol)
(widget-get widget :value)))
tmp
- (state (cond ((setq tmp (get symbol 'customized-value))
- (if (condition-case nil
- (equal value (eval (car tmp)))
- (error nil))
- 'saved
- 'set))
- ((setq tmp (get symbol 'saved-value))
- (if (condition-case nil
- (equal value (eval (car tmp)))
- (error nil))
- 'saved
- 'set))
+ (state (cond ((and (setq tmp (get symbol 'customized-value))
+ (not (condition-case nil
+ (equal value (eval (car tmp)))
+ (error nil))))
+ 'set)
+ ((and (setq tmp (get symbol 'saved-value))
+ (not (condition-case nil
+ (equal value (eval (car tmp)))
+ (error nil))))
+ 'saved)
((setq tmp (get symbol 'factory-value))
(if (condition-case nil
(equal value (eval (car tmp)))
(set symbol (eval (setq val (widget-value child))))
(put symbol 'customized-value (list val)))
(t
- (set symbol (widget-value child))
+ (set symbol (setq val (widget-value child)))
(put symbol 'customized-value (list (custom-quote val)))))
(custom-variable-state-set widget)
(custom-redraw-magic widget)))
+++ /dev/null
-;;; custom-opt.el --- An option group.
-;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-;;
-;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Keywords: help, faces
-;; Version: 1.24
-;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
-
-;;; Code:
-
-(require 'custom)
-
-(defgroup options nil
- "This group contains often used customization options."
- :group 'emacs)
-
-(defvar custom-options
- '((line-number-mode boolean)
- (column-number-mode boolean)
- (debug-on-error boolean)
- (debug-on-quit boolean)
- (case-fold-search boolean)
- (case-replace boolean)
- (transient-mark-mode boolean))
- "Alist of customization options.
-The first element of each entry should be a variable name, the second
-a widget type.")
-
-(let ((options custom-options)
- option name type)
- (while options
- (setq option (car options)
- options (cdr options)
- name (nth 0 option)
- type (nth 1 option))
- (put name 'custom-type type)
- (custom-add-to-group 'options name 'custom-variable))
- (run-hooks 'custom-define-hook))
-
-;;; The End.
-
-(provide 'custom-opt)
-
-;; custom-edit.el ends here
;;; custom.el -- Tools for declaring and initializing options.
;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.24
+;; Version: 1.38
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(define-widget-keywords :prefix :tag :load :link :options :type :group)
;; These autoloads should be deleted when the file is added to Emacs
-(autoload 'customize "custom-edit" nil t)
-(autoload 'customize-variable "custom-edit" nil t)
-(autoload 'customize-face "custom-edit" nil t)
-(autoload 'customize-apropos "custom-edit" nil t)
-(autoload 'customize-customized "custom-edit" nil t)
-(autoload 'custom-buffer-create "custom-edit")
-(autoload 'custom-menu-update "custom-edit")
-(autoload 'custom-make-dependencies "custom-edit")
+
+(unless (fboundp 'load-gc)
+ (autoload 'customize "custom-edit" nil t)
+ (autoload 'customize-variable "custom-edit" nil t)
+ (autoload 'customize-face "custom-edit" nil t)
+ (autoload 'customize-apropos "custom-edit" nil t)
+ (autoload 'customize-customized "custom-edit" nil t)
+ (autoload 'custom-buffer-create "custom-edit")
+ (autoload 'custom-menu-update "custom-edit")
+ (autoload 'custom-make-dependencies "custom-edit"))
;;; Compatibility.
;;; The `defcustom' Macro.
-;;;###autoload
(defun custom-declare-variable (symbol value doc &rest args)
"Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
(unless (and (default-boundp symbol)
(run-hooks 'custom-define-hook)
symbol)
-;;;###autoload
(defmacro defcustom (symbol value doc &rest args)
"Declare SYMBOL as a customizable variable that defaults to VALUE.
DOC is the variable documentation.
;;; The `defface' Macro.
-;;;###autoload
(defun custom-declare-face (face spec doc &rest args)
"Like `defface', but FACE is evaluated as a normal argument."
(put face 'factory-face spec)
(run-hooks 'custom-define-hook)
face)
-;;;###autoload
(defmacro defface (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
FACE does not need to be quoted.
;;; The `defgroup' Macro.
-;;;###autoload
(defun custom-declare-group (symbol members doc &rest args)
"Like `defgroup', but SYMBOL is evaluated as a normal argument."
(put symbol 'custom-group (nconc members (get symbol 'custom-group)))
(run-hooks 'custom-define-hook)
symbol)
-;;;###autoload
(defmacro defgroup (symbol members doc &rest args)
"Declare SYMBOL as a customization group containing MEMBERS.
SYMBOL does not need to be quoted.
information."
`(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
-;;;###autoload
(defun custom-add-to-group (group option widget)
"To existing GROUP add a new OPTION of type WIDGET,
If there already is an entry for that option, overwrite it."
match)))
(defconst custom-face-attributes
- '((:bold (toggle :format "Bold: %v") custom-set-face-bold)
- (:italic (toggle :format "Italic: %v") custom-set-face-italic)
+ '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
+ (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
(:underline
- (toggle :format "Underline: %v") set-face-underline-p)
+ (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
(:foreground (color :tag "Foreground") set-face-foreground)
(:background (color :tag "Background") set-face-background)
(:stipple (editable-field :format "Stipple: %v") set-face-stipple))
(make-face-italic face frame)
(make-face-unitalic face frame)))
-;;;###autoload
(defun custom-initialize-faces (&optional frame)
"Initialize all custom faces for FRAME.
If FRAME is nil or omitted, initialize them for all frames."
;;; Initializing.
-;;;###autoload
(defun custom-set-variables (&rest args)
"Initialize variables according to user preferences.
(put symbol 'saved-value (list value)))
(setq args (cdr (cdr args)))))))
-;;;###autoload
(defun custom-set-faces (&rest args)
"Initialize faces according to user preferences.
The arguments should be a list where each entry has the form:
(easy-menu-create-keymaps (car custom-help-menu)
(cdr custom-help-menu)))))))
-(custom-menu-reset)
+(unless (fboundp 'load-gc)
+ (custom-menu-reset))
;;; The End.
(cond
((or (string= file "custom.el") (string= file "browse-url.el"))
(setq byte-compile-warnings nil))
- (xemacs
- (setq byte-compile-warnings
- '(free-vars unresolved callargs redefine)))
(t
(setq byte-compile-warnings
'(free-vars unresolved callargs redefine obsolete))))
'(("_" "_" underline)
("/" "/" italic)
("\\*" "\\*" bold)
- ;;("_/" "/_" underline-italic)
- ;;("_\\*" "\\*_" underline-bold)
+ ("_/" "/_" underline-italic)
+ ("_\\*" "\\*_" underline-bold)
("\\*/" "/\\*" bold-italic)
- ;;("_\\*/" "/\\*_" underline-bold-italic)
- )))
+ ("_\\*/" "/\\*_" underline-bold-italic))))
`(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
2 3 gnus-emphasis-underline)
,@(mapcar
(goto-char (point-min))
;; Hide the "header".
(when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp))
+ (gnus-article-hide-text-type (1+ (match-beginning 0))
+ (match-end 0) 'pgp))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
"Replace consecutive blank lines with one empty line."
(interactive)
(save-excursion
- (let (buffer-read-only)
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only)
;; First make all blank lines empty.
(goto-char (point-min))
+ (search-forward "\n\n" nil t)
(while (re-search-forward "^[ \t]+$" nil t)
(replace-match "" nil t))
;; Then replace multiple empty lines with a single empty line.
(goto-char (point-min))
+ (search-forward "\n\n" nil t)
(while (re-search-forward "\n\n\n+" nil t)
(replace-match "\n\n" t t)))))
:type 'regexp)
(defcustom gnus-button-alist
- `(("\\(\\b<\\(url: ?\\)?news:\\([^>\n\t ]*\\)>\\)" 1 t
- gnus-button-message-id 3)
+ `(("<\\(url: ?\\)?news:\\([^>\n\t ]*\\)>" 0 t
+ gnus-button-message-id 2)
("\\bnews:\\([^\n\t ]+\\)" 0 t gnus-button-message-id 1)
("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
gnus-button-fetch-group 4)
(gnus-article-add-button start (1- end) 'gnus-signature-toggle
end)))))))
+(defun gnus-button-in-region-p (b e prop)
+ "Say whether PROP exists in the region."
+ (text-property-not-all b e prop nil))
+
(defun gnus-article-add-buttons (&optional force)
"Find external references in the article and make buttons of them.
\"External references\" are things like Message-IDs and URLs, as
(from (match-beginning 0)))
(when (and (or (eq t (nth 1 entry))
(eval (nth 1 entry)))
- (not (get-text-property (point) 'gnus-callback)))
+ (not (gnus-button-in-region-p from end 'gnus-callback)))
;; That optional form returned non-nil, so we add the
;; button.
(gnus-article-add-button
(require 'gnus-score)
(let (gnus-visual
gnus-score-find-score-files-function
+ gnus-home-score-file
gnus-apply-kill-hook
gnus-summary-expunge-below)
(gnus-group-read-group all t)))
(defcustom gnus-kill-file-mode-hook nil
"Hook for Gnus kill file mode."
- :group 'gnus-score
+ :group 'gnus-score-kill
:type 'hook)
(defcustom gnus-kill-expiry-days 7
"*Number of days before expiring unused kill file entries."
- :group 'gnus-score
+ :group 'gnus-score-kill
+ :group 'gnus-score-expire
:type 'integer)
(defcustom gnus-kill-save-kill-file nil
"*If non-nil, will save kill files after processing them."
- :group 'gnus-score
+ :group 'gnus-score-kill
:type 'boolean)
(defcustom gnus-winconf-kill-file nil
"What does this do, Lars?"
- :group 'gnus-score
+ :group 'gnus-score-kill
:type 'sexp)
(defcustom gnus-kill-killed t
If it is nil, Gnus will never apply kill files to articles that have
already been through the scoring process, which might very well save lots
of time."
- :group 'gnus-score
+ :group 'gnus-score-kill
:type 'boolean)
\f
;; ignore scanning followups.
(and (string-match "@@NCM" (mail-header-subject header))
(or gnus-nocem-liberal-fetch
- (and (string= "" (mail-header-references header))
+ (and (or (string= "" (mail-header-references
+ header))
+ (null (mail-header-references header)))
(not (member (mail-header-message-id header)
gnus-nocem-seen-message-ids))))
(gnus-nocem-check-article group header)))))))
(setq gnus-global-score-files
'(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
\"/ftp.some-where:/pub/score\"))"
- :group 'gnus-score
+ :group 'gnus-score-files
:type '(repeat file))
(defcustom gnus-score-file-single-match-alist nil
These score files are loaded in addition to any files returned by
gnus-score-find-score-files-function (which see)."
- :group 'gnus-score
+ :group 'gnus-score-files
:type '(repeat (cons regexp (repeat file))))
(defcustom gnus-score-file-multiple-match-alist nil
These score files are loaded in addition to any files returned by
gnus-score-find-score-files-function (which see)."
- :group 'gnus-score
+ :group 'gnus-score-files
:type '(repeat (cons regexp (repeat file))))
(defcustom gnus-score-file-suffix "SCORE"
"Suffix of the score files."
- :group 'gnus-score
+ :group 'gnus-score-files
:type 'string)
(defcustom gnus-adaptive-file-suffix "ADAPT"
"Suffix of the adaptive score files."
- :group 'gnus-score
+ :group 'gnus-score-files
+ :group 'gnus-score-adapt
:type 'string)
(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
This variable can also be a list of functions to be called. Each
function should either return a list of score files, or a list of
score alists."
- :group 'gnus-score
+ :group 'gnus-score-files
:type '(radio (function-item gnus-score-find-single)
(function-item gnus-score-find-hierarchical)
(function-item gnus-score-find-bnews)
(defcustom gnus-score-interactive-default-score 1000
"*Scoring commands will raise/lower the score with this number as the default."
- :group 'gnus-score
+ :group 'gnus-score-default
:type 'integer)
(defcustom gnus-score-expiry-days 7
"*Number of days before unused score file entries are expired.
If this variable is nil, no score file entries will be expired."
- :group 'gnus-score
+ :group 'gnus-score-expire
:type '(choice (const :tag "never" nil)
number))
"*In non-nil, update matching score entry dates.
If this variable is nil, then score entries that provide matches
will be expired along with non-matching score entries."
- :group 'gnus-score
+ :group 'gnus-score-expire
:type 'boolean)
(defcustom gnus-orphan-score nil
"*All orphans get this score added. Set in the score file."
- :group 'gnus-score
+ :group 'gnus-score-default
:type 'integer)
(defcustom gnus-decay-scores nil
"*If non-nil, decay non-permanent scores."
- :group 'gnus-score
+ :group 'gnus-score-decay
:type 'boolean)
(defcustom gnus-decay-score-function 'gnus-decay-score
"*Function called to decay a score.
It is called with one parameter -- the score to be decayed."
- :group 'gnus-score
+ :group 'gnus-score-decay
:type '(radio (function-item gnus-decay-score)
(function :tag "Other")))
(defcustom gnus-score-decay-constant 3
"*Decay all \"small\" scores with this amount."
- :group 'gnus-score
+ :group 'gnus-score-decay
:type 'integer)
(defcustom gnus-score-decay-scale .05
"*Decay all \"big\" scores with this factor."
- :group 'gnus-score
+ :group 'gnus-score-decay
:type 'number)
(defcustom gnus-home-score-file nil
The list will be traversed from the beginning towards the end looking
for matches."
- :group 'gnus-score
+ :group 'gnus-score-files
:type '(choice string
(repeat (choice string
(cons regexp (repeat file))
(defcustom gnus-home-adapt-file nil
"Variable to control where new adaptive score entries are to go.
This variable allows the same syntax as `gnus-home-score-file'."
- :group 'gnus-score
+ :group 'gnus-score-adapt
+ :group 'gnus-score-files
:type '(choice string
(repeat (choice string
(cons regexp (repeat file))
(gnus-killed-mark (from -1) (subject -20))
(gnus-del-mark (from -2) (subject -15)))
"Alist of marks and scores."
-:group 'gnus-score
+:group 'gnus-score-adapt
:type '(repeat (cons (symbol :tag "Mark")
(repeat (list (choice :tag "Header"
(const from)
(defcustom gnus-ignored-adaptive-words nil
"List of words to be ignored when doing adaptive word scoring."
- :group 'gnus-score
+ :group 'gnus-score-adapt
:type '(repeat string))
(defcustom gnus-default-ignored-adaptive-words
"both" "true" "off" "say" "another" "state" "might" "under" "start"
"try" "re")
"Default list of words to be ignored when doing adaptive word scoring."
- :group 'gnus-score
+ :group 'gnus-score-adapt
:type '(repeat string))
(defcustom gnus-default-adaptive-word-score-alist
(,gnus-killed-mark . -20)
(,gnus-del-mark . -15))
"Alist of marks and scores."
-:group 'gnus-score
+:group 'gnus-score-adapt
:type '(repeat (cons (character :tag "Mark")
(integer :tag "Score"))))
(defcustom gnus-score-mimic-keymap nil
"*Have the score entry functions pretend that they are a keymap."
- :group 'gnus-score
+ :group 'gnus-score-default
:type 'boolean)
(defcustom gnus-score-exact-adapt-limit 10
than this variable, exact matching will be used.
If this variable is nil, exact matching will always be used."
- :group 'gnus-score
+ :group 'gnus-score-adapt
:type '(choice (const nil) integer))
(defcustom gnus-score-uncacheable-files "ADAPT$"
"All score files that match this regexp will not be cached."
- :group 'gnus-score
+ :group 'gnus-score-adapt
+ :group 'gnus-score-files
:type 'regexp)
(defcustom gnus-score-default-header nil
f: followup
If nil, the user will be asked for a header."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "from" a)
(const :tag "subject" s)
(const :tag "body" b)
=: equal to number
If nil, the user will be asked for a match type."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "substring" s)
(const :tag "exact string" e)
(const :tag "fuzzy string" f)
(defcustom gnus-score-default-fold nil
"Use case folding for new score file entries iff not nil."
- :group 'gnus-score
+ :group 'gnus-score-default
:type 'boolean)
(defcustom gnus-score-default-duration nil
i: immediate
If nil, the user will be asked for a duration."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "temporary" t)
(const :tag "permanent" p)
(const :tag "immediate" i)))
(defcustom gnus-score-after-write-file-function nil
"Function called with the name of the score file just written to disk."
- :group 'gnus-score
+ :group 'gnus-score-files
:type 'function)
\f
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string (cdr entry)) ")
-")))
+ (prin1-to-string (cdr entry)) ")\n")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
(defun gnus-server-copy-server (from to)
(interactive
(list
- (unless (gnus-server-server-name)
- (error "No server on the current line"))
+ (or (gnus-server-server-name)
+ (error "No server on the current line"))
(read-string "Copy to: ")))
(unless from
(error "No server on current line"))
(error "No name to copy to"))
(when (assoc to gnus-server-alist)
(error "%s already exists" to))
- (unless (assoc from gnus-server-alist)
+ (unless (gnus-server-to-method from)
(error "%s: no such server" from))
- (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist))))
+ (let ((to-entry (cons from (gnus-copy-sequence
+ (gnus-server-to-method from)))))
(setcar to-entry to)
(setcar (nthcdr 2 to-entry) to)
(push to-entry gnus-server-killed-servers)
(if (not (gnus-check-backend-function
'request-regenerate (car (gnus-server-to-method server))))
(error "This backend doesn't support regeneration")
- (gnus-message 5 "Requesing regeneration of %s..." server)
+ (gnus-message 5 "Requesting regeneration of %s..." server)
(when (gnus-request-regenerate server)
- (gnus-message 5 "Requesing regeneration of %s...done" server)))))
+ (gnus-message 5 "Requesting regeneration of %s...done" server)))))
(provide 'gnus-srvr)
"*Non-nil means that Gnus will use a dribble file to store user updates.
If Emacs should crash without saving the .newsrc files, complete
information can be restored from the dribble file."
- :group 'gnus-start
+ :group 'gnus-dribble-file
:type 'boolean)
(defcustom gnus-dribble-directory nil
"*The directory where dribble files will be saved.
If this variable is nil, the directory where the .newsrc files are
saved will be used."
- :group 'gnus-start
+ :group 'gnus-dribble-file
:type '(choice directory (const nil)))
(defcustom gnus-check-new-newsgroups t
"*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
If this variable is nil, then you have to tell Gnus explicitly to
check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
- :group 'gnus-start
+ :group 'gnus-start-server
:type 'boolean)
(defcustom gnus-read-active-file t
be told about new newsgroups that arrive. To do that, set
`gnus-check-new-newsgroups' to `ask-server'. This may not work
properly with all servers."
- :group 'gnus-start
+ :group 'gnus-start-server
:type '(choice (const nil)
(const some)
(const t)))
(defcustom gnus-level-subscribed 5
"*Groups with levels less than or equal to this variable are subscribed."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-level-unsubscribed 7
"*Groups with levels less than or equal to this variable are unsubscribed.
Groups with levels less than `gnus-level-subscribed', which should be
less than this variable, are subscribed."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-level-zombie 8
"*Groups with this level are zombie groups."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-level-killed 9
"*Groups with this level are killed."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-level-default-subscribed 3
"*New subscribed groups will be subscribed at this level."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-level-default-unsubscribed 6
"*New unsubscribed groups will be unsubscribed at this level."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-activate-level (1+ gnus-level-subscribed)
"*Groups higher than this level won't be activated on startup.
Setting this variable to something low might save lots of time when
you have many groups that you aren't interested in."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-activate-foreign-newsgroups 4
might take a while. By setting this variable to nil, you'll save time,
but you won't be told how many unread articles there are in the
groups."
- :group 'gnus-start
+ :group 'gnus-group-levels
:type 'integer)
(defcustom gnus-save-newsrc-file t
be readily understood by other newsreaders. If you don't plan on
using other newsreaders, set this variable to nil to save some time on
exit."
- :group 'gnus-start
+ :group 'gnus-newsrc
:type 'boolean)
(defcustom gnus-save-killed-list t
This variable can also be a regexp. In that case, all groups that do
not match this regexp will be removed before saving the list."
- :group 'gnus-start
+ :group 'gnus-newsrc
:type 'boolean)
(defcustom gnus-ignored-newsgroups
Any lines in the active file matching this regular expression are
removed from the newsgroup list before anything else is done to it,
thus making them effectively non-existent."
- :group 'gnus-start
+ :group 'gnus-group-new
:type 'regexp)
(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
for your decision; `gnus-subscribe-killed' kills all new groups;
`gnus-subscribe-zombies' will make all new groups into zombies."
- :group 'gnus-start
+ :group 'gnus-group-new
:type '(radio (function-item gnus-subscribe-randomly)
(function-item gnus-subscribe-alphabetically)
(function-item gnus-subscribe-hierarchically)
Gnus will the subscribe all new newsgroups in these hierarchies with
the subscription method in this variable."
- :group 'gnus-start
+ :group 'gnus-group-new
:type '(radio (function-item gnus-subscribe-randomly)
(function-item gnus-subscribe-alphabetically)
(function-item gnus-subscribe-hierarchically)
If the user pressed `d', Gnus will descend the hierarchy, `y' will
subscribe to all newsgroups in the hierarchy and `s' will skip this
hierarchy in its entirety."
- :group 'gnus-start
+ :group 'gnus-group-new
:type 'boolean)
(defcustom gnus-auto-subscribed-groups
New groups that match this regexp will not be handled by
`gnus-subscribe-newsgroup-method'. Instead, they will
be subscribed using `gnus-subscribe-options-newsgroup-method'."
- :group 'gnus-start
+ :group 'gnus-group-new
:type 'regexp)
(defcustom gnus-options-subscribe nil
New groups that match this regexp will not be handled by
`gnus-subscribe-newsgroup-method'. Instead, they will
be subscribed using `gnus-subscribe-options-newsgroup-method'."
- :group 'gnus-start
+ :group 'gnus-group-new
:type '(choice regexp
(const :tag "none" nil)))
"*All new groups matching this regexp will be ignored.
Note that this variable deals only with new newsgroups. This variable
does not affect old (already subscribed) newsgroups."
- :group 'gnus-start
+ :group 'gnus-group-new
:type '(choice regexp
(const :tag "none" nil)))
"*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-start
+ :group 'gnus-newsrc
:type 'boolean)
(defcustom gnus-check-bogus-groups-hook nil
"A hook run after removing bogus groups."
- :group 'gnus-start
+ :group 'gnus-start-server
:type 'hook)
(defcustom gnus-startup-hook nil
(defcustom gnus-get-new-news-hook nil
"A hook run just before Gnus checks for new news."
- :group 'gnus-start
+ :group 'gnus-group-new
:type '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."
- :group 'gnus-start
+ :group 'gnus-group-new
:type 'hook)
(defcustom gnus-save-newsrc-hook nil
"A hook called before saving any of the newsrc files."
- :group 'gnus-start
+ :group 'gnus-newsrc
:type 'hook)
(defcustom gnus-save-quick-newsrc-hook nil
"A hook called just before saving the quick newsrc file.
Can be used to turn version control on or off."
- :group 'gnus-start
+ :group 'gnus-newsrc
:type 'hook)
(defcustom gnus-save-standard-newsrc-hook nil
"A hook called just before saving the standard newsrc file.
Can be used to turn version control on or off."
- :group 'gnus-start
+ :group 'gnus-newsrc
:type 'hook)
;;; Internal variables
(set-file-modes dribble-file modes))
;; Possibly eval the file later.
(when (gnus-y-or-n-p
- "Auto-save file exists. Do you want to read it? ")
+ "Gnus auto-save file exists. Do you want to read it? ")
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
bogus group entry info)
(gnus-message 5 "Checking bogus newsgroups...")
(unless (gnus-read-active-file-p)
- (gnus-read-active-file))
+ (gnus-read-active-file t))
(when (gnus-read-active-file-p)
;; Find all bogus newsgroup that are subscribed.
(while newsrc
(gnus-dribble-touch))
;; Get the active file(s) from the backend(s).
-(defun gnus-read-active-file ()
+(defun gnus-read-active-file (&optional force)
(gnus-group-set-mode-line)
(let ((methods
(append
(gnus-request-scan nil method))
(cond
((and (eq gnus-read-active-file 'some)
- (gnus-check-backend-function 'retrieve-groups (car method)))
+ (gnus-check-backend-function 'retrieve-groups (car method))
+ (not force))
(let ((newsrc (cdr gnus-newsrc-alist))
(gmethod (gnus-server-get-method nil method))
groups info)
(defcustom gnus-summary-default-score 0
"*Default article score level.
If this variable is nil, scoring will be disabled."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "disable")
integer))
"*Mark all articles with a score below this variable as read.
This variable is local to each summary buffer and usually set by the
score file."
- :group 'gnus-score
+ :group 'gnus-score-default
:type 'integer)
(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
(defcustom gnus-summary-expunge-below nil
"All articles that have a score less than this variable will be expunged."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
See `gnus-thread-score-function' for en explanation of what a
\"thread score\" is."
:group 'gnus-treading
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method."
(interactive "P")
- (gnus-summary-move-article n nil select-method 'copy))
+ (gnus-summary-move-article n to-newsgroup select-method 'copy))
(defun gnus-summary-crosspost-article (&optional n)
"Crosspost the current article to some other group."
;; Decide whether to append to a file or to an Emacs buffer.
(let ((outbuf (get-file-buffer filename)))
(if (not outbuf)
- (append-to-file (point-min) (point-max) filename)
+ (let ((buffer-read-only nil))
+ (save-excursion
+ (goto-char (point-max))
+ (forward-char -2)
+ (unless (looking-at "\n\n")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n"))
+ (goto-char (point-max))
+ (append-to-file (point-min) (point-max) filename)))
;; File has been visited, in buffer OUTBUF.
(set-buffer outbuf)
(let ((buffer-read-only nil))
"Starting your favorite newsreader."
:group 'gnus)
+(defgroup gnus-start-server nil
+ "Server options at startup."
+ :group 'gnus-start)
+
;; These belong to gnus-group.el.
(defgroup gnus-group nil
"Group buffers."
:link '(custom-manual "(gnus)Foreign Groups")
:group 'gnus-group)
+(defgroup gnus-group-new nil
+ "Automatic subscription of new groups."
+ :group 'gnus-group)
+
(defgroup gnus-group-levels nil
"Group levels."
:link '(custom-manual "(gnus)Group Levels")
"Adaptive score files."
:group 'gnus-score)
+(defgroup gnus-score-default nil
+ "Default values for score files."
+ :group 'gnus-score)
+
+(defgroup gnus-score-expire nil
+ "Expiring score rules."
+ :group 'gnus-score)
+
+(defgroup gnus-score-decay nil
+ "Decaying score rules."
+ :group 'gnus-score)
+
(defgroup gnus-score-files nil
"Score and kill file names."
:group 'gnus-score
"Options controling the visual fluff."
:group 'gnus)
-(defgroup gnus-mail-expire nil
- "Expiring articles in mail backends."
- :group 'gnus-mail)
-
(defgroup gnus-files nil
"Files used by Gnus."
:group 'gnus)
+(defgroup gnus-dribble-file nil
+ "Auto save file."
+ :link '(custom-manual "(gnus)Auto Save")
+ :group 'gnus-files)
+
+(defgroup gnus-newsrc nil
+ "Storing Gnus state."
+ :group 'gnus-files)
+
(defgroup gnus-server nil
"Options related to newsservers and other servers used by Gnus."
:group 'gnus)
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.12"
+(defconst gnus-version-number "5.4.13"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
"*Groups in which to automatically mark read articles as expirable.
If non-nil, this should be a regexp that should match all groups in
which to perform auto-expiry. This only makes sense for mail groups."
- :group 'gnus-mail-expire
+ :group 'nnmail-expire
:type '(choice (const nil)
regexp))
expiring - which means that all read articles will be deleted after
\(say) one week. (This only goes for mail groups and the like, of
course.)"
- :group 'gnus-mail-expire
+ :group 'nnmail-expire
:type '(choice (const nil)
regexp))
(eval-and-compile
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-send-letter "mh-comp")
+ (autoload 'gnus-point-at-eol "gnus-util")
+ (autoload 'gnus-point-at-bol "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
(autoload 'gnus-output-to-rmail "gnus-util"))
;;; Utility functions.
;;;
-(defun message-point-at-bol ()
- "Return point at the beginning of the line."
- (let ((p (point)))
- (beginning-of-line)
- (prog1
- (point)
- (goto-char p))))
-
-(defun message-point-at-eol ()
- "Return point at the end of the line."
- (let ((p (point)))
- (end-of-line)
- (prog1
- (point)
- (goto-char p))))
-
(defmacro message-y-or-n-p (question show &rest text)
"Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
`(message-talkative-question 'y-or-n-p ,question ,show ,@text))
;; We build the table, if necessary.
(when (or (not message-caesar-translation-table)
(/= (aref message-caesar-translation-table ?a) (+ ?a n)))
- (let ((i -1)
- (table (make-string 256 0)))
- (while (< (incf i) 256)
- (aset table i i))
- (setq table
- (concat
- (substring table 0 ?A)
- (substring table (+ ?A n) (+ ?A n (- 26 n)))
- (substring table ?A (+ ?A n))
- (substring table (+ ?A 26) ?a)
- (substring table (+ ?a n) (+ ?a n (- 26 n)))
- (substring table ?a (+ ?a n))
- (substring table (+ ?a 26) 255)))
- (setq message-caesar-translation-table table)))
+ (setq message-caesar-translation-table
+ (message-make-caesar-translation-table n)))
;; Then we translate the region. Do it this way to retain
;; text properties.
(while (< b e)
(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)
+ (table (make-string 256 0)))
+ (while (< (incf i) 256)
+ (aset table i i))
+ (concat
+ (substring table 0 ?A)
+ (substring table (+ ?A n) (+ ?A n (- 26 n)))
+ (substring table ?A (+ ?A n))
+ (substring table (+ ?A 26) ?a)
+ (substring table (+ ?a n) (+ ?a n (- 26 n)))
+ (substring table ?a (+ ?a n))
+ (substring table (+ ?a 26) 255))))
+
(defun message-caesar-buffer-body (&optional rotnum)
"Caesar rotates all letters in the current buffer by 13 places.
Used to encode/decode possibly offensive messages (commonly in net.jokes).
(forward-line -1))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
- (delete-region (point) (message-point-at-eol))
+ (delete-region (point) (gnus-point-at-eol))
(insert value))
;; Add the deletable property to the headers that require it.
(and (memq header message-deletable-headers)
references message-id follow-to
(inhibit-point-motion-hooks t)
(message-this-is-news t)
- followup-to distribution newsgroups gnus-warning)
+ followup-to distribution newsgroups gnus-warning posted-to)
(save-restriction
(narrow-to-region
(goto-char (point-min))
message-id (message-fetch-field "message-id" t)
followup-to (message-fetch-field "followup-to")
newsgroups (message-fetch-field "newsgroups")
+ posted-to (message-fetch-field "posted-to")
reply-to (message-fetch-field "reply-to")
distribution (message-fetch-field "distribution")
mct (message-fetch-field "mail-copies-to"))
responses here are directed to other newsgroups."))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
+ (posted-to
+ `((Newsgroups . ,posted-to)))
(t
`((Newsgroups . ,newsgroups))))
,@(and distribution (list (cons 'Distribution distribution)))
font-lock-auto-fontify)
(turn-on-font-lock)))
+(defun message-xmas-make-caesar-translation-table (n)
+ "Create a rot table with offset N."
+ (let ((i -1)
+ (table (make-string 256 0))
+ (a (char-int ?a))
+ (A (char-int ?A)))
+ (while (< (incf i) 256)
+ (aset table i i))
+ (concat
+ (substring table 0 A)
+ (substring table (+ A n) (+ A n (- 26 n)))
+ (substring table A (+ A n))
+ (substring table (+ A 26) a)
+ (substring table (+ a n) (+ a n (- 26 n)))
+ (substring table a (+ a n))
+ (substring table (+ a 26) 255))))
+
+(when (>= emacs-major-version 20)
+ (fset 'message-make-caesar-translation-table
+ 'message-xmas-make-caesar-translation-table))
+
(add-hook 'message-mode-hook 'message-xmas-maybe-fontify)
(provide 'messagexmas)
(eval-when-compile (require 'cl))
(require 'custom)
-(defgroup gnus-mail nil
- "Mailreading.."
+(defgroup nnmail nil
+ "Reading mail with Gnus."
:group 'gnus)
+(defgroup nnmail-retrieve nil
+ "Retrieving new mail."
+ :group 'nnmail)
+
+(defgroup nnmail-prepare nil
+ "Preparing (or mangling) new mail after retrival."
+ :group 'nnmail)
+
+(defgroup nnmail-duplicate nil
+ "Handling of duplicate mail messages."
+ :group 'nnmail)
+
+(defgroup nnmail-split nil
+ "Organizing the incomming mail in folders."
+ :group 'nnmail)
+
+(defgroup nnmail-files nil
+ "Mail files."
+ :group 'gnus-files
+ :group 'nnmail)
+
+(defgroup nnmail-expire nil
+ "Expiring old mail."
+ :group 'nnmail)
+
+(defgroup nnmail-procmail nil
+ "Interfacing with procmail and other mail agents."
+ :group 'nnmail)
+
+(defgroup nnmail-various nil
+ "Various mail options."
+ :group 'nnmail)
+
(defcustom nnmail-split-methods
'(("mail.misc" ""))
"Incoming mail will be split according to this variable.
The last element should always have \"\" as the regexp.
This variable can also have a function as its value."
- :group 'gnus-mail
+ :group 'nnmail-split
:type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
(function-item nnmail-split-fancy)
(function :tag "Other")))
(defcustom nnmail-crosspost t
"If non-nil, do crossposting if several split methods match the mail.
If nil, the first match found will be used."
- :group 'gnus-mail
+ :group 'nnmail-split
:type 'boolean)
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
"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 'gnus-mail
+ :group 'nnmail-procmail
+ :group 'nnmail-various
:type 'boolean)
(defcustom nnmail-use-long-file-names nil
"If non-nil the mail backends will use long file and directory names.
If nil, groups like \"mail.misc\" will end up in directories like
\"mail/misc/\"."
- :group 'gnus-mail
+ :group 'nnmail-files
:type 'boolean)
(defcustom nnmail-default-file-modes 384
"Set the mode bits of all new mail files to this integer."
- :group 'gnus-mail
+ :group 'nnmail-files
:type 'integer)
(defcustom nnmail-expiry-wait 7
This variable can either be a number (which will be interpreted as a
number of days) -- this doesn't have to be an integer. This variable
can also be `immediate' and `never'."
- :group 'gnus-mail
+ :group 'nnmail-expire
:type '(choice (const immediate)
(integer :tag "days")
(const never)))
((string-match \"junk\" newsgroup) 1)
((string-match \"important\" newsgroup) 'never)
(t 7))))"
- :group 'gnus-mail
+ :group 'nnmail-expire
:type '(choice (const :tag "nnmail-expiry-wait" nil)
(function :format "%v" nnmail-)))
used as incoming mailboxes.
If this variable is a directory (i. e., it's name ends with a \"/\"),
treat all files in that directory as incoming spool files."
- :group 'gnus-mail
+ :group 'nnmail-files
:type 'file)
(defcustom nnmail-crash-box "~/.gnus-crash-box"
"File where Gnus will store mail while processing it."
- :group 'gnus-mail
+ :group 'nnmail-files
:type 'file)
(defcustom nnmail-use-procmail nil
"*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
The file(s) in `nnmail-spool-file' will also be read."
- :group 'gnus-mail
+ :group 'nnmail-procmail
:type 'boolean)
(defcustom nnmail-procmail-directory "~/incoming/"
"*When using procmail (and the like), incoming mail is put in this directory.
The Gnus mail backends will read the mail from this directory."
- :group 'gnus-mail
+ :group 'nnmail-procmail
:type 'directory)
(defcustom nnmail-procmail-suffix "\\.spool"
"*Suffix of files created by procmail (and the like).
This variable might be a suffix-regexp to match the suffixes of
several files - eg. \".spool[0-9]*\"."
- :group 'gnus-mail
+ :group 'nnmail-procmail
:type 'regexp)
(defcustom nnmail-resplit-incoming nil
"*If non-nil, re-split incoming procmail sorted mail."
- :group 'gnus-mail
+ :group 'nnmail-procmail
:type 'boolean)
(defcustom nnmail-delete-file-function 'delete-file
"Function called to delete files in some mail backends."
- :group 'gnus-mail
+ :group 'nnmail-files
:type 'function)
(defcustom nnmail-crosspost-link-function 'add-name-to-file
This is `add-name-to-file' by default, which means that crossposts
will use hard links. If your file system doesn't allow hard
links, you could set this variable to `copy-file' instead."
- :group 'gnus-mail
+ :group 'nnmail-files
:type '(radio (function-item add-name-to-file)
(function-item copy-file)
(function :tag "Other")))
This can also be a function. In that case, the function will be
called with two parameters -- the name of the INBOX file, and the file
to be moved to."
- :group 'gnus-mail
+ :group 'nnmail-files
+ :group 'nnmail-retrieve
:type 'string)
(defcustom nnmail-pop-password-required nil
"*Non-nil if a password is required when reading mail using POP."
- :group 'gnus-mail
+ :group 'nnmail-retrieve
:type 'boolean)
(defcustom nnmail-read-incoming-hook
;; the flag that says you have mail.
(when (eq (process-status \"display-time\") 'run)
(display-time-filter display-time-process \"\"))))"
- :group 'gnus-mail
+ :group 'nnmail-prepare
:type 'hook)
;; Suggested by Erik Selberg <speed@cs.washington.edu>.
(defcustom nnmail-prepare-incoming-hook nil
"Hook called before treating incoming mail.
The hook is run in a buffer with all the new, incoming mail."
- :group 'gnus-mail
+ :group 'nnmail-prepare
:type 'hook)
(defcustom nnmail-prepare-incoming-header-hook nil
"Hook called narrowed to the headers of each message.
This can be used to remove excessive spaces (and stuff like
that) from the headers before splitting and saving the messages."
- :group 'gnus-mail
+ :group 'nnmail-prepare
:type 'hook)
(defcustom nnmail-prepare-incoming-message-hook nil
"Hook called narrowed to each message."
- :group 'gnus-mail
+ :group 'nnmail-prepare
:type 'hook)
(defcustom nnmail-list-identifiers nil
"Regexp that matches list identifiers to be removed.
This can also be a list of regexps."
- :group 'gnus-mail
- :type '(choice regexp
+ :group 'nnmail-prepare
+ :type '(choice (const :tag "none" nil)
+ regexp
(repeat regexp)))
(defcustom nnmail-pre-get-new-mail-hook nil
"Hook called just before starting to handle new incoming mail."
- :group 'gnus-mail
+ :group 'nnmail-retrieve
:type 'hook)
(defcustom nnmail-post-get-new-mail-hook nil
"Hook called just after finishing handling new incoming mail."
- :group 'gnus-mail
+ :group 'nnmail-retrieve
:type 'hook)
(defcustom nnmail-split-hook nil
The functions in this hook are free to modify the buffer
contents in any way they choose -- the buffer contents are
discarded after running the split process."
- :group 'gnus-mail
+ :group 'nnmail-split
:type 'hook)
;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
(defcustom nnmail-tmp-directory nil
- "*If non-nil, use this directory for temporary storage when reading incoming mail."
- :group 'gnus-mail
+ "*If non-nil, use this directory for temporary storage.
+Used when reading incoming mail."
+ :group 'nnmail-files
+ :group 'nnmail-retrieve
:type '(choice (const :tag "default" nil)
(directory :format "%v")))
"*The number of the articles which indicates a large newsgroup.
If the number of the articles is greater than the value, verbose
messages will be shown to indicate the current status."
- :group 'gnus-mail
+ :group 'nnmail-various
:type 'integer)
(defcustom nnmail-split-fancy "mail.misc"
(any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
;; Unmatched mail goes to the catch all group.
\"misc.misc\"))"
- :group 'gnus-mail
+ :group 'nnmail-split
;; Sigh!
:type 'sexp)
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
(mail . "mailer-daemon\\|postmaster\\|uucp"))
"Alist of abbreviations allowed in `nnmail-split-fancy'."
- :group 'gnus-mail
+ :group 'nnmail-split
:type '(repeat (cons :format "%v" symbol regexp)))
(defcustom nnmail-delete-incoming t
"*If non-nil, the mail backends will delete incoming files after
splitting."
- :group 'gnus-mail
+ :group 'nnmail-retrieve
:type 'boolean)
(defcustom nnmail-message-id-cache-length 1000
"*The approximate number of Message-IDs nnmail will keep in its cache.
If this variable is nil, no checking on duplicate messages will be
performed."
- :group 'gnus-mail
+ :group 'nnmail-duplicate
:type '(choice (const :tag "disable" nil)
(integer :format "%v")))
(defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
"*The file name of the nnmail Message-ID cache."
- :group 'gnus-mail
+ :group 'nnmail-duplicate
+ :group 'nnmail-files
:type 'file)
(defcustom nnmail-treat-duplicates 'warn
This variable can also be a function. It will be called from a buffer
narrowed to the article in question with the Message-ID as a
parameter. It should return nil, `warn' or `delete'."
- :group 'gnus-mail
+ :group 'nnmail-duplicate
:type '(choice (const :tag "off" nil)
(const warn)
(const delete)))
(if nnmail-tmp-directory
(concat
(file-name-as-directory nnmail-tmp-directory)
- (file-name-nondirectory (concat temp "Incoming")))
- (concat temp "Incoming")))))
+ (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.
(setq found t
his nil)))
found))
-
+
+(defun nnmail-pop3-movemail (inbox crashbox)
+ "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
+ (require 'pop3)
+ (let ((pop3-maildrop
+ (substring inbox (match-end (string-match "^po:" inbox)))))
+ (pop3-movemail crashbox)))
+
(run-hooks 'nnmail-load-hook)
(provide 'nnmail)
(deffoo nnmh-request-newgroups (date &optional server)
(nnmh-request-list server))
-(deffoo nnmh-request-expire-articles (articles newsgroup &optional server force)
+(deffoo nnmh-request-expire-articles (articles newsgroup
+ &optional server force)
(nnmh-possibly-change-directory newsgroup server)
(let* ((active-articles
(mapcar
(defvoo nnweb-search nil
"Search string to feed to DejaNews.")
-(defvoo nnweb-max-hits 30
+(defvoo nnweb-max-hits 100
"Maximum number of hits to display.")
(defvoo nnweb-ephemeral-p nil
--- /dev/null
+;;; widget-browse.el --- Functions for browsing widgets.
+;;
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: extensions
+;; Version: 1.38
+;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+
+;;; Commentary:
+;;
+;; Widget browser. See `widget.el'.
+
+;;; Code:
+
+(require 'easymenu)
+(require 'custom)
+(require 'widget-edit)
+(require 'cl)
+
+(defgroup widget-browse nil
+ "Customization support for browsing widgets."
+ :group 'widgets)
+
+;;; The Mode.
+
+(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
+ widget-browse-mode-map
+ "Menu used in widget browser buffers."
+ '("Widget"
+ ["Browse" widget-browse t]
+ ["Browse At" widget-browse-at t]))
+
+(defcustom widget-browse-mode-hook nil
+ "Hook called when entering widget-browse-mode."
+ :type 'hook
+ :group 'widget-browse)
+
+(defun widget-browse-mode ()
+ "Major mode for widget browser buffers.
+
+The following commands are available:
+
+\\[widget-forward] Move to next button or editable field.
+\\[widget-backward] Move to previous button or editable field.
+\\[widget-button-click] Activate button under the mouse pointer.
+\\[widget-button-press] Activate button under point.
+
+Entry to this mode calls the value of `widget-browse-mode-hook'
+if that value is non-nil."
+ (kill-all-local-variables)
+ (setq major-mode 'widget-browse-mode
+ mode-name "Widget")
+ (use-local-map widget-browse-mode-map)
+ (easy-menu-add widget-browse-mode-menu)
+ (run-hooks 'widget-browse-mode-hook))
+
+;;; Commands.
+
+;;;###autoload
+(defun widget-browse-at (pos)
+ "Browse the widget under point."
+ (interactive "d")
+ (let* ((field (get-text-property pos 'field))
+ (button (get-text-property pos 'button))
+ (doc (get-text-property pos 'widget-doc))
+ (text (cond (field "This is an editable text area.")
+ (button "This is an active area.")
+ (doc "This is documentation text.")
+ (t "This is unidentified text.")))
+ (widget (or field button doc)))
+ (when widget
+ (widget-browse widget))
+ (message text)))
+
+(defvar widget-browse-history nil)
+
+(defun widget-browse (widget)
+ "Create a widget browser for WIDGET."
+ (interactive (list (completing-read "Widget: "
+ obarray
+ (lambda (symbol)
+ (get symbol 'widget-type))
+ t nil 'widget-browse-history)))
+ (if (stringp widget)
+ (setq widget (intern widget)))
+ (unless (if (symbolp widget)
+ (get widget 'widget-type)
+ (and (consp widget)
+ (get (widget-type widget) 'widget-type)))
+ (error "Not a widget."))
+ ;; Create the buffer.
+ (if (symbolp widget)
+ (let ((buffer (format "*Browse %s Widget*" widget)))
+ (kill-buffer (get-buffer-create buffer))
+ (switch-to-buffer (get-buffer-create buffer)))
+ (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)
+ (bury-buffer))
+ "Quit")
+ (widget-insert "\n")
+
+ ;; Top text indicating whether it is a class or object browser.
+ (if (listp widget)
+ (widget-insert "Widget object browser.\n\nClass: ")
+ (widget-insert "Widget class browser.\n\n")
+ (widget-create 'widget-browse
+ :format "%[%v%]\n%d"
+ :doc (get widget 'widget-documentation)
+ widget)
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ (widget-insert "\nSuper: ")
+ (setq widget (get widget 'widget-type)))
+
+ ;; Now show the attributes.
+ (let ((name (car widget))
+ (items (cdr widget))
+ key value printer)
+ (widget-create 'widget-browse
+ :format "%[%v%]"
+ name)
+ (widget-insert "\n")
+ (while items
+ (setq key (nth 0 items)
+ value (nth 1 items)
+ printer (or (get key 'widget-keyword-printer)
+ 'widget-browse-sexp)
+ items (cdr (cdr items)))
+ (widget-insert "\n" (symbol-name key) "\n\t")
+ (funcall printer widget key value)
+ (widget-insert "\n")))
+ (widget-setup)
+ (goto-char (point-min)))
+
+;;; The `widget-browse' Widget.
+
+(define-widget 'widget-browse 'push-button
+ "Button for creating a widget browser.
+The :value of the widget shuld be the widget to be browsed."
+ :format "%[[%v]%]"
+ :value-create 'widget-browse-value-create
+ :action 'widget-browse-action)
+
+(defun widget-browse-action (widget &optional event)
+ ;; Create widget browser for WIDGET's :value.
+ (widget-browse (widget-get widget :value)))
+
+(defun widget-browse-value-create (widget)
+ ;; Insert type name.
+ (let ((value (widget-get widget :value)))
+ (cond ((symbolp value)
+ (insert (symbol-name value)))
+ ((consp value)
+ (insert (symbol-name (widget-type value))))
+ (t
+ (insert "strange")))))
+
+;;; Keyword Printer Functions.
+
+(defun widget-browse-widget (widget key value)
+ "Insert description of WIDGET's KEY VALUE.
+VALUE is assumed to be a widget."
+ (widget-create 'widget-browse value))
+
+(defun widget-browse-widgets (widget key value)
+ "Insert description of WIDGET's KEY VALUE.
+VALUE is assumed to be a list of widgets."
+ (while value
+ (widget-create 'widget-browse
+ (car value))
+ (setq value (cdr value))
+ (when value
+ (widget-insert " "))))
+
+(defun widget-browse-sexp (widget key value)
+ "Insert description of WIDGET's KEY VALUE.
+Nothing is assumed about value."
+ (let ((pp (condition-case signal
+ (pp-to-string value)
+ (error (prin1-to-string signal)))))
+ (when (string-match "\n\\'" pp)
+ (setq pp (substring pp 0 (1- (length pp)))))
+ (if (cond ((string-match "\n" pp)
+ nil)
+ ((> (length pp) (- (window-width) (current-column)))
+ nil)
+ (t t))
+ (widget-insert pp)
+ (widget-create 'push-button
+ :tag "show"
+ :action (lambda (widget &optional event)
+ (with-output-to-temp-buffer
+ "*Pp Eval Output*"
+ (princ (widget-get widget :value))))
+ pp))))
+
+(defun widget-browse-sexps (widget key value)
+ "Insert description of WIDGET's KEY VALUE.
+VALUE is assumed to be a list of widgets."
+ (let ((target (current-column)))
+ (while value
+ (widget-browse-sexp widget key (car value))
+ (setq value (cdr value))
+ (when value
+ (widget-insert "\n" (make-string target ?\ ))))))
+
+;;; Keyword Printers.
+
+(put :parent 'widget-keyword-printer 'widget-browse-widget)
+(put :children 'widget-keyword-printer 'widget-browse-widgets)
+(put :buttons 'widget-keyword-printer 'widget-browse-widgets)
+(put :button 'widget-keyword-printer 'widget-browse-widget)
+(put :args 'widget-keyword-printer 'widget-browse-sexps)
+
+;;; The End:
+
+(provide 'widget-browse)
+
+;; widget-browse.el ends here
;;; widget-edit.el --- Functions for creating and using widgets.
;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 1.24
+;; Version: 1.38
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(defmacro defgroup (&rest args) nil)
(defmacro defcustom (&rest args) nil)
(defmacro defface (&rest args) nil)
+ (define-widget-keywords :prefix :tag :load :link :options :type :group)
(when (fboundp 'copy-face)
(copy-face 'default 'widget-documentation-face)
(copy-face 'bold 'widget-button-face)
;;
;; These are not really widget specific.
-(defun widget-plist-member (plist prop)
+(defsubst widget-plist-member (plist prop)
;; Return non-nil if PLIST has the property PROP.
;; PLIST is a property list, which is a list of the form
;; (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol.
items nil t)
items)))))
+(defun widget-get-sibling (widget)
+ "Get the item WIDGET is assumed to toggle.
+This is only meaningful for radio buttons or checkboxes in a list."
+ (let* ((parent (widget-get widget :parent))
+ (children (widget-get parent :children))
+ child)
+ (catch 'child
+ (while children
+ (setq child (car children)
+ children (cdr children))
+ (when (eq (widget-get child :button) widget)
+ (throw 'child child)))
+ nil)))
+
;;; Widget text specifications.
;;
;; These functions are for specifying text properties.
(unless (widget-get widget :size)
(add-text-properties to (1+ to) (list 'field widget
- 'face face
- 'local-map map
- 'keymap map)))))
+ 'face face)))
+ (add-text-properties to (1+ to) (list 'local-map map
+ 'keymap map))))
(defun widget-specify-button (widget from to)
;; Specify button for WIDGET between FROM and TO.
;;; Widget Properties.
+(defsubst widget-type (widget)
+ "Return the type of WIDGET, a symbol."
+ (car widget))
+
(defun widget-put (widget property value)
"In WIDGET set PROPERTY to VALUE.
The value can later be retrived with `widget-get'."
"In WIDGET, get the value of PROPERTY.
The value could either be specified when the widget was created, or
later with `widget-put'."
- (cond ((widget-plist-member (cdr widget) property)
- (plist-get (cdr widget) property))
- ((car widget)
- (widget-get (get (car widget) 'widget-type) property))
- (t nil)))
+ (let ((missing t)
+ value tmp)
+ (while missing
+ (cond ((setq tmp (widget-plist-member (cdr widget) property))
+ (setq value (car (cdr tmp))
+ missing nil))
+ ((setq tmp (car widget))
+ (setq widget (get tmp 'widget-type)))
+ (t
+ (setq missing nil))))
+ value))
(defun widget-member (widget property)
"Non-nil iff there is a definition in WIDGET for PROPERTY."
(cons (list (car vals)) (cdr vals)))
(t nil)))
+;;; Glyphs.
+
+(defcustom widget-glyph-directory (concat data-directory "custom/")
+ "Where widget glyphs are located.
+If this variable is nil, widget will try to locate the directory
+automatically. This does not work yet."
+ :group 'widgets
+ :type 'directory)
+
+(defcustom widget-glyph-enable t
+ "If non nil, use glyphs in images when available."
+ :group 'widgets
+ :type 'boolean)
+
+(defun widget-glyph-insert (widget tag image)
+ "In WIDGET, insert the text TAG or, if supported, IMAGE.
+IMAGE should be a name sans extension of an xpm or xbm file located in
+`widget-glyph-directory'"
+ (if (and (string-match "XEmacs" emacs-version)
+ widget-glyph-enable
+ (fboundp 'make-glyph)
+ image)
+ (let ((file (concat widget-glyph-directory
+ (if (string-match "/\\'" widget-glyph-directory)
+ ""
+ "/")
+ image
+ (if (featurep 'xpm) ".xpm" ".xbm"))))
+ (if (file-readable-p file)
+ (widget-glyph-insert-glyph widget tag (make-glyph file))
+ ;; File not readable, give up.
+ (insert tag)))
+ ;; We don't want or can't use glyphs.
+ (insert tag)))
+
+(defun widget-glyph-insert-glyph (widget tag glyph)
+ "In WIDGET, with alternative text TAG, insert GLYPH."
+ (set-glyph-image glyph (cons 'tty tag))
+ (set-glyph-property glyph 'widget widget)
+ (insert "*")
+ (add-text-properties (1- (point)) (point)
+ (list 'invisible t
+ 'end-glyph glyph)))
+
;;; Creating Widgets.
;;;###autoload
(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 "\M-\t" 'widget-backward)
(define-key widget-keymap [(shift tab)] 'widget-backward)
(define-key widget-keymap [(shift tab)] 'widget-backward)
(define-key widget-keymap [backtab] 'widget-backward)
(if (string-match "XEmacs" (emacs-version))
- (define-key widget-keymap [button2] 'widget-button-click)
- (define-key widget-keymap [menu-bar] 'nil)
- (define-key widget-keymap [mouse-2] 'widget-button-click))
+ (progn
+ (define-key widget-keymap [button2] 'widget-button-click)
+ (define-key widget-keymap [button1] 'widget-button1-click))
+ (define-key widget-keymap [mouse-2] 'ignore)
+ (define-key widget-keymap [down-mouse-2] 'widget-button-click))
(define-key widget-keymap "\C-m" 'widget-button-press))
(defvar widget-global-map global-map
(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))
(define-key widget-field-keymap "\C-m" 'widget-field-activate)
+ (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line)
+ (define-key widget-field-keymap "\C-e" 'widget-end-of-line)
(set-keymap-parent widget-field-keymap global-map))
(defvar widget-text-keymap nil
(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))
+ (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line)
+ (define-key widget-text-keymap "\C-e" 'widget-end-of-line)
(set-keymap-parent widget-text-keymap global-map))
(defun widget-field-activate (pos &optional event)
"Activate the ediable field at point."
(interactive "@d")
- (let* ((field (get-text-property pos 'field)))
+ (let ((field (get-text-property pos 'field)))
(if field
(widget-apply field :action event)
(call-interactively
(defun widget-button-click (event)
"Activate button below mouse pointer."
(interactive "@e")
- (widget-button-press (event-point event) event))
+ (cond ((and (fboundp 'event-glyph)
+ (event-glyph event))
+ (let ((widget (glyph-property (event-glyph event) 'widget)))
+ (if widget
+ (widget-apply widget :action event)
+ (message "You clicked on a glyph."))))
+ ((event-point event)
+ (let ((button (get-text-property (event-point event) 'button)))
+ (if button
+ (widget-apply button :action event)
+ (call-interactively
+ (or (lookup-key widget-global-map [ button2 ])
+ (lookup-key widget-global-map [ down-mouse-2 ])
+ (lookup-key widget-global-map [ mouse-2]))))))
+ (t
+ (message "You clicked somewhere weird."))))
+
+(defun widget-button1-click (event)
+ "Activate glyph below mouse pointer."
+ (interactive "@e")
+ (if (and (fboundp 'event-glyph)
+ (event-glyph event))
+ (let ((widget (glyph-property (event-glyph event) 'widget)))
+ (if widget
+ (widget-apply widget :action event)
+ (message "You clicked on a glyph.")))
+ (call-interactively (lookup-key widget-global-map (this-command-keys)))))
(defun widget-button-press (pos &optional event)
"Activate button at POS."
(interactive "@d")
- (let* ((button (get-text-property pos 'button)))
+ (let ((button (get-text-property pos 'button)))
(if button
(widget-apply button :action event)
- (call-interactively
- (lookup-key widget-global-map (this-command-keys))))))
+ (let ((command (lookup-key widget-global-map (this-command-keys))))
+ (when (commandp command)
+ (call-interactively command))))))
(defun widget-move (arg)
"Move point to the ARG next field or button.
(run-hooks 'widget-backward-hook)
(widget-move (- arg)))
+(defun widget-beginning-of-line ()
+ "Go to beginning of field or beginning of line, whichever is first."
+ (interactive)
+ (let ((bol (save-excursion (beginning-of-line) (point)))
+ (prev (previous-single-property-change (point) 'field)))
+ (goto-char (max bol (or prev bol)))))
+
+(defun widget-end-of-line ()
+ "Go to end of field or end of line, whichever is first."
+ (interactive)
+ (let ((bol (save-excursion (end-of-line) (point)))
+ (prev (next-single-property-change (point) 'field)))
+ (goto-char (min bol (or prev bol)))))
+
+(defun widget-kill-line ()
+ "Kill to end of field or end of line, whichever is first."
+ (interactive)
+ (let ((field (get-text-property (point) 'field))
+ (newline (save-excursion (search-forward "\n")))
+ (next (next-single-property-change (point) 'field)))
+ (if (and field (> newline next))
+ (kill-region (point) next)
+ (call-interactively 'kill-line))))
+
;;; Setting up the buffer.
(defvar widget-field-new nil)
(widget-specify-insert
(let ((from (point))
(tag (widget-get widget :tag))
+ (glyph (widget-get widget :tag-glyph))
(doc (widget-get widget :doc))
button-begin button-end
sample-begin sample-end
value-pos)
(insert (widget-get widget :format))
(goto-char from)
- ;; Parse % escapes in format.
+ ;; Parse escapes in format.
(while (re-search-forward "%\\(.\\)" nil t)
(let ((escape (aref (match-string 1) 0)))
(replace-match "" t t)
(insert "\n")
(insert-char ? (widget-get widget :indent))))
((eq escape ?t)
- (if tag
- (insert tag)
- (let ((standard-output (current-buffer)))
- (princ (widget-get widget :value)))))
+ (cond (glyph
+ (widget-glyph-insert widget (or tag "image") glyph))
+ (tag
+ (insert tag))
+ (t
+ (let ((standard-output (current-buffer)))
+ (princ (widget-get widget :value))))))
((eq escape ?d)
(when doc
(setq doc-begin (point))
;;; The `push-button' Widget.
+(defcustom widget-push-button-gui t
+ "If non nil, use GUI push buttons when available."
+ :group 'widgets
+ :type 'boolean)
+
+;; Cache already created GUI objects.
+(defvar widget-push-button-cache nil)
+
(define-widget 'push-button 'item
"A pushable button."
- :format "%[[%t]%]")
+ :value-create 'widget-push-button-value-create
+ :format "%[%v%]")
+
+(defun widget-push-button-value-create (widget)
+ ;; Insert text representing the `on' and `off' states.
+ (let* ((tag (or (widget-get widget :tag)
+ (widget-get widget :value)))
+ (text (concat "[" tag "]"))
+ (gui (cdr (assoc tag widget-push-button-cache))))
+ (if (and (fboundp 'make-gui-button)
+ (fboundp 'make-glyph)
+ widget-push-button-gui
+ (string-match "XEmacs" emacs-version))
+ (progn
+ (unless gui
+ (setq gui (make-gui-button tag 'widget-gui-action widget))
+ (push (cons tag gui) widget-push-button-cache))
+ (widget-glyph-insert-glyph widget text
+ (make-glyph (car (aref gui 1)))))
+ (insert text))))
+
+(defun widget-gui-action (widget)
+ "Apply :action for WIDGET."
+ (widget-apply widget :action (this-command-keys)))
;;; The `link' Widget.
;;; The `toggle' Widget.
-(define-widget 'toggle 'menu-choice
+(define-widget 'toggle 'item
"Toggle between two states."
- :convert-widget 'widget-toggle-convert-widget
- :format "%v"
+ :format "%[%v%]\n"
+ :value-create 'widget-toggle-value-create
+ :action 'widget-toggle-action
+ :match (lambda (widget value) t)
:on "on"
:off "off")
-(defun widget-toggle-convert-widget (widget)
- ;; Create the types representing the `on' and `off' states.
- (let ((on-type (widget-get widget :on-type))
- (off-type (widget-get widget :off-type)))
- (unless on-type
- (setq on-type
- (list 'choice-item
- :value t
- :match (lambda (widget value) value)
- :tag (widget-get widget :on))))
- (unless off-type
- (setq off-type
- (list 'choice-item :value nil :tag (widget-get widget :off))))
- (widget-put widget :args (list on-type off-type)))
- widget)
-
+(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-get widget :on-glyph))
+ (widget-glyph-insert widget
+ (widget-get widget :off)
+ (widget-get widget :off-glyph))))
+
+(defun widget-toggle-action (widget &optional event)
+ ;; Toggle value.
+ (widget-value-set widget (not (widget-value widget)))
+ (widget-apply widget :notify widget event))
+
;;; The `checkbox' Widget.
(define-widget 'checkbox 'toggle
"A checkbox toggle."
- :convert-widget 'widget-item-convert-widget
- :on-type '(choice-item :format "%[[X]%]" t)
- :off-type '(choice-item :format "%[[ ]%]" nil))
+ :format "%[%v%]"
+ :on "[X]"
+ :on-glyph "check1"
+ :off "[ ]"
+ :off-glyph "check0")
;;; The `checklist' Widget.
(define-widget 'radio-button 'toggle
"A radio button for use in the `radio' widget."
:notify 'widget-radio-button-notify
- :on-type '(choice-item :format "%[(*)%]" t)
- :off-type '(choice-item :format "%[( )%]" nil))
+ :format "%[%v%]"
+ :on "(*)"
+ :on-glyph "radio1"
+ :off "( )"
+ :off-glyph "radio0")
(defun widget-radio-button-notify (widget child &optional event)
- ;; Notify the parent.
+ ;; Tell daddy.
(widget-apply (widget-get widget :parent) :action widget event))
;;; The `radio-button-choice' Widget.
;;; The `editable-list' Widget.
+(defcustom widget-editable-list-gui nil
+ "If non nil, use GUI push-buttons in editable list when available."
+ :type 'boolean
+ :group 'widgets)
+
(define-widget 'editable-list 'default
"A variable list of widgets of the same type."
:convert-widget 'widget-types-convert-widget
(defun widget-editable-list-format-handler (widget escape)
;; We recognize the insert button.
- (cond ((eq escape ?i)
- (and (widget-get widget :indent)
- (insert-char ? (widget-get widget :indent)))
- (widget-create-child-and-convert widget 'insert-button))
- (t
- (widget-default-format-handler widget escape))))
+ (let ((widget-push-button-gui widget-editable-list-gui))
+ (cond ((eq escape ?i)
+ (and (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
+ (widget-create-child-and-convert widget 'insert-button))
+ (t
+ (widget-default-format-handler widget escape)))))
(defun widget-editable-list-value-create (widget)
;; Insert all values
(defun widget-editable-list-entry-create (widget value conv)
;; Create a new entry to the list.
(let ((type (nth 0 (widget-get widget :args)))
+ (widget-push-button-gui widget-editable-list-gui)
child delete insert)
(widget-specify-insert
(save-excursion
(define-widget 'boolean 'toggle
"To be nil or non-nil, that is the question."
:tag "Boolean"
- :format "%{%t%}: %v")
+ :format "%{%t%}: %[%v%]\n")
;;; The `color' Widget.
;;; widget.el --- a library of user interface components.
;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.24
+;; Version: 1.38
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(set (car keywords) (car keywords)))
(setq keywords (cdr keywords)))))))
-(define-widget-keywords :valid-regexp
+(define-widget-keywords :tag-glyph :off-glyph :on-glyph :valid-regexp
: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
;; These autoloads should be deleted when the file is added to Emacs.
(autoload 'widget-create "widget-edit")
(autoload 'widget-insert "widget-edit")
+(autoload 'widget-browse "widget-browse" nil t)
+(autoload 'widget-browse-at "widget-browse" nil t)
;;;###autoload
(defun define-widget (name class doc &rest args)
+Sun Feb 16 15:43:34 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.texi (Mail Backend Variables): Fix.
+
+ * message.texi (Various Message Variables): Addition.
+
Mon Feb 10 07:18:16 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.texi (Article Commands): Addition.
@comment node-name, next, previous, up
@top The Customization Library
-Version: 1.24
+Version: 1.34
@menu
* Introduction::
@cindex incoming mail files
@cindex deleting incoming files
If non-@code{nil}, the mail backends will delete the temporary incoming
-file after splitting mail into the proper groups. This is @code{nil} by
-default for reasons of security.
+file after splitting mail into the proper groups. This is @code{t} by
+default.
+
+@c This is @code{nil} by
+@c default for reasons of security.
@c Since Red Gnus is an alpha release, it is to be expected to lose mail.
(No Gnus release since (ding) Gnus 0.10 (or something like that) have
@code{message-send-mail-with-sendmail}. If you prefer using MH
instead, set this variable to @code{message-send-mail-with-mh}.
+@item message-mh-deletable-headers
+@vindex message-mh-deletable-headers
+Most versions of MH doesn't like being fed messages that contain the
+headers in this variable. If this variable is non-@code{nil} (which is
+the default), these headers will be removed before mailing. Set it to
+@code{nil} if your MH can handle these headers.
+
@end table
@vindex message-header-setup-hook
Hook called narrowed to the headers after initializing the headers.
+For instance, if you're running Gnus and wish to insert a
+@samp{Mail-Copies-To} header in all your news articles and all messages
+you send to mailing lists, you could do something like the following:
+
+@lisp
+(defun my-message-header-setup-hook ()
+ (when (or (message-fetch-field "newsgroups")
+ (gnus-group-find-parameter
+ gnus-newsgroup-namegroup 'to-address)
+ (gnus-group-find-parameter
+ gnus-newsgroup-namegroup 'to-list))
+ (insert "Mail-Copies-To: never\n")))
+
+(add-hook 'message-header-setup-hook 'my-message-header-setup-hook)
+@end lisp
+
@item message-send-hook
@vindex message-send-hook
Hook run before sending messages.
\input texinfo.tex
-@c $Id: widget.texi,v 1.3 1997/02/03 18:09:45 steve Exp $
+@c $Id: widget.texi,v 1.4 1997/02/16 21:58:10 steve Exp $
@c %**start of header
@setfilename widget
@comment node-name, next, previous, up
@top The Emacs Widget Library
-Version: 1.24
+Version: 1.34
@menu
* Introduction::
The string inserted by the @samp{%t} escape in the format
string.
+@item :tag-glyph
+Name of image to use instead of the string specified by `:tag' on
+Emacsen that supports it.
+
@item :help-echo
Message displayed whenever you move to the widget with either
@code{widget-forward} or @code{widget-backward}.
@code{editable-list} widget).
@end table
+@deffn {User Option} widget-glyph-directory
+Directory where glyphs are found.
+Widget will look here for a file with the same name as specified for the
+image, with either a @samp{.xpm} (if supported) or @samp{.xbm} extension.
+@end deffn
+
+@deffn{User Option} widget-glyph-enable
+If non-nil, allow glyphs to appear on displayes where they are supported.
+@end deffn
+
+
@menu
* link::
* url-link::
String representing the `on' state. By default the string @samp{on}.
@item :off
String representing the `off' state. By default the string @samp{off}.
-@item :on-type
-Type representing the `on' state. By default an `item' widget displaying
-the string specified with the @code{:on} keyword.
-@item :off-type
-Type representing the `off' state. By default an `item' widget
-displaying the string specified with the @code{:off} keyword.
+@item :on-glyph
+Name of a glyph to be used instead of the `:on' text string, on emacsen
+that supports it.
+@item :off-glyph
+Name of a glyph to be used instead of the `:off' text string, on emacsen
+that supports it.
@end table
@node checkbox, checklist, toggle, Basic Types
@comment node-name, next, previous, up
@section Properties
-You can examine or set this value by using the widget object that was
-returned by @code{widget-create}.
+You can examine or set the value of a widget by using the widget object
+that was returned by @code{widget-create}.
@defun widget-value widget
Return the current value contained in @var{widget}.
Non-nil if @var{widget} has a value (even nil) for property @var{property}.
@end defun
+Occasionally it can be useful to know which kind of widget you have,
+i.e. the name of the widget type you gave when the widget was created.
+
+@defun widget-type widget
+Return the name of @var{widget}, a symbol.
+@end defun
+
@node Defining New Widgets, Widget Wishlist., Widget Properties, Top
@comment node-name, next, previous, up
@section Defining New Widgets
@itemize @bullet
@item
-In general, we need @strong{much} better support for keyboard
-operations.
-
-@itemize -
-@item
It should be possible to add or remove items from a list with @kbd{C-k}
and @kbd{C-o} (suggested by @sc{rms}).
-@item
-@kbd{C-k} should kill to end of field or end of line, whatever come
-first.
-
-@item
-Commands to move to the beginning/end of a field.
-
-@end itemize
-
@item
The @samp{[INS]} and @samp{[DEL]} buttons should be replaced by a single
dash (@samp{-}). The dash should be a button that, when activated, ask
the ugly buttons, the dash is my idea).
@item
-Use graphical versions of the widgets for emacsen that can do that.
-I.e. real radio buttons and checkmarks instead of their @sc{ascii}
-equivalents.
-
-@item
-There should be support for browsing the widget documentation.
-
-@item
-There should be a way to specify that @key{RET} in a field will call the
-@code{:activate} function. This should be used by widgets such as
-@code{file} and @code{symbol} prompt with completion.
+Widgets such as @code{file} and @code{symbol} should prompt with completion.
@item
The @code{menu-choice} tag should be prettier, something like the abbreviated
@item
The functions used in many widgets, like
@code{widget-item-convert-widget}, should not have names that are
-specific to the first widget where I used them.
+specific to the first widget where I happended to use them.
@item
Unchecked items in a @code{radio-button-choice} or @code{checklist}
@item
Document `helper' functions for defining new widgets.
-@item
-Show button menus on mouse down.
-
@item
Activate the item this is below the mouse when the button is
released, not the item this is below the mouse when the button is
Split, when needed, keywords into those useful for normal
customization, those primarily useful when deriving, and those who
represent runtime information.
+
+@item
+Figure out terminology and @sc{api} for the class/type/object/super
+stuff.
+
+Perhaps the correct model is delegation?
+
+@item
+Document @code{widget-browse}.
+
+@item
+Add object and class hierarchies to the browser.
+
@end itemize
@contents
projects / gnus / commitdiff