-;;; custom-edit.el --- Tools for customization Emacs.
+;;; cus-edit.el --- Tools for customization Emacs.
;;
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
-;; Version: 1.38
+;; Version: 1.48
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;;; Commentary:
;;; Code:
(require 'custom)
-(require 'widget-edit)
+(require 'wid-edit)
(require 'easymenu)
(define-widget-keywords :custom-prefixes :custom-menu :custom-show
:custom-set :custom-save :custom-reset-current :custom-reset-saved
:custom-reset-factory)
+;;; Customization Groups.
+
+(defgroup emacs nil
+ "Customization of the One True Editor."
+ :link '(custom-manual "(emacs)Top"))
+
+;; Most of these groups are stolen from `finder.el',
+(defgroup editing nil
+ "Basic text editing facilities."
+ :group 'emacs)
+
+(defgroup abbrev nil
+ "Abbreviation handling, typing shortcuts, macros."
+ :tag "Abbreviations"
+ :group 'editing)
+
+(defgroup matching nil
+ "Various sorts of searching and matching."
+ :group 'editing)
+
+(defgroup emulations nil
+ "Emulations of other editors."
+ :group 'editing)
+
+(defgroup mouse nil
+ "Mouse support."
+ :group 'editing)
+
+(defgroup outlines nil
+ "Support for hierarchical outlining."
+ :group 'editing)
+
+(defgroup external 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
+ :group 'development)
+
+(defgroup programming nil
+ "Support for programming in other languages."
+ :group 'emacs)
+
+(defgroup languages nil
+ "Specialized modes for editing programming languages."
+ :group 'programming)
+
+(defgroup lisp nil
+ "Lisp support, including Emacs Lisp."
+ :group 'languages
+ :group 'development)
+
+(defgroup c nil
+ "Support for the C language and related languages."
+ :group 'languages)
+
+(defgroup tools nil
+ "Programming tools."
+ :group 'programming)
+
+(defgroup oop nil
+ "Support for object-oriented programming."
+ :group 'programming)
+
+(defgroup applications nil
+ "Applications written in Emacs."
+ :group 'emacs)
+
+(defgroup calendar nil
+ "Calendar and time management support."
+ :group 'applications)
+
+(defgroup mail nil
+ "Modes for electronic-mail handling."
+ :group 'applications)
+
+(defgroup news nil
+ "Support for netnews reading and posting."
+ :group 'applications)
+
+(defgroup games nil
+ "Games, jokes and amusements."
+ :group 'applications)
+
+(defgroup development nil
+ "Support for further development of Emacs."
+ :group 'emacs)
+
+(defgroup docs nil
+ "Support for Emacs documentation."
+ :group 'development)
+
+(defgroup extensions nil
+ "Emacs Lisp language extensions."
+ :group 'development)
+
+(defgroup internal nil
+ "Code for Emacs internals, build process, defaults."
+ :group 'development)
+
+(defgroup maint nil
+ "Maintenance aids for the Emacs development group."
+ :tag "Maintenance"
+ :group 'development)
+
+(defgroup environment nil
+ "Fitting Emacs with its environment."
+ :group 'emacs)
+
+(defgroup comm nil
+ "Communications, networking, remote access to files."
+ :tag "Communication"
+ :group 'environment)
+
+(defgroup hardware nil
+ "Support for interfacing with exotic hardware."
+ :group 'environment)
+
+(defgroup terminals nil
+ "Support for terminal types."
+ :group 'environment)
+
+(defgroup unix nil
+ "Front-ends/assistants for, or emulators of, UNIX features."
+ :group 'environment)
+
+(defgroup vms nil
+ "Support code for vms."
+ :group 'environment)
+
+(defgroup i18n nil
+ "Internationalization and alternate character-set support."
+ :group 'environment
+ :group 'editing)
+
+(defgroup frames nil
+ "Support for Emacs frames and window systems."
+ :group 'environment)
+
+(defgroup data nil
+ "Support editing files of data."
+ :group 'emacs)
+
+(defgroup wp nil
+ "Word processing."
+ :group 'emacs)
+
+(defgroup tex nil
+ "Code related to the TeX formatter."
+ :group 'wp)
+
+(defgroup faces nil
+ "Support for multiple fonts."
+ :group 'emacs)
+
+(defgroup hypermedia nil
+ "Support for links between text or other media types."
+ :group 'emacs)
+
+(defgroup help nil
+ "Support for on-line help systems."
+ :group 'emacs)
+
+(defgroup local nil
+ "Code local to your site."
+ :group 'emacs)
+
+(defgroup customize '((widgets custom-group))
+ "Customization of the Customization support."
+ :link '(custom-manual "(custom)Top")
+ :link '(url-link :tag "Development Page"
+ "http://www.dina.kvl.dk/~abraham/custom/")
+ :prefix "custom-"
+ :group 'help
+ :group 'faces)
+
;;; Utilities.
(defun custom-quote (sexp)
(custom-buffer-create (list (list symbol 'custom-variable))))
;;;###autoload
-(defun customize-face (symbol)
- "Customize FACE."
- (interactive (list (completing-read "Customize face: "
+(defun customize-face (&optional symbol)
+ "Customize SYMBOL, which should be a face name or nil.
+If SYMBOL is nil, customize all faces."
+ (interactive (list (completing-read "Customize face: (default all) "
obarray 'custom-facep)))
- (if (stringp symbol)
- (setq symbol (intern symbol)))
- (unless (symbolp symbol)
- (error "Should be a symbol %S" symbol))
- (custom-buffer-create (list (list symbol 'custom-face))))
+ (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
+ (let ((found nil))
+ (message "Looking for faces...")
+ (mapcar (lambda (symbol)
+ (setq found (cons (list symbol 'custom-face) found)))
+ (face-list))
+ (message "Creating customization buffer...")
+ (custom-buffer-create found))
+ (if (stringp symbol)
+ (setq symbol (intern symbol)))
+ (unless (symbolp symbol)
+ (error "Should be a symbol %S" symbol))
+ (custom-buffer-create (list (list symbol 'custom-face)))))
;;;###autoload
(defun customize-customized ()
:tag "Done"
:help-echo "Push me to bury the buffer."
:action (lambda (widget &optional event)
- (bury-buffer)))
+ (bury-buffer)
+ ;; Steal button release event.
+ (if (and (fboundp 'button-press-event-p)
+ (fboundp 'next-command-event))
+ ;; XEmacs
+ (and event
+ (button-press-event-p event)
+ (next-command-event))
+ ;; Emacs
+ (when (memq 'down (event-modifiers event))
+ (read-event)))))
(widget-insert "\n")
(widget-setup))
(default-value symbol)
(widget-get widget :value)))
tmp
- (state (cond ((and (setq tmp (get symbol 'customized-value))
- (not (condition-case nil
- (equal value (eval (car tmp)))
- (error nil))))
- 'set)
- ((and (setq tmp (get symbol 'saved-value))
- (not (condition-case nil
- (equal value (eval (car tmp)))
- (error nil))))
- 'saved)
+ (state (cond ((setq tmp (get symbol 'customized-value))
+ (if (condition-case nil
+ (equal value (eval (car tmp)))
+ (error nil))
+ 'set
+ 'changed))
+ ((setq tmp (get symbol 'saved-value))
+ (if (condition-case nil
+ (equal value (eval (car tmp)))
+ (error nil))
+ 'saved
+ 'changed))
((setq tmp (get symbol 'factory-value))
(if (condition-case nil
(equal value (eval (car tmp)))
(error nil))
'factory
- 'set))
+ 'changed))
(t 'rogue))))
(widget-put widget :custom-state state)))
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
- (answer (widget-choose (symbol-name (widget-get widget :value))
+ (answer (widget-choose (custom-unlispify-tag-name
+ (widget-get widget :value))
custom-variable-menu
event)))
(if answer
:format-handler 'custom-face-format-handler
:sample-face 'custom-face-tag-face
:help-echo "Push me to set or reset this face."
- :documentation-property 'face-documentation
+ :documentation-property '(lambda (face)
+ (get-face-documentation face))
:value-create 'custom-face-value-create
:action 'custom-face-action
:custom-set 'custom-face-set
(custom-redraw widget))
(let* ((completion-ignore-case t)
(symbol (widget-get widget :value))
- (answer (widget-choose (symbol-name symbol)
+ (answer (widget-choose (custom-unlispify-tag-name symbol)
custom-face-menu event)))
(if answer
(funcall answer widget)))))
(widget-put widget :custom-state 'unknown)
(custom-redraw widget))
(let* ((completion-ignore-case t)
- (answer (widget-choose (symbol-name (widget-get widget :value))
+ (answer (widget-choose (custom-unlispify-tag-name
+ (widget-get widget :value))
custom-group-menu
event)))
(if answer
;;; The End.
-(provide 'custom-edit)
+(provide 'cus-edit)
-;; custom-edit.el ends here
+;; cus-edit.el ends here
projects / gnus / blobdiff