;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,1999,2000,01,02,03,2004 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
(defgroup emulations nil
"Emulations of other editors."
+ :link '(custom-manual "(emacs)Emulation")
:group 'editing)
(defgroup mouse nil
"Interfacing to external utilities."
:group 'emacs)
-(defgroup bib nil
- "Code related to the `bib' bibliography processor."
- :tag "Bibliography"
- :group 'external)
-
(defgroup processes nil
"Process, subshell, compilation, and job control support."
:group 'external
(defgroup c nil
"Support for the C language and related languages."
+ :link '(custom-manual "(ccmode)")
:group 'languages)
(defgroup tools nil
(defgroup news nil
"Support for netnews reading and posting."
+ :link '(custom-manual "(gnus)")
:group 'applications)
(defgroup games nil
(defgroup i18n nil
"Internationalization and alternate character-set support."
+ :link '(custom-manual "(emacs)International")
:group 'environment
:group 'editing)
(defgroup customize '((widgets custom-group))
"Customization of the Customization support."
:link '(custom-manual "(elisp)Customization")
- :link '(url-link :tag "(Old?) Development Page"
- "http://www.dina.kvl.dk/~abraham/custom/")
:prefix "custom-"
:group 'help)
(defgroup abbrev-mode nil
"Word abbreviations mode."
+ :link '(custom-manual "(emacs)Abbrevs")
:group 'abbrev)
(defgroup alloc nil
(defgroup undo nil
"Undoing changes in buffers."
+ :link '(custom-manual "(emacs)Undo")
:group 'editing)
(defgroup modeline nil
"Content of the modeline."
:group 'environment)
-(defgroup fill nil
- "Indenting and filling text."
- :group 'editing)
-
(defgroup editing-basics nil
"Most basic editing facilities."
:group 'editing)
(defgroup minibuffer nil
"Controling the behaviour of the minibuffer."
+ :link '(custom-manual "(emacs)Minibuffer")
:group 'environment)
(defgroup keyboard nil
(defgroup windows nil
"Windows within a frame."
+ :link '(custom-manual "(emacs)Windows")
:group 'environment)
;;; Utilities.
(let ((name (format "*Customize Group: %s*"
(custom-unlispify-tag-name group))))
(if (get-buffer name)
- (let ((window (selected-window))
+ (let (
;; Copied from `custom-buffer-create-other-window'.
(pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (pop-to-buffer name)
- (select-window window))
+ (pop-to-buffer name))
(custom-buffer-create-other-window
(list (list group 'custom-group))
name
;;;###autoload
(defun customize-face (&optional face)
- "Customize SYMBOL, which should be a face name or nil.
-If SYMBOL is nil, customize all faces.
+ "Customize FACE, which should be a face name or nil.
+If FACE is nil, customize all faces.
Interactively, when point is on text which has a face specified,
-suggest to customized that face, if it's customizable."
+suggest to customize that face, if it's customizable."
(interactive
(list (read-face-name "Customize face" "all faces" t)))
(if (member face '(nil ""))
;;;###autoload
(defun customize-face-other-window (&optional face)
- "Show customization buffer for face SYMBOL in other window.
+ "Show customization buffer for face FACE in other window.
Interactively, when point is on text which has a face specified,
-suggest to customized that face, if it's customizable."
+suggest to customize that face, if it's customizable."
(interactive
(list (read-face-name "Customize face" "all faces" t)))
(if (member face '(nil ""))
(get symbol 'standard-value))))
(when (and cval ;Declared with defcustom.
(default-boundp symbol) ;Has a value.
- (not (equal (eval (car cval))
+ (not (equal (eval (car cval))
;; Which does not match customize.
(default-value symbol))))
(push (list symbol 'custom-variable) found)))))
;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from
;; the window.
(defun custom-bury-buffer (buffer)
- (bury-buffer))
+ (with-current-buffer buffer
+ (bury-buffer)))
(defcustom custom-buffer-done-function 'custom-bury-buffer
"*Function called to remove a Custom buffer when the user is done with it.
:type 'integer
:group 'custom-buffer)
+(defun custom-get-fresh-buffer (name)
+ "Get a fresh new buffer with name NAME.
+If the buffer already exist, clean it up to be like new.
+Beware: it's not quite like new. Good enough for custom, but maybe
+not for everybody."
+ ;; To be more complete, we should also kill all permanent-local variables,
+ ;; but it's not needed for custom.
+ (let ((buf (get-buffer name)))
+ (when (and buf (buffer-local-value 'buffer-file-name buf))
+ ;; This will check if the file is not saved.
+ (kill-buffer buf)
+ (setq buf nil))
+ (if (null buf)
+ (get-buffer-create name)
+ (with-current-buffer buf
+ (kill-all-local-variables)
+ (run-hooks 'kill-buffer-hook)
+ ;; Delete overlays before erasing the buffer so the overlay hooks
+ ;; don't get run spuriously when we erase the buffer.
+ (let ((ols (overlay-lists)))
+ (dolist (ol (nconc (car ols) (cdr ols)))
+ (delete-overlay ol)))
+ (erase-buffer)
+ buf))))
+
;;;###autoload
(defun custom-buffer-create (options &optional name description)
"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."
- (unless name (setq name "*Customization*"))
- (kill-buffer (get-buffer-create name))
- (pop-to-buffer (get-buffer-create name))
+ (pop-to-buffer (custom-get-fresh-buffer (or name "*Customization*")))
(custom-buffer-create-internal options description))
;;;###autoload
(defun custom-buffer-create-other-window (options &optional name description)
- "Create a buffer containing OPTIONS.
+ "Create a buffer containing OPTIONS, and display it in another window.
+The result includes selecting that window.
Optional NAME is the name of the buffer.
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."
(unless name (setq name "*Customization*"))
- (kill-buffer (get-buffer-create name))
- (let ((window (selected-window))
- (pop-up-windows t)
+ (let ((pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (pop-to-buffer (get-buffer-create name))
- (custom-buffer-create-internal options description)
- (select-window window)))
+ (pop-to-buffer (custom-get-fresh-buffer name))
+ (custom-buffer-create-internal options description)))
(defcustom custom-reset-button-menu nil
"If non-nil, only show a single reset button in customize buffers.
(unless group
(setq group 'emacs))
(let ((name "*Customize Browser*"))
- (kill-buffer (get-buffer-create name))
- (pop-to-buffer (get-buffer-create name)))
+ (pop-to-buffer (custom-get-fresh-buffer name)))
(custom-mode)
(widget-insert "\
Square brackets show active fields; type RET or click mouse-1
(custom-load-symbol (widget-value widget)))
(defun custom-unloaded-symbol-p (symbol)
- "Return non-nil if the dependencies of SYMBOL has not yet been loaded."
+ "Return non-nil if the dependencies of SYMBOL have not yet been loaded."
(let ((found nil)
(loads (get symbol 'custom-loads))
load)
found))
(defun custom-unloaded-widget-p (widget)
- "Return non-nil if the dependencies of WIDGET has not yet been loaded."
+ "Return non-nil if the dependencies of WIDGET have not yet been loaded."
(custom-unloaded-symbol-p (widget-value widget)))
(defun custom-toggle-hide (widget)
(type (widget-type widget))
(buttons (widget-get widget :buttons))
(start (point))
- found)
+ (parents nil))
(insert (or initial-string "Parent groups:"))
(mapatoms (lambda (symbol)
(let ((entry (assq name (get symbol 'custom-group))))
:tag (custom-unlispify-tag-name symbol)
symbol)
buttons)
- (setq found t)))))
- (widget-put widget :buttons buttons)
- (if found
- (insert "\n")
+ (setq parents (cons symbol parents))))))
+ (and (null (get name 'custom-links)) ;No links of its own.
+ (= (length parents) 1) ;A single parent.
+ (let* ((links (get (car parents) 'custom-links))
+ (many (> (length links) 2)))
+ (when links
+ (insert "\nParent documentation: ")
+ (while links
+ (push (widget-create-child-and-convert widget (car links))
+ buttons)
+ (setq links (cdr links))
+ (cond ((null links)
+ (insert ".\n"))
+ ((null (cdr links))
+ (if many
+ (insert ", and ")
+ (insert " and ")))
+ (t
+ (insert ", ")))))))
+ (if parents
+ (insert "\n")
(delete-region start (point)))
- found))
+ (widget-put widget :buttons buttons)
+ parents))
;;; The `custom-comment' Widget.
:group 'custom-buffer
:version "20.3")
+(defun custom-variable-documentation (variable)
+ "Return documentation of VARIABLE for use in Custom buffer.
+Normally just return the docstring. But if VARIABLE automatically
+becomes buffer local when set, append a message to that effect."
+ (if (and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
+ (concat (documentation-property variable 'variable-documentation)
+ "\n
+This variable automatically becomes buffer-local when set outside Custom.
+However, setting it through Custom sets the default value.")
+ (documentation-property variable 'variable-documentation)))
+
(define-widget 'custom-variable 'custom
"Customize variable."
:format "%v"
:help-echo "Set or reset this variable."
- :documentation-property 'variable-documentation
+ :documentation-property #'custom-variable-documentation
:custom-category 'option
:custom-state nil
:custom-menu 'custom-variable-menu-create
becomes the backup value, so you can get it again."
(let* ((symbol (widget-value widget))
(set (or (get symbol 'custom-set) 'set-default))
- (comment-widget (widget-get widget :comment-widget))
(value (get symbol 'saved-value))
(comment (get symbol 'saved-variable-comment)))
(cond ((or value comment)
The value that was current before this operation
becomes the backup value, so you can get it again."
(let* ((symbol (widget-value widget))
- (set (or (get symbol 'custom-set) 'set-default))
- (comment-widget (widget-get widget :comment-widget)))
+ (set (or (get symbol 'custom-set) 'set-default)))
(if (get symbol 'standard-value)
(progn
(custom-variable-backup-value widget)
(unless (widget-get widget :inactive)
(let ((tag (custom-face-edit-attribute-tag widget))
(from (copy-marker (widget-get widget :from)))
- (to (widget-get widget :to))
(value (widget-value widget))
(inhibit-read-only t)
(inhibit-modification-hooks t))
(widget-setup)))))
(defun custom-face-edit-delete (widget)
- "Remove widget from the buffer."
+ "Remove WIDGET from the buffer."
(let ((inactive (widget-get widget :inactive))
(inhibit-read-only t)
(inhibit-modification-hooks t))
Match frames with no color support.")
mono)))
(group :sibling-args (:help-echo "\
+The minimum number of colors the frame should support.")
+ (const :format "" min-colors)
+ (integer :tag "Minimum number of colors" ))
+ (group :sibling-args (:help-echo "\
Only match frames with the specified intensity.")
(const :format "\
Background brightness: "
"Set the state of WIDGET."
(let* ((symbol (widget-value widget))
(comment (get symbol 'face-comment))
- tmp temp)
- (widget-put widget :custom-state
- (cond ((progn
- (setq tmp (get symbol 'customized-face))
- (setq temp (get symbol 'customized-face-comment))
- (or tmp temp))
- (if (equal temp comment)
- 'set
- 'changed))
- ((progn
- (setq tmp (get symbol 'saved-face))
- (setq temp (get symbol 'saved-face-comment))
- (or tmp temp))
- (if (equal temp comment)
- 'saved
- 'changed))
- ((get symbol 'face-defface-spec)
- (if (equal comment nil)
- 'standard
- 'changed))
- (t
- 'rogue)))))
+ tmp temp
+ (state
+ (cond ((progn
+ (setq tmp (get symbol 'customized-face))
+ (setq temp (get symbol 'customized-face-comment))
+ (or tmp temp))
+ (if (equal temp comment)
+ 'set
+ 'changed))
+ ((progn
+ (setq tmp (get symbol 'saved-face))
+ (setq temp (get symbol 'saved-face-comment))
+ (or tmp temp))
+ (if (equal temp comment)
+ 'saved
+ 'changed))
+ ((get symbol 'face-defface-spec)
+ (if (equal comment nil)
+ 'standard
+ 'changed))
+ (t
+ 'rogue))))
+ ;; If the user called set-face-attribute to change the default
+ ;; for new frames, this face is "set outside of Customize".
+ (if (and (not (eq state 'rogue))
+ (get symbol 'face-modified))
+ (setq state 'changed))
+ (widget-put widget :custom-state state)))
(defun custom-face-action (widget &optional event)
"Show the menu for `custom-face' WIDGET.
(and (not (boundp symbol))
(not (eq (get symbol 'force-value)
'rogue))))))
- (comment (get symbol 'saved-variable-comment))
- sep)
+ (comment (get symbol 'saved-variable-comment)))
;; Check `requests'.
(dolist (request requests)
(when (and (symbolp request) (not (featurep request)))
(suppress-keymap custom-mode-map)
(define-key custom-mode-map " " 'scroll-up)
(define-key custom-mode-map "\177" 'scroll-down)
+ (define-key custom-mode-map "\C-x\C-s" 'Custom-save)
(define-key custom-mode-map "q" 'Custom-buffer-done)
(define-key custom-mode-map "u" 'Custom-goto-parent)
(define-key custom-mode-map "n" 'widget-forward)
(use-local-map custom-mode-map)
(easy-menu-add Custom-mode-menu)
(make-local-variable 'custom-options)
+ (make-local-variable 'custom-local-buffer)
(make-local-variable 'widget-documentation-face)
(setq widget-documentation-face 'custom-documentation-face)
(make-local-variable 'widget-button-face)
(provide 'cus-edit)
+;;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f
;;; cus-edit.el ends here
HCoop / bpt / emacs.git / blobdiff