Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-edit.el @ 179:9ad43877534d r20-3b16

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b16
author cvs
date Mon, 13 Aug 2007 09:52:19 +0200
parents 8eaf7971accc
children bfd6434d15b3
comparison
equal deleted inserted replaced
178:e703507b8a00 179:9ad43877534d
1 ;;; cus-edit.el --- Tools for customization Emacs. 1 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, faces 6 ;; Keywords: help, faces
7 ;; Version: 1.9951 7 ;; Version: 1.9953
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
438 (defcustom custom-unlispify-menu-entries t 438 (defcustom custom-unlispify-menu-entries t
439 "Display menu entries as words instead of symbols if non nil." 439 "Display menu entries as words instead of symbols if non nil."
440 :group 'custom-menu 440 :group 'custom-menu
441 :type 'boolean) 441 :type 'boolean)
442 442
443 (defcustom custom-unlispify-remove-prefixes nil
444 "Non-nil means remove group prefixes from option names in buffer."
445 :group 'custom-menu
446 :type 'boolean)
447
443 (defun custom-unlispify-menu-entry (symbol &optional no-suffix) 448 (defun custom-unlispify-menu-entry (symbol &optional no-suffix)
444 "Convert symbol into a menu entry." 449 "Convert symbol into a menu entry."
445 (cond ((not custom-unlispify-menu-entries) 450 (cond ((not custom-unlispify-menu-entries)
446 (symbol-name symbol)) 451 (symbol-name symbol))
447 ((get symbol 'custom-tag) 452 ((get symbol 'custom-tag)
456 (goto-char (point-min)) 461 (goto-char (point-min))
457 (when (and (eq (get symbol 'custom-type) 'boolean) 462 (when (and (eq (get symbol 'custom-type) 'boolean)
458 (re-search-forward "-p\\'" nil t)) 463 (re-search-forward "-p\\'" nil t))
459 (replace-match "" t t) 464 (replace-match "" t t)
460 (goto-char (point-min))) 465 (goto-char (point-min)))
461 (let ((prefixes custom-prefix-list) 466 (if custom-unlispify-remove-prefixes
462 prefix) 467 (let ((prefixes custom-prefix-list)
463 (while prefixes 468 prefix)
464 (setq prefix (car prefixes)) 469 (while prefixes
465 (if (search-forward prefix (+ (point) (length prefix)) t) 470 (setq prefix (car prefixes))
466 (progn 471 (if (search-forward prefix (+ (point) (length prefix)) t)
467 (setq prefixes nil) 472 (progn
468 (delete-region (point-min) (point))) 473 (setq prefixes nil)
469 (setq prefixes (cdr prefixes))))) 474 (delete-region (point-min) (point)))
475 (setq prefixes (cdr prefixes))))))
470 (subst-char-in-region (point-min) (point-max) ?- ?\ t) 476 (subst-char-in-region (point-min) (point-max) ?- ?\ t)
471 (capitalize-region (point-min) (point-max)) 477 (capitalize-region (point-min) (point-max))
472 (unless no-suffix 478 (unless no-suffix
473 (goto-char (point-max)) 479 (goto-char (point-max))
474 (insert "...")) 480 (insert "..."))
1132 (message "Creating customization buffer...done")) 1138 (message "Creating customization buffer...done"))
1133 1139
1134 ;;; The Tree Browser. 1140 ;;; The Tree Browser.
1135 1141
1136 ;;;###autoload 1142 ;;;###autoload
1137 (defun customize-browse (group) 1143 (defun customize-browse (&optional group)
1138 "Create a tree browser for the customize hierarchy." 1144 "Create a tree browser for the customize hierarchy."
1139 (interactive (list (let ((completion-ignore-case t)) 1145 (interactive)
1140 (completing-read "Customize group: (default emacs) " 1146 (unless group
1141 obarray 1147 (setq group 'emacs))
1142 (lambda (symbol)
1143 (get symbol 'custom-group))
1144 t))))
1145
1146 (when (stringp group)
1147 (if (string-equal "" group)
1148 (setq group 'emacs)
1149 (setq group (intern group))))
1150 (let ((name "*Customize Browser*")) 1148 (let ((name "*Customize Browser*"))
1151 (kill-buffer (get-buffer-create name)) 1149 (kill-buffer (get-buffer-create name))
1152 (switch-to-buffer (get-buffer-create name))) 1150 (switch-to-buffer (get-buffer-create name)))
1153 (custom-mode) 1151 (custom-mode)
1154 (widget-insert "\ 1152 (widget-insert "\
1155 Invoke [+] or [?] below to expand items, and [-] to collapse items.\n") 1153 Square brackets show active fields; type RET or click mouse-2
1154 on an active field to invoke its action.
1155 Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
1156 (if custom-browse-only-groups 1156 (if custom-browse-only-groups
1157 (widget-insert "\ 1157 (widget-insert "\
1158 Invoke the [Group] button below to edit that item in another window.\n\n") 1158 Invoke the [Group] button below to edit that item in another window.\n\n")
1159 (widget-insert "Invoke the ") 1159 (widget-insert "Invoke the ")
1160 (widget-create 'item 1160 (widget-create 'item
1601 (cond ((symbolp load) 1601 (cond ((symbolp load)
1602 (condition-case nil 1602 (condition-case nil
1603 (require load) 1603 (require load)
1604 (error nil))) 1604 (error nil)))
1605 ;; Don't reload a file already loaded. 1605 ;; Don't reload a file already loaded.
1606 ((and (boundp 'preloaded-file-list)
1607 (member load preloaded-file-list)))
1606 ((assoc load load-history)) 1608 ((assoc load load-history))
1607 ((assoc (locate-library load) load-history)) 1609 ((assoc (locate-library load) load-history))
1608 (t 1610 (t
1609 (condition-case nil 1611 (condition-case nil
1610 ;; Without this, we would load cus-edit recursively. 1612 ;; Without this, we would load cus-edit recursively.
2583 2585
2584 (defun custom-group-value-create (widget) 2586 (defun custom-group-value-create (widget)
2585 "Insert a customize group for WIDGET in the current buffer." 2587 "Insert a customize group for WIDGET in the current buffer."
2586 (let* ((state (widget-get widget :custom-state)) 2588 (let* ((state (widget-get widget :custom-state))
2587 (level (widget-get widget :custom-level)) 2589 (level (widget-get widget :custom-level))
2588 (indent (widget-get widget :indent)) 2590 ;; (indent (widget-get widget :indent))
2589 (prefix (widget-get widget :custom-prefix)) 2591 (prefix (widget-get widget :custom-prefix))
2590 (buttons (widget-get widget :buttons)) 2592 (buttons (widget-get widget :buttons))
2591 (tag (widget-get widget :tag)) 2593 (tag (widget-get widget :tag))
2592 (symbol (widget-value widget)) 2594 (symbol (widget-value widget))
2593 (members (custom-group-members symbol 2595 (members (custom-group-members symbol
2598 (or members (custom-unloaded-widget-p widget))) 2600 (or members (custom-unloaded-widget-p widget)))
2599 (custom-browse-insert-prefix prefix) 2601 (custom-browse-insert-prefix prefix)
2600 (push (widget-create-child-and-convert 2602 (push (widget-create-child-and-convert
2601 widget 'custom-browse-visibility 2603 widget 'custom-browse-visibility
2602 ;; :tag-glyph "plus" 2604 ;; :tag-glyph "plus"
2603 :tag (if (custom-unloaded-widget-p widget) "?" "+")) 2605 :tag "+")
2604 buttons) 2606 buttons)
2605 (insert "-- ") 2607 (insert "-- ")
2606 ;; (widget-glyph-insert nil "-- " "horizontal") 2608 ;; (widget-glyph-insert nil "-- " "horizontal")
2607 (push (widget-create-child-and-convert 2609 (push (widget-create-child-and-convert
2608 widget 'custom-browse-group-tag) 2610 widget 'custom-browse-group-tag)
3029 3031
3030 ;;; The Customize Menu. 3032 ;;; The Customize Menu.
3031 3033
3032 ;;; Menu support 3034 ;;; Menu support
3033 3035
3034 (unless (string-match "XEmacs" emacs-version)
3035 (defconst custom-help-menu
3036 '("Customize"
3037 ["Update menu" Custom-menu-update t]
3038 ["Browse" (customize-browse 'emacs) t]
3039 ["Group..." customize-group t]
3040 ["Option..." customize-option t]
3041 ["Face..." customize-face t]
3042 ["Saved..." customize-saved t]
3043 ["Set..." customize-customized t]
3044 "--"
3045 ["Apropos..." customize-apropos t]
3046 ["Group apropos..." customize-apropos-groups t]
3047 ["Option apropos..." customize-apropos-options t]
3048 ["Face apropos..." customize-apropos-faces t])
3049 ;; This menu should be identical to the one defined in `menu-bar.el'.
3050 "Customize menu")
3051
3052 (defun custom-menu-reset ()
3053 "Reset customize menu."
3054 (remove-hook 'custom-define-hook 'custom-menu-reset)
3055 (define-key global-map [menu-bar help-menu customize-menu]
3056 (cons (car custom-help-menu)
3057 (easy-menu-create-keymaps (car custom-help-menu)
3058 (cdr custom-help-menu)))))
3059
3060 (defun Custom-menu-update (event)
3061 "Update customize menu."
3062 (interactive "e")
3063 (add-hook 'custom-define-hook 'custom-menu-reset)
3064 (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs))
3065 (menu `(,(car custom-help-menu)
3066 ,emacs
3067 ,@(cdr (cdr custom-help-menu)))))
3068 (let ((map (easy-menu-create-keymaps (car menu) (cdr menu))))
3069 (define-key global-map [menu-bar help-menu customize-menu]
3070 (cons (car menu) map))))))
3071
3072 (defcustom custom-menu-nesting 2 3036 (defcustom custom-menu-nesting 2
3073 "Maximum nesting in custom menus." 3037 "Maximum nesting in custom menus."
3074 :type 'integer 3038 :type 'integer
3075 :group 'custom-menu) 3039 :group 'custom-menu)
3076 3040
3167 (suppress-keymap custom-mode-map) 3131 (suppress-keymap custom-mode-map)
3168 (define-key custom-mode-map " " 'scroll-up) 3132 (define-key custom-mode-map " " 'scroll-up)
3169 (define-key custom-mode-map "\177" 'scroll-down) 3133 (define-key custom-mode-map "\177" 'scroll-down)
3170 (define-key custom-mode-map "q" 'bury-buffer) 3134 (define-key custom-mode-map "q" 'bury-buffer)
3171 (define-key custom-mode-map "u" 'Custom-goto-parent) 3135 (define-key custom-mode-map "u" 'Custom-goto-parent)
3136 (define-key custom-mode-map "n" 'widget-forward)
3137 (define-key custom-mode-map "p" 'widget-backward)
3172 ;; (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke) 3138 ;; (define-key custom-mode-map [mouse-1] 'Custom-move-and-invoke)
3173 ) 3139 )
3174 3140
3175 (defun Custom-move-and-invoke (event) 3141 (defun Custom-move-and-invoke (event)
3176 "Move to where you click, and if it is an active field, invoke it." 3142 "Move to where you click, and if it is an active field, invoke it."