Mercurial > hg > xemacs-beta
diff lisp/custom/cus-edit.el @ 167:85ec50267440 r20-3b10
Import from CVS: tag r20-3b10
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:45:46 +0200 |
parents | 5a88923fcbfe |
children | 929b76928fce |
line wrap: on
line diff
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:44:44 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:45:46 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9937 +;; Version: 1.9940 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -568,6 +568,11 @@ (const :tag "none" nil)) :group 'custom-browse) +(defcustom custom-browse-only-groups nil + "If non-nil, show group members only within each customization group." + :type 'boolean + :group 'custom-browse) + (defcustom custom-buffer-sort-alphabetically nil "If non-nil, sort members of each customization group alphabetically." :type 'boolean @@ -874,7 +879,12 @@ (interactive) (let ((found nil)) (mapatoms (lambda (symbol) - (and (get symbol 'customized-face) + (and (condition-case nil + (get symbol 'customized-face) + (t (progn + (message "Bad plist in %s" + (symbol-name symbol)) + nil))) (custom-facep symbol) (push (list symbol 'custom-face) found)) (and (get symbol 'customized-value) @@ -891,7 +901,12 @@ (interactive) (let ((found nil)) (mapatoms (lambda (symbol) - (and (get symbol 'saved-face) + (and (condition-case nil + (get symbol 'saved-face) + (t (progn + (message "Bad plist in %s" + (symbol-name symbol)) + nil))) (custom-facep symbol) (push (list symbol 'custom-face) found)) (and (get symbol 'saved-value) @@ -1116,7 +1131,7 @@ (switch-to-buffer (get-buffer-create name))) (custom-mode) (widget-insert "\ -Invoke [+] below to expand items, and [-] to collapse items. +Invoke [+] or [?] below to expand items, and [-] to collapse items. Invoke the [Group], [Face], and [Option] buttons below to edit that item in another window.\n\n") (let ((custom-buffer-style 'tree)) @@ -1127,52 +1142,52 @@ :value group)) (goto-char (point-min))) -(define-widget 'custom-tree-visibility 'item +(define-widget 'custom-browse-visibility 'item "Control visibility of of items in the customize tree browser." :format "%[[%t]%]" - :action 'custom-tree-visibility-action) - -(defun custom-tree-visibility-action (widget &rest ignore) + :action 'custom-browse-visibility-action) + +(defun custom-browse-visibility-action (widget &rest ignore) (let ((custom-buffer-style 'tree)) (custom-toggle-parent widget))) -(define-widget 'custom-tree-group-tag 'push-button +(define-widget 'custom-browse-group-tag 'push-button "Show parent in other window when activated." :tag "Group" :tag-glyph "folder" - :action 'custom-tree-group-tag-action) - -(defun custom-tree-group-tag-action (widget &rest ignore) + :action 'custom-browse-group-tag-action) + +(defun custom-browse-group-tag-action (widget &rest ignore) (let ((parent (widget-get widget :parent))) (customize-group-other-window (widget-value parent)))) -(define-widget 'custom-tree-variable-tag 'push-button +(define-widget 'custom-browse-variable-tag 'push-button "Show parent in other window when activated." :tag "Option" :tag-glyph "option" - :action 'custom-tree-variable-tag-action) - -(defun custom-tree-variable-tag-action (widget &rest ignore) + :action 'custom-browse-variable-tag-action) + +(defun custom-browse-variable-tag-action (widget &rest ignore) (let ((parent (widget-get widget :parent))) (customize-variable-other-window (widget-value parent)))) -(define-widget 'custom-tree-face-tag 'push-button +(define-widget 'custom-browse-face-tag 'push-button "Show parent in other window when activated." :tag "Face" :tag-glyph "face" - :action 'custom-tree-face-tag-action) - -(defun custom-tree-face-tag-action (widget &rest ignore) + :action 'custom-browse-face-tag-action) + +(defun custom-browse-face-tag-action (widget &rest ignore) (let ((parent (widget-get widget :parent))) (customize-face-other-window (widget-value parent)))) -(defconst custom-tree-alist '((" " "space") +(defconst custom-browse-alist '((" " "space") (" | " "vertical") ("-\\ " "top") (" |-" "middle") (" `-" "bottom"))) -(defun custom-tree-insert-prefix (prefix) +(defun custom-browse-insert-prefix (prefix) "Insert PREFIX. On XEmacs convert it to line graphics." (if nil ; (string-match "XEmacs" emacs-version) (progn @@ -1181,7 +1196,7 @@ (let ((entry (substring prefix 0 3))) (setq prefix (substring prefix 3)) (let ((overlay (make-overlay (1- (point)) (point) nil t nil)) - (name (nth 1 (assoc entry custom-tree-alist)))) + (name (nth 1 (assoc entry custom-browse-alist)))) (overlay-put overlay 'end-glyph (widget-glyph-find name entry)) (overlay-put overlay 'start-open t) (overlay-put overlay 'end-open t))))) @@ -1565,8 +1580,31 @@ "Load all dependencies for WIDGET." (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." + (let ((found nil) + (loads (get symbol 'custom-loads)) + load) + (while loads + (setq load (car loads) + loads (cdr loads)) + (cond ((symbolp load) + (unless (featurep load) + (setq found t))) + ((assoc load load-history)) + ((assoc (locate-library load) load-history) + (message nil)) + (t + (setq found t)))) + found)) + +(defun custom-unloaded-widget-p (widget) + "Return non-nil if the dependencies of WIDGET has not yet been loaded." + (custom-unloaded-symbol-p (widget-value widget))) + (defun custom-toggle-hide (widget) "Toggle visibility of WIDGET." + (custom-load-widget widget) (let ((state (widget-get widget :custom-state))) (cond ((memq state '(invalid modified)) (error "There are unset changes")) @@ -1621,7 +1659,13 @@ found) (insert (or initial-string "Parent groups:")) (mapatoms (lambda (symbol) - (let ((entry (assq name (get symbol 'custom-group)))) + (let ((entry (assq name + (condition-case nil + (get symbol 'custom-group) + (t (progn + (message "Bad plist in %s" + (symbol-name symbol)) + nil)))))) (when (eq (nth 1 entry) type) (insert " ") (push (widget-create-child-and-convert @@ -1717,7 +1761,7 @@ (cond ((eq custom-buffer-style 'tree) (insert prefix (if last " `--- " " |--- ")) (push (widget-create-child-and-convert - widget 'custom-tree-variable-tag) + widget 'custom-browse-variable-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons)) @@ -2151,7 +2195,7 @@ (cond ((eq custom-buffer-style 'tree) (insert prefix (if is-last " `--- " " |--- ")) (push (widget-create-child-and-convert - widget 'custom-tree-face-tag) + widget 'custom-browse-face-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons)) @@ -2504,54 +2548,56 @@ (tag (widget-get widget :tag)) (symbol (widget-value widget))) (cond ((and (eq custom-buffer-style 'tree) - (eq state 'hidden)) - (custom-tree-insert-prefix prefix) + (eq state 'hidden) + (or (get symbol 'custom-group) + (custom-unloaded-widget-p widget))) + (custom-browse-insert-prefix prefix) (push (widget-create-child-and-convert - widget 'custom-tree-visibility + widget 'custom-browse-visibility ;; :tag-glyph "plus" - :tag "+") + :tag (if (custom-unloaded-widget-p widget) "?" "+")) buttons) (insert "-- ") ;; (widget-glyph-insert nil "-- " "horizontal") (push (widget-create-child-and-convert - widget 'custom-tree-group-tag) + widget 'custom-browse-group-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons)) ((and (eq custom-buffer-style 'tree) (zerop (length (get symbol 'custom-group)))) - (custom-tree-insert-prefix prefix) + (custom-browse-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") ;; (widget-glyph-insert nil "-- " "horizontal") (push (widget-create-child-and-convert - widget 'custom-tree-group-tag) + widget 'custom-browse-group-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons)) ((eq custom-buffer-style 'tree) - (custom-tree-insert-prefix prefix) + (custom-browse-insert-prefix prefix) (custom-load-widget widget) (if (zerop (length (get symbol 'custom-group))) (progn - (custom-tree-insert-prefix prefix) + (custom-browse-insert-prefix prefix) (insert "[ ]-- ") ;; (widget-glyph-insert nil "[ ]" "empty") ;; (widget-glyph-insert nil "-- " "horizontal") (push (widget-create-child-and-convert - widget 'custom-tree-group-tag) + widget 'custom-browse-group-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons)) (push (widget-create-child-and-convert - widget 'custom-tree-visibility + widget 'custom-browse-visibility ;; :tag-glyph "minus" :tag "-") buttons) (insert "-\\ ") ;; (widget-glyph-insert nil "-\\ " "top") (push (widget-create-child-and-convert - widget 'custom-tree-group-tag) + widget 'custom-browse-group-tag) buttons) (insert " " tag "\n") (widget-put widget :buttons buttons) @@ -2561,7 +2607,6 @@ custom-browse-order-groups)) (prefixes (widget-get widget :custom-prefixes)) (custom-prefix-list (custom-prefix-add symbol prefixes)) - (length (length members)) (extra-prefix (if (widget-get widget :custom-last) " " " | ")) @@ -2570,17 +2615,18 @@ (while members (setq entry (car members) members (cdr members)) - (push (widget-create-child-and-convert - widget (nth 1 entry) - :group widget - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :custom-prefixes custom-prefix-list - :custom-level (1+ level) - :custom-last (null members) - :value (nth 0 entry) - :custom-prefix prefix) - children)) + (when (or (not custom-browse-only-groups) + (eq (nth 1 entry) 'custom-group)) + (push (widget-create-child-and-convert + widget (nth 1 entry) + :group widget + :tag (custom-unlispify-tag-name (nth 0 entry)) + :custom-prefixes custom-prefix-list + :custom-level (1+ level) + :custom-last (null members) + :value (nth 0 entry) + :custom-prefix prefix) + children))) (widget-put widget :children (reverse children))) (message "Creating group...done"))) ;; Nested style. @@ -2849,7 +2895,12 @@ (princ "\n")) (princ "(custom-set-variables") (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-value)) + (let ((value (condition-case nil + (get symbol 'saved-value) + (t (progn + (message "Bad plist in %s" + (symbol-name symbol)) + nil)))) (requests (get symbol 'custom-requests)) (now (not (or (get symbol 'standard-value) (and (not (boundp symbol)) @@ -2892,7 +2943,12 @@ (princ ")") (princ " t)")))) (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-face))) + (let ((value (condition-case nil + (get symbol 'saved-face) + (t (progn + (message "Bad plist in %s" + (symbol-name symbol))) + nil)))) (when (and (not (eq symbol 'default)) ;; Don't print default face here. value) @@ -2914,14 +2970,17 @@ "Save all user options which have been set in this session." (interactive) (mapatoms (lambda (symbol) - (let ((face (get symbol 'customized-face)) - (value (get symbol 'customized-value))) - (when face - (put symbol 'saved-face face) - (put symbol 'customized-face nil)) - (when value - (put symbol 'saved-value value) - (put symbol 'customized-value nil))))) + (condition-case nil + (let ((face (get symbol 'customized-face)) + (value (get symbol 'customized-value))) + (when face + (put symbol 'saved-face face) + (put symbol 'customized-face nil)) + (when value + (put symbol 'saved-value value) + (put symbol 'customized-value nil))) + (t (message "Bad plist in %s" + (symbol-name symbol)))))) ;; We really should update all custom buffers here. (custom-save-all)) @@ -2941,17 +3000,17 @@ (unless (string-match "XEmacs" emacs-version) (defconst custom-help-menu '("Customize" - ["Update menu..." Custom-menu-update t] - ["Browse..." (customize-browse 'emacs) t] + ["Update menu" Custom-menu-update t] + ["Browse" (customize-browse 'emacs) t] ["Group..." customize-group t] - ["Variable..." customize-variable t] + ["Option..." customize-option t] ["Face..." customize-face t] ["Saved..." customize-saved t] ["Set..." customize-customized t] - ["--" custom-menu-sep t] + "--" ["Apropos..." customize-apropos t] ["Group apropos..." customize-apropos-groups t] - ["Variable apropos..." customize-apropos-options t] + ["Option apropos..." customize-apropos-options t] ["Face apropos..." customize-apropos-faces t]) ;; This menu should be identical to the one defined in `menu-bar.el'. "Customize menu")