+Sat Apr 12 01:42:42 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Gnus v5.4.44 is released.
+
+Sat Apr 12 01:10:31 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nnweb.el (nnweb-request-scan): Init nnweb-hashtb.
+
+Thu Apr 10 20:05:13 1997 Sudish Joseph <sj@eng.mindspring.net>
+
+ * gnus-art.el (gnus-article-delete-invisible-text): Do an entire
+ region instead a single char in each pass. It's faster and
+ doesn't confuse ps-print.
+ (gnus-article-delete-text-of-type): Ditto.
+
+Sat Apr 12 00:35:07 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-sum.el (gnus-adjust-marked-articles): Wouldn't remove
+ `expire' marks.
+
Thu Apr 10 22:07:46 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Gnus v5.4.43 is released.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.70
+;; Version: 1.82
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
:custom-set :custom-save :custom-reset-current :custom-reset-saved
:custom-reset-factory)
+(put 'custom-define-hook 'custom-type 'hook)
+(put 'custom-define-hook 'factory-value '(nil))
+(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
+
;;; Customization Groups.
(defgroup emacs nil
:link '(url-link :tag "Development Page"
"http://www.dina.kvl.dk/~abraham/custom/")
:prefix "custom-"
- :group 'help
+ :group 'help)
+
+(defgroup custom-faces nil
+ "Faces used by customize."
+ :group 'customize
:group 'faces)
;;; Utilities.
(nreverse (cons (substring regexp start) all)))
regexp))
+(defun custom-variable-prompt ()
+ ;; Code stolen from `help.el'.
+ "Prompt for a variable, defaulting to the variable at point.
+Return a list suitable for use in `interactive'."
+ (let ((v (variable-at-point))
+ (enable-recursive-minibuffers t)
+ val)
+ (setq val (completing-read
+ (if v
+ (format "Customize variable (default %s): " v)
+ "Customize variable: ")
+ obarray 'boundp t))
+ (list (if (equal val "")
+ v (intern val)))))
+
+;;; Unlispify.
+
(defvar custom-prefix-list nil
"List of prefixes that should be ignored by `custom-unlispify'")
(erase-buffer)
(princ symbol (current-buffer))
(goto-char (point-min))
+ (when (and (eq (get symbol 'custom-type) 'boolean)
+ (re-search-forward "-p\\'" nil t))
+ (replace-match "" t t)
+ (goto-char (point-min)))
(let ((prefixes custom-prefix-list)
prefix)
(while prefixes
(concat (symbol-name symbol) "-"))
prefixes))
-;;; The Custom Mode.
-
-(defvar custom-options nil
- "Customization widgets in the current buffer.")
-
-(defvar custom-mode-map nil
- "Keymap for `custom-mode'.")
-
-(unless custom-mode-map
- (setq custom-mode-map (make-sparse-keymap))
- (set-keymap-parent custom-mode-map widget-keymap)
- (define-key custom-mode-map "q" 'bury-buffer))
-
-(easy-menu-define custom-mode-menu
- custom-mode-map
- "Menu used in customization buffers."
- '("Custom"
- ["Set" custom-set t]
- ["Save" custom-save t]
- ["Reset to Current" custom-reset-current t]
- ["Reset to Saved" custom-reset-saved t]
- ["Reset to Factory Settings" custom-reset-factory t]
- ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
-
-(defcustom custom-mode-hook nil
- "Hook called when entering custom-mode."
- :type 'hook
+;;; Guess.
+
+(defcustom custom-guess-name-alist
+ '(("-p\\'" boolean)
+ ("-hook\\'" hook)
+ ("-face\\'" face)
+ ("-file\\'" file)
+ ("-function\\'" function)
+ ("-functions\\'" (repeat function))
+ ("-list\\'" (repeat sexp))
+ ("-alist\\'" (repeat (cons sexp sexp))))
+ "Alist of (MATCH TYPE).
+
+MATCH should be a regexp matching the name of a symbol, and TYPE should
+be a widget suitable for editing the value of that symbol. The TYPE
+of the first entry where MATCH matches the name of the symbol will be
+used.
+
+This is used for guessing the type of variables not declared with
+customize."
+ :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
:group 'customize)
-(defun custom-mode ()
- "Major mode for editing customization buffers.
+(defcustom custom-guess-doc-alist
+ '(("\\`\\*?Non-nil " boolean))
+ "Alist of (MATCH TYPE).
-The following commands are available:
+MATCH should be a regexp matching a documentation string, and TYPE
+should be a widget suitable for editing the value of a variable with
+that documentation string. The TYPE of the first entry where MATCH
+matches the name of the symbol will be used.
-\\[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-set] Set all modifications.
-\\[custom-save] Make all modifications default.
-\\[custom-reset-current] Reset all modified options.
-\\[custom-reset-saved] Reset all modified or set options.
-\\[custom-reset-factory] Reset all options.
+This is used for guessing the type of variables not declared with
+customize."
+ :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
+ :group 'customize)
-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)
- (easy-menu-add custom-mode-menu)
- (make-local-variable 'custom-options)
- (run-hooks 'custom-mode-hook))
+(defun custom-guess-type (symbol)
+ "Guess a widget suitable for editing the value of SYMBOL.
+This is done by matching SYMBOL with `custom-guess-name-alist' and
+if that fails, the doc string with `custom-guess-doc-alist'."
+ (let ((name (symbol-name symbol))
+ (names custom-guess-name-alist)
+ current found)
+ (while names
+ (setq current (car names)
+ names (cdr names))
+ (when (string-match (nth 0 current) name)
+ (setq found (nth 1 current)
+ names nil)))
+ (unless found
+ (let ((doc (documentation-property symbol 'variable-documentation))
+ (docs custom-guess-doc-alist))
+ (when doc
+ (while docs
+ (setq current (car docs)
+ docs (cdr docs))
+ (when (string-match (nth 0 current) doc)
+ (setq found (nth 1 current)
+ docs nil))))))
+ found))
;;; Custom Mode Commands.
+(defvar custom-options nil
+ "Customization widgets in the current buffer.")
+
(defun custom-set ()
"Set changes in all modified options."
(interactive)
;;;###autoload
(defun customize-variable (symbol)
"Customize SYMBOL, which must be a variable."
- (interactive
- ;; Code stolen from `help.el'.
- (let ((v (variable-at-point))
- (enable-recursive-minibuffers t)
- val)
- (setq val (completing-read
- (if v
- (format "Customize variable (default %s): " v)
- "Customize variable: ")
- obarray 'boundp t))
- (list (if (equal val "")
- v (intern val)))))
+ (interactive (custom-variable-prompt))
(custom-buffer-create (list (list symbol 'custom-variable))))
+;;;###autoload
+(defun customize-variable-other-window (symbol)
+ "Customize SYMBOL, which must be a variable.
+Show the buffer in another window, but don't select it."
+ (interactive (custom-variable-prompt))
+ (custom-buffer-create-other-window (list (list symbol 'custom-variable))))
+
;;;###autoload
(defun customize-face (&optional symbol)
"Customize SYMBOL, which should be a face name or nil.
(message "Looking for faces...")
(mapcar (lambda (symbol)
(setq found (cons (list symbol 'custom-face) found)))
- (face-list))
+ (nreverse (mapcar 'intern
+ (sort (mapcar 'symbol-name (face-list))
+ 'string<))))
+
(custom-buffer-create found))
(if (stringp symbol)
(setq symbol (intern symbol)))
(error "Should be a symbol %S" symbol))
(custom-buffer-create (list (list symbol 'custom-face)))))
+;;;###autoload
+(defun customize-face-other-window (&optional symbol)
+ "Show customization buffer for FACE in other window."
+ (interactive (list (completing-read "Customize face: "
+ obarray 'custom-facep)))
+ (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
+ ()
+ (if (stringp symbol)
+ (setq symbol (intern symbol)))
+ (unless (symbolp symbol)
+ (error "Should be a symbol %S" symbol))
+ (custom-buffer-create-other-window (list (list symbol 'custom-face)))))
+
;;;###autoload
(defun customize-customized ()
"Customize all already customized user options."
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
- (message "Creating customization buffer...")
(kill-buffer (get-buffer-create "*Customization*"))
(switch-to-buffer (get-buffer-create "*Customization*"))
+ (custom-buffer-create-internal options))
+
+(defun custom-buffer-create-other-window (options)
+ "Create a buffer containing OPTIONS.
+OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
+SYMBOL is a customization option, and WIDGET is a widget for editing
+that option."
+ (kill-buffer (get-buffer-create "*Customization*"))
+ (let ((window (selected-window)))
+ (switch-to-buffer-other-window (get-buffer-create "*Customization*"))
+ (custom-buffer-create-internal options)
+ (select-window window)))
+
+
+(defun custom-buffer-create-internal (options)
+ (message "Creating customization buffer...")
(custom-mode)
(widget-insert "This is a customization buffer.
Push RET or click mouse-2 on the word ")
(message "Creating customization setup...")
(widget-setup)
(goto-char (point-min))
+ (forward-char) ;Kludge: bob is writable in XEmacs.
(message "Creating customization buffer...done"))
;;; Modification of Basic Widgets.
(string :tag "Magic")
face
(string :tag "Description"))))
- :group 'customize)
+ :group 'customize
+ :group 'custom-faces)
(defcustom custom-magic-show 'long
"Show long description of the state of each customization option."
(t
(funcall show widget value)))))
+(defvar custom-load-recursion nil
+ "Hack to avoid recursive dependencies.")
+
(defun custom-load-symbol (symbol)
"Load all dependencies for SYMBOL."
- (let ((loads (get symbol 'custom-loads))
- load)
- (while loads
- (setq load (car loads)
- loads (cdr loads))
- (cond ((symbolp load)
- (condition-case nil
- (require load)
- (error nil)))
- ((assoc load load-history))
- (t
- (condition-case nil
- (load-library load)
- (error nil)))))))
+ (unless custom-load-recursion
+ (let ((custom-load-recursion t)
+ (loads (get symbol 'custom-loads))
+ load)
+ (while loads
+ (setq load (car loads)
+ loads (cdr loads))
+ (cond ((symbolp load)
+ (condition-case nil
+ (require load)
+ (error nil)))
+ ((assoc load load-history))
+ (t
+ (condition-case nil
+ (load-library load)
+ (error nil))))))))
(defun custom-load-widget (widget)
"Load all dependencies for WIDGET."
(defface custom-variable-sample-face '((t (:underline t)))
"Face used for unpushable variable tags."
- :group 'customize)
+ :group 'custom-faces)
(defface custom-variable-button-face '((t (:underline t :bold t)))
"Face used for pushable variable tags."
- :group 'customize)
+ :group 'custom-faces)
(define-widget 'custom-variable 'custom
"Customize variable."
:custom-reset-saved 'custom-variable-reset-saved
:custom-reset-factory 'custom-variable-reset-factory)
+(defun custom-variable-type (symbol)
+ "Return a widget suitable for editing the value of SYMBOL.
+If SYMBOL has a `custom-type' property, use that.
+Otherwise, look up symbol in `custom-guess-type-alist'."
+ (let* ((type (or (get symbol 'custom-type)
+ (and (not (get symbol 'factory-value))
+ (custom-guess-type symbol))
+ 'sexp))
+ (options (get symbol 'custom-options))
+ (tmp (if (listp type)
+ (copy-list type)
+ (list type))))
+ (when options
+ (widget-put tmp :options options))
+ tmp))
+
(defun custom-variable-value-create (widget)
"Here is where you edit the variables value."
(custom-load-widget widget)
(form (widget-get widget :custom-form))
(state (widget-get widget :custom-state))
(symbol (widget-get widget :value))
- (options (get symbol 'custom-options))
- (child-type (or (get symbol 'custom-type) 'sexp))
(tag (widget-get widget :tag))
- (type (let ((tmp (if (listp child-type)
- (copy-list child-type)
- (list child-type))))
- (when options
- (widget-put tmp :options options))
- tmp))
+ (type (custom-variable-type symbol))
(conv (widget-convert type))
(value (if (default-boundp symbol)
(default-value symbol)
(goto-char (widget-get val :from))
(error "%s" (widget-get val :error)))
((eq form 'lisp)
- (set symbol (eval (setq val (widget-value child))))
+ (set-default symbol (eval (setq val (widget-value child))))
(put symbol 'customized-value (list val)))
(t
- (set symbol (setq val (widget-value child)))
+ (set-default symbol (setq val (widget-value child)))
(put symbol 'customized-value (list (custom-quote val)))))
(custom-variable-state-set widget)
(custom-redraw-magic widget)))
(error "%s" (widget-get val :error)))
((eq form 'lisp)
(put symbol 'saved-value (list (widget-value child)))
- (set symbol (eval (widget-value child))))
+ (set-default symbol (eval (widget-value child))))
(t
(put symbol
'saved-value (list (custom-quote (widget-value
child))))
- (set symbol (widget-value child))))
+ (set-default symbol (widget-value child))))
(put symbol 'customized-value nil)
(custom-save-all)
(custom-variable-state-set widget)
(let ((symbol (widget-value widget)))
(if (get symbol 'saved-value)
(condition-case nil
- (set symbol (eval (car (get symbol 'saved-value))))
+ (set-default symbol (eval (car (get symbol 'saved-value))))
(error nil))
(error "No saved value for %s" symbol))
(put symbol 'customized-value nil)
"Restore the factory setting for the variable being edited by WIDGET."
(let ((symbol (widget-value widget)))
(if (get symbol 'factory-value)
- (set symbol (eval (car (get symbol 'factory-value))))
+ (set-default symbol (eval (car (get symbol 'factory-value))))
(error "No factory default for %S" symbol))
(put symbol 'customized-value nil)
(when (get symbol 'saved-value)
(defface custom-face-tag-face '((t (:underline t)))
"Face used for face tags."
- :group 'customize)
+ :group 'custom-faces)
(define-widget 'custom-face 'custom
"Customize face."
and so forth. The remaining group tags are shown with
`custom-group-tag-face'."
:type '(repeat face)
- :group 'customize)
+ :group 'custom-faces)
(defface custom-group-tag-face-1 '((((class color)
(background dark))
(:foreground "blue" :underline t))
(t (:underline t)))
"Face used for low level group tags."
- :group 'customize)
+ :group 'custom-faces)
(define-widget 'custom-group 'custom
"Customize group."
(unless (bolp)
(princ "\n"))
(princ "(custom-set-faces")
+ (let ((value (get 'default 'saved-face)))
+ ;; The default face must be first, since it affects the others.
+ (when value
+ (princ "\n '(default ")
+ (prin1 value)
+ (if (or (get 'default 'factory-face)
+ (and (not (custom-facep 'default))
+ (not (get 'default 'force-face))))
+ (princ ")")
+ (princ " t)"))))
(mapatoms (lambda (symbol)
(let ((value (get symbol 'saved-face)))
- (when value
+ (when (and (not (eq symbol 'default))
+ ;; Don't print default face here.
+ value)
(princ "\n '(")
(princ symbol)
(princ " ")
;;; The Customize Menu.
-(defcustom custom-menu-nesting 2
- "Maximum nesting in custom menus."
- :type 'integer
- :group 'customize)
+;;; Menu support
+
+(unless (string-match "XEmacs" emacs-version)
+ (defconst custom-help-menu '("Customize"
+ ["Update menu..." custom-menu-update t]
+ ["Group..." customize t]
+ ["Variable..." customize-variable t]
+ ["Face..." customize-face t]
+ ["Saved..." customize-customized t]
+ ["Apropos..." customize-apropos t])
+ ;; This menu should be identical to the one defined in `menu-bar.el'.
+ "Customize menu")
+
+ (defun custom-menu-reset ()
+ "Reset customize menu."
+ (remove-hook 'custom-define-hook 'custom-menu-reset)
+ (define-key global-map [menu-bar help-menu customize-menu]
+ (cons (car custom-help-menu)
+ (easy-menu-create-keymaps (car custom-help-menu)
+ (cdr custom-help-menu)))))
+
+ (defun custom-menu-update (event)
+ "Update customize menu."
+ (interactive "e")
+ (add-hook 'custom-define-hook 'custom-menu-reset)
+ (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
+ (menu `(,(car custom-help-menu)
+ ,emacs
+ ,@(cdr (cdr custom-help-menu)))))
+ (let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
+ (define-key global-map [menu-bar help-menu customize-menu]
+ (cons (car menu) map)))))
+
+ (defcustom custom-menu-nesting 2
+ "Maximum nesting in custom menus."
+ :type 'integer
+ :group 'customize))
(defun custom-face-menu-create (widget symbol)
"Ignoring WIDGET, create a menu entry for customization face SYMBOL."
`(custom-buffer-create '((,symbol custom-variable)))
t))))
+;; Add checkboxes to boolean variable entries.
(widget-put (get 'boolean 'widget-type)
:custom-menu (lambda (widget symbol)
(vector (custom-unlispify-menu-entry symbol)
(let ((custom-menu-nesting (1- custom-menu-nesting)))
(custom-menu-create symbol))))
+;;;###autoload
(defun custom-menu-create (symbol &optional name)
"Create menu for customization group SYMBOL.
If optional NAME is given, use that as the name of the menu.
(let ((item (vector name
`(custom-buffer-create '((,symbol custom-group)))
t)))
- (if (and (>= custom-menu-nesting 0)
+ (if (and (or (not (boundp 'custom-menu-nesting))
+ (>= custom-menu-nesting 0))
(< (length (get symbol 'custom-group)) widget-menu-max-size))
(let ((custom-prefix-list (custom-prefix-add symbol
custom-prefix-list)))
item)))
;;;###autoload
-(defun custom-menu-update (event)
- "Update customize menu."
- (interactive "e")
- (add-hook 'custom-define-hook 'custom-menu-reset)
- (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
- (menu `(,(car custom-help-menu)
- ,emacs
- ,@(cdr (cdr custom-help-menu)))))
- (let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
- (define-key global-map [menu-bar help-menu customize-menu]
- (cons (car menu) map)))))
-
-;;; Dependencies.
+(defun customize-menu-create (symbol)
+ "Return a customize menu for customization group SYMBOL.
+The format is suitable for use with `easy-menu-define'."
+ (if (string-match "XEmacs" emacs-version)
+ ;; We can delay it under XEmacs.
+ `("Customize"
+ :filter (lambda (&rest junk)
+ (cdr (custom-menu-create ',symbol))))
+ ;; But we must create it now under Emacs.
+ (cons "Customize" (cdr (custom-menu-create symbol)))))
-;;;###autoload
-(defun custom-make-dependencies ()
- "Batch function to extract custom dependencies from .el files.
-Usage: emacs -batch *.el -f custom-make-dependencies > deps.el"
- (let ((buffers (buffer-list)))
- (while buffers
- (set-buffer (car buffers))
- (setq buffers (cdr buffers))
- (let ((file (buffer-file-name)))
- (when (and file (string-match "\\`\\(.*\\)\\.el\\'" file))
- (goto-char (point-min))
- (condition-case nil
- (let ((name (file-name-nondirectory (match-string 1 file))))
- (while t
- (let ((expr (read (current-buffer))))
- (when (and (listp expr)
- (memq (car expr) '(defcustom defface defgroup)))
- (eval expr)
- (put (nth 1 expr) 'custom-where name)))))
- (error nil))))))
- (mapatoms (lambda (symbol)
- (let ((members (get symbol 'custom-group))
- item where found)
- (when members
- (princ "(put '")
- (princ symbol)
- (princ " 'custom-loads '(")
- (while members
- (setq item (car (car members))
- members (cdr members)
- where (get item 'custom-where))
- (unless (or (null where)
- (member where found))
- (when found
- (princ " "))
- (prin1 where)
- (push where found)))
- (princ "))\n"))))))
+;;; The Custom Mode.
+
+(defvar custom-mode-map nil
+ "Keymap for `custom-mode'.")
+
+(unless custom-mode-map
+ (setq custom-mode-map (make-sparse-keymap))
+ (set-keymap-parent custom-mode-map widget-keymap)
+ (define-key custom-mode-map "q" 'bury-buffer))
+
+(easy-menu-define custom-mode-customize-menu
+ custom-mode-map
+ "Menu used in customization buffers."
+ (customize-menu-create 'customize))
+
+(easy-menu-define custom-mode-menu
+ custom-mode-map
+ "Menu used in customization buffers."
+ `("Custom"
+ ["Set" custom-set t]
+ ["Save" custom-save t]
+ ["Reset to Current" custom-reset-current t]
+ ["Reset to Saved" custom-reset-saved t]
+ ["Reset to Factory Settings" custom-reset-factory t]
+ ["Info" (Info-goto-node "(custom)The Customization Buffer") t]))
+
+(defcustom custom-mode-hook nil
+ "Hook called when entering custom-mode."
+ :type 'hook
+ :group 'customize)
+
+(defun custom-mode ()
+ "Major mode for editing customization buffers.
+
+The following commands are available:
+
+Move to next button or editable field. \\[widget-forward]
+Move to previous button or editable field. \\[widget-backward]
+Activate button under the mouse pointer. \\[widget-button-click]
+Activate button under point. \\[widget-button-press]
+Set all modifications. \\[custom-set]
+Make all modifications default. \\[custom-save]
+Reset all modified options. \\[custom-reset-current]
+Reset all modified or set options. \\[custom-reset-saved]
+Reset all options. \\[custom-reset-factory]
+
+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)
+ (easy-menu-add custom-mode-customize-menu)
+ (easy-menu-add custom-mode-menu)
+ (make-local-variable 'custom-options)
+ (run-hooks 'custom-mode-hook))
;;; The End.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.70
+;; Version: 1.82
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(color-instance-name (specifier-instance (face-foreground face) frame)))
(defalias 'custom-face-foreground 'face-foreground))
+(defalias 'custom-face-font-name (if (string-match "XEmacs" emacs-version)
+ 'face-font-name
+ 'face-font))
+
(eval-and-compile
(unless (fboundp 'frame-property)
- ;; XEmacs function missing in Emacs 19.34.
+ ;; XEmacs function missing in Emacs.
(defun frame-property (frame property &optional default)
"Return FRAME's value for property PROPERTY."
(or (cdr (assq property (frame-parameters frame)))
;; XEmacs function missing in Emacs.
(defun face-doc-string (face)
"Get the documentation string for FACE."
- (get face 'face-doc-string)))
+ (get face 'face-documentation)))
(unless (fboundp 'set-face-doc-string)
;; XEmacs function missing in Emacs.
(defun set-face-doc-string (face string)
"Set the documentation string for FACE to STRING."
- (put face 'face-doc-string string)))
-
- (when (and (not (fboundp 'set-face-stipple))
- (fboundp 'set-face-background-pixmap))
- ;; Emacs function missing in XEmacs 19.15.
- (defun set-face-stipple (face pixmap &optional frame)
- ;; Written by Kyle Jones.
- "Change the stipple pixmap of face FACE to PIXMAP.
-PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
-
-Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
-where WIDTH and HEIGHT are the size in pixels,
-and DATA is a string, containing the raw bits of the bitmap.
-
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
- (while (not (find-face face))
- (setq face (signal 'wrong-type-argument (list 'facep face))))
- (while (cond ((stringp pixmap)
- (unless (file-readable-p pixmap)
- (setq pixmap (vector 'xbm ':file pixmap)))
- nil)
- ((and (consp pixmap) (= (length pixmap) 3))
- (setq pixmap (vector 'xbm ':data pixmap))
- nil)
- (t t))
- (setq pixmap (signal 'wrong-type-argument
- (list 'stipple-pixmap-p pixmap))))
- (while (and frame (not (framep frame)))
- (setq frame (signal 'wrong-type-argument (list 'framep frame))))
- (set-face-background-pixmap face pixmap frame))))
+ (put face 'face-documentation string))))
(unless (fboundp 'x-color-values)
;; Emacs function missing in XEmacs 19.14.
(defconst custom-face-attributes
'((:bold (toggle :format "Bold: %[%v%]\n"
:help-echo "Control whether a bold font should be used.")
- custom-set-face-bold)
+ custom-set-face-bold
+ custom-face-bold)
(:italic (toggle :format "Italic: %[%v%]\n"
:help-echo "\
Control whether an italic font should be used.")
- custom-set-face-italic)
+ custom-set-face-italic
+ custom-face-italic)
(:underline (toggle :format "Underline: %[%v%]\n"
:help-echo "\
Control whether the text should be underlined.")
;; (custom-invert-face face frame)))
(:stipple (editable-field :format "Stipple: %v"
:help-echo "Name of background bitmap file.")
- set-face-stipple))
+ set-face-stipple custom-face-stipple))
"Alist of face attributes.
The elements are of the form (KEY TYPE SET GET) where KEY is a symbol
Each keyword should be listed in `custom-face-attributes'.
If FRAME is nil, use the default face."
+ (condition-case nil
+ ;; Attempt to get `font.el' from w3.
+ (require 'font)
+ (error nil))
(let ((atts custom-face-attributes)
att result get)
(while atts
(make-face-bold face frame)
(make-face-unbold face frame)))
+(defun custom-face-bold (face &rest args)
+ "Return non-nil if the font of FACE is bold."
+ (let* ((font (apply 'custom-face-font-name face args))
+ (fontobj (font-create-object font)))
+ (font-bold-p fontobj)))
+
(defun custom-set-face-italic (face value &optional frame)
"Set the italic property of FACE to VALUE."
(if value
(make-face-italic face frame)
(make-face-unitalic face frame)))
+(defun custom-face-italic (face &rest args)
+ "Return non-nil if the font of FACE is italic."
+ (let* ((font (apply 'custom-face-font-name face args))
+ (fontobj (font-create-object font)))
+ (font-italic-p fontobj)))
+
+(defun custom-face-stipple (face &rest args)
+ "Return the name of the stipple file used for FACE."
+ (if (string-match "XEmacs" emacs-version)
+ (let ((image (apply 'specifier-instance
+ (face-background-pixmap face) args)))
+ (when image
+ (image-instance-file-name image)))
+ (apply 'face-stipple face args)))
+
(when (string-match "XEmacs" emacs-version)
;; Support for special XEmacs font attributes.
(autoload 'font-create-object "font" nil)
- (unless (fboundp 'face-font-name)
- (defun face-font-name (face &rest args)
- (apply 'face-font face args)))
-
(defun custom-set-face-font-size (face size &rest args)
"Set the font of FACE to SIZE"
- (let* ((font (apply 'face-font-name face args))
+ (let* ((font (apply 'custom-face-font-name face args))
(fontobj (font-create-object font)))
(set-font-size fontobj size)
(apply 'font-set-face-font face fontobj args)))
+ (defun custom-face-font-size (face &rest args)
+ "Return the size of the font of FACE as a string."
+ (let* ((font (apply 'custom-face-font-name face args))
+ (fontobj (font-create-object font)))
+ (format "%d" (font-size fontobj))))
+
(defun custom-set-face-font-family (face family &rest args)
- "Set the font of FACE to FAMILY"
- (let* ((font (apply 'face-font-name face args))
+ "Set the font of FACE to FAMILY."
+ (let* ((font (apply 'custom-face-font-name face args))
(fontobj (font-create-object font)))
(set-font-family fontobj family)
(apply 'font-set-face-font face fontobj args)))
- (nconc custom-face-attributes
- '((:family (editable-field :format "Font Family: %v"
- :help-echo "\
+ (defun custom-face-font-family (face &rest args)
+ "Return the name of the font family of FACE."
+ (let* ((font (apply 'custom-face-font-name face args))
+ (fontobj (font-create-object font)))
+ (font-family fontobj)))
+
+ (setq custom-face-attributes
+ (append '((:family (editable-field :format "Font Family: %v"
+ :help-echo "\
Name of font family to use (e.g. times).")
- custom-set-face-font-family)
- (:size (editable-field :format "Size: %v"
- :help-echo "\
+ custom-set-face-font-family
+ custom-face-font-family)
+ (:size (editable-field :format "Size: %v"
+ :help-echo "\
Text size (e.g. 9pt or 2mm).")
- custom-set-face-font-size))))
+ custom-set-face-font-size
+ custom-face-font-size)
+ (:strikethru (toggle :format "Strikethru: %[%v%]\n"
+ :help-echo "\
+Control whether the text should be strikethru.")
+ set-face-strikethru-p
+ face-strikethru-p))
+ custom-face-attributes)))
;;; Frames.
(initialize-face-resources symbol frame))))
(face-list)))
+;;;###autoload
(defun custom-initialize-frame (&optional frame)
"Initialize local faces for FRAME if necessary.
If FRAME is missing or nil, the first member of (frame-list) is used."
(custom-get-frame-properties frame))
(custom-initialize-faces frame)))
-;; Enable. This should go away when bundled with Emacs.
-(unless (string-match "XEmacs" emacs-version)
- (add-hook 'after-make-frame-hook 'custom-initialize-frame))
-
;;; Initializing.
(and (fboundp 'make-face)
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.70
+;; Version: 1.82
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(define-widget-keywords :prefix :tag :load :link :options :type :group)
-;; These autoloads should be deleted when the file is added to Emacs
-
+;; These autoloads should be deleted eventually.
(unless (fboundp 'load-gc)
;; From cus-edit.el
(autoload 'customize "cus-edit" nil t)
(autoload 'customize-variable "cus-edit" nil t)
+ (autoload 'customize-variable-other-window "cus-edit" nil t)
(autoload 'customize-face "cus-edit" nil t)
+ (autoload 'customize-face-other-window "cus-edit" nil t)
(autoload 'customize-apropos "cus-edit" nil t)
(autoload 'customize-customized "cus-edit" nil t)
(autoload 'custom-buffer-create "cus-edit")
- (autoload 'custom-menu-update "cus-edit")
(autoload 'custom-make-dependencies "cus-edit")
+ (autoload 'customize-menu-create "cus-edit")
+
;; From cus-face.el
(autoload 'custom-declare-face "cus-face")
(autoload 'custom-set-faces "cus-face"))
+(defvar custom-define-hook nil
+ ;; Customize information for this option is in `cus-edit.el'.
+ "Hook called after defining each customize option.")
+
;;; The `defcustom' Macro.
(defun custom-declare-variable (symbol value doc &rest args)
"Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
- (unless (and (default-boundp symbol)
- (not (get symbol 'saved-value)))
+ ;; Bind this variable unless it already is bound.
+ (unless (default-boundp symbol)
+ ;; Use the saved value if it exists, otherwise the factory setting.
(set-default symbol (if (get symbol 'saved-value)
(eval (car (get symbol 'saved-value)))
(eval value))))
+ ;; Remember the factory setting.
(put symbol 'factory-value (list value))
+ ;; Maybe this option was rogue in an earlier version. It no longer is.
+ (when (get symbol 'force-value)
+ ;; It no longer is.
+ (put symbol 'force-value nil))
(when doc
(put symbol 'variable-documentation doc))
(while args
(value (nth 1 entry))
(now (nth 2 entry)))
(put symbol 'saved-value (list value))
- (when now
- (put symbol 'force-value t)
- (set-default symbol (eval value)))
+ (cond (now
+ ;; Rogue variable, set it now.
+ (put symbol 'force-value t)
+ (set-default symbol (eval value)))
+ ((default-boundp symbol)
+ ;; Something already set this, overwrite it.
+ (set-default symbol (eval value))))
(setq args (cdr args)))
;; Old format, a plist of SYMBOL VALUE pairs.
(let ((symbol (nth 0 args))
(put symbol 'saved-value (list value)))
(setq args (cdr (cdr args)))))))
-;;; Meta Customization
-
-(defcustom custom-define-hook nil
- "Hook called after defining each customize option."
- :group 'customize
- :type 'hook)
-
-;;; Menu support
-
-(defconst custom-help-menu
- `("Customize"
- ,(if (string-match "XEmacs" emacs-version)
- '("Emacs" :filter (lambda (&rest junk)
- (cdr (custom-menu-create 'emacs))))
- ["Update menu..." custom-menu-update t])
- ["Group..." customize t]
- ["Variable..." customize-variable t]
- ["Face..." customize-face t]
- ["Saved..." customize-customized t]
- ["Apropos..." customize-apropos t])
- "Customize menu")
-
-(defun custom-menu-reset ()
- "Reset customize menu."
- (remove-hook 'custom-define-hook 'custom-menu-reset)
- (if (string-match "XEmacs" emacs-version)
- (when (fboundp 'add-submenu)
- (add-submenu '("Options") custom-help-menu))
- (define-key global-map [menu-bar help-menu customize-menu]
- (cons (car custom-help-menu)
- (easy-menu-create-keymaps (car custom-help-menu)
- (cdr custom-help-menu))))))
-
-(if (string-match "XEmacs" emacs-version)
- (autoload 'custom-menu-create "cus-edit")
- (custom-menu-reset))
-
;;; The End.
(provide 'custom)
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
- (let ((b (point-min)))
- (while (setq b (text-property-any b (point-max) 'article-type type))
- (delete-region b (incf b))))))
+ (let ((e (point-min))
+ b)
+ (while (setq b (text-property-any e (point-max) 'article-type type))
+ (setq e (text-property-not-all b (point-max) 'article-type type))
+ (delete-region b e)))))
(defun gnus-article-delete-invisible-text ()
"Delete all invisible text in the current buffer."
(save-excursion
- (let ((b (point-min)))
- (while (setq b (text-property-any b (point-max) 'invisible t))
- (delete-region b (incf b))))))
+ (let ((e (point-min))
+ b)
+ (while (setq b (text-property-any e (point-max) 'invisible t))
+ (setq e (text-property-not-all b (point-max) 'invisible t))
+ (delete-region b e)))))
(defun gnus-article-text-type-exists-p (type)
"Say whether any text of type TYPE exists in the buffer."
;; All articles have to be subsets of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expirable reply save))
+ ((memq mark '(tick dormant expire reply save))
(while articles
(when (or (< (setq article (pop articles)) min) (> article max))
(set var (delq article (symbol-value var))))))
(run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info))
(gnus-close-group group)
- ;; Make sure where I was, and go to next newsgroup.
+ ;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
(gnus-group-jump-to-group group))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "5.4.43"
+(defconst gnus-version-number "5.4.44"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
(deffoo nnweb-request-scan (&optional group server)
(nnweb-possibly-change-server group server)
+ (setq nnweb-hashtb (gnus-make-hashtable 4095))
(funcall (nnweb-definition 'map))
(unless nnweb-ephemeral-p
(nnweb-write-active)
(nnheader-temp-write nil
(nnheader-insert-file-contents (nnweb-overview-file group))
(goto-char (point-min))
- (setq nnweb-hashtb (gnus-make-hashtable
- (count-lines (point-min) (point-max))))
(let (header)
(while (not (eobp))
(setq header (nnheader-parse-nov))
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 1.70
+;; Version: 1.82
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(unless widget-browse-mode-map
(setq widget-browse-mode-map (make-sparse-keymap))
- (set-keymap-parent widget-browse-mode-map widget-keymap))
+ (set-keymap-parent widget-browse-mode-map widget-keymap)
+ (define-key widget-browse-mode-map "q" 'bury-buffer))
+
+(easy-menu-define widget-browse-mode-customize-menu
+ widget-browse-mode-map
+ "Menu used in widget browser buffers."
+ (customize-menu-create 'widgets))
(easy-menu-define widget-browse-mode-menu
widget-browse-mode-map
(setq major-mode 'widget-browse-mode
mode-name "Widget")
(use-local-map widget-browse-mode-map)
+ (easy-menu-add widget-browse-mode-customize-menu)
(easy-menu-add widget-browse-mode-menu)
(run-hooks 'widget-browse-mode-hook))
(defvar widget-browse-history nil)
+;;;###autoload
(defun widget-browse (widget)
"Create a widget browser for WIDGET."
(interactive (list (completing-read "Widget: "
(widget-browse-mode)
;; Quick way to get out.
- (widget-create 'push-button
- :action (lambda (widget &optional event)
- (bury-buffer))
- "Quit")
- (widget-insert "\n")
+;; (widget-create 'push-button
+;; :action (lambda (widget &optional event)
+;; (bury-buffer))
+;; "Quit")
+;; (widget-insert "\n")
;; Top text indicating whether it is a class or object browser.
(if (listp widget)
(widget-setup)
(goto-char (point-min)))
+;;;###autoload
+(defun widget-browse-other-window (&optional widget)
+ "Show widget browser for WIDGET in other window."
+ (interactive)
+ (let ((window (selected-window)))
+ (switch-to-buffer-other-window "*Browse Widget*")
+ (if widget
+ (widget-browse widget)
+ (call-interactively 'widget-browse))
+ (select-window window)))
+
+
;;; The `widget-browse' Widget.
(define-widget 'widget-browse 'push-button
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
-;; Version: 1.70
+;; Version: 1.82
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(define-widget 'push-button 'item
"A pushable button."
:value-create 'widget-push-button-value-create
+ :text-format "[%s]"
:format "%[%v%]")
(defun widget-push-button-value-create (widget)
;; Insert text representing the `on' and `off' states.
(let* ((tag (or (widget-get widget :tag)
(widget-get widget :value)))
- (text (concat "[" tag "]"))
+ (text (format (widget-get widget :text-format) tag))
(gui (cdr (assoc tag widget-push-button-cache))))
(if (and (fboundp 'make-gui-button)
(fboundp 'make-glyph)
(defun widget-vector-match (widget value)
(and (vectorp value)
(widget-group-match widget
- (widget-apply :value-to-internal widget value))))
+ (widget-apply widget :value-to-internal value))))
(define-widget 'cons 'group
"A cons-cell."
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.70
+;; Version: 1.82
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
(set (car keywords) (car keywords)))
(setq keywords (cdr keywords)))))))
-(define-widget-keywords :deactivate :active :inactive :activate
- :sibling-args :delete-button-args
+(define-widget-keywords :text-format :deactivate :active :inactive
+ :activate :sibling-args :delete-button-args
:insert-button-args :append-button-args :button-args
:tag-glyph :off-glyph :on-glyph :valid-regexp
:secret :sample-face :sample-face-get :case-fold :widget-doc
(autoload 'widget-create "wid-edit")
(autoload 'widget-insert "wid-edit")
(autoload 'widget-browse "wid-browse" nil t)
+ (autoload 'widget-browse-other-window "wid-browse" nil t)
(autoload 'widget-browse-at "wid-browse" nil t))
(defun define-widget (name class doc &rest args)
+Sat Apr 12 00:26:47 1997 Francois Felix Ingrand <felix@laas.fr>
+
+ * gnus.texi (NoCeM): Addition.
+
Thu Apr 10 21:25:14 1997 Hrvoje Niksic <hniksic@srce.hr>
* gnus.texi (Emacs/XEmacs Code): Addition.
@comment node-name, next, previous, up
@top The Customization Library
-Version: 1.70
+Version: 1.82
@menu
* Introduction::
@comment node-name, next, previous, up
@section Declarations
+This section describes how to declare customization groups, variables,
+and faces. It doesn't contain any examples, but please look at the file
+@file{cus-edit.el} which contains many declarations you can learn from.
+
@menu
* Declaring Groups::
* Declaring Variables::
@item
Make it possible to append to `choice', `radio', and `set' options.
+@item
+Make it possible to customize code, for example to enable or disable a
+global minor mode.
+
@item
Ask whether set or modified variables should be saved in
@code{kill-buffer-hook}.
@samp{<jens@@lemming0.lem.uni-karlsruhe.de>}.@refill
@item
-Use @file{font.el} to extract font attributes from rogue faces.
+Empty customization groups should start open (harder than it looks).
@item
-Empty customization groups should start open (harder than it looks).
+Make it possible to include a comment/remark/annotation when saving an
+option.
@end itemize
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Gnus 5.4.43 Manual
+@settitle Gnus 5.4.44 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Gnus 5.4.43 Manual
+@title Gnus 5.4.44 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Gnus 5.4.43.
+This manual corresponds to Gnus 5.4.44.
@end ifinfo
function. If this is too slow and you don't care for verification
(which may be dangerous), you can set this variable to @code{nil}.
+If you want signed NoCeM messages to be verified and unsigned messages
+not to be verified (but used anyway), you could do something like:
+
+@lisp
+(setq gnus-nocem-verifyer 'my-gnus-mc-verify)
+
+(defun my-gnus-mc-verify ()
+ (not (eq 'forged
+ (ignore-errors
+ (if (mc-verify)
+ t
+ 'forged)))))
+@end lisp
+
+This might be dangerous, though.
+
@item gnus-nocem-directory
@vindex gnus-nocem-directory
This is where Gnus will store its NoCeM cache files. The default is
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Message 5.4.43 Manual
+@settitle Message 5.4.44 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Message 5.4.43 Manual
+@title Message 5.4.44 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Message 5.4.43. Message is distributed with
+This manual corresponds to Message 5.4.44. Message is distributed with
the Gnus distribution bearing the same version number as this manual
has.
\input texinfo.tex
-@c $Id: widget.texi,v 1.98 1997/04/02 16:26:18 abraham Exp $
-
@c %**start of header
@setfilename widget
@settitle The Emacs Widget Library
@comment node-name, next, previous, up
@top The Emacs Widget Library
-Version: 1.70
+Version: 1.82
@menu
* Introduction::
property. The value should be a string, which will be inserted in the
buffer.
+The following extra properties are recognized.
+
+@table @code
+@item :text-format
+The format string used when the push button cannot be displayed
+graphically. There are two escapes, @code{%s}, which must be present
+exactly once, will be substituted with the tag, and @code{%%} will be
+substituted with a singe @samp{%}.
+@end table
+
+By default the tag will be shown in brackets.
+
@node editable-field, text, push-button, Basic Types
@comment node-name, next, previous, up
@subsection The @code{editable-field} Widget
projects / gnus / commitdiff