-Thu Sep 19 03:05:01 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+Sun Sep 22 11:48:02 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
- * gnus.el: Red Gnus v0.37 is released.
+ * custom.el (defcustom): Eval and compile.
+ * widget.el (define-widget-keywords): Ditto.
+
+Sat Sep 21 09:29:54 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * article.el (article-strip-multiple-blank-lines): Would strip all
+ blank lines.
+
+Fri Sep 20 06:52:07 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.39 is released.
Thu Sep 19 18:57:59 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* message.el (message-ignored-cited-headers): Doc fix.
+Thu Sep 19 03:05:01 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.38 is released.
+
+Thu Sep 19 03:05:01 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.37 is released.
+
Wed Sep 18 10:36:08 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus-async.el (gnus-async-prefetch-article-p): New variable.
(require 'nnheader)
(require 'gnus-util)
(require 'message)
-
-(defvar gnus-ignored-headers
- "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
- "*All headers that match this regexp will be hidden.
+(require 'custom)
+
+(defgroup article nil
+ "Article display."
+ :group 'gnus)
+
+(defcustom gnus-ignored-headers
+ '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:"
+ "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
+ "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
+ "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
+ "All headers that match this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
-If `article-visible-headers' is non-nil, this variable will be ignored.")
-
-(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
- "*All headers that do not match this regexp will be hidden.
+If `article-visible-headers' is non-nil, this variable will be ignored."
+ :type '(repeat string) ;Leave monster regexp to lisp.
+ :group 'article)
+
+(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-")
+ "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.
-If this variable is non-nil, `article-ignored-headers' will be ignored.")
+If this variable is non-nil, `article-ignored-headers' will be ignored."
+ :type '(repeat string) ;Leave monster regexp to lisp.
+ :group 'article)
-(defvar gnus-sorted-header-list
+(defcustom gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
"^Cc:" "^Date:" "^Organization:")
- "*This variable is a list of regular expressions.
+ "This variable is a list of regular expressions.
If it is non-nil, headers that match the regular expressions will
be placed first in the article buffer in the sequence specified by
-this list.")
+this list."
+ :type '(repeat string)
+ :group 'article)
-(defvar gnus-boring-article-headers
- '(empty followup-to reply-to)
- "*Headers that are only to be displayed if they have interesting data.
+(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
+ "Headers that are only to be displayed if they have interesting data.
Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', and `date'.")
-
-(defvar gnus-signature-separator '("^-- $" "^-- *$")
+`reply-to', and `date'."
+ :type '(set (item :tag "Headers with no content." empty)
+ (item :tag "Newsgroups with only one group." newsgroups)
+ (item :tag "Followup-to identical to newsgroups." followup-to)
+ (item :tag "Reply-to identical to from." reply-to)
+ (item :tag "Date less than four days old." date))
+ :group 'article)
+
+(defcustom gnus-signature-separator '("^-- $" "^-- *$")
"Regexp matching signature separator.
This can also be a list of regexps. In that case, it will be checked
from head to tail looking for a separator. Searches will be done from
-the end of the buffer.")
+the end of the buffer."
+ :type '(repeat string)
+ :group 'article)
-(defvar gnus-signature-limit nil
- "Provide a limit to what is considered a signature.
+(defcustom gnus-signature-limit nil
+ "Provide a limit to what is considered a signature.
If it is a number, no signature may not be longer (in characters) than
that number. If it is a floating point number, no signature may be
longer (in lines) than that number. If it is a function, the function
will be called without any parameters, and if it returns nil, there is
no signature in the buffer. If it is a string, it will be used as a
-regexp. If it matches, the text in question is not a signature.")
+regexp. If it matches, the text in question is not a signature."
+ :type '(choice integer number function string)
+ :group 'article)
-(defvar gnus-hidden-properties '(invisible t intangible t)
- "Property list to use for hiding text.")
+(defcustom gnus-hidden-properties '(invisible t intangible t)
+ "Property list to use for hiding text."
+ :type 'sexp
+ :group 'article)
-(defvar gnus-article-x-face-command
+(defcustom gnus-article-x-face-command
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
"String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
-asynchronously. The compressed face will be piped to this command.")
-
-(defvar gnus-article-x-face-too-ugly nil
- "Regexp matching posters whose face shouldn't be shown automatically.")
-
-(defvar gnus-emphasis-alist
- '(("_\\(\\w+\\)_" 0 1 'underline)
- ("\\W\\(/\\(\\w+\\)/\\)\\W" 1 2 'italic)
- ("\\(_\\*\\|\\*_\\)\\(\\w+\\)\\(_\\*\\|\\*_\\)" 0 2 'bold-underline)
- ("\\*\\(\\w+\\)\\*" 0 1 'bold))
+asynchronously. The compressed face will be piped to this command."
+ :type 'string ;Leave function case to Lisp.
+ :group 'article)
+
+(defcustom gnus-article-x-face-too-ugly nil
+ "Regexp matching posters whose face shouldn't be shown automatically."
+ :type 'regexp
+ :group 'article)
+
+(defcustom gnus-emphasis-alist
+ '(("_\\(\\w+\\)_" 0 1 underline)
+ ("\\W\\(/\\(\\w+\\)/\\)\\W" 1 2 italic)
+ ("\\(_\\*\\|\\*_\\)\\(\\w+\\)\\(_\\*\\|\\*_\\)" 0 2 bold-underline)
+ ("\\*\\(\\w+\\)\\*" 0 1 bold))
"Alist that says how to fontify certain phrases.
Each item looks like this:
is a number that says what regular expression grouping used to find
the entire emphasized word. The third is a number that says what
regexp grouping should be displayed and highlighted. The fourth
-is the face used for highlighting.")
+is the face used for highlighting."
+ :type '(repeat (list :value ("" 0 0 default)
+ regexp
+ (integer :tag "Match group")
+ (integer :tag "Emphasize group")
+ face))
+ :group 'article)
(eval-and-compile
(autoload 'hexl-hex-string-to-integer "hexl")
(replace-match "" nil t))
;; Then replace multiple empty lines with a single empty line.
(goto-char (point-min))
- (while (re-search-forward "\n\n+" nil t)
- (replace-match "\n" nil t)))))
+ (while (re-search-forward "\n\n\n+" nil t)
+ (replace-match "\n\n" t t)))))
(defun article-strip-blank-lines ()
"Strip leading, trailing and multiple blank lines."
(setq beg (point)))
t)))
-(defvar article-time-units
+(defconst article-time-units
`((year . ,(* 365.25 24 60 60))
(week . ,(* 7 24 60 60))
(day . ,(* 24 60 60))
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 0.9
+;; Version: 0.94
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(require 'custom)
(require 'widget-edit)
-(let ((keywords '(:custom-show
- :custom-documentation-show
- :custom-documentation-property
- :custom-level
- :custom-status)))
- (while keywords
- (or (boundp (car keywords))
- (set (car keywords) (car keywords)))
- (setq keywords (cdr keywords))))
+(define-widget-keywords :custom-show :custom-doc :custom-magic
+ :custom-state :custom-documentation-property :custom-level :custom-form
+ :custom-apply :custom-set-default :custom-reset)
;;; Utilities.
sexp
(list 'quote sexp)))
+(defun custom-unimplemented (&rest ignore)
+ "Apologize for my laziness."
+ (error "Sorry, not implemented"))
+
+;;; Modification of Basic Widgets.
+;;
+;; We add extra properties to the basic widgets needed here. This is
+;; fine, as long as we are careful to stay within out own namespace.
+;;
+;; We want simple widgets to be displayed by default, but complex
+;; widgets to be hidden.
+
+(widget-put (get 'item 'widget-type) :custom-show t)
+(widget-put (get 'editable-field 'widget-type) :custom-show t)
+(widget-put (get 'menu-choice 'widget-type) :custom-show t)
+
+;;; The `custom-magic' Widget
+
+(define-widget 'custom-magic 'item
+ "Status feedback for customization option."
+ :format "%[%v%]"
+ :action 'widget-choice-item-action
+ :value-create 'custom-magic-value-create)
+
+(defface custom-invalid-face '((((class color))
+ (:foreground "yellow" :background "red"))
+ (t
+ (:bold t :italic t :underline t)))
+ "Face used when the customize item is invalid."
+ :group 'customize)
+
+(defface custom-rogue-face '((((class color))
+ (:foreground "pink" :background "black"))
+ (t
+ (:underline t)))
+ "Face used when the customize item is not defined for customization."
+ :group 'customize)
+
+(defface custom-modified-face '((((class color))
+ (:foreground "white" :background "blue"))
+ (t
+ (:italic t :bold)))
+ "Face used when the customize item has been modified."
+ :group 'customize)
+
+(defface custom-applied-face '((((class color))
+ (:foreground "blue" :background "white"))
+ (t
+ (:italic t)))
+ "Face used when the customize item has been applied."
+ :group 'customize)
+
+(defface custom-saved-face '((t (:underline t)))
+ "Face used when the customize item has been saved."
+ :group 'customize)
+
+(defcustom custom-magic-alist '((nil "#" underline)
+ (unknown "?" italic)
+ (hidden "-" default)
+ (invalid "x" custom-invalid-face)
+ (modified "*" custom-modified-face)
+ (applied "+" custom-applied-face)
+ (saved "!" custom-saved-face)
+ (rogue "@" custom-rogue-face)
+ (factory " " nil))
+ "Alist of magic representing a customize items status.
+Each entry is of the form (STATE MAGIC FACE), where
+
+STATE is one of the following symbols:
+
+`nil'
+ For internal use, should never occur.
+`unknown'
+ For internal use, should never occur.
+`hidden'
+ This item is not being displayed.
+`invalid'
+ This item is modified, but has an invalid form.
+`modified'
+ This item is modified, and has a valid form.
+`applied'
+ This items current value has been changed temporarily.
+`saved'
+ This item is marked for saving.
+`rogue'
+ This item has no customization information.
+`factory'
+ This item is unchanged from the factory default.
+
+MAGIC is a string used to present that state.
+
+FACE is a face used to present the state.
+
+The list should be sorted most significant first."
+ :type '(repeat (list (choice (item nil)
+ (item unknown)
+ (item hidden)
+ (item invalid)
+ (item modified)
+ (item applied)
+ (item saved)
+ (item rogue)
+ (item factory))
+ string face))
+ :group 'customize)
+
+(defun custom-magic-value-create (widget)
+ ;; Create compact status report for WIDGET.
+ (let* ((parent (widget-get widget :parent))
+ (state (widget-get parent :custom-state))
+ (entry (assq state custom-magic-alist))
+ (magic (nth 1 entry))
+ (face (nth 2 entry)))
+ (if (eq (widget-get parent :custom-form) 'lisp)
+ (widget-insert "(" magic ")")
+ (widget-insert "[" magic "]"))
+ (widget-put widget :button-face face)))
+
+(defun custom-magic-reset (widget)
+ "Redraw the :custom-magic property of WIDGET."
+ (let ((magic (widget-get widget :custom-magic)))
+ (widget-value-set magic (widget-value magic))))
+
;;; The `custom-level' Widget.
(define-widget 'custom-level 'item
(defun custom-level-action (widget &optional event)
"Toggle visibility for parent to WIDGET."
(let* ((parent (widget-get widget :parent))
- (show (widget-get parent :custom-show)))
- (widget-apply parent :validate)
- (widget-put parent :custom-show (not show))
- (custom-reset parent)))
+ (state (widget-get parent :custom-state)))
+ (cond ((memq state '(invalid modified))
+ (error "There are unapplied changes"))
+ ((eq state 'hidden)
+ (widget-put parent :custom-state 'unknown))
+ (t
+ (widget-put parent :custom-state 'hidden)))
+ (custom-redraw parent)))
;;; The `custom-help' Widget.
-(define-widget 'custom-help 'push
+(define-widget 'custom-help 'push-button
"The custom documentation button."
+ :format "%[[%t]%] %d"
:help-echo "Push me to toggle the documentation."
:action 'custom-help-action)
-(defun custom-help-action (widget &optional event)
- "Toggle documentation visibility for parent to WIDGET."
- (let* ((parent (widget-get widget :parent))
- (symbol (widget-get parent :value))
- (property (widget-get parent :custom-documentation-property))
- (text (or (widget-get parent :doc)
- (documentation-property symbol property)))
- (newline (string-match "\n." text))
- (old (widget-get parent :custom-documentation-show))
- (new (cond ((eq old t)
- nil)
- ((null old)
- (if newline
- 'first-line
- t))
- (t
- (if newline
- t
- nil)))))
- (widget-apply parent :validate)
- (widget-put parent :custom-documentation-show new)
- (custom-reset parent)))
+(defun custom-help-action (widget &optional event)
+ "Toggle documentation for WIDGET."
+ (let ((old (widget-get widget :doc))
+ (new (widget-get widget :custom-doc)))
+ (widget-put widget :doc new)
+ (widget-put widget :custom-doc old))
+ (widget-value-set widget (widget-value widget)))
;;; The `custom' Widget.
(define-widget 'custom 'default
"Customize a user option."
:convert-widget 'widget-item-convert-widget
- :format "%l%h%[%t%]: %v%x"
+ :format "%l%[%t%]: %v%m %h"
:format-handler 'custom-format-handler
+ :notify 'custom-notify
:custom-level 1
- :custom-show nil
- :custom-documentation-show 'first-line
+ :custom-state 'hidden
:custom-documentation-property 'widget-subclass-responsibility
:value-create 'widget-subclass-responsibility
:value-delete 'widget-radio-value-delete
:value-get 'widget-item-value-get
- :validate 'widget-repeat-validate
+ :validate 'widget-editable-list-validate
:match (lambda (widget value) (symbolp value)))
(defun custom-format-handler (widget escape)
;; We recognize extra escape sequences.
- (let* (child
- (symbol (widget-get widget :value))
+ (let* ((symbol (widget-get widget :value))
+ (buttons (widget-get widget :buttons))
(level (widget-get widget :custom-level))
(doc-property (widget-get widget :custom-documentation-property))
(doc-try (or (widget-get widget :doc)
(documentation-property symbol doc-property)))
(doc-text (and (stringp doc-try)
(> (length doc-try) 1)
- doc-try))
- (doc-show (widget-get widget :custom-documentation-show)))
+ doc-try)))
(cond ((eq escape ?l)
(when level
- (setq child
- (widget-create 'custom-level
- :parent widget
- (make-string level ?*)))
+ (push (widget-create-child-and-convert
+ widget 'custom-level (make-string level ?*))
+ buttons)
(widget-insert " ")))
+ ((eq escape ?m)
+ (and (eq (preceding-char) ?\n)
+ (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
+ (let ((magic (widget-create-child-and-convert
+ widget 'custom-magic nil)))
+ (widget-put widget :custom-magic magic)
+ (push magic buttons)))
((eq escape ?h)
(when doc-text
- (setq child (widget-create 'custom-help
- :parent widget
- "?"))
- (widget-insert " ")))
- ((eq escape ?x)
- (and doc-text doc-show
- (let ((start (point)))
- ;; The first "*" in a doc string means interactively
- ;; user editable. Since we are providing a facility
- ;; for the user to interactively edit the variable,
- ;; that information is redundant. Remove it.
- (cond ((eq doc-show t)
- (if (eq (aref doc-text 0) ?*)
- (widget-insert (substring doc-text 1))
- (widget-insert doc-text)))
- ((eq (aref doc-text 0) ?*)
- (string-match "\\`.\\(.*\\)" doc-text)
- (widget-insert (match-string 1 doc-text)))
- (t
- (string-match "\\`.*" doc-text)
- (widget-insert (match-string 0 doc-text))))
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))
- (widget-specify-doc widget start (point)))))
+ (and (eq (preceding-char) ?\n)
+ (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
+ ;; The `*' in the beginning is redundant.
+ (when (eq (aref doc-text 0) ?*)
+ (setq doc-text (substring doc-text 1)))
+ ;; Get rid of trailing newlines.
+ (when (string-match "\n+\\'" doc-text)
+ (setq doc-text (substring doc-text 0 (match-beginning 0))))
+ (push (if (string-match "\n." doc-text)
+ ;; Allow multiline doc to be hiden.
+ (widget-create-child-and-convert
+ widget 'custom-help
+ :doc (progn
+ (string-match "\\`.*" doc-text)
+ (match-string 0 doc-text))
+ :custom-doc doc-text
+ "?")
+ ;; A single line is just inserted.
+ (widget-create-child-and-convert
+ widget 'item :format "%d" :doc doc-text nil))
+ buttons)))
(t
(widget-default-format-handler widget escape)))
- (when child
- (widget-put widget
- :buttons (cons child (widget-get widget :buttons))))))
+ (widget-put widget :buttons buttons)))
-(defun custom-unimplemented (&rest ignore)
- "Apologize for my laziness."
- (error "Sorry, not implemented"))
+(defun custom-notify (widget &rest args)
+ "Keep track of changes."
+ (widget-put widget :custom-state 'modified)
+ (let ((buffer-undo-list t))
+ (custom-magic-reset widget))
+ (apply 'widget-default-notify widget args))
-(defun custom-reset (widget)
+(defun custom-redraw (widget)
"Redraw WIDGET with current settings."
(widget-value-set widget (widget-value widget))
+ (custom-redraw-magic widget))
+
+(defun custom-redraw-magic (widget)
+ "Redraw WIDGET state with current settings."
+ (while widget
+ (let ((magic (widget-get widget :custom-magic)))
+ (unless magic
+ (debug))
+ (widget-value-set magic (widget-value magic))
+ (when (setq widget (widget-get widget :group))
+ (custom-group-state-update widget))))
(widget-setup))
;;; The `custom-variable' Widget.
(define-widget 'custom-variable 'custom
"Customize variable."
+ :format "%l%v%m %h"
:help-echo "Push me to set or reset this variable."
:custom-documentation-property 'variable-documentation
- :custom-show 'child
- :custom-status 'edit
+ :custom-state nil
+ :custom-form 'edit
:value-create 'custom-variable-value-create
- :action 'custom-variable-action)
-
-(widget-put (get 'default 'widget-type) :custom-show t)
+ :action 'custom-variable-action
+ :custom-apply 'custom-variable-apply
+ :custom-set-default 'custom-variable-set-default
+ :custom-reset 'custom-redraw)
(defun custom-variable-value-create (widget)
"Here is where you edit the variables value."
- (let* ((status (widget-get widget :custom-status))
- (child-show (widget-get widget :custom-show))
+ (let* ((buttons (widget-get widget :buttons))
+ (children (widget-get widget :children))
+ (form (widget-get widget :custom-form))
+ (state (widget-get widget :custom-state))
(symbol (widget-get widget :value))
(child-type (or (get symbol 'custom-type) 'sexp))
- (type (if (listp child-type) child-type (list child-type)))
- (show (if (eq child-show 'child)
- (widget-get type :custom-show)
- child-show))
- (dummy (widget-put widget :custom-show show))
- (child (cond ((not show)
- (widget-create 'custom-level
- "[show]"))
- ((eq status 'lisp)
- (let ((value (cond ((get symbol 'saved-value)
- (car (get symbol 'saved-value)))
- ((get symbol 'factory-value)
- (car (get symbol 'factory-value)))
- ((boundp symbol)
- (custom-quote
- (symbol-value symbol)))
- (t
- (custom-quote
- (widget-get type :value))))))
- (widget-create 'sexp :value value)))
- (t
- (let ((value (if (boundp symbol)
- (symbol-value symbol)
- (widget-get type :value))))
- (widget-create type :value value))))))
+ (type (if (listp child-type)
+ child-type
+ (list child-type)))
+ conv value)
+ ;; If the widget is new, the child determine whether it is hidden.
+ (cond (state)
+ ((widget-get type :custom-show)
+ (setq state 'unknown))
+ (t
+ (setq state 'hidden)))
+ ;; If the widget is not hidden, we will need its value.
+ (unless (eq state 'hidden)
+ (setq conv (widget-convert type)
+ value (if (boundp symbol)
+ (symbol-value symbol)
+ (widget-get conv :value))))
+ ;; If we don't know the state, see if we need to edit it in lisp form.
+ (when (eq state 'unknown)
+ (unless (widget-apply (widget-convert type) :match value)
+ (setq form 'lisp)))
+ ;; Now we can create the child widget.
+ (cond ((eq state 'hidden)
+ ;; Make hidden value easy to show.
+ (push (widget-create-child-and-convert
+ widget 'custom-level
+ :tag (symbol-name symbol)
+ :format "%t: %[show%]")
+ buttons))
+ ((eq form 'lisp)
+ ;; In lisp mode edit the saved value when possible.
+ (let* ((value (cond ((get symbol 'saved-value)
+ (car (get symbol 'saved-value)))
+ ((get symbol 'factory-value)
+ (car (get symbol 'factory-value)))
+ ((boundp symbol)
+ (custom-quote (symbol-value symbol)))
+ (t
+ (custom-quote (widget-get conv :value))))))
+ (push (widget-create-child-and-convert widget 'sexp
+ :tag (symbol-name symbol)
+ :parent widget
+ :value value)
+ children)))
+ (t
+ ;; Edit mode.
+ (push (widget-create-child-and-convert widget type
+ :tag (symbol-name symbol)
+ :value value)
+ children)))
+ ;; Now update the state.
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))
- (widget-put child :parent widget)
- (widget-put widget :children (list child))))
+ (if (eq state 'hidden)
+ (widget-put widget :custom-state state)
+ (custom-variable-state-set widget))
+ (widget-put widget :custom-form form)
+ (widget-put widget :buttons buttons)
+ (widget-put widget :children children)))
+
+(defun custom-variable-state-set (widget)
+ "Set the state of WIDGET."
+ (let* ((symbol (widget-value widget))
+ (value (symbol-value symbol)))
+ (widget-put widget
+ :custom-state (if (get symbol 'saved-value)
+ (if (equal (custom-quote value)
+ (car (get symbol 'saved-value)))
+ 'saved
+ 'applied)
+ (if (get symbol 'factory-value)
+ (if (equal (custom-quote value)
+ (car (get symbol
+ 'factory-value)))
+ 'factory
+ 'applied)
+ 'rogue)))))
(defvar custom-variable-menu
'(("Edit" . custom-variable-edit)
- ("Edit Lisp" . custom-variable-edit-lisp)
+ ("Edit Default" . custom-variable-edit-lisp)
("Apply" . custom-variable-apply)
("Set Default" . custom-variable-set-default)
- ("Reset" . custom-reset)
+ ("Reset" . custom-redraw)
("Reset to Default" . custom-variable-default)
("Reset to Factory Settings" . custom-variable-factory))
"Alist of actions for the `custom-variable' widget.
(defun custom-variable-edit (widget)
"Edit value of WIDGET."
- (custom-variable-apply widget)
- (widget-put widget :custom-show t)
- (widget-put widget :custom-status 'edit)
- (custom-reset widget))
+ (widget-put widget :custom-state 'unknown)
+ (widget-put widget :custom-form 'edit)
+ (custom-redraw widget))
(defun custom-variable-edit-lisp (widget)
"Edit the lisp representation of the value of WIDGET."
- (custom-variable-apply widget)
- (widget-put widget :custom-show t)
- (widget-put widget :custom-status 'lisp)
- (custom-reset widget))
+ (widget-put widget :custom-state 'unknown)
+ (widget-put widget :custom-form 'lisp)
+ (custom-redraw widget))
(defun custom-variable-apply (widget)
"Set the current value for the variable being edited by WIDGET."
- (let ((status (widget-get widget :custom-status))
- (show (widget-get widget :custom-show))
+ (let ((form (widget-get widget :custom-form))
+ (state (widget-get widget :custom-state))
(child (car (widget-get widget :children)))
- (symbol (widget-value widget)))
- (unless show
- (error "You can only apply visible options"))
- (widget-apply child :validate)
- (if (eq status 'lisp)
- (set symbol (eval (widget-value child)))
- (set symbol (widget-value child)))))
+ (symbol (widget-value widget))
+ val)
+ (cond ((eq state 'hidden)
+ (error "Cannot apply hidden variable."))
+ ((setq val (widget-apply child :validate))
+ (error "Invalid %S"))
+ ((eq form 'lisp)
+ (set symbol (eval (widget-value child))))
+ (t
+ (set symbol (widget-value child))))
+ (custom-variable-state-set widget)
+ (custom-redraw-magic widget)))
(defun custom-variable-set-default (widget)
"Set the default value for the variable being edited by WIDGET."
- (let ((status (widget-get widget :custom-status))
- (show (widget-get widget :custom-show))
+ (let ((form (widget-get widget :custom-form))
+ (state (widget-get widget :custom-state))
(child (car (widget-get widget :children)))
- (symbol (widget-value widget)))
- (unless show
- (error "Can't apply hidden value."))
- (widget-apply child :validate)
- (if (eq status 'lisp)
- (put symbol 'saved-value (list (widget-value child)))
- (put symbol 'saved-value (list (custom-quote (widget-value child)))))))
+ (symbol (widget-value widget))
+ val)
+ (cond ((eq state 'hidden)
+ (error "Cannot apply hidden variable."))
+ ((setq val (widget-apply child :validate))
+ (error "Invalid %S"))
+ ((eq form 'lisp)
+ (put symbol 'saved-value (list (widget-value child))))
+ (t
+ (put symbol
+ 'saved-value (list (custom-quote (widget-value
+ child))))))
+ (custom-variable-state-set widget)
+ (custom-redraw-magic widget)))
(defun custom-variable-default (widget)
"Restore the default value for the variable being edited by WIDGET."
(let ((symbol (widget-value widget)))
- (cond ((get symbol 'saved-value)
- (set symbol (car (get symbol 'saved-value))))
- ((get symbol 'factory-value)
- (set symbol (car (get symbol 'factory-value))))
- (t
- (error "No default value for %s" symbol))))
- (custom-reset widget))
+ (if (get symbol 'saved-value)
+ (set symbol (car (get symbol 'saved-value)))
+ (error "No default value for %s" symbol))
+ (widget-put widget :custom-state 'unknown)
+ (custom-redraw widget)))
(defun custom-variable-factory (widget)
"Restore the factory setting for the variable being edited by WIDGET."
(let ((symbol (widget-value widget)))
(if (get symbol 'factory-value)
(set symbol (car (get symbol 'factory-value)))
- (error "No factory default for %S" symbol)))
- (custom-reset widget))
+ (error "No factory default for %S" symbol))
+ (when (get symbol 'saved-value)
+ (put symbol 'saved-value nil))
+ (widget-put widget :custom-state 'unknown)
+ (custom-redraw widget)))
;;; The `custom-face-edit' Widget.
(define-widget 'custom-face-edit 'checklist
"Edit face attributes."
- :format "%t:\n%v"
+ :format "%t: %v"
:tag "Attributes"
+ :extra-offset 12
:args (mapcar (lambda (att)
(list 'group
:inline t
;;; The `custom-display' Widget.
-(define-widget 'custom-display 'choice
+(define-widget 'custom-display 'menu-choice
"Select a display type."
:tag "Display"
:value t
:args '((const :tag "all" t)
- (checklist :entry-format "\n%b %v"
- :args ((list (const :format "Type: " type)
- (checklist :inline t
- (const :format "X "
- x)
- (const :format "TTY"
- tty)))
- (list (const :format "Class: " class)
- (checklist :inline t
- (const :format "Color "
- color)
- (const :format
- "Grayscale "
- grayscale)
- (const :format "Monochrome"
- mono)))
- (list (const :format "Background: " background)
- (checklist :inline t
- (const :format "Light "
- light)
- (const :format "Dark\n"
- dark)))))))
+ (checklist :offset 0
+ :extra-offset 9
+ :args ((group (const :format "Type: " type)
+ (checklist :inline t
+ :offset 0
+ (const :format "X "
+ x)
+ (const :format "TTY%n"
+ tty)))
+ (group (const :format "Class: " class)
+ (checklist :inline t
+ :offset 0
+ (const :format "Color "
+ color)
+ (const :format
+ "Grayscale "
+ grayscale)
+ (const :format "Monochrome%n"
+ mono)))
+ (group (const :format "Background: " background)
+ (checklist :inline t
+ :offset 0
+ (const :format "Light "
+ light)
+ (const :format "Dark\n"
+ dark)))))))
;;; The `custom-face' Widget.
(define-widget 'custom-face 'custom
"Customize face."
- :format "%l%h%[%t%]: %s%x%v"
+ :format "%l%[%t%]: %s%m %h%v"
:format-handler 'custom-face-format-handler
:help-echo "Push me to set or reset this face."
:custom-documentation-property 'face-documentation
:value-create 'custom-face-value-create
- :action 'custom-face-action)
+ :action 'custom-face-action
+ :custom-apply 'custom-face-apply
+ :custom-set-default 'custom-face-set-default
+ :custom-reset 'custom-redraw)
(defun custom-face-format-handler (widget escape)
;; We recognize extra escape sequences.
(let* (child
(symbol (widget-get widget :value)))
(cond ((eq escape ?s)
- (setq child (widget-create 'choice-item
- :parent widget
- :format "(%[sample%])\n"
- :button-face symbol)))
+ (setq child (widget-create-child-and-convert
+ widget 'custom-level
+ :format "(%[sample%])\n"
+ :button-face symbol)))
(t
(custom-format-handler widget escape)))
(when child
(defun custom-face-value-create (widget)
;; Create a list of the display specifications.
- (when (widget-get widget :custom-show)
+ (unless (eq (preceding-char) ?\n)
+ (insert "\n"))
+ (when (not (eq (widget-get widget :custom-state) 'hidden))
(let* ((symbol (widget-value widget))
- (edit (widget-create 'repeat
- :entry-format "%i %d %v"
- :parent widget
- :value (or (get symbol 'saved-face)
- (get symbol 'factory-face))
- '(list custom-display custom-face-edit))))
+ (edit (widget-create-child-and-convert
+ widget 'editable-list
+ :entry-format "%i %d %v"
+ :value (or (get symbol 'saved-face)
+ (get symbol 'factory-face))
+ '(group :format "%v"
+ custom-display custom-face-edit))))
+ (custom-face-state-set widget)
(widget-put widget :children (list edit)))))
(defvar custom-face-menu
'(("Apply" . custom-face-apply)
("Set Default" . custom-face-set-default)
- ("Default" . custom-face-default)
- ("Factory" . custom-face-factory))
+ ("Reset to Default" . custom-face-default)
+ ("Reset to Factory Setting" . custom-face-factory))
"Alist of actions for the `custom-face' widget.
The key is a string containing the name of the action, the value is a
lisp function taking the widget as an element which will be called
when the action is chosen.")
+(defun custom-face-state-set (widget)
+ "Set the state of WIDGET."
+ (let ((symbol (widget-value widget)))
+ (widget-put widget :custom-state (cond ((get symbol 'saved-face)
+ 'saved)
+ ((get symbol 'factory-face)
+ 'factory)
+ (t
+ 'rogue)))))
+
(defun custom-face-action (widget &optional event)
"Show the menu for `custom-face' WIDGET.
Optional EVENT is the location for the menu."
+ (when (eq (widget-get widget :custom-state) 'hidden)
+ (error "You cannot edit a hidden face"))
(let* ((completion-ignore-case t)
- (answer (widget-choose (symbol-name (widget-get widget :value))
- custom-face-menu
- event)))
+ (symbol (widget-get widget :value))
+ (answer (widget-choose (symbol-name symbol) custom-face-menu event)))
(if answer
- (funcall answer widget))))
+ (funcall answer widget))
+ (custom-face-state-set widget)
+ (custom-redraw-magic widget)))
(defun custom-face-apply (widget)
"Make the face attributes in WIDGET take effect."
- (unless (widget-get widget :custom-show)
- (error "You cannot apply hidden face"))
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (widget-value child)))
(defun custom-face-set-default (widget)
"Make the face attributes in WIDGET default."
- (unless (widget-get widget :custom-show)
- (error "You cannot set default for hidden face"))
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (widget-value child)))
(defun custom-face-default (widget)
"Restore WIDGET to the face's default attributes."
- (unless (widget-get widget :custom-show)
- (error "You cannot reset to default for hidden face"))
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children))))
- (widget-value-set child (or (get symbol 'saved-face)
- (get symbol 'factory-face)))
- (widget-setup)))
+ (unless (get symbol 'saved-face)
+ (error "No saved value for this face")
+ (widget-value-set child (get symbol 'saved-face)))))
(defun custom-face-factory (widget)
"Restore WIDGET to the face's factory settings."
- (unless (widget-get widget :custom-show)
- (error "You cannot reset to factory setting for hidden face"))
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children))))
- (widget-value-set child (or (get symbol 'factory-face)
- (get symbol 'saved-face)))
- (widget-setup)))
+ (unless (get symbol 'factory-face)
+ (error "No factory default for this face"))
+ (when (get symbol 'saved-face)
+ (put symbol 'saved-face nil))
+ (widget-value-set child (get symbol 'factory-face))))
;;; The `face' Widget.
(define-widget 'face 'default
"Select and customize a face."
:convert-widget 'widget-item-convert-widget
- :custom-show nil
- :format "%[%t%]\n%v"
+ :format "%[%t%]%v"
+ :value 'default
:value-create 'widget-face-value-create
:value-delete 'widget-radio-value-delete
:value-get 'widget-item-value-get
- :validate 'widget-repeat-validate
+ :validate 'widget-editable-list-validate
:action 'widget-face-action
:match '(lambda (widget value) (symbolp value)))
(defun widget-face-value-create (widget)
;; Create a `custom-face' child.
(let* ((symbol (widget-value widget))
- (child (widget-create 'custom-face
- :custom-level nil
- :custom-show t
- :tag "Face"
- :value symbol)))
+ (child (widget-create-child-and-convert
+ widget 'custom-face
+ :custom-level nil
+ :tag ""
+ :value symbol)))
+ (custom-magic-reset child)
(widget-put widget :children (list child))))
(defvar face-history nil
(define-widget 'custom-group 'custom
"Customize group."
- :format "%l%h%[%t%]:\n%x%v"
+ :format "%l%[%t%]:\n%m %h%v"
:custom-documentation-property 'group-documentation
:help-echo "Push me to set or reset all members of this group."
:value-create 'custom-group-value-create
- :action 'custom-group-action)
+ :action 'custom-group-action
+ :custom-apply 'custom-group-apply
+ :custom-set-default 'custom-group-set-default
+ :custom-reset 'custom-group-reset)
(defun custom-group-value-create (widget)
- (let* ((show (widget-get widget :custom-show))
+ (let* ((state (widget-get widget :custom-state))
(level (widget-get widget :custom-level))
(symbol (widget-value widget))
(members (get symbol 'custom-group)))
- (when show
- (widget-put widget
- :children (mapcar (lambda (entry)
- (widget-insert "\n")
- (prog1
- (widget-create (nth 1 entry)
- :parent widget
- :custom-level
- (1+ level)
- :value (nth 0 entry))
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))))
- members)))))
+ (unless (eq state 'hidden)
+ (let* ((children (mapcar (lambda (entry)
+ (widget-insert "\n")
+ (prog1
+ (widget-create-child-and-convert
+ widget (nth 1 entry)
+ :group widget
+ :custom-level (1+ level)
+ :value (nth 0 entry))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))))
+ members)))
+ (mapcar 'custom-magic-reset children)
+ (widget-put widget :children children)
+ (custom-group-state-update widget)))))
(defvar custom-group-menu
- '(("Apply" . custom-unimplemented)
- ("Set Default" . custom-unimplemented)
- ("Reset" . custom-reset)
- ("Reset to Default" . custom-unimplemented)
- ("Reset to Factory Settings" . custom-unimplemented))
+ '(("Apply" . custom-group-apply)
+ ("Set Default" . custom-group-set-default)
+ ("Reset" . custom-group-reset))
"Alist of actions for the `custom-group' widget.
The key is a string containing the name of the action, the value is a
lisp function taking the widget as an element which will be called
(if answer
(funcall answer widget))))
+(defun custom-group-apply (widget)
+ "Apply changes in all modified group members."
+ (let ((children (widget-get widget :children)))
+ (mapcar (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-apply)))
+ children )))
+
+(defun custom-group-set-default (widget)
+ "Set default in all modified group members."
+ (let ((children (widget-get widget :children)))
+ (mapcar (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-set-default)))
+ children )))
+
+(defun custom-group-reset (widget)
+ "Reset all modified group members."
+ (let ((children (widget-get widget :children)))
+ (mapcar (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-reset)))
+ children )))
+
+(defun custom-group-state-update (widget)
+ "Update magic."
+ (unless (eq (widget-get widget :custom-state) 'hidden)
+ (let* ((children (widget-get widget :children))
+ (states (mapcar (lambda (child)
+ (widget-get child :custom-state))
+ children))
+ (magics custom-magic-alist)
+ (found 'factory))
+ (while magics
+ (let ((magic (car (car magics))))
+ (if (and (not (eq magic 'hidden))
+ (memq magic states))
+ (setq found magic
+ magics nil)
+ (setq magics (cdr magics)))))
+ (widget-put widget :custom-state found)))
+ (custom-magic-reset widget))
+
;;; The `custom-save' Command.
(defcustom custom-file "~/.emacs"
+ "File used for storing customization information.
+If you change this from the default \"~/.emacs\" you need to
+explicitly load that file for the settings to take effect."
:type 'file
- :group 'customize
- "File used for storing customization information.")
+ :group 'customize)
(defun custom-save-delete (symbol)
"Delete the call to SYMBOL form `custom-file'.
(setq custom-mode-map (make-sparse-keymap))
(set-keymap-parent custom-mode-map widget-keymap))
+(easy-menu-define custom-mode-menu
+ custom-mode-map
+ "Menu used in customization buffers."
+ '("Custom"
+ ["Apply" custom-apply t]
+ ["Set Default" custom-set-default t]
+ ["Reset" custom-reset t]
+ ["Save" custom-save t]))
+
(defun custom-mode ()
"Major mode for editing customization buffers.
Read the non-existing manual for information about how to use it.
-\\{custom-mode-map}"
+\\[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.
+\\[custom-apply] Apply all modifications.
+\\[custom-set-default] Make all modifications default.
+\\[custom-reset] Undo all modifications.
+\\[custom-save] Save defaults for future emacs sessions.
+
+Entry to this mode calls the value of `custom-mode-hook'
+if that value is non-nil."
(kill-all-local-variables)
(setq major-mode 'custom-mode
mode-name "Custom")
(use-local-map custom-mode-map)
- (make-local-variable 'custom-options))
+ (make-local-variable 'custom-options)
+ (run-hooks 'custom-mode-hook))
+
+;;; Custom Mode Commands.
+
+(defun custom-apply ()
+ "Apply changes in all modified options."
+ (interactive)
+ (let ((children custom-options))
+ (mapcar (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-apply)))
+ children)))
+
+(defun custom-set-default ()
+ "Set default in all modified group members."
+ (interactive)
+ (let ((children custom-options))
+ (mapcar (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-set-default)))
+ children)))
+
+(defun custom-reset ()
+ "Reset all modified group members."
+ (interactive)
+ (let ((children custom-options))
+ (mapcar (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-reset)))
+ children)))
;;; The Customize Commands
(custom-buffer-create (list (list symbol 'custom-face))))
;;;###autoload
-(defun customize-apropos (regexp)
- "Customize all user options matching REGEXP"
- (interactive "sCustomize regexp: ")
+(defun customize-apropos (regexp &optional all)
+ "Customize all user options matching REGEXP.
+If ALL (e.g., started with a prefix key), include options which are not
+user-settable."
+ (interactive "sCustomize regexp: \nP")
(let ((found nil))
(mapatoms (lambda (symbol)
(when (string-match regexp (symbol-name symbol))
(when (and (boundp symbol)
(or (get symbol 'default-value)
(get symbol 'factory-value)
- (get symbol 'variable-documentation)))
+ (if all
+ (get symbol 'variable-documentation)
+ (user-variable-p symbol))))
(setq found
(cons (list symbol 'custom-variable) found))))))
(if found
")
(setq custom-options
(mapcar (lambda (entry)
- (widget-create (nth 1 entry)
- :value (nth 0 entry))
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))
- (widget-insert "\n"))
+ (prog1
+ (widget-create (nth 1 entry)
+ :value (nth 0 entry))
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n"))
+ (widget-insert "\n")))
options))
- (widget-create 'push
+ (widget-create 'push-button
+ :tag "Apply"
+ :help-echo "Push me to apply all modifications,"
+ :action (lambda (widget &optional event)
+ (custom-apply)))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Set Default"
+ :help-echo "Push me to make the modifications default."
+ :action (lambda (widget &optional event)
+ (custom-set-default)))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Reset"
+ :help-echo "Push me to undo all modifications.."
+ :action (lambda (widget &optional event)
+ (custom-reset)))
+ (widget-insert " ")
+ (widget-create 'push-button
:tag "Save"
:help-echo "Push me to store the new defaults permanently."
- :action (lambda (widget &optional event) (custom-save)))
+ :action (lambda (widget &optional event)
+ (custom-save)))
+ (widget-insert "\n")
(widget-setup))
;;; The End.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 0.9
+;; Version: 0.94
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(require 'widget)
-(let ((keywords '(:type :group)))
- (while keywords
- (or (boundp (car keywords))
- (set (car keywords) (car keywords)))
- (setq keywords (cdr keywords))))
+(define-widget-keywords :type :group)
;; These autoloads should be deleted when the file is added to Emacs
(autoload 'customize "custom-edit" nil t)
(autoload 'customize-face "custom-edit" nil t)
(autoload 'customize-apropos "custom-edit" nil t)
-;;; Face Utilities.
-
-(make-face 'custom-face-empty)
-
-(defun custom-face-display-set (face spec &optional frame)
- "Set FACE to the attributes to the first matching entry in SPEC.
-Iff optional FRAME is non-nil, set it for that frame only.
-See `defface' for information about SPEC."
- (make-face face)
- (copy-face 'custom-face-empty face)
- (while spec
- (let* ((entry (car spec))
- (display (nth 0 entry))
- (atts (nth 1 entry)))
- (setq spec (cdr spec))
- (when (custom-display-match-frame display frame)
- (apply 'custom-face-attribites-set face frame atts)
- (setq spec nil)))))
-
-(defun custom-display-match-frame (display frame)
- "Non-nil iff DISPLAY matches FRAME.
-If FRAME is nil, the current FRAME is used."
- (unless frame
- (setq frame (selected-frame)))
- (if (eq display t)
- t
- (let ((match t)
- (pars (frame-parameters frame)))
- (while (and display match)
- (let* ((entry (car display))
- (req (car entry))
- (options (cdr entry)))
- (setq display (cdr display))
- (cond ((eq req 'type)
- (setq match (memq window-system options)))
- ((eq req 'class)
- (let ((class (cdr (assq 'display-type pars))))
- (setq match (memq class options))))
- ((eq req 'background)
- (let ((background (cdr (assq 'background-mode pars))))
- (setq match (memq background options))))
- (t
- (error "Unknown req `%S' with options `%S'" req options)))))
- match)))
-
-(defvar custom-face-attributes
- '((:bold (toggle :format "Bold: %v") custom-set-face-bold)
- (:italic (toggle :format "Italic: %v") custom-set-face-italic)
- (:underline
- (toggle :format "Underline: %v") set-face-underline-p)
- (:foreground (color :tag "Foreground") set-face-foreground)
- (:background (color :tag "Background") set-face-background)
- (:stipple (field :format "Stipple: %v") set-face-stipple))
- "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
-attibute, SET is a function for setting the attribute value.
-
-The SET function should take three arguments, the face to modify, the
-value of the attribute, and optionally the frame where the face should
-be changed.")
-
-(defun custom-face-attribites-set (face frame &rest atts)
- "For FACE on FRAME set the attributes [KEYWORD VALUE]....
-Each keyword should be listed in `custom-face-attributes'.
-
-If FRAME is nil, set the default face."
- (while atts
- (let* ((name (nth 0 atts))
- (value (nth 1 atts))
- (fun (nth 2 (assq name custom-face-attributes))))
- (setq atts (cdr (cdr atts)))
- (funcall fun face value))))
-
-(defun custom-set-face-bold (face value &optional frame)
- "Set the bold property of FACE to VALUE."
- (condition-case nil
- (if value
- (make-face-bold face frame)
- (make-face-unbold face frame))
- (error nil)))
-
-(defun custom-set-face-italic (face value &optional frame)
- "Set the italic property of FACE to VALUE."
- (condition-case nil
- (if value
- (make-face-italic face frame)
- (make-face-unitalic face frame))
- (error nil)))
-
-;;;###autoload
-(defun custom-initialize-faces (&optional frame)
- "Initialize all custom faces for FRAME.
-If FRAME is nil or omitted, initialize them for all frames."
- (mapatoms (lambda (symbol)
- (let ((spec (or (get symbol 'saved-face)
- (get symbol 'factory-face))))
- (when spec
- (custom-face-display-set symbol spec frame))))))
+;;; Compatibility.
+
+(fset 'custom-x-color-values
+ (if (fboundp 'x-color-values)
+ 'x-color-values
+ (lambda (color)
+ (color-instance-rgb-components
+ (make-color-instance color)))))
+
+(defun custom-background-mode ()
+ "Kludge to detext background mode."
+ (let* ((bg-resource
+ (condition-case ()
+ (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
+ (error nil)))
+ (params (frame-parameters))
+ (color (condition-case ()
+ (or (assq 'background-color params)
+ (color-instance-name
+ (specifier-instance
+ (face-background 'default))))
+ (error nil))))
+ (cond (bg-resource (intern (downcase bg-resource)))
+ ((and color
+ (< (apply '+ (custom-x-color-values color))
+ (/ (apply '+ (custom-x-color-values "white")) 3)))
+ 'dark)
+ (t 'light))))
;;; The `defcustom' Macro.
;;;###autoload
-(defun custom-declare-variable (symbol value &rest args)
+(defun custom-declare-variable (symbol value doc &rest args)
"Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
(unless (default-boundp symbol)
(set-default symbol (eval value)))
(put symbol 'factory-value (list value))
+ (when doc
+ (put symbol 'variable-documentation doc))
(while args
(let ((arg (car args)))
(setq args (cdr args))
- (cond ((symbolp arg)
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" keyword))
- (setq args (cdr args))
- (cond ((eq keyword :type)
- (put symbol 'custom-type value))
- ((eq keyword :group)
- (custom-add-to-group value symbol 'custom-variable))
- (t
- (error "Unknown keyword %s" symbol)))))
- ((stringp arg)
- (put symbol 'variable-documentation arg)
- (when args
- (error "Junk at end of args %s" args)))
- (t
- (error "Junk in args %S"))))))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (cond ((eq keyword :type)
+ (put symbol 'custom-type value))
+ ((eq keyword :group)
+ (custom-add-to-group value symbol 'custom-variable))
+ (t
+ (error "Unknown keyword %s" symbol)))))))
;;;###autoload
-(defmacro defcustom (symbol value &rest args)
+(defmacro defcustom (symbol value doc &rest args)
"Declare SYMBOL as a customizable variable that defaults to VALUE.
+DOC is the variable documentation.
+
Neither SYMBOL nor VALUE needs to be quoted.
If SYMBOL is not already bound, initialize it to VALUE.
The remaining arguments should have the form
- [KEYWORD VALUE]... DOC
-
-where DOC is the variable documentation.
+ [KEYWORD VALUE]...
The following KEYWORD's are defined:
Read the section about customization in the emacs lisp manual for more
information."
- `(custom-declare-variable (quote ,symbol) (quote ,value) ,@args))
+ `(eval-and-compile
+ (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)))
;;; The `defface' Macro.
;;;###autoload
-(defun custom-declare-face (face spec &rest args)
+(defun custom-declare-face (face spec doc &rest args)
"Like `defface', but FACE is evaluated as a normal argument."
(put face 'factory-face spec)
(let ((value (or (get face 'saved-face) spec)))
(custom-face-display-set face value))
+ (when doc
+ (put face 'face-documentation doc))
(while args
(let ((arg (car args)))
(setq args (cdr args))
- (cond ((symbolp arg)
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" :type))
- (setq args (cdr args))
- (cond ((eq keyword :group)
- (custom-add-to-group value face 'custom-face))
- (t
- (error "Unknown keyword %s" face)))))
- ((stringp arg)
- (put face 'face-documentation arg)
- (when args
- (error "Junk at end of args %s" args)))
- (t
- (error "Junk in args %S"))))))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" :type))
+ (setq args (cdr args))
+ (cond ((eq keyword :group)
+ (custom-add-to-group value face 'custom-face))
+ (t
+ (error "Unknown keyword %s" face)))))))
;;;###autoload
-(defmacro defface (face spec &rest args)
+(defmacro defface (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
FACE does not need to be quoted.
+Third argument DOC is the face documentation.
+
If FACE has been set with `custom-set-face', set the face attributes
as specified by that function, otherwise set the face attributes
according to SPEC.
The remaining arguments should have the form
- [KEYWORD VALUE]... DOC
-
-where DOC is the face documentation.
+ [KEYWORD VALUE]...
The following KEYWORD's are defined:
Read the section about customization in the emacs lisp manual for more
information."
- `(custom-declare-face (quote ,face) ,spec ,@args))
+ `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
;;; The `defgroup' Macro.
;;;###autoload
-(defun custom-declare-group (symbol members &rest args)
+(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)))
+ (when doc
+ (put symbol 'group-documentation doc))
(while args
(let ((arg (car args)))
(setq args (cdr args))
- (cond ((symbolp arg)
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" :type))
- (setq args (cdr args))
- (cond ((eq keyword :group)
- (custom-add-to-group value symbol 'custom-group))
- (t
- (error "Unknown keyword %s" symbol)))))
- ((stringp arg)
- (put symbol 'group-documentation arg)
- (when args
- (error "Junk at end of args %s" args)))
- (t
- (error "Junk in args %S"))))))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" :type))
+ (setq args (cdr args))
+ (cond ((eq keyword :group)
+ (custom-add-to-group value symbol 'custom-group))
+ (t
+ (error "Unknown keyword %s" symbol)))))))
;;;###autoload
-(defmacro defgroup (symbol members &rest args)
+(defmacro defgroup (symbol members doc &rest args)
"Declare SYMBOL as a customization group containing MEMBERS.
SYMBOL does not need to be quoted.
+Third arg DOC is the group documentation.
+
MEMBERS should be an alist of the form ((NAME WIDGET)...) where
NAME is a symbol and WIDGET is a widget is a widget for editing that
symbol. Useful widgets are `custom-variable' for editing variables,
The remaining arguments should have the form
- [KEYWORD VALUE]... DOC
-
-where DOC is the group documentation.
+ [KEYWORD VALUE]...
The following KEYWORD's are defined:
Read the section about customization in the emacs lisp manual for more
information."
- `(custom-declare-group (quote ,symbol) ,members ,@args))
+ `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
;;;###autoload
(defun custom-add-to-group (group option widget)
(setcar (cdr old) widget)
(put group 'custom-group (nconc members (list (list option widget)))))))
+;;; Face Utilities.
+
+(make-face 'custom-face-empty)
+
+(defun custom-face-display-set (face spec &optional frame)
+ "Set FACE to the attributes to the first matching entry in SPEC.
+Iff optional FRAME is non-nil, set it for that frame only.
+See `defface' for information about SPEC."
+ (make-face face)
+ (copy-face 'custom-face-empty face)
+ (while spec
+ (let* ((entry (car spec))
+ (display (nth 0 entry))
+ (atts (nth 1 entry)))
+ (setq spec (cdr spec))
+ (when (custom-display-match-frame display frame)
+ (apply 'custom-face-attribites-set face frame atts)
+ (setq spec nil)))))
+
+(defcustom custom-background-mode nil
+ "The brightness of the background.
+Set this to the symbol dark if your background color is dark, light if
+your background is light, or nil (default) if you want Emacs to
+examine the brightness for you."
+ :group 'customize
+ :type '(choice (choice-item dark)
+ (choice-item light)
+ (choice-item :tag "default" nil)))
+
+(defun custom-display-match-frame (display frame)
+ "Non-nil iff DISPLAY matches FRAME.
+If FRAME is nil, the current FRAME is used."
+ ;; This is a kludge to get started, we realle should use specifiers!
+ (unless frame
+ (setq frame (selected-frame)))
+ (if (eq display t)
+ t
+ (let ((match t)
+ (pars (frame-parameters frame)))
+ (while (and display match)
+ (let* ((entry (car display))
+ (req (car entry))
+ (options (cdr entry)))
+ (setq display (cdr display))
+ (cond ((eq req 'type)
+ (setq match (if (fboundp 'device-type)
+ (device-type frame)
+ (memq window-system options))))
+ ((eq req 'class)
+ (let ((class (if (fboundp 'device-class)
+ (device-class frame)
+ (cdr (assq 'display-type pars)))))
+ (setq match (memq class options))))
+ ((eq req 'background)
+ (let ((background (or custom-background-mode
+ (cdr (assq 'background-mode pars))
+ (custom-background-mode))))
+ (setq match (memq background options))))
+ (t
+ (error "Unknown req `%S' with options `%S'" req options)))))
+ match)))
+
+(defvar custom-face-attributes
+ '((:bold (toggle :format "Bold: %v") custom-set-face-bold)
+ (:italic (toggle :format "Italic: %v") custom-set-face-italic)
+ (:underline
+ (toggle :format "Underline: %v") 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))
+ "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
+attibute, SET is a function for setting the attribute value.
+
+The SET function should take three arguments, the face to modify, the
+value of the attribute, and optionally the frame where the face should
+be changed.")
+
+(defun custom-face-attribites-set (face frame &rest atts)
+ "For FACE on FRAME set the attributes [KEYWORD VALUE]....
+Each keyword should be listed in `custom-face-attributes'.
+
+If FRAME is nil, set the default face."
+ (while atts
+ (let* ((name (nth 0 atts))
+ (value (nth 1 atts))
+ (fun (nth 2 (assq name custom-face-attributes))))
+ (setq atts (cdr (cdr atts)))
+ (funcall fun face value))))
+
+(defun custom-set-face-bold (face value &optional frame)
+ "Set the bold property of FACE to VALUE."
+ (condition-case nil
+ (if value
+ (make-face-bold face frame)
+ (make-face-unbold face frame))
+ (error nil)))
+
+(defun custom-set-face-italic (face value &optional frame)
+ "Set the italic property of FACE to VALUE."
+ (condition-case nil
+ (if value
+ (make-face-italic face frame)
+ (make-face-unitalic face frame))
+ (error nil)))
+
+;;;###autoload
+(defun custom-initialize-faces (&optional frame)
+ "Initialize all custom faces for FRAME.
+If FRAME is nil or omitted, initialize them for all frames."
+ (mapatoms (lambda (symbol)
+ (let ((spec (or (get symbol 'saved-face)
+ (get symbol 'factory-face))))
+ (when spec
+ (custom-face-display-set symbol spec frame))))))
+
;;; Initializing.
;;;###autoload
"Customization of the One True Editor.")
(defgroup customize nil
- :group 'emacs
- "Customization of the Customization support.")
+ "Customization of the Customization support."
+ :group 'emacs)
;;; The End.
* gnus-summary-save-in-file (article format).
* gnus-summary-save-in-vm (use VM's folder format).")
-(defvar gnus-rmail-save-name (function gnus-plain-save-name)
+(defvar gnus-rmail-save-name 'gnus-plain-save-name
"*A function generating a file name to save articles in Rmail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-(defvar gnus-mail-save-name (function gnus-plain-save-name)
+(defvar gnus-mail-save-name 'gnus-plain-save-name
"*A function generating a file name to save articles in Unix mail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-(defvar gnus-folder-save-name (function gnus-folder-save-name)
+(defvar gnus-folder-save-name 'gnus-folder-save-name
"*A function generating a file name to save articles in MH folder.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
-(defvar gnus-file-save-name (function gnus-numeric-save-name)
+(defvar gnus-file-save-name 'gnus-numeric-save-name
"*A function generating a file name to save articles in article format.
The function is called with NEWSGROUP, HEADERS, and optional
LAST-FILE.")
(require 'nnheader)
(defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/")
- :group 'gnus
- :type 'directory
- "*Directory variable from which all other Gnus file variables are derived.")
+ "*Directory variable from which all other Gnus file variables are derived."
+ :group 'gnus-start
+ :type 'directory)
(defcustom gnus-default-directory nil
- :group 'gnus
- :type 'directory
- "*Default directory for all Gnus buffers.")
+ "*Default directory for all Gnus buffers."
+ :group 'gnus-start
+ :type 'directory)
;; Site dependent variables. These variables should be defined in
;; paths.el.
(equal gnus-nntp-service "nntp"))
nil
(list gnus-nntp-service)))
- :group 'gnus
- :type '(list
- (choice
- (item :tag "NNTP server" nntp)
- (item :tag "Local spool" nnspool))
- (field :tag "The name of server"))
"*Default method for selecting a newsgroup.
This variable should be a list, where the first element is how the
news is to be fetched, the second is the address.
(require 'custom)
(defgroup gnus nil
- :group 'emacs
- "The coffee-brewing, all singing, all dancing, kitchen sink newsreader.")
+ "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
+ :group 'emacs)
(defgroup gnus-start nil
- :group 'gnus
- "Starting your favorite newsreader.")
+ "Starting your favorite newsreader."
+ :group 'gnus)
(defgroup gnus-score nil
- :group 'gnus
- "Score and kill file handling.")
+ "Score and kill file handling."
+ :group 'gnus )
-(defconst gnus-version-number "0.39"
+(defconst gnus-version-number "0.40"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
"Version string for this version of Gnus.")
(defcustom gnus-inhibit-startup-message nil
+ "*If non-nil, the startup message will not be displayed."
:group 'gnus-start
- :type 'toggle
- "*If non-nil, the startup message will not be displayed.")
+ :type 'toggle)
(defcustom gnus-play-startup-jingle nil
+ "If non-nil, play the Gnus jingle at startup."
:group 'gnus-start
- :type 'toggle
- "If non-nil, play the Gnus jingle at startup.")
+ :type 'toggle)
;;; Kludges to help the transition from the old `custom.el'.
(kill-buffer (current-buffer))))))
(defcustom gnus-kill-file-name "KILL"
+ "Suffix of the kill files."
:group 'gnus-score
- :type 'string
- "Suffix of the kill files.")
+ :type 'string)
(defun gnus-newsgroup-kill-file (newsgroup)
"Return the name of a kill file name for NEWSGROUP.
("r" . "")
("d0" . "")
("d1" . "")))))
- (setq buffer-file-name nil))
- )t
+ (setq buffer-file-name nil)))
(provide 'nnweb)
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 0.9
+;; Version: 0.94
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(require 'widget)
(require 'custom)
(require 'cl)
+(autoload 'pp-to-string "pp")
;;; Compatibility.
;;; Customization.
(defgroup widgets nil
- :group 'emacs
- "Customization support for the Widget Library.")
+ "Customization support for the Widget Library."
+ :group 'emacs)
-(defface widget-button-face
- '((t (:bold t)))
- :group 'widgets
- "Face used for widget buttons.")
+(defface widget-documentation-face '((t ()))
+ "Face used for documentation text."
+ :group 'widgets)
+
+(defface widget-button-face '((t (:bold t)))
+ "Face used for widget buttons."
+ :group 'widgets)
(defcustom widget-mouse-face 'highlight
+ "Face used for widget buttons when the mouse is above them."
:type 'face
- :group 'widgets
- "Face used for widget buttons when the mouse is above them.")
-
-(defface widget-field-face
- '((((type x)
- (class grayscale color)
- (background light))
- (:background "light gray"))
- (((type x)
- (class grayscale color)
- (background dark))
- (:background "dark gray"))
- (t
- (:italic t)))
- :group 'widgets
- "Face used for editable fields.")
+ :group 'widgets)
+
+(defface widget-field-face '((((type x)
+ (class grayscale color)
+ (background light))
+ (:background "light gray"))
+ (((type x)
+ (class grayscale color)
+ (background dark))
+ (:background "dark gray"))
+ (t
+ (:italic t)))
+ "Face used for editable fields."
+ :group 'widgets)
(defcustom widget-menu-max-size 40
- :type 'integer
"Largest number of items allowed in a popup-menu.
-Larger menus are read through the minibuffer.")
+Larger menus are read through the minibuffer."
+ :type 'integer)
;;; Utility functions.
;;
(defun widget-specify-doc (widget from to)
;; Specify documentation for WIDGET between FROM and TO.
- (put-text-property from to 'widget-doc widget))
-
+ (add-text-properties from to (list 'widget-doc widget
+ 'face 'widget-documentation-face)))
(defmacro widget-specify-insert (&rest form)
;; Execute FORM without inheriting any text properties.
(widget-apply widget :create)
widget))
+(defun widget-create-child-and-convert (parent type &rest args)
+ "As part of the widget PARENT, create a child widget TYPE.
+The child is converted, using the keyword arguments ARGS."
+ (let ((widget (apply 'widget-convert type args)))
+ (widget-put widget :parent parent)
+ (unless (widget-get widget :indent)
+ (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+ (or (widget-get widget :extra-offset) 0)
+ (widget-get parent :offset))))
+ (widget-apply widget :create)
+ widget))
+
+(defun widget-create-child (parent type)
+ "Create widget of TYPE. "
+ (let ((widget (copy-list type)))
+ (widget-put widget :parent parent)
+ (unless (widget-get widget :indent)
+ (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
+ (widget-get parent :offset))))
+ (widget-apply widget :create)
+ widget))
+
;;;###autoload
(defun widget-delete (widget)
"Delete WIDGET."
:value-to-internal (lambda (widget value) value)
:value-to-external (lambda (widget value) value)
:create 'widget-default-create
+ :indent nil
+ :offset 0
:format-handler 'widget-default-format-handler
:button-face-get 'widget-default-button-face-get
:delete 'widget-default-delete
:value-set 'widget-default-value-set
:value-inline 'widget-default-value-inline
:menu-tag-get 'widget-default-menu-tag-get
- :validate (lambda (widget) t)
+ :validate (lambda (widget) nil)
:action 'widget-default-action
:notify 'widget-default-notify)
(setq button-begin (point)))
((eq escape ?\])
(setq button-end (point)))
+ ((eq escape ?n)
+ (when (widget-get widget :indent)
+ (insert "\n")
+ (insert-char ? (widget-get widget :indent))))
((eq escape ?t)
(if tag
(insert tag)
:match 'widget-item-match
:match-inline 'widget-item-match-inline
:action 'widget-item-action
- :format "%t\n")
+ :format "%t\n%d")
(defun widget-item-convert-widget (widget)
;; Initialize :value and :tag from :args in WIDGET.
;; Items are simple.
(widget-get widget :value))
-;;; The `push' Widget.
+;;; The `push-button' Widget.
-(define-widget 'push 'item
+(define-widget 'push-button 'item
"A pushable button."
:format "%[[%t]%]%d")
"An embedded link."
:format "%[_%t_%]%d")
-;;; The `field' Widget.
+;;; The `editable-field' Widget.
-(define-widget 'field 'default
+(define-widget 'editable-field 'default
"An editable text field."
:convert-widget 'widget-item-convert-widget
:format "%v"
:value ""
- :tag "field"
+ :action 'widget-field-action
:value-create 'widget-field-value-create
:value-delete 'widget-field-value-delete
:value-get 'widget-field-value-get
:match 'widget-field-match)
+;; History of field minibuffer edits.
+(defvar widget-field-history nil)
+
+(defun widget-field-action (widget &optional event)
+ ;; Edit the value in the minibuffer.
+ (let ((tag (widget-apply widget :menu-tag-get))
+ (invalid (widget-apply widget :validate)))
+ (when invalid
+ (error (widget-get invalid :error)))
+ (widget-value-set widget (read-string (concat tag ": ")
+ (widget-get widget :value)
+ 'widget-field-history))))
+
(defun widget-field-value-create (widget)
;; Create an editable text field.
(insert " ")
(define-widget 'text 'field
"A multiline text area.")
-;;; The `choice' Widget.
+;;; The `menu-choice' Widget.
-(define-widget 'choice 'default
+(define-widget 'menu-choice 'default
"A menu of options."
:convert-widget 'widget-choice-convert-widget
:format "%[%t%]: %v"
(setq current (car args)
args (cdr args))
(when (widget-apply current :match value)
- (widget-put widget :children (list (widget-create current
- :parent widget
- :value value)))
+ (widget-put widget :children (list (widget-create-child-and-convert
+ widget current :value value)))
(widget-put widget :choice current)
(setq args nil
current nil)))
(when current
(let ((void (widget-get widget :void)))
- (widget-put widget :children (list (widget-create void
- :parent widget
- :value value)))
+ (widget-put widget :children (list (widget-create-child-and-convert
+ widget void :value value)))
(widget-put widget :choice void)))))
(defun widget-choice-value-get (widget)
;;; The `toggle' Widget.
-(define-widget 'toggle 'choice
+(define-widget 'toggle 'menu-choice
"Toggle between two states."
:convert-widget 'widget-toggle-convert-widget
:format "%v"
"A multiple choice widget."
:convert-widget 'widget-choice-convert-widget
:format "%v"
+ :offset 4
:entry-format "%b %v"
:menu-tag "checklist"
:greedy nil
(defun widget-checklist-add-item (widget type chosen)
;; Create checklist item in WIDGET of type TYPE.
;; If the item is checked, CHOSEN is a cons whose cdr is the value.
+ (and (eq (preceding-char) ?\n)
+ (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
(widget-specify-insert
(let* ((children (widget-get widget :children))
(buttons (widget-get widget :buttons))
(cond ((eq escape ?%)
(insert "%"))
((eq escape ?b)
- (setq button (widget-create 'checkbox
- :parent widget
- :value (not (null chosen)))))
+ (setq button (widget-create-child-and-convert
+ widget 'checkbox :value (not (null chosen)))))
((eq escape ?v)
(setq child
(cond ((not chosen)
- (widget-create type :parent widget))
+ (widget-create-child widget type))
((widget-get type :inline)
- (widget-create type
- :parent widget
- :value (cdr chosen)))
+ (widget-create-child-and-convert
+ widget type :value (cdr chosen)))
(t
- (widget-create type
- :parent widget
- :value (car (cdr chosen)))))))
+ (widget-create-child-and-convert
+ widget type :value (car (cdr chosen)))))))
(t
(error "Unknown escape `%c'" escape)))))
;; Update properties.
;; Notify the parent.
(widget-apply (widget-get widget :parent) :action widget event))
-;;; The `radio' Widget.
+;;; The `radio-button-choice' Widget.
-(define-widget 'radio 'default
+(define-widget 'radio-button-choice 'default
"Select one of multiple options."
:convert-widget 'widget-choice-convert-widget
+ :offset 4
:format "%v"
:entry-format "%b %v"
:menu-tag "radio"
(defun widget-radio-value-create (widget)
;; Insert all values
(let ((args (widget-get widget :args))
- (indent (widget-get widget :indent))
arg)
(while args
(setq arg (car args)
args (cdr args))
- (widget-radio-add-item widget arg)
- (and indent args (insert-char ?\ indent)))))
+ (widget-radio-add-item widget arg))))
(defun widget-radio-add-item (widget type)
"Add to radio widget WIDGET a new radio button item of type TYPE."
- (setq type (widget-convert type))
+ ;; (setq type (widget-convert type))
+ (and (eq (preceding-char) ?\n)
+ (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
(widget-specify-insert
(let* ((value (widget-get widget :value))
(children (widget-get widget :children))
(cond ((eq escape ?%)
(insert "%"))
((eq escape ?b)
- (setq button (widget-create 'radio-button
- :parent widget
- :value (not (null chosen)))))
+ (setq button (widget-create-child-and-convert
+ widget 'radio-button
+ :value (not (null chosen)))))
((eq escape ?v)
(setq child (if chosen
- (widget-create type
- :parent widget
- :value value)
- (widget-create type :parent widget))))
+ (widget-create-child-and-convert
+ widget type :value value)
+ (widget-create-child widget type))))
(t
(error "Unknown escape `%c'" escape)))))
;; Update properties.
;;; The `insert-button' Widget.
-(define-widget 'insert-button 'push
- "An insert button for the `repeat' widget."
+(define-widget 'insert-button 'push-button
+ "An insert button for the `editable-list' widget."
:tag "INS"
:action 'widget-insert-button-action)
;;; The `delete-button' Widget.
-(define-widget 'delete-button 'push
- "A delete button for the `repeat' widget."
+(define-widget 'delete-button 'push-button
+ "A delete button for the `editable-list' widget."
:tag "DEL"
:action 'widget-delete-button-action)
(widget-apply (widget-get widget :parent)
:delete-at (widget-get widget :widget)))
-;;; The `repeat' Widget.
+;;; The `editable-list' Widget.
-(define-widget 'repeat 'default
+(define-widget 'editable-list 'default
"A variable list of widgets of the same type."
:convert-widget 'widget-choice-convert-widget
+ :offset 12
:format "%v%i\n"
- :format-handler 'widget-repeat-format-handler
+ :format-handler 'widget-editable-list-format-handler
:entry-format "%i %d %v"
- :menu-tag "repeat"
- :value-create 'widget-repeat-value-create
+ :menu-tag "editable-list"
+ :value-create 'widget-editable-list-value-create
:value-delete 'widget-radio-value-delete
- :value-get 'widget-repeat-value-get
- :validate 'widget-repeat-validate
- :match 'widget-repeat-match
- :match-inline 'widget-repeat-match-inline
- :insert-before 'widget-repeat-insert-before
- :delete-at 'widget-repeat-delete-at)
-
-(defun widget-repeat-format-handler (widget escape)
+ :value-get 'widget-editable-list-value-get
+ :validate 'widget-editable-list-validate
+ :match 'widget-editable-list-match
+ :match-inline 'widget-editable-list-match-inline
+ :insert-before 'widget-editable-list-insert-before
+ :delete-at 'widget-editable-list-delete-at)
+
+(defun widget-editable-list-format-handler (widget escape)
;; We recognize the insert button.
(cond ((eq escape ?i)
- (insert " ")
- (backward-char 1)
- (let* ((from (point))
- (button (widget-create (list 'insert-button
- :parent widget))))
- (widget-specify-button button from (point)))
- (forward-char 1))
+ (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-repeat-value-create (widget)
+;(defun widget-editable-list-format-handler (widget escape)
+; ;; We recognize the insert button.
+; (cond ((eq escape ?i)
+; (insert " ")
+; (backward-char 1)
+; (let* ((from (point))
+; (button (widget-create-child-and-convert
+; widget 'insert-button)))
+; (widget-specify-button button from (point)))
+; (forward-char 1))
+; (t
+; (widget-default-format-handler widget escape))))
+
+(defun widget-editable-list-value-create (widget)
;; Insert all values
(let* ((value (widget-get widget :value))
(type (nth 0 (widget-get widget :args)))
(while value
(let ((answer (widget-match-inline type value)))
(if answer
- (setq children (cons (widget-repeat-entry-create
- widget (if inlinep
- (car answer)
- (car (car answer))))
+ (setq children (cons (widget-editable-list-entry-create
+ widget
+ (if inlinep
+ (car answer)
+ (car (car answer)))
+ t)
children)
value (cdr answer))
(setq value nil))))
(widget-put widget :children (nreverse children))))
-(defun widget-repeat-value-get (widget)
+(defun widget-editable-list-value-get (widget)
;; Get value of the child widget.
(apply 'append (mapcar (lambda (child) (widget-apply child :value-inline))
(widget-get widget :children))))
-(defun widget-repeat-validate (widget)
+(defun widget-editable-list-validate (widget)
;; All the chilren must be valid.
(let ((children (widget-get widget :children))
child found)
found (widget-apply child :validate)))
found))
-(defun widget-repeat-match (widget value)
- ;; Value must be a list and all the members must match the repeat type.
+(defun widget-editable-list-match (widget value)
+ ;; Value must be a list and all the members must match the type.
(and (listp value)
- (null (cdr (widget-repeat-match-inline widget value)))))
+ (null (cdr (widget-editable-list-match-inline widget value)))))
-(defun widget-repeat-match-inline (widget value)
+(defun widget-editable-list-match-inline (widget value)
(let ((type (nth 0 (widget-get widget :args)))
(ok t)
found)
(setq ok nil))))
(cons found value)))
-(defun widget-repeat-insert-before (widget before)
+(defun widget-editable-list-insert-before (widget before)
;; Insert a new child in the list of children.
(save-excursion
(let ((children (widget-get widget :children))
(goto-char (widget-get before :entry-from)))
(t
(goto-char (widget-get widget :value-pos))))
- (let ((child (widget-repeat-entry-create
- widget (widget-get (nth 0 (widget-get widget :args))
- :value))))
+ (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)
+ (widget-get child :entry-from)))
(widget-specify-text (widget-get child :entry-from)
(widget-get child :entry-to))
(if (eq (car children) before)
(widget-setup)
(widget-apply widget :notify widget))
-(defun widget-repeat-delete-at (widget child)
+(defun widget-editable-list-delete-at (widget child)
;; Delete child from list of children.
(save-excursion
(let ((buttons (copy-list (widget-get widget :buttons)))
(widget-setup)
(widget-apply widget :notify widget))
-(defun widget-repeat-entry-create (widget value)
+(defun widget-editable-list-entry-create (widget value conv)
;; Create a new entry to the list.
(let ((type (nth 0 (widget-get widget :args)))
- (indent (widget-get widget :indent))
child delete insert)
(widget-specify-insert
(save-excursion
- (insert (widget-get widget :entry-format))
- (if indent
- (insert-char ?\ indent)))
+ (and (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
+ (insert (widget-get widget :entry-format)))
;; Parse % escapes in format.
(while (re-search-forward "%\\(.\\)" nil t)
(let ((escape (aref (match-string 1) 0)))
(cond ((eq escape ?%)
(insert "%"))
((eq escape ?i)
- (setq insert (widget-create 'insert-button
- :parent widget)))
+ (setq insert (widget-create-child-and-convert
+ widget 'insert-button)))
((eq escape ?d)
- (setq delete (widget-create 'delete-button
- :parent widget)))
+ (setq delete (widget-create-child-and-convert
+ widget 'delete-button)))
((eq escape ?v)
- (setq child (widget-create type
- :parent widget
- :value value)))
+ (if conv
+ (setq child (widget-create-child-and-convert
+ widget type :value value))
+ (setq child (widget-create-child widget type))))
(t
(error "Unknown escape `%c'" escape)))))
(widget-put widget
:format "%v"
:value-create 'widget-group-value-create
:value-delete 'widget-radio-value-delete
- :value-get 'widget-repeat-value-get
- :validate 'widget-repeat-validate
+ :value-get 'widget-editable-list-value-get
+ :validate 'widget-editable-list-validate
:match 'widget-group-match
:match-inline 'widget-group-match-inline)
;; Create each component.
(let ((args (widget-get widget :args))
(value (widget-get widget :value))
- (indent (widget-get widget :indent))
arg answer children)
(while args
(setq arg (car args)
args (cdr args)
answer (widget-match-inline arg value)
- value (cdr answer)
- children (cons (cond ((null answer)
- (widget-create arg :parent widget))
- ((widget-get arg :inline)
- (widget-create arg
- :parent widget
- :value (car answer)))
- (t
- (widget-create arg
- :parent widget
- :value (car (car answer)))))
- children))
- (and args indent (insert-char ?\ indent)))
+ value (cdr answer))
+ (and (eq (preceding-char) ?\n)
+ (widget-get widget :indent)
+ (insert-char ? (widget-get widget :indent)))
+ (push (cond ((null answer)
+ (widget-create-child widget arg))
+ ((widget-get arg :inline)
+ (widget-create-child-and-convert
+ widget arg :value (car answer)))
+ (t
+ (widget-create-child-and-convert
+ widget arg :value (car (car answer)))))
+ children))
(widget-put widget :children (nreverse children))))
(defun widget-group-match (widget values)
"An immutable sexp."
:format "%t\n")
-(define-widget 'string 'field
- "A string")
+(define-widget 'string 'editable-field
+ "A string"
+ :tag "String"
+ :format "%[%t%]: %v")
+
+(define-widget 'regexp 'string
+ ;; Should do validation.
+ "A regular expression.")
(define-widget 'file 'string
"A file widget.
(define-widget 'symbol 'string
"A lisp symbol."
:value nil
+ :tag "Symbol"
:match (lambda (widget value) (symbolp value))
:value-to-internal (lambda (widget value) (symbol-name value))
:value-to-external (lambda (widget value) (intern value)))
+(define-widget 'function 'symbol
+ ;; Should complete on functions.
+ "A lisp function."
+ :tag "Function")
+
+(define-widget 'variable 'symbol
+ ;; Should complete on variables.
+ "A lisp variable."
+ :tag "Variable")
+
(define-widget 'sexp 'string
"An arbitrary lisp expression."
+ :tag "Lisp expression"
:value nil
:validate 'widget-sexp-validate
- :match (lambda (widget value) t)
- :value-to-internal (lambda (widget value) (pp-to-string value))
+ :match (lambda (widget value) t)
+ :value-to-internal 'widget-sexp-value-to-internal
:value-to-external (lambda (widget value) (read value)))
+(defun widget-sexp-value-to-internal (widget value)
+ ;; Use pp for printer representation.
+ (let ((pp (pp-to-string value)))
+ (while (string-match "\n\\'" pp)
+ (setq pp (substring pp 0 -1)))
+ (if (or (string-match "\n\\'" pp)
+ (> (length pp) 40))
+ (concat "\n" pp)
+ pp)))
+
(defun widget-sexp-validate (widget)
;; Valid if we can read the string and there is no junk left after it.
(save-excursion
- (set-buffer (get-buffer-create " *Widget Scratch*"))
- (erase-buffer)
- (insert (widget-apply widget :value-get))
- (goto-char (point-min))
- (condition-case data
- (let ((value (read (current-buffer))))
- (if (eobp)
- (if (widget-apply widget :match value)
- t
- (widget-put widget :error (widget-get widget :type-error))
- nil)
- (widget-put widget
- :error (format "Junk at end of expression: %s"
- (buffer-substring (point) (point-max))))
- nil))
- (error (widget-put widget :error (error-message-string data))
- nil))))
+ (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*"))))
+ (erase-buffer)
+ (insert (widget-apply widget :value-get))
+ (goto-char (point-min))
+ (condition-case data
+ (let ((value (read buffer)))
+ (if (eobp)
+ (if (widget-apply widget :match value)
+ nil
+ (widget-put widget :error (widget-get widget :type-error))
+ widget)
+ (widget-put widget
+ :error (format "Junk at end of expression: %s"
+ (buffer-substring (point)
+ (point-max))))
+ widget))
+ (error (widget-put widget :error (error-message-string data))
+ widget)))))
(define-widget 'integer 'sexp
"An integer."
+ :tag "Integer"
:value 0
:type-error "This field should contain an integer"
:match (lambda (widget value) (integerp value)))
(define-widget 'number 'sexp
"A floating point number."
+ :tag "Number"
:value 0.0
:type-error "This field should contain a number"
:match (lambda (widget value) (numberp value)))
(define-widget 'list 'group
- "A lisp list.")
+ "A lisp list."
+ :tag "List"
+ :format "%t:\n%v")
(define-widget 'vector 'group
"A lisp vector."
+ :tag "Vector"
+ :format "%t:\n%v"
:match 'widget-vector-match
:value-to-internal (lambda (widget value) (append value nil))
:value-to-external (lambda (widget value) (apply 'vector value)))
(define-widget 'cons 'group
"A cons-cell."
+ :tag "Cons-cell"
+ :format "%t:\n%v"
:match 'widget-cons-match
:value-to-internal (lambda (widget value)
(list (car value) (cdr value)))
(widget-group-match widget
(widget-apply :value-to-internal widget value))))
+(define-widget 'choice 'menu-choice
+ "A union of several sexp types."
+ :tag "Choice"
+ :format "%[%t%]: %v")
+
+(define-widget 'repeat 'editable-list
+ "A variable length homogeneous list."
+ :tag "Repeat"
+ :format "%[%t%]:\n%v%i\n")
+
+(define-widget 'set 'checklist
+ "A list of members from a fixed set."
+ :tag "Set"
+ :format "%[%t%]:\n%v")
+
+(define-widget 'boolean 'toggle
+ "To be nil or non-nil, that is the question."
+ :tag "Boolean"
+ :format "%t: %v")
+
;;; The `color' Widget.
(define-widget 'color-item 'choice-item
(facemenu-get-face (intern (concat "fg:" (widget-value widget))))
(error 'default)))
-(define-widget 'color 'push
+(define-widget 'color 'push-button
"Choose a color name (with sample)."
:format "%[%t%]: %v"
+ :tag "Color"
:value "default"
:value-create 'widget-color-value-create
:value-delete 'widget-radio-value-delete
widget-color-choice-list)
(defun widget-color-value-create (widget)
- (let ((child (widget-create 'color-item
- :parent widget
- (widget-get widget :value))))
+ (let ((child (widget-create-child-and-convert
+ widget 'color-item (widget-get widget :value))))
(widget-put widget :children (list child))))
(defun widget-color-value-get (widget)
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
-;; Version: 0.9
+;; Version: 0.94
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(eval-when-compile (require 'cl))
-(let ((keywords
- '(:create :convert-widget :format :value-create :tag :doc :from :to
- :args :value :value-from :value-to :action :value-set
- :value-delete :match :parent :delete :menu-tag-get
- :value-get :choice :void :menu-tag :on :off :on-type
- :off-type :notify :entry-format :button :children
- :buttons :insert-before :delete-at :format-handler
- :widget :value-pos :value-to-internal :indent :size
- :value-to-external :validate :error :directory :must-match
- :type-error :value-inline :inline :match-inline
- :greedy :button-face-get :button-face :value-face :keymap
- :entry-from :entry-to :help-echo)))
- (while keywords
- (or (boundp (car keywords))
- (set (car keywords) (car keywords)))
- (setq keywords (cdr keywords))))
+(defmacro define-widget-keywords (&rest keys)
+ `(eval-and-compile
+ (let ((keywords (quote ,keys)))
+ (while keywords
+ (or (boundp (car keywords))
+ (set (car keywords) (car keywords)))
+ (setq keywords (cdr keywords))))))
+
+(define-widget-keywords
+ :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
+ :value-get :choice :void :menu-tag :on :off :on-type :off-type
+ :notify :entry-format :button :children :buttons :insert-before
+ :delete-at :format-handler :widget :value-pos :value-to-internal
+ :indent :size :value-to-external :validate :error :directory
+ :must-match :type-error :value-inline :inline :match-inline :greedy
+ :button-face-get :button-face :value-face :keymap :entry-from
+ :entry-to :help-echo)
;; These autoloads should be deleted when the file is added to Emacs.
(autoload 'widget-create "widget-edit")
+Sat Sep 21 08:11:43 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (New Groups): Split into three nodes.
+ (Group Parameters): Shortened.
+ (Browse Foreign Server): Corrected.
+
Thu Sep 19 18:45:15 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Mail and Procmail): Addition.
egrep -v "end{document}" gnus.tmplatexi1 > gnus.tmplatexi
cat postamble.tex >> gnus.tmplatexi
$(LATEX) gnus.tmplatexi
+ $(LATEX) gnus.tmplatexi
$(DVIPS) -f gnus.dvi > gnus.ps
+pss:
+ make latex
+ make latexps
+
+psout:
+ make latex
+ make latexboth
+ make out
+
latexboth:
rm -f gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz
make latexps
gzip gnus-manual-standard.ps
out:
+ cp gnus-manual-standard.ps.gz gnus-manual-a4.ps.gz \
+ /local/ftp/pub/emacs/gnus/manual
mv gnus-manual-standard.ps.gz gnus-manual-a4.ps.gz \
/hom/larsi/www_docs/gnus/manual
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Red Gnus 0.24 Manual
+@settitle Red Gnus 0.40 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
\clearpage
}
-\newcommand{\gnusitemx}[1]{\vspace{-\itemsep}\item#1}
+\newcommand{\gnusitemx}[1]{\mbox{}\vspace*{-\itemsep}\vspace*{-\parsep}\item#1}
\newcommand{\gnussection}[1]{
\renewcommand{\gnussectionname}{#1}
{
\ifodd\count0
{
-\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\gnuschaptername\hfill\arabic{page}
-}
-}
-}
+\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\gnuschaptername\hfill\arabic{page}}}}
}
\else
{
-\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}
-}
+\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}
}
\fi
}
@tex
@titlepage
-@title Red Gnus 0.24 Manual
+@title Red Gnus 0.40 Manual
@author by Lars Magne Ingebrigtsen
@page
@code{gnus-no-server} command to start Gnus. That might come in handy
if you're in a hurry as well. This command will not attempt to contact
your primary server---instead, it will just activate all groups on level
-1 and 2. (You should preferably keep no native groups on those two
-levels.)
+@code{1} and @code{2}. (You should preferably keep no native groups on
+those two levels.)
@node Slave Gnusae
@cindex new groups
@cindex subscription
+@vindex gnus-check-new-newsgroups
+If you are satisfied that you really never want to see any new groups,
+you can set @code{gnus-check-new-newsgroups} to @code{nil}. This will
+also save you some time at startup. Even if this variable is
+@code{nil}, you can always subscribe to the new groups just by pressing
+@kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable
+is @code{t} by default.
+
+@menu
+* Checking New Groups:: Determining what groups are new.
+* Subscription Methods:: What Gnus should do with new groups.
+* Filtering New Groups:: Making Gnus ignore certain new groups.
+@end menu
+
+
+@node Checking New Groups
+@subsection Checking New Groups
+
+Gnus normally determines whether a group is new or not by comparing the
+list of groups from the active file(s) with the lists of subscribed and
+dead groups. This isn't a particularly fast method. If
+@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the
+server for new groups since the last time. This is both faster and
+cheaper. This also means that you can get rid of the list of killed
+groups altogether, so you may set @code{gnus-save-killed-list} to
+@code{nil}, which will save time both at startup, at exit, and all over.
+Saves disk space, too. Why isn't this the default, then?
+Unfortunately, not all servers support this command.
+
+I bet I know what you're thinking now: How do I find out whether my
+server supports @code{ask-server}? No? Good, because I don't have a
+fail-safe answer. I would suggest just setting this variable to
+@code{ask-server} and see whether any new groups appear within the next
+few days. If any do, then it works. If none do, then it doesn't
+work. I could write a function to make Gnus guess whether the server
+supports @code{ask-server}, but it would just be a guess. So I won't.
+You could @code{telnet} to the server and say @code{HELP} and see
+whether it lists @samp{NEWGROUPS} among the commands it understands. If
+it does, then it might work. (But there are servers that lists
+@samp{NEWGROUPS} without supporting the function properly.)
+
+This variable can also be a list of select methods. If so, Gnus will
+issue an @code{ask-server} command to each of the select methods, and
+subscribe them (or not) using the normal methods. This might be handy
+if you are monitoring a few servers for new groups. A side effect is
+that startup will take much longer, so you can meditate while waiting.
+Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss.
+
+
+@node Subscription Methods
+@subsection Subscription Methods
+
@vindex gnus-subscribe-newsgroup-method
What Gnus does when it encounters a new group is determined by the
@code{gnus-subscribe-newsgroup-method} variable.
@code{gnus-subscribe-hierarchical-interactive}. This is an error. This
will not work. This is ga-ga. So don't do it.
+
+@node Filtering New Groups
+@subsection Filtering New Groups
+
A nice and portable way to control which new newsgroups should be
subscribed (or ignored) is to put an @dfn{options} line at the start of
the @file{.newsrc} file. Here's an example:
@code{nnfolder}, @code{nnmbox}, and @code{nnmh}) subscribed. If you
don't like that, just set this variable to @code{nil}.
-@vindex gnus-check-new-newsgroups
-If you are satisfied that you really never want to see any new groups,
-you could set @code{gnus-check-new-newsgroups} to @code{nil}. This will
-also save you some time at startup. Even if this variable is
-@code{nil}, you can always subscribe to the new groups just by pressing
-@kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable
-is @code{t} by default.
-
-Gnus normally determines whether a group is new or not by comparing the
-list of groups from the active file(s) with the lists of subscribed and
-dead groups. This isn't a particularly fast method. If
-@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the
-server for new groups since the last time. This is both faster and
-cheaper. This also means that you can get rid of the list of killed
-groups altogether, so you may set @code{gnus-save-killed-list} to
-@code{nil}, which will save time both at startup, at exit, and all over.
-Saves disk space, too. Why isn't this the default, then?
-Unfortunately, not all servers support this command.
-
-I bet I know what you're thinking now: How do I find out whether my
-server supports @code{ask-server}? No? Good, because I don't have a
-fail-safe answer. I would suggest just setting this variable to
-@code{ask-server} and see whether any new groups appear within the next
-few days. If any do, then it works. If none do, then it doesn't
-work. I could write a function to make Gnus guess whether the server
-supports @code{ask-server}, but it would just be a guess. So I won't.
-You could @code{telnet} to the server and say @code{HELP} and see
-whether it lists @samp{NEWGROUPS} among the commands it understands. If
-it does, then it might work. (But there are servers that lists
-@samp{NEWGROUPS} without supporting the function properly.)
-
-This variable can also be a list of select methods. If so, Gnus will
-issue an @code{ask-server} command to each of the select methods, and
-subscribe them (or not) using the normal methods. This might be handy
-if you are monitoring a few servers for new groups. A side effect is
-that startup will take much longer, so you can meditate while waiting.
-Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss.
-
@node Changing Servers
@section Changing Servers
Note that if you subscribe to lots and lots of groups, setting this
variable to @code{nil} will probably make Gnus slower, not faster. At
present, having this variable @code{nil} will slow Gnus down
-considerably, unless you read news over a 2400 baud modem.
+considerably, unless you read news over a @code{2400} baud modem.
This variable can also have the value @code{some}. Gnus will then
attempt to read active info only on the subscribed groups. On some
Quite simple, huh?
-You can see that there are 25 unread articles in
+You can see that there are @code{25} unread articles in
@samp{news.announce.newusers}. There are no unread articles, but some
ticked articles, in @samp{alt.fan.andrea-dworkin} (see that little
asterisk at the beginning of the line?)
@item t
Estimated total number of articles. (This is really @var{max-number}
-minus @var{min-number} plus 1.)
+minus @var{min-number} plus @code{1}.)
@item y
Number of unread, unticked, non-dormant articles.
minimum amount of fuzz (@code{gnus-group-quick-select-group}). No
scoring/killing will be performed, there will be no highlights and no
expunging. This might be useful if you're in a real hurry and have to
-enter some humongous group. If you give a 0 prefix to this command
+enter some humongous group. If you give a @code{0} prefix to this command
(i.e., @kbd{0 M-RET}), Gnus won't even generate the summary buffer.
This might be useful if you want to toggle threading before entering the
group.
@vindex gnus-large-newsgroup
The @code{gnus-large-newsgroup} variable says what Gnus should consider
-to be a big group. This is 200 by default. If the group has more
+to be a big group. This is @code{200} by default. If the group has more
unread articles than this, Gnus will query the user before entering the
group. The user can then specify how many articles should be fetched
from the server. If the user specifies a negative number (@code{-n}),
@cindex level
All groups have a level of @dfn{subscribedness}. For instance, if a
-group is on level 2, it is more subscribed than a group on level 5. You
+group is on level @code{2}, it is more subscribed than a group on level @code{5}. You
can ask Gnus to just list groups on a given level or lower
(@pxref{Listing Groups}), or to just check for new articles in groups on
a given level or lower (@pxref{Scanning New Messages}).
@vindex gnus-level-zombie
@vindex gnus-level-unsubscribed
@vindex gnus-level-subscribed
-Gnus considers groups on between levels 1 and
-@code{gnus-level-subscribed} (inclusive) (default 5) to be subscribed,
+Gnus considers groups on between levels @code{1} and
+@code{gnus-level-subscribed} (inclusive) (default @code{5}) to be subscribed,
@code{gnus-level-subscribed} (exclusive) and
-@code{gnus-level-unsubscribed} (inclusive) (default 7) to be
+@code{gnus-level-unsubscribed} (inclusive) (default @code{7}) to be
unsubscribed, @code{gnus-level-zombie} to be zombies (walking dead)
-(default 8) and @code{gnus-level-killed} to be killed (default 9),
+(default @code{8}) and @code{gnus-level-killed} to be killed (default @code{9}),
completely dead. Gnus treats subscribed and unsubscribed groups exactly
the same, but zombie and killed groups have no information on what
articles you have read, etc, stored. This distinction between dead and
for reasons of efficiency.
It is recommended that you keep all your mail groups (if any) on quite
-low levels (e.g. 1 or 2).
+low levels (e.g. @code{1} or @code{2}).
If you want to play with the level variables, you should show some care.
Set them once, and don't touch them ever again. Better yet, don't touch
@vindex gnus-level-default-unsubscribed
@vindex gnus-level-default-subscribed
Two closely related variables are @code{gnus-level-default-subscribed}
-(default 3) and @code{gnus-level-default-unsubscribed} (default 6),
+(default @code{3}) and @code{gnus-level-default-unsubscribed} (default @code{6}),
which are the levels that new groups will be put on if they are
(un)subscribed. These two variables should, of course, be inside the
relevant legal ranges.
Gnus will normally just activate groups that are on level
@code{gnus-activate-level} or less. If you don't want to activate
unsubscribed groups, for instance, you might set this variable to
-@code{5}.
+@code{5}. The default is @code{6}.
@node Group Score
group. You can then sort the group buffer based on this score.
Alternatively, you can sort on score and then level. (Taken together,
the level and the score is called the @dfn{rank} of the group. A group
-that is on level 4 and has a score of 1 has a higher rank than a group
-on level 5 that has a score of 300. (The level is the most significant
+that is on level @code{4} and has a score of @code{1} has a higher rank than a group
+on level @code{5} that has a score of @code{300}. (The level is the most significant
part and the score is the least significant part.)
@findex gnus-summary-bubble-group
@section Group Parameters
@cindex group parameters
-Gnus stores all information on a group in a list that is usually known
-as the @dfn{group info}. This list has from three to six elements.
-Here's an example info.
-
-@lisp
-("nnml:mail.ding" 3 ((1 . 232) 244 (256 . 270)) ((tick 246 249))
- (nnml "private") ((to-address . "ding@@ifi.uio.no")))
-@end lisp
-
-The first element is the @dfn{group name}, as Gnus knows the group,
-anyway. The second element is the @dfn{subscription level}, which
-normally is a small integer. The third element is a list of ranges of
-read articles. The fourth element is a list of lists of article marks
-of various kinds. The fifth element is the select method (or virtual
-server, if you like). The sixth element is a list of @dfn{group
-parameters}, which is what this section is about.
-
-Any of the last three elements may be missing if they are not required.
-In fact, the vast majority of groups will normally only have the first
-three elements, which saves quite a lot of cons cells.
-
The group parameters store information local to a particular group:
@table @code
@findex gnus-browse-mode
A new buffer with a list of available groups will appear. This buffer
-will be use the @code{gnus-browse-mode}. This buffer looks a bit
-(well, a lot) like a normal group buffer, but with one major difference
-- you can't enter any of the groups. If you want to read any of the
-news available on that server, you have to subscribe to the groups you
-think may be interesting, and then you have to exit this buffer. The
-new groups will be added to the group buffer, and then you can read them
-as you would any other group.
-
-Future versions of Gnus may possibly permit reading groups straight from
-the browse buffer.
+will be use the @code{gnus-browse-mode}. This buffer looks a bit (well,
+a lot) like a normal group buffer.
Here's a list of keystrokes available in the browse mode:
@item Q
@kindex Q (Group)
@findex gnus-group-quit
-Quit Gnus without saving any startup files (@code{gnus-group-quit}).
+Quit Gnus without saving the @file{.newsrc} files (@code{gnus-group-quit}).
+The dribble file will be saved, though (@pxref{Auto Save}).
@end table
@vindex gnus-exit-gnus-hook
even group the Emacs sex groups as a sub-topic to either the Emacs
groups or the sex groups---or both! Go wild!
+Here's an example:
+
+@example
+Gnus
+ Emacs -- I wuw it!
+ 3: comp.emacs
+ 2: alt.religion.emacs
+ Naughty Emacs
+ 452: alt.sex.emacs
+ 0: comp.talk.emacs.recovery
+ Misc
+ 8: comp.binaries.fractals
+ 13: comp.sources.unix
+@end example
+
@findex gnus-topic-mode
@kindex t (Group)
To get this @emph{fab} functionality you simply turn on (ooh!) the
@end example
So, here we have one top-level topic, two topics under that, and one
-sub-topic under one of the sub-topics. (There is always just one (1)
+sub-topic under one of the sub-topics. (There is always just one (@code{1})
top-level topic). This topology can be expressed as follows:
@lisp
@table @kbd
-@item M-f
-@kindex M-f (Group)
+
+@item H f
+@kindex H f (Group)
+@itemx M-f
@findex gnus-group-fetch-faq
@vindex gnus-group-faq-directory
@cindex FAQ
@code{gnus-group-faq-directory}, which is usually a directory on a
remote machine. This variable can also be a list of directories. In
that case, giving a prefix to this command will allow you to choose
-between the various sites. @code{ange-ftp} will be used for fetching
-the file.
+between the various sites. @code{ange-ftp} (or @code{efs}) will be used
+for fetching the file.
If fetching from the first site is unsuccessful, Gnus will attempt to go
through @code{gnus-group-faq-directory} and try to open them one by one.
@findex gnus-group-read-init-file
@vindex gnus-init-file
@cindex reading init file
-Read the init file (@code{gnus-init-file}, which defaults to
+Re-read the init file (@code{gnus-init-file}, which defaults to
@file{~/.gnus}) (@code{gnus-group-read-init-file}).
@item s
@vindex gnus-summary-mode-line-format
You can also change the format of the summary mode bar. Set
-@code{gnus-summary-mode-line-format} to whatever you like. Here are the
-elements you can play with:
+@code{gnus-summary-mode-line-format} to whatever you like. The default
+is @samp{Gnus: %%b [%A] %Z}.
+
+Here are the elements you can play with:
@table @samp
@item G
@item gnus-summary-highlight
@vindex gnus-summary-highlight
Summary lines are highlighted according to this variable, which is a
-list where the elements are on the format @code{(FORM . FACE)}. If you
+list where the elements are on the format @var{(FORM . FACE)}. If you
would, for instance, like ticked articles to be italic and high-scored
articles to be bold, you could set this variable to something like
@lisp
@section Choosing Articles
@cindex selecting articles
+@menu
+* Choosing Commands:: Commands for choosing articles.
+* Choosing Variables:: Variables that influence these commands.
+@end menu
+
+
+@node Choosing Commands
+@subsection Choosing Commands
+
None of the following movement commands understand the numeric prefix,
and they all select and display an article.
history as you like.
@end table
+
+@node Choosing Variables
+@subsection Choosing Variables
+
Some variables that are relevant for moving and selecting articles:
@table @code
Scroll to the end of the article (@code{gnus-summary-end-of-article}).
@item A s
+@itemx s
@kindex A s (Summary)
+@kindex s (Summary)
@findex gnus-summary-isearch-article
Perform an isearch in the article buffer
(@code{gnus-summary-isearch-article}).
Forward the current article to some other person
(@code{gnus-summary-mail-forward}).
-@item S o p
-@kindex S o p (Summary)
-@findex gnus-summary-post-forward
-Forward the current article to a newsgroup
-(@code{gnus-summary-post-forward}).
-
@item S m
@itemx m
@kindex m (Summary)
(@code{gnus-uu-digest-mail-forward}). This command uses the
process/prefix convention (@pxref{Process/Prefix}).
-@item S O p
-@kindex S O p (Summary)
-@findex gnus-uu-digest-post-forward
-Digest the current series and forward the result to a newsgroup
-(@code{gnus-uu-digest-mail-forward}).
-
@item S M-c
@kindex S M-c (Summary)
@findex gnus-summary-mail-crosspost-complaint
(@code{gnus-summary-followup-with-original}). This command uses the
process/prefix convention.
+@item S o p
+@kindex S o p (Summary)
+@findex gnus-summary-post-forward
+Forward the current article to a newsgroup
+(@code{gnus-summary-post-forward}).
+
+@item S O p
+@kindex S O p (Summary)
+@findex gnus-uu-digest-post-forward
+Digest the current series and forward the result to a newsgroup
+(@code{gnus-uu-digest-mail-forward}).
+
@item S u
@kindex S u (Summary)
@findex gnus-uu-post-news
to the post buffer (which is called @code{*post-buf*}). There you will
find the article you just posted, with all the headers intact. Change
the @code{Message-ID} header to a @code{Cancel} or @code{Supersedes}
-header by substituting one of those words for @code{Message-ID}. Then
-just press @kbd{C-c C-c} to send the article as you would do normally.
-The previous article will be canceled/superseded.
+header by substituting one of those words for the word
+@code{Message-ID}. Then just press @kbd{C-c C-c} to send the article as
+you would do normally. The previous article will be
+canceled/superseded.
Just remember, kids: There is no 'c' in 'supersede'.
subjects of the loose threads before gathering them into one big
super-thread. This might be too strict a requirement, what with the
presence of stupid newsreaders that chop off long subjects lines. If
-you think so, set this variable to, say, 20 to require that only the
-first 20 characters of the subjects have to match. If you set this
+you think so, set this variable to, say, @code{20} to require that only the
+first @code{20} characters of the subjects have to match. If you set this
variable to a really low number, you'll find that Gnus will gather
everything in sight into one thread, which isn't very helpful.
@item gnus-simplify-ignored-prefixes
@vindex gnus-simplify-ignored-prefixes
If you set @code{gnus-summary-gather-subject-limit} to something as low
-as 10, you might consider setting this variable to something sensible:
+as @code{10}, you might consider setting this variable to something sensible:
@c Written by Michael Ernst <mernst@cs.rice.edu>
@lisp
First, some caveats. There are some pitfalls to using asynchronous
article fetching, especially the way Gnus does it.
-Let's say you are reading article 1, which is short, and article 2 is
+Let's say you are reading article @code{1}, which is short, and article @code{2} is
quite long, and you are not interested in reading that. Gnus does not
-know this, so it goes ahead and fetches article 2. You decide to read
-article 3, but since Gnus is in the process of fetching article 2, the
+know this, so it goes ahead and fetches article @code{2}. You decide to read
+article @code{3}, but since Gnus is in the process of fetching article @code{2}, the
connection is blocked.
To avoid these situations, Gnus will open two (count 'em two)
@vindex gnus-use-article-prefetch
You can control how many articles that are to be pre-fetched by setting
-@code{gnus-use-article-prefetch}. This is 30 by default, which means
+@code{gnus-use-article-prefetch}. This is @code{30} by default, which means
that when you read an article in the group, the backend will pre-fetch
-the next 30 articles. If this variable is @code{t}, the backend will
+the next @code{30} articles. If this variable is @code{t}, the backend will
pre-fetch all the articles that it can without bound. If it is
@code{nil}, no pre-fetching will be made.
data structure as the only parameter.
If, for instance, you wish to pre-fetch only unread articles that are
-shorter than 100 lines, you could say something like:
+shorter than @code{100} lines, you could say something like:
@lisp
(defun my-async-short-unread-p (data)
So where does the massive article-fetching and storing come into the
picture? The @code{gnus-jog-cache} command will go through all
subscribed newsgroups, request all unread articles, and store them in
-the cache. You should only ever, ever ever ever, use this command if 1)
+the cache. You should only ever, ever ever ever, use this command if @code{1})
your connection to the @sc{nntp} server is really, really, really slow
-and 2) you have a really, really, really huge disk. Seriously.
+and @code{2}) you have a really, really, really huge disk. Seriously.
@vindex gnus-uncacheable-groups
It is likely that you do not want caching on some groups. For instance,
@example
@{***@}-(***)-[odd]-[Gun]
- | \[Jan]
- | \[odd]-[Eri]
- | \(***)-[Eri]
- | \[odd]-[Paa]
+ | \[Jan]
+ | \[odd]-[Eri]
+ | \(***)-[Eri]
+ | \[odd]-[Paa]
\[Bjo]
\[Gun]
\[Gun]-[Jor]
@samp{group}: If the split is a string, that will be taken as a group name.
@item
-@code{(FIELD VALUE SPLIT)}: If the split is a list, and the first
+@var{(FIELD VALUE SPLIT)}: If the split is a list, and the first
element is a string, then that means that if header FIELD (a regexp)
contains VALUE (also a regexp), then store the message as specified by
SPLIT.
@item
-@code{(| SPLIT...)}: If the split is a list, and the first element is
+@var{(| SPLIT...)}: If the split is a list, and the first element is
@code{|} (vertical bar), then process each SPLIT until one of them
matches. A SPLIT is said to match if it will cause the mail message to
be stored in one or more groups.
@item
-@code{(& SPLIT...)}: If the split is a list, and the first element is
+@var{(& SPLIT...)}: If the split is a list, and the first element is
@code{&}, then process all SPLITs in the list.
@item
@quotation
@strong{Te Deum}
+
@sp 1
Not because of victories @*
I sing,@*
but for the common sunshine,@*
the breeze,@*
the largess of the spring.
+
@sp 1
Not for victory@*
but for the day's work done@*
(auto-expire (to-address "ding@@ifi.uio.no")))
@end example
-The first element is the group name as Gnus knows the group; the second
-is the group level; the third is the read articles in range format; the
-fourth is a list of article marks lists; the fifth is the select method;
-and the sixth contains the group parameters.
+The first element is the @dfn{group name}---as Gnus knows the group,
+anyway. The second element is the @dfn{subscription level}, which
+normally is a small integer. The third element is a list of ranges of
+read articles. The fourth element is a list of lists of article marks
+of various kinds. The fifth element is the select method (or virtual
+server, if you like). The sixth element is a list of @dfn{group
+parameters}, which is what this section is about.
+
+Any of the last three elements may be missing if they are not required.
+In fact, the vast majority of groups will normally only have the first
+three elements, which saves quite a lot of cons cells.
Here's a BNF definition of the group info format:
projects / gnus / commitdiff