cgit.sxemacs.org Git - gnus/blob - lisp/custom-edit.el

   1 ;;; custom-edit.el --- Tools for customization Emacs.
   2 ;;
   3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
   6 ;; Keywords: help, faces
   7 ;; Version: 1.12
   8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
   9
  10 ;;; Commentary:
  11 ;;
  12 ;; See `custom.el'.
  13
  14 ;;; Code:
  15
  16 (require 'custom)
  17 (require 'widget-edit)
  18 (require 'easymenu)
  19
  20 (define-widget-keywords :custom-menu :custom-show :custom-magic
  21   :custom-state :custom-level :custom-form
  22   :custom-apply :custom-set-default :custom-reset)
  23
  24 ;;; Utilities.
  25
  26 (defun custom-quote (sexp)
  27   "Quote SEXP iff it is not self quoting."
  28   (if (or (memq sexp '(t nil))
  29           (and (symbolp sexp)
  30                (eq (aref (symbol-name sexp) 0) ?:))
  31           (and (listp sexp)
  32                (memq (car sexp) '(lambda)))
  33           (stringp sexp)
  34           (numberp sexp))
  35       sexp
  36     (list 'quote sexp)))
  37
  38 (defun custom-split-regexp-maybe (regexp)
  39   "If REGEXP is a string, split it to a list at `\\|'.
  40 You can get the original back with from the result with:
  41   (mapconcat 'identity result \"\\|\")
  42
  43 IF REGEXP is not a string, return it unchanged."
  44   (if (stringp regexp)
  45       (let ((start 0)
  46             all)
  47         (while (string-match "\\\\|" regexp start)
  48           (setq all (cons (substring regexp start (match-beginning 0)) all)
  49                 start (match-end 0)))
  50         (nreverse (cons (substring regexp start) all)))
  51     regexp))
  52
  53 (defvar custom-prefix-list nil
  54   "List of prefixes that should be ignored by `custom-unlispify'")
  55
  56 (defcustom custom-unlispify-menu-entries t
  57   "Display menu entries as words instead of symbols if non nil."
  58   :group 'customize
  59   :type 'boolean)
  60
  61 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
  62   "Convert symbol into a menu entry."
  63   (cond ((not custom-unlispify-menu-entries)
  64          (symbol-name symbol))
  65         ((get symbol 'custom-tag)
  66          (if no-suffix
  67              (get symbol 'custom-tag)
  68            (concat (get symbol 'custom-tag) "...")))
  69         (t
  70          (save-excursion
  71            (set-buffer (get-buffer-create " *Custom-Work*"))
  72            (erase-buffer)
  73            (princ symbol (current-buffer))
  74            (goto-char (point-min))
  75            (let ((prefixes custom-prefix-list)
  76                  prefix)
  77              (while prefixes
  78                (setq prefix (car prefixes))
  79                (if (search-forward prefix (+ (point) (length prefix)) t)
  80                    (progn
  81                      (setq prefixes nil)
  82                      (delete-region (point-min) (point)))
  83                  (setq prefixes (cdr prefixes)))))
  84            (subst-char-in-region (point-min) (point-max) ?- ?\  t)
  85            (capitalize-region (point-min) (point-max))
  86            (unless no-suffix
  87              (goto-char (point-max))
  88              (insert "..."))
  89            (buffer-string)))))
  90
  91 ;;; The Custom Mode.
  92
  93 (defvar custom-options nil
  94   "Customization widgets in the current buffer.")
  95
  96 (defvar custom-mode-map nil
  97   "Keymap for `custom-mode'.")
  98
  99 (unless custom-mode-map
 100   (setq custom-mode-map (make-sparse-keymap))
 101   (set-keymap-parent custom-mode-map widget-keymap))
 102
 103 (easy-menu-define custom-mode-menu
 104     custom-mode-map
 105   "Menu used in customization buffers."
 106     '("Custom"
 107       ["Apply" custom-apply t]
 108       ["Set Default" custom-set-default t]
 109       ["Reset" custom-reset t]
 110       ["Save" custom-save t]))
 111
 112 (defcustom custom-mode-hook nil
 113   "Hook called when entering custom-mode."
 114   :type 'hook
 115   :group 'customize)
 116
 117 (defun custom-mode ()
 118   "Major mode for editing customization buffers.
 119
 120 The following commands are available:
 121
 122 \\[widget-forward]              Move to next button or editable field.
 123 \\[widget-backward]             Move to previous button or editable field.
 124 \\[widget-button-click]         Activate button under the mouse pointer.
 125 \\[widget-button-press]         Activate button under point.
 126 \\[custom-apply]                Apply all modifications.
 127 \\[custom-set-default]          Make all modifications default.
 128 \\[custom-reset]                Undo all modifications.
 129 \\[custom-save]                 Save defaults for future emacs sessions.
 130
 131 Entry to this mode calls the value of `custom-mode-hook'
 132 if that value is non-nil."
 133   (kill-all-local-variables)
 134   (setq major-mode 'custom-mode
 135         mode-name "Custom")
 136   (use-local-map custom-mode-map)
 137   (make-local-variable 'custom-options)
 138   (run-hooks 'custom-mode-hook))
 139
 140 ;;; Custom Mode Commands.
 141
 142 (defun custom-apply ()
 143   "Apply changes in all modified options."
 144   (interactive)
 145   (let ((children custom-options))
 146     (mapcar (lambda (child)
 147               (when (eq (widget-get child :custom-state) 'modified)
 148                 (widget-apply child :custom-apply)))
 149             children)))
 150
 151 (defun custom-set-default ()
 152   "Set default in all modified group members."
 153   (interactive)
 154   (let ((children custom-options))
 155     (mapcar (lambda (child)
 156               (when (eq (widget-get child :custom-state) 'modified)
 157                 (widget-apply child :custom-set-default)))
 158             children)))
 159
 160 (defun custom-reset ()
 161   "Reset all modified group members."
 162   (interactive)
 163   (let ((children custom-options))
 164     (mapcar (lambda (child)
 165               (when (eq (widget-get child :custom-state) 'modified)
 166                 (widget-apply child :custom-reset)))
 167             children)))
 168
 169 ;;; The Customize Commands
 170
 171 ;;;###autoload
 172 (defun customize (symbol)
 173   "Customize SYMBOL, which must be a customization group."
 174   (interactive (list (completing-read "Customize group: (default emacs) "
 175                                       obarray
 176                                       (lambda (symbol)
 177                                         (get symbol 'custom-group))
 178                                       t)))
 179
 180   (when (stringp symbol)
 181     (if (string-equal "" symbol)
 182         (setq symbol 'emacs)
 183       (setq symbol (intern symbol))))
 184   (custom-buffer-create (list (list symbol 'custom-group))))
 185
 186 ;;;###autoload
 187 (defun customize-variable (symbol)
 188   "Customize SYMBOL, which must be a variable."
 189   (interactive
 190    ;; Code stolen from `help.el'.
 191    (let ((v (variable-at-point))
 192          (enable-recursive-minibuffers t)
 193          val)
 194      (setq val (completing-read
 195                 (if v
 196                     (format "Customize variable (default %s): " v)
 197                   "Customize variable: ")
 198                 obarray 'boundp t))
 199      (list (if (equal val "")
 200                v (intern val)))))
 201   (custom-buffer-create (list (list symbol 'custom-variable))))
 202
 203 ;;;###autoload
 204 (defun customize-face (symbol)
 205   "Customize FACE."
 206   (interactive (list (completing-read "Customize face: "
 207                                       obarray 'custom-facep)))
 208   (if (stringp symbol)
 209       (setq symbol (intern symbol)))
 210   (unless (symbolp symbol)
 211     (error "Should be a symbol %S" symbol))
 212   (custom-buffer-create (list (list symbol 'custom-face))))
 213
 214 ;;;###autoload
 215 (defun customize-customized ()
 216   "Customize all already customized user options."
 217   (interactive)
 218   (let ((found nil))
 219     (mapatoms (lambda (symbol)
 220                 (and (get symbol 'saved-face)
 221                      (custom-facep symbol)
 222                      (setq found (cons (list symbol 'custom-face) found)))
 223                 (and (get symbol 'saved-value)
 224                      (boundp symbol)
 225                      (setq found
 226                            (cons (list symbol 'custom-variable) found)))))
 227     (if found
 228         (custom-buffer-create found)
 229       (error "No customized user options"))))
 230
 231 ;;;###autoload
 232 (defun customize-apropos (regexp &optional all)
 233   "Customize all user options matching REGEXP.
 234 If ALL (e.g., started with a prefix key), include options which are not
 235 user-settable."
 236   (interactive "sCustomize regexp: \nP")
 237   (let ((found nil))
 238     (mapatoms (lambda (symbol)
 239                 (when (string-match regexp (symbol-name symbol))
 240                   (when (get symbol 'custom-group)
 241                     (setq found (cons (list symbol 'custom-group) found)))
 242                   (when (custom-facep symbol)
 243                     (setq found (cons (list symbol 'custom-face) found)))
 244                   (when (and (boundp symbol)
 245                              (or (get symbol 'saved-value)
 246                                  (get symbol 'factory-value)
 247                                  (if all
 248                                      (get symbol 'variable-documentation)
 249                                    (user-variable-p symbol))))
 250                     (setq found
 251                           (cons (list symbol 'custom-variable) found))))))
 252     (if found
 253         (custom-buffer-create found)
 254       (error "No matches"))))
 255
 256 ;;;###autoload
 257 (defun custom-buffer-create (options)
 258   "Create a buffer containing OPTIONS.
 259 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
 260 SYMBOL is a customization option, and WIDGET is a widget for editing
 261 that option."
 262   (kill-buffer (get-buffer-create "*Customization*"))
 263   (switch-to-buffer (get-buffer-create "*Customization*"))
 264   (custom-mode)
 265   (widget-insert "This is a customization buffer.
 266 Push RET or click mouse-2 on the word ")
 267   (widget-create 'info-link
 268                  :tag "help"
 269                  :help-echo "Push me for help."
 270                  "(custom)The Customization Buffer")
 271   (widget-insert " for more information.\n\n")
 272   (setq custom-options
 273         (mapcar (lambda (entry)
 274                   (prog1
 275                       (if (> (length options) 1)
 276                           (widget-create (nth 1 entry)
 277                                          :value (nth 0 entry))
 278                         ;; If there is only one entry, don't hide it!
 279                         (widget-create (nth 1 entry)
 280                                        :custom-state 'unknown
 281                                        :value (nth 0 entry)))
 282                     (unless (eq (preceding-char) ?\n)
 283                       (widget-insert "\n"))
 284                     (widget-insert "\n")))
 285                 options))
 286   (mapcar 'custom-magic-reset custom-options)
 287   (widget-create 'push-button
 288                  :tag "Apply"
 289                  :help-echo "Push me to apply all modifications."
 290                  :action (lambda (widget &optional event)
 291                            (custom-apply)))
 292   (widget-insert " ")
 293   (widget-create 'push-button
 294                  :tag "Set Default"
 295                  :help-echo "Push me to make the modifications default."
 296                  :action (lambda (widget &optional event)
 297                            (custom-set-default)))
 298   (widget-insert " ")
 299   (widget-create 'push-button
 300                  :tag "Reset"
 301                  :help-echo "Push me to undo all modifications.."
 302                  :action (lambda (widget &optional event)
 303                            (custom-reset)))
 304   (widget-insert " ")
 305   (widget-create 'push-button
 306                  :tag "Save"
 307                  :help-echo "Push me to store the new defaults permanently."
 308                  :action (lambda (widget &optional event)
 309                            (custom-save)))
 310   (widget-insert "\n")
 311   (widget-setup))
 312
 313 ;;; Modification of Basic Widgets.
 314 ;;
 315 ;; We add extra properties to the basic widgets needed here.  This is
 316 ;; fine, as long as we are careful to stay within out own namespace.
 317 ;;
 318 ;; We want simple widgets to be displayed by default, but complex
 319 ;; widgets to be hidden.
 320
 321 (widget-put (get 'item 'widget-type) :custom-show t)
 322 (widget-put (get 'editable-field 'widget-type)
 323             :custom-show (lambda (widget value)
 324                            (let ((pp (pp-to-string value)))
 325                              (cond ((string-match "\n" pp)
 326                                     nil)
 327                                    ((> (length pp) 40)
 328                                     nil)
 329                                    (t t)))))
 330 (widget-put (get 'menu-choice 'widget-type) :custom-show t)
 331
 332 ;;; The `custom-manual' Widget.
 333
 334 (define-widget 'custom-manual 'info-link
 335   "Link to the manual entry for this customization option."
 336   :tag "Manual")
 337
 338 ;;; The `custom-magic' Widget.
 339
 340 (define-widget 'custom-magic 'item
 341   "Status feedback for customization option."
 342   :format "%[%v%]"
 343   :action 'widget-choice-item-action
 344   :value-create 'custom-magic-value-create)
 345
 346 (defface custom-invalid-face '((((class color))
 347                                 (:foreground "yellow" :background "red"))
 348                                (t
 349                                 (:bold t :italic t :underline t)))
 350   "Face used when the customize item is invalid.")
 351
 352 (defface custom-rogue-face '((((class color))
 353                               (:foreground "pink" :background "black"))
 354                              (t
 355                               (:underline t)))
 356   "Face used when the customize item is not defined for customization.")
 357
 358 (defface custom-modified-face '((((class color))
 359                                  (:foreground "white" :background "blue"))
 360                                 (t
 361                                  (:italic t :bold)))
 362   "Face used when the customize item has been modified.")
 363
 364 (defface custom-applied-face '((((class color))
 365                                 (:foreground "blue" :background "white"))
 366                                (t
 367                                 (:italic t)))
 368   "Face used when the customize item has been applied.")
 369
 370 (defface custom-saved-face '((t (:underline t)))
 371   "Face used when the customize item has been saved.")
 372
 373 (defcustom custom-magic-alist '((nil "#" underline)
 374                                 (unknown "?" italic)
 375                                 (hidden "-" default)
 376                                 (invalid "x" custom-invalid-face)
 377                                 (modified "*" custom-modified-face)
 378                                 (applied "+" custom-applied-face)
 379                                 (saved "!" custom-saved-face)
 380                                 (rogue "@" custom-rogue-face)
 381                                 (factory " " nil))
 382   "Alist of magic representing a customize items status.
 383 Each entry is of the form (STATE MAGIC FACE), where
 384
 385 STATE is one of the following symbols:
 386
 387 `nil'
 388    For internal use, should never occur.
 389 `unknown'
 390    For internal use, should never occur.
 391 `hidden'
 392    This item is not being displayed.
 393 `invalid'
 394    This item is modified, but has an invalid form.
 395 `modified'
 396    This item is modified, and has a valid form.
 397 `applied'
 398    This items current value has been changed temporarily.
 399 `saved'
 400    This item is marked for saving.
 401 `rogue'
 402    This item has no customization information.
 403 `factory'
 404    This item is unchanged from the factory default.
 405
 406 MAGIC is a string used to present that state.
 407
 408 FACE is a face used to present the state.
 409
 410 The list should be sorted most significant first."
 411   :type '(repeat (list (choice (const nil)
 412                                (const unknown)
 413                                (const hidden)
 414                                (const invalid)
 415                                (const modified)
 416                                (const applied)
 417                                (const saved)
 418                                (const rogue)
 419                                (const factory))
 420                        string face))
 421   :group 'customize)
 422
 423 (defun custom-magic-value-create (widget)
 424   ;; Create compact status report for WIDGET.
 425   (let* ((parent (widget-get widget :parent))
 426          (state (widget-get parent :custom-state))
 427          (entry (assq state custom-magic-alist))
 428          (magic (nth 1 entry))
 429          (face (nth 2 entry)))
 430     (if (eq (widget-get parent :custom-form) 'lisp)
 431         (widget-insert "(" magic ")")
 432       (widget-insert "[" magic "]"))
 433     (widget-put widget :button-face face)))
 434
 435 (defun custom-magic-reset (widget)
 436   "Redraw the :custom-magic property of WIDGET."
 437   (let ((magic (widget-get widget :custom-magic)))
 438     (widget-value-set magic (widget-value magic))))
 439
 440 ;;; The `custom-level' Widget.
 441
 442 (define-widget 'custom-level 'item
 443   "The custom level buttons."
 444   :format "%[%t%]"
 445   :help-echo "Push me to expand or collapse this item."
 446   :action 'custom-level-action)
 447
 448 (defun custom-level-action (widget &optional event)
 449   "Toggle visibility for parent to WIDGET."
 450   (let* ((parent (widget-get widget :parent))
 451          (state (widget-get parent :custom-state)))
 452     (cond ((memq state '(invalid modified))
 453            (error "There are unapplied changes"))
 454           ((eq state 'hidden)
 455            (widget-put parent :custom-state 'unknown))
 456           (t
 457            (widget-put parent :custom-state 'hidden)))
 458     (custom-redraw parent)))
 459
 460 ;;; The `custom' Widget.
 461
 462 (defvar custom-save-needed-p nil
 463   "Non-nil if any customizations need to be saved.")
 464
 465 (add-hook 'kill-emacs-hook 'custom-save-maybe)
 466
 467 (defun custom-save-maybe ()
 468   (and custom-save-needed-p
 469        (y-or-n-p "You have unsaved customizations, save them now? ")
 470        (custom-save)))
 471
 472 (define-widget 'custom 'default
 473   "Customize a user option."
 474   :convert-widget 'widget-item-convert-widget
 475   :format "%l%[%t%]: %v%m %h%a"
 476   :format-handler 'custom-format-handler
 477   :notify 'custom-notify
 478   :custom-level 1
 479   :custom-state 'hidden
 480   :documentation-property 'widget-subclass-responsibility
 481   :value-create 'widget-subclass-responsibility
 482   :value-delete 'widget-children-value-delete
 483   :value-get 'widget-item-value-get
 484   :validate 'widget-editable-list-validate
 485   :match (lambda (widget value) (symbolp value)))
 486
 487 (defun custom-format-handler (widget escape)
 488   ;; We recognize extra escape sequences.
 489   (let* ((buttons (widget-get widget :buttons))
 490          (state (widget-get widget :custom-state))
 491          (level (widget-get widget :custom-level)))
 492     (cond ((eq escape ?l)
 493            (when level
 494              (push (widget-create-child-and-convert
 495                     widget 'custom-level (make-string level ?*))
 496                    buttons)
 497              (widget-insert " ")
 498              (widget-put widget :buttons buttons)))
 499           ((eq escape ?L)
 500              (push (widget-create-child-and-convert
 501                     widget 'custom-level
 502                     :format "%[%t%]"
 503                     (if (eq state 'hidden) "show" "hide"))
 504                    buttons)
 505              (widget-insert " ")
 506              (widget-put widget :buttons buttons))
 507           ((eq escape ?m)
 508            (and (eq (preceding-char) ?\n)
 509                 (widget-get widget :indent)
 510                 (insert-char ?  (widget-get widget :indent)))
 511            (let ((magic (widget-create-child-and-convert
 512                          widget 'custom-magic nil)))
 513              (widget-put widget :custom-magic magic)
 514              (push magic buttons)
 515              (widget-put widget :buttons buttons)))
 516           ((eq escape ?a)
 517            (let* ((symbol (widget-get widget :value))
 518                   (links (get symbol 'custom-links))
 519                   (many (> (length links) 2)))
 520              (when links
 521                (and (eq (preceding-char) ?\n)
 522                     (widget-get widget :indent)
 523                     (insert-char ?  (widget-get widget :indent)))
 524                (insert "See also ")
 525                (while links
 526                  (push (widget-create-child-and-convert widget (car links))
 527                        buttons)
 528                  (setq links (cdr links))
 529                  (cond ((null links)
 530                         (insert ".\n"))
 531                        ((null (cdr links))
 532                         (if many
 533                             (insert ", and ")
 534                           (insert " and ")))
 535                        (t
 536                         (insert ", "))))
 537                (widget-put widget :buttons buttons))))
 538           (t
 539            (widget-default-format-handler widget escape)))))
 540
 541 (defun custom-notify (widget &rest args)
 542   "Keep track of changes."
 543   (widget-put widget :custom-state 'modified)
 544   (let ((buffer-undo-list t))
 545     (custom-magic-reset widget))
 546   (apply 'widget-default-notify widget args))
 547
 548 (defun custom-redraw (widget)
 549   "Redraw WIDGET with current settings."
 550   (widget-value-set widget (widget-value widget))
 551   (custom-redraw-magic widget))
 552
 553 (defun custom-redraw-magic (widget)
 554   "Redraw WIDGET state with current settings."
 555   (while widget
 556     (let ((magic (widget-get widget :custom-magic)))
 557       (unless magic
 558         (debug))
 559       (widget-value-set magic (widget-value magic))
 560       (when (setq widget (widget-get widget :group))
 561         (custom-group-state-update widget))))
 562   (widget-setup))
 563
 564 (defun custom-show (widget value)
 565   "Non-nil if WIDGET should be shown with VALUE by default."
 566   (let ((show (widget-get widget :custom-show)))
 567     (cond ((null show)
 568            nil)
 569           ((eq t show)
 570            t)
 571           (t
 572            (funcall show widget value)))))
 573
 574 (defun custom-load-symbol (symbol)
 575   "Load all dependencies for SYMBOL."
 576   (let ((loads (get symbol 'custom-loads))
 577         load)
 578     (while loads
 579       (setq load (car loads)
 580             loads (cdr loads))
 581       (cond ((symbolp load)
 582              (require load))
 583             ((member load load-history))
 584             (t
 585              (load-library load))))))
 586
 587 (defun custom-load-widget (widget)
 588   "Load all dependencies for WIDGET."
 589   (custom-load-symbol (widget-value widget)))
 590
 591 ;;; The `custom-variable' Widget.
 592
 593 (define-widget 'custom-variable 'custom
 594   "Customize variable."
 595   :format "%l%v%m %h%a"
 596   :help-echo "Push me to set or reset this variable."
 597   :documentation-property 'variable-documentation
 598   :custom-state nil
 599   :custom-menu 'custom-variable-menu-create
 600   :custom-form 'edit
 601   :value-create 'custom-variable-value-create
 602   :action 'custom-variable-action
 603   :custom-apply 'custom-variable-apply
 604   :custom-set-default 'custom-variable-set-default
 605   :custom-reset 'custom-redraw)
 606
 607 (defun custom-variable-value-create (widget)
 608   "Here is where you edit the variables value."
 609   (custom-load-widget widget)
 610   (let* ((buttons (widget-get widget :buttons))
 611          (children (widget-get widget :children))
 612          (form (widget-get widget :custom-form))
 613          (state (widget-get widget :custom-state))
 614          (symbol (widget-get widget :value))
 615          (options (get symbol 'custom-options))
 616          (child-type (or (get symbol 'custom-type) 'sexp))
 617          (type (let ((tmp (if (listp child-type)
 618                               (copy-list child-type)
 619                             (list child-type))))
 620                  (when options
 621                    (widget-put tmp :options options))
 622                  tmp))
 623          (conv (widget-convert type))
 624          (value (if (default-boundp symbol)
 625                     (default-value symbol)
 626                   (widget-get conv :value))))
 627     ;; If the widget is new, the child determine whether it is hidden.
 628     (cond (state)
 629           ((custom-show type value)
 630            (setq state 'unknown))
 631           (t
 632            (setq state 'hidden)))
 633     ;; If we don't know the state, see if we need to edit it in lisp form.
 634     (when (eq state 'unknown)
 635       (unless (widget-apply conv :match value)
 636         ;; (widget-apply (widget-convert type) :match value)
 637         (setq form 'lisp)))
 638     ;; Now we can create the child widget.
 639     (cond ((eq state 'hidden)
 640            ;; Make hidden value easy to show.
 641            (push (widget-create-child-and-convert
 642                   widget 'custom-level
 643                   :tag (symbol-name symbol)
 644                   :format "%t: %[show%]")
 645                  buttons))
 646           ((eq form 'lisp)
 647            ;; In lisp mode edit the saved value when possible.
 648            (let* ((value (cond ((get symbol 'saved-value)
 649                                 (car (get symbol 'saved-value)))
 650                                ((get symbol 'factory-value)
 651                                 (car (get symbol 'factory-value)))
 652                                ((default-boundp symbol)
 653                                 (custom-quote (default-value symbol)))
 654                                (t
 655                                 (custom-quote (widget-get conv :value))))))
 656              (push (widget-create-child-and-convert widget 'sexp
 657                                                     :tag (symbol-name symbol)
 658                                                     :parent widget
 659                                                     :value value)
 660                    children)))
 661           (t
 662            ;; Edit mode.
 663
 664            (push (widget-create-child-and-convert widget type
 665                                                   :tag (symbol-name symbol)
 666                                                   :value value)
 667                  children)))
 668     ;; Now update the state.
 669     (unless (eq (preceding-char) ?\n)
 670       (widget-insert "\n"))
 671     (if (eq state 'hidden)
 672         (widget-put widget :custom-state state)
 673       (custom-variable-state-set widget))
 674     (widget-put widget :custom-form form)
 675     (widget-put widget :buttons buttons)
 676     (widget-put widget :children children)))
 677
 678 (defun custom-variable-state-set (widget)
 679   "Set the state of WIDGET."
 680   (let* ((symbol (widget-value widget))
 681          (value (if (default-boundp symbol)
 682                     (default-value symbol)
 683                   (widget-get widget :value)))
 684          (state (if (get symbol 'saved-value)
 685                     (if (condition-case nil
 686                             (equal value
 687                                    (eval (car (get symbol 'saved-value))))
 688                           (error nil))
 689                         'saved
 690                       'applied)
 691                   (if (get symbol 'factory-value)
 692                       (if (condition-case nil
 693                               (equal value
 694                                      (eval (car (get symbol 'factory-value))))
 695                             (error nil))
 696                           'factory
 697                         'applied)
 698                     'rogue))))
 699     (widget-put widget :custom-state state)))
 700
 701 (defvar custom-variable-menu
 702   '(("Edit" . custom-variable-edit)
 703     ("Edit Default" . custom-variable-edit-lisp)
 704     ("Apply" . custom-variable-apply)
 705     ("Set Default" . custom-variable-set-default)
 706     ("Reset" . custom-redraw)
 707     ("Reset to Default" . custom-variable-default)
 708     ("Reset to Factory Settings" . custom-variable-factory))
 709   "Alist of actions for the `custom-variable' widget.
 710 The key is a string containing the name of the action, the value is a
 711 lisp function taking the widget as an element which will be called
 712 when the action is chosen.")
 713
 714 (defun custom-variable-action (widget &optional event)
 715   "Show the menu for `custom-variable' WIDGET.
 716 Optional EVENT is the location for the menu."
 717   (let* ((completion-ignore-case t)
 718          (answer (widget-choose (symbol-name (widget-get widget :value))
 719                                 custom-variable-menu
 720                                 event)))
 721     (if answer
 722         (funcall answer widget))))
 723
 724 (defun custom-variable-edit (widget)
 725   "Edit value of WIDGET."
 726   (widget-put widget :custom-state 'unknown)
 727   (widget-put widget :custom-form 'edit)
 728   (custom-redraw widget))
 729
 730 (defun custom-variable-edit-lisp (widget)
 731   "Edit the lisp representation of the value of WIDGET."
 732   (widget-put widget :custom-state 'unknown)
 733   (widget-put widget :custom-form 'lisp)
 734   (custom-redraw widget))
 735
 736 (defun custom-variable-apply (widget)
 737   "Set the current value for the variable being edited by WIDGET."
 738   (let ((form (widget-get widget :custom-form))
 739         (state (widget-get widget :custom-state))
 740         (child (car (widget-get widget :children)))
 741         (symbol (widget-value widget))
 742         val)
 743     (cond ((eq state 'hidden)
 744            (error "Cannot apply hidden variable."))
 745           ((setq val (widget-apply child :validate))
 746            (error "Invalid %S" val))
 747           ((eq form 'lisp)
 748            (set symbol (eval (widget-value child))))
 749           (t
 750            (set symbol (widget-value child))))
 751     (custom-variable-state-set widget)
 752     (custom-redraw-magic widget)))
 753
 754 (defun custom-variable-set-default (widget)
 755   "Set the default value for the variable being edited by WIDGET."
 756   (let ((form (widget-get widget :custom-form))
 757         (state (widget-get widget :custom-state))
 758         (child (car (widget-get widget :children)))
 759         (symbol (widget-value widget))
 760         val)
 761     (cond ((eq state 'hidden)
 762            (error "Cannot apply hidden variable."))
 763           ((setq val (widget-apply child :validate))
 764            (error "Invalid %S" val))
 765           ((eq form 'lisp)
 766            (setq custom-save-needed-p (cons symbol custom-save-needed-p))
 767            (put symbol 'saved-value (list (widget-value child)))
 768            (set symbol (eval (widget-value child))))
 769           (t
 770            (setq custom-save-needed-p (cons symbol custom-save-needed-p))
 771            (put symbol
 772                 'saved-value (list (custom-quote (widget-value
 773                                                   child))))
 774            (set symbol (widget-value child))))
 775     (custom-variable-state-set widget)
 776     (custom-redraw-magic widget)))
 777
 778 (defun custom-variable-default (widget)
 779   "Restore the default value for the variable being edited by WIDGET."
 780   (let ((symbol (widget-value widget)))
 781     (if (get symbol 'saved-value)
 782         (condition-case nil
 783             (set symbol (eval (car (get symbol 'saved-value))))
 784           (error nil))
 785       (error "No default value for %s" symbol))
 786     (widget-put widget :custom-state 'unknown)
 787     (custom-redraw widget)))
 788
 789 (defun custom-variable-factory (widget)
 790   "Restore the factory setting for the variable being edited by WIDGET."
 791   (let ((symbol (widget-value widget)))
 792     (if (get symbol 'factory-value)
 793         (set symbol (eval (car (get symbol 'factory-value))))
 794       (error "No factory default for %S" symbol))
 795     (when (get symbol 'saved-value)
 796       (setq custom-save-needed-p (cons symbol custom-save-needed-p))
 797       (put symbol 'saved-value nil))
 798     (widget-put widget :custom-state 'unknown)
 799     (custom-redraw widget)))
 800
 801 ;;; The `custom-face-edit' Widget.
 802
 803 (defvar custom-face-edit-args
 804   (mapcar (lambda (att)
 805             (list 'group
 806                   :inline t
 807                   (list 'const :format "" :value (nth 0 att))
 808                   (nth 1 att)))
 809           custom-face-attributes))
 810
 811 (define-widget 'custom-face-edit 'checklist
 812   "Edit face attributes."
 813   :format "%t: %v"
 814   :tag "Attributes"
 815   :extra-offset 12
 816   :args (mapcar (lambda (att)
 817                   (list 'group
 818                         :inline t
 819                         (list 'const :format "" :value (nth 0 att))
 820                         (nth 1 att)))
 821                 custom-face-attributes))
 822
 823 ;;; The `custom-display' Widget.
 824
 825 (define-widget 'custom-display 'menu-choice
 826   "Select a display type."
 827   :tag "Display"
 828   :value t
 829   :args '((const :tag "all" t)
 830           (checklist :offset 0
 831                      :extra-offset 9
 832                      :args ((group (const :format "Type: " type)
 833                                    (checklist :inline t
 834                                               :offset 0
 835                                               (const :format "X "
 836                                                      x)
 837                                               (const :format "TTY%n"
 838                                                      tty)))
 839                             (group (const :format "Class: " class)
 840                                    (checklist :inline t
 841                                               :offset 0
 842                                               (const :format "Color "
 843                                                      color)
 844                                               (const :format
 845                                                      "Grayscale "
 846                                                      grayscale)
 847                                               (const :format "Monochrome%n"
 848                                                      mono)))
 849                             (group  (const :format "Background: " background)
 850                                     (checklist :inline t
 851                                                :offset 0
 852                                                (const :format "Light "
 853                                                       light)
 854                                                (const :format "Dark\n"
 855                                                       dark)))))))
 856
 857 ;;; The `custom-face' Widget.
 858
 859 (define-widget 'custom-face 'custom
 860   "Customize face."
 861   :format "%l%[%t%]: %s%m %h%a%v"
 862   :format-handler 'custom-face-format-handler
 863   :help-echo "Push me to set or reset this face."
 864   :documentation-property 'face-documentation
 865   :value-create 'custom-face-value-create
 866   :action 'custom-face-action
 867   :custom-apply 'custom-face-apply
 868   :custom-set-default 'custom-face-set-default
 869   :custom-reset 'custom-redraw
 870   :custom-menu 'custom-face-menu-create)
 871
 872 (defun custom-face-format-handler (widget escape)
 873   ;; We recognize extra escape sequences.
 874   (let (child
 875         (state (widget-get widget :custom-state))
 876         (symbol (widget-get widget :value)))
 877     (cond ((eq escape ?s)
 878            (and (string-match "XEmacs" emacs-version)
 879                 ;; XEmacs cannot display initialized faces.
 880                 (not (custom-facep symbol))
 881                 (copy-face 'custom-face-empty symbol))
 882            (setq child (widget-create-child-and-convert
 883                         widget 'custom-level
 884                         :format "(%[%t%])\n"
 885                         :button-face symbol
 886                         (if (eq state 'hidden) "show" "hide"))))
 887           (t
 888            (custom-format-handler widget escape)))
 889     (when child
 890       (widget-put widget
 891                   :buttons (cons child (widget-get widget :buttons))))))
 892
 893 (defun custom-face-value-create (widget)
 894   ;; Create a list of the display specifications.
 895   (unless (eq (preceding-char) ?\n)
 896     (insert "\n"))
 897   (when (not (eq (widget-get widget :custom-state) 'hidden))
 898     (custom-load-widget widget)
 899     (let* ((symbol (widget-value widget))
 900            (edit (widget-create-child-and-convert
 901                   widget 'editable-list
 902                   :entry-format "%i %d %v"
 903                   :value (or (get symbol 'saved-face)
 904                              (get symbol 'factory-face))
 905                   '(group :format "%v"
 906                           custom-display custom-face-edit))))
 907       (custom-face-state-set widget)
 908       (widget-put widget :children (list edit)))))
 909
 910 (defvar custom-face-menu
 911   '(("Apply" . custom-face-apply)
 912     ("Set Default" . custom-face-set-default)
 913     ("Reset to Default" . custom-face-default)
 914     ("Reset to Factory Setting" . custom-face-factory))
 915   "Alist of actions for the `custom-face' widget.
 916 The key is a string containing the name of the action, the value is a
 917 lisp function taking the widget as an element which will be called
 918 when the action is chosen.")
 919
 920 (defun custom-face-state-set (widget)
 921   "Set the state of WIDGET."
 922   (let ((symbol (widget-value widget)))
 923     (widget-put widget :custom-state (cond ((get symbol 'saved-face)
 924                                             'saved)
 925                                            ((get symbol 'factory-face)
 926                                             'factory)
 927                                            (t
 928                                             'rogue)))))
 929
 930 (defun custom-face-action (widget &optional event)
 931   "Show the menu for `custom-face' WIDGET.
 932 Optional EVENT is the location for the menu."
 933   (when (eq (widget-get widget :custom-state) 'hidden)
 934     (error "You cannot edit a hidden face"))
 935   (let* ((completion-ignore-case t)
 936          (symbol (widget-get widget :value))
 937          (answer (widget-choose (symbol-name symbol) custom-face-menu event)))
 938     (if answer
 939         (funcall answer widget))))
 940
 941 (defun custom-face-apply (widget)
 942   "Make the face attributes in WIDGET take effect."
 943   (let* ((symbol (widget-value widget))
 944          (child (car (widget-get widget :children)))
 945          (value (widget-value child)))
 946     (custom-face-display-set symbol value)
 947     (custom-face-state-set widget)
 948     (custom-redraw-magic widget)))
 949
 950 (defun custom-face-set-default (widget)
 951   "Make the face attributes in WIDGET default."
 952   (let* ((symbol (widget-value widget))
 953          (child (car (widget-get widget :children)))
 954          (value (widget-value child)))
 955     (custom-face-display-set symbol value)
 956     (put symbol 'saved-face value)
 957     (custom-face-state-set widget)
 958     (custom-redraw-magic widget)))
 959
 960 (defun custom-face-default (widget)
 961   "Restore WIDGET to the face's default attributes."
 962   (let* ((symbol (widget-value widget))
 963          (child (car (widget-get widget :children)))
 964          (value (get symbol 'saved-face)))
 965     (unless value
 966       (error "No saved value for this face")
 967       (custom-face-display-set symbol value)
 968     (widget-value-set child value)
 969     (custom-face-state-set widget)
 970     (custom-redraw-magic widget))))
 971
 972 (defun custom-face-factory (widget)
 973   "Restore WIDGET to the face's factory settings."
 974   (let* ((symbol (widget-value widget))
 975          (child (car (widget-get widget :children)))
 976          (value (get symbol 'factory-face)))
 977     (unless value
 978       (error "No factory default for this face"))
 979     (when (get symbol 'saved-face)
 980       (put symbol 'saved-face nil))
 981     (custom-face-display-set symbol value)
 982     (widget-value-set child value)
 983     (custom-face-state-set widget)
 984     (custom-redraw-magic widget)))
 985
 986 ;;; The `face' Widget.
 987
 988 (define-widget 'face 'default
 989   "Select and customize a face."
 990   :convert-widget 'widget-item-convert-widget
 991   :format "%[%t%]: %v"
 992   :tag "Face"
 993   :value 'default
 994   :value-create 'widget-face-value-create
 995   :value-delete 'widget-face-value-delete
 996   :value-get 'widget-item-value-get
 997   :validate 'widget-editable-list-validate
 998   :action 'widget-face-action
 999   :match '(lambda (widget value) (symbolp value)))
1000
1001 (defun widget-face-value-create (widget)
1002   ;; Create a `custom-face' child.
1003   (let* ((symbol (widget-value widget))
1004          (child (widget-create-child-and-convert
1005                  widget 'custom-face
1006                  :format "%t %s%m %h%v"
1007                  :custom-level nil
1008                  :value symbol)))
1009     (custom-magic-reset child)
1010     (setq custom-options (cons child custom-options))
1011     (widget-put widget :children (list child))))
1012
1013 (defun widget-face-value-delete (widget)
1014   ;; Remove the child from the options.
1015   (let ((child (car (widget-get widget :children))))
1016     (setq custom-options (delq child custom-options))
1017     (widget-children-value-delete widget)))
1018
1019 (defvar face-history nil
1020   "History of entered face names.")
1021
1022 (defun widget-face-action (widget &optional event)
1023   "Prompt for a face."
1024   (let ((answer (completing-read "Face: "
1025                                  (mapcar (lambda (face)
1026                                            (list (symbol-name face)))
1027                                          (face-list))
1028                                  nil nil nil
1029                                  'face-history)))
1030     (unless (zerop (length answer))
1031       (widget-value-set widget (intern answer))
1032       (widget-apply widget :notify widget event)
1033       (widget-setup))))
1034
1035 ;;; The `hook' Widget.
1036
1037 (define-widget 'hook 'list
1038   "A emacs lisp hook"
1039   :convert-widget 'custom-hook-convert-widget
1040   :tag "Hook")
1041
1042 (defun custom-hook-convert-widget (widget)
1043   ;; Handle `:custom-options'.
1044   (let* ((options (widget-get widget :options))
1045          (other `(editable-list :inline t
1046                                 :entry-format "%i %d%v"
1047                                 (function :format " %v")))
1048          (args (if options
1049                    (list `(checklist :inline t
1050                                      ,@(mapcar (lambda (entry)
1051                                                  `(function-item ,entry))
1052                                                options))
1053                          other)
1054                  (list other))))
1055     (widget-put widget :args args)
1056     widget))
1057
1058 ;;; The `custom-group' Widget.
1059
1060 (define-widget 'custom-group 'custom
1061   "Customize group."
1062   :format "%l%[%t%]: %L\n%m %h%a%v"
1063   :documentation-property 'group-documentation
1064   :help-echo "Push me to set or reset all members of this group."
1065   :value-create 'custom-group-value-create
1066   :action 'custom-group-action
1067   :custom-apply 'custom-group-apply
1068   :custom-set-default 'custom-group-set-default
1069   :custom-reset 'custom-group-reset
1070   :custom-menu 'custom-group-menu-create)
1071
1072 (defun custom-group-value-create (widget)
1073   (let ((state (widget-get widget :custom-state)))
1074     (unless (eq state 'hidden)
1075       (custom-load-widget widget)
1076       (let* ((level (widget-get widget :custom-level))
1077              (symbol (widget-value widget))
1078              (members (get symbol 'custom-group))
1079              (children (mapcar (lambda (entry)
1080                                  (widget-insert "\n")
1081                                  (prog1
1082                                      (widget-create-child-and-convert
1083                                       widget (nth 1 entry)
1084                                       :group widget
1085                                       :custom-level (1+ level)
1086                                       :value (nth 0 entry))
1087                                    (unless (eq (preceding-char) ?\n)
1088                                      (widget-insert "\n"))))
1089                                members)))
1090         (mapcar 'custom-magic-reset children)
1091         (widget-put widget :children children)
1092         (custom-group-state-update widget)))))
1093
1094 (defvar custom-group-menu
1095   '(("Apply" . custom-group-apply)
1096     ("Set Default" . custom-group-set-default)
1097     ("Reset" . custom-group-reset))
1098   "Alist of actions for the `custom-group' widget.
1099 The key is a string containing the name of the action, the value is a
1100 lisp function taking the widget as an element which will be called
1101 when the action is chosen.")
1102
1103 (defun custom-group-action (widget &optional event)
1104   "Show the menu for `custom-group' WIDGET.
1105 Optional EVENT is the location for the menu."
1106   (let* ((completion-ignore-case t)
1107          (answer (widget-choose (symbol-name (widget-get widget :value))
1108                                 custom-group-menu
1109                                 event)))
1110     (if answer
1111         (funcall answer widget))))
1112
1113 (defun custom-group-apply (widget)
1114   "Apply changes in all modified group members."
1115   (let ((children (widget-get widget :children)))
1116     (mapcar (lambda (child)
1117               (when (eq (widget-get child :custom-state) 'modified)
1118                 (widget-apply child :custom-apply)))
1119             children )))
1120
1121 (defun custom-group-set-default (widget)
1122   "Set default in all modified group members."
1123   (let ((children (widget-get widget :children)))
1124     (mapcar (lambda (child)
1125               (when (eq (widget-get child :custom-state) 'modified)
1126                 (widget-apply child :custom-set-default)))
1127             children )))
1128
1129 (defun custom-group-reset (widget)
1130   "Reset all modified group members."
1131   (let ((children (widget-get widget :children)))
1132     (mapcar (lambda (child)
1133               (when (eq (widget-get child :custom-state) 'modified)
1134                 (widget-apply child :custom-reset)))
1135             children )))
1136
1137 (defun custom-group-state-update (widget)
1138   "Update magic."
1139   (unless (eq (widget-get widget :custom-state) 'hidden)
1140     (let* ((children (widget-get widget :children))
1141            (states (mapcar (lambda (child)
1142                              (widget-get child :custom-state))
1143                            children))
1144            (magics custom-magic-alist)
1145            (found 'factory))
1146       (while magics
1147         (let ((magic (car (car magics))))
1148           (if (and (not (eq magic 'hidden))
1149                    (memq magic states))
1150               (setq found magic
1151                     magics nil)
1152             (setq magics (cdr magics)))))
1153       (widget-put widget :custom-state found)))
1154   (custom-magic-reset widget))
1155
1156 ;;; The `custom-save' Command.
1157
1158 (defcustom custom-file "~/.emacs"
1159   "File used for storing customization information.
1160 If you change this from the default \"~/.emacs\" you need to
1161 explicitly load that file for the settings to take effect."
1162   :type 'file
1163   :group 'customize)
1164
1165 (defun custom-save-delete (symbol)
1166   "Delete the call to SYMBOL form `custom-file'.
1167 Leave point at the location of the call, or after the last expression."
1168   (set-buffer (find-file-noselect custom-file))
1169   (goto-char (point-min))
1170   (catch 'found
1171     (while t
1172       (let ((sexp (condition-case nil
1173                       (read (current-buffer))
1174                     (end-of-file (throw 'found nil)))))
1175         (when (and (listp sexp)
1176                    (eq (car sexp) symbol))
1177           (delete-region (save-excursion
1178                            (backward-sexp)
1179                            (point))
1180                          (point))
1181           (throw 'found nil))))))
1182
1183 (defun custom-save-variables ()
1184   "Save all customized variables in `custom-file'."
1185   (save-excursion
1186     (custom-save-delete 'custom-set-variables)
1187     (let ((standard-output (current-buffer)))
1188       (unless (bolp)
1189         (princ "\n"))
1190       (princ "(custom-set-variables")
1191       (mapatoms (lambda (symbol)
1192                   (let ((value (get symbol 'saved-value)))
1193                     (when value
1194                       (princ "\n '(")
1195                       (princ symbol)
1196                       (princ " ")
1197                       (prin1 (car value))
1198                       (if (or (get symbol 'factory-value)
1199                               (and (not (boundp symbol))
1200                                    (not (get symbol 'force-value))))
1201                           (princ ")")
1202                         (princ " t)"))))))
1203       (princ ")")
1204       (unless (eolp)
1205         (princ "\n")))))
1206
1207 (defun custom-save-faces ()
1208   "Save all customized faces in `custom-file'."
1209   (save-excursion
1210     (custom-save-delete 'custom-set-faces)
1211     (let ((standard-output (current-buffer)))
1212       (unless (bolp)
1213         (princ "\n"))
1214       (princ "(custom-set-faces")
1215       (mapatoms (lambda (symbol)
1216                   (let ((value (get symbol 'saved-face)))
1217                     (when value
1218                       (princ "\n '(")
1219                       (princ symbol)
1220                       (princ " ")
1221                       (prin1 value)
1222                       (if (or (get symbol 'factory-face)
1223                               (and (not (custom-facep symbol))
1224                                    (not (get symbol 'force-face))))
1225                           (princ ")")
1226                         (princ " t)"))))))
1227       (princ ")")
1228       (unless (eolp)
1229         (princ "\n")))))
1230
1231 (defun custom-save ()
1232   "Save all customizations in `custom-file'."
1233   (interactive)
1234   (custom-save-variables)
1235   (custom-save-faces)
1236   (setq custom-save-needed-p nil)
1237   (save-excursion
1238     (set-buffer (find-file-noselect custom-file))
1239     (save-buffer)))
1240
1241 ;;; The Customize Menu.
1242
1243 (defcustom custom-menu-nesting 2
1244   "Maximum nesting in custom menus."
1245   :type 'integer
1246   :group 'customize)
1247
1248 (defun custom-face-menu-create (widget symbol)
1249   "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
1250   (vector (custom-unlispify-menu-entry symbol)
1251           `(custom-buffer-create '((,symbol custom-face)))
1252           t))
1253
1254 (defun custom-variable-menu-create (widget symbol)
1255   "Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
1256   (let ((type (get symbol 'custom-type)))
1257     (unless (listp type)
1258       (setq type (list type)))
1259     (if (and type (widget-get type :custom-menu))
1260         (widget-apply type :custom-menu symbol)
1261       (vector (custom-unlispify-menu-entry symbol)
1262               `(custom-buffer-create '((,symbol custom-variable)))
1263               t))))
1264
1265 (widget-put (get 'boolean 'widget-type)
1266             :custom-menu (lambda (widget symbol)
1267                            (vector (custom-unlispify-menu-entry symbol)
1268                                    `(custom-buffer-create
1269                                      '((,symbol custom-variable)))
1270                                    ':style 'toggle
1271                                    ':selected symbol)))
1272
1273 (defun custom-group-menu-create (widget symbol)
1274   "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
1275   (custom-menu-create symbol))
1276
1277 (defun custom-menu-create (symbol &optional name)
1278   "Create menu for customization group SYMBOL.
1279 If optional NAME is given, use that as the name of the menu.
1280 Otherwise make up a name from SYMBOL.
1281 The menu is in a format applicable to `easy-menu-define'."
1282   (unless name
1283     (setq name (custom-unlispify-menu-entry symbol)))
1284   (let ((item (vector name
1285                       `(custom-buffer-create '((,symbol custom-group)))
1286                       t)))
1287     (if (> custom-menu-nesting 0)
1288         (let ((custom-menu-nesting (1- custom-menu-nesting))
1289               (custom-prefix-list (cons (or (get symbol 'custom-prefix)
1290                                             (concat (symbol-name symbol) "-"))
1291                                         custom-prefix-list)))
1292           (custom-load-symbol symbol)
1293           `(,(custom-unlispify-menu-entry symbol t)
1294             ,item
1295             "--"
1296             ,@(mapcar (lambda (entry)
1297                         (widget-apply (if (listp (nth 1 entry))
1298                                           (nth 1 entry)
1299                                         (list (nth 1 entry)))
1300                                       :custom-menu (nth 0 entry)))
1301                       (get symbol 'custom-group))))
1302       item)))
1303
1304 ;;;###autoload
1305 (defun custom-menu-update ()
1306   "Update customize menu."
1307   (interactive)
1308   (add-hook 'custom-define-hook 'custom-menu-reset)
1309   (let ((menu `(,(car custom-help-menu)
1310                 ,(widget-apply '(custom-group) :custom-menu 'emacs)
1311                 ,@(cdr (cdr custom-help-menu)))))
1312     (if (fboundp 'add-submenu)
1313         (add-submenu '("Help") menu)
1314       (define-key global-map [menu-bar help-menu customize-menu]
1315         (cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu)))))))
1316
1317 ;;; Dependencies.
1318
1319 ;;;###autoload
1320 (defun custom-make-dependencies ()
1321   "Batch function to extract custom dependencies from .el files.
1322 Usage: emacs -batch *.el -f custom-make-dependencies > deps.el"
1323   (let ((buffers (buffer-list)))
1324     (while buffers
1325       (set-buffer (car buffers))
1326       (setq buffers (cdr buffers))
1327       (let ((file (buffer-file-name)))
1328         (when (and file (string-match "\\`\\(.*\\)\\.el\\'" file))
1329           (goto-char (point-min))
1330           (condition-case nil
1331               (let ((name (file-name-nondirectory (match-string 1 file))))
1332                 (while t
1333                   (let ((expr (read (current-buffer))))
1334                     (when (and (listp expr)
1335                                (memq (car expr) '(defcustom defface defgroup)))
1336                       (eval expr)
1337                       (put (nth 1 expr) 'custom-where name)))))
1338             (error nil))))))
1339   (mapatoms (lambda (symbol)
1340               (let ((members (get symbol 'custom-group))
1341                     item where found)
1342                 (when members
1343                   (princ "(put '")
1344                   (princ symbol)
1345                   (princ " 'custom-loads '(")
1346                   (while members
1347                     (setq item (car (car members))
1348                           members (cdr members)
1349                           where (get item 'custom-where))
1350                     (unless (or (null where)
1351                                 (member where found))
1352                       (when found
1353                         (princ " "))
1354                       (prin1 where)
1355                       (push where found)))
1356                   (princ "))\n"))))))
1357
1358 ;;; The End.
1359
1360 (provide 'custom-edit)
1361
1362 ;; custom-edit.el ends here