]> git.eshelyaron.com Git - emacs.git/commitdiff
Synched with 1.9942.
authorPer Abrahamsen <abraham@dina.kvl.dk>
Wed, 2 Jul 1997 15:35:18 +0000 (15:35 +0000)
committerPer Abrahamsen <abraham@dina.kvl.dk>
Wed, 2 Jul 1997 15:35:18 +0000 (15:35 +0000)
lisp/cus-edit.el
lisp/wid-edit.el

index d24167aaea0466d540147ecb8770eeccf73e474a..156b78b793f76f73e982eb2ff76e7a1f25b665b2 100644 (file)
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.9936
+;; Version: 1.9942
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -568,6 +568,11 @@ If `last', order groups after non-groups."
                 (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
@@ -1118,9 +1123,27 @@ Reset all values in this buffer to their standard settings."
     (switch-to-buffer (get-buffer-create name)))
   (custom-mode)
   (widget-insert "\
-Invoke [+] 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")
+Invoke [+] or [?] below to expand items, and [-] to collapse items.\n")
+  (if custom-browse-only-groups
+      (widget-insert "\
+Invoke the [Group] button below to edit that item in another window.\n\n")
+    (widget-insert "Invoke the ") 
+    (widget-create 'item 
+                  :format "%t"
+                  :tag "[Group]"
+                  :tag-glyph "folder")
+    (widget-insert ", ")
+    (widget-create 'item 
+                  :format "%t"
+                  :tag "[Face]"
+                  :tag-glyph "face")
+    (widget-insert ", and ")
+    (widget-create 'item 
+                  :format "%t"
+                  :tag "[Option]"
+                  :tag-glyph "option")
+    (widget-insert " buttons below to edit that
+item in another window.\n\n"))
   (let ((custom-buffer-style 'tree))
     (widget-create 'custom-group 
                   :custom-last t
@@ -1129,52 +1152,52 @@ item in another window.\n\n")
                   :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)
+  :action 'custom-browse-visibility-action)
 
-(defun custom-tree-visibility-action (widget &rest ignore)
+(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)
+  :action 'custom-browse-group-tag-action)
 
-(defun custom-tree-group-tag-action (widget &rest ignore)
+(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)
+  :action 'custom-browse-variable-tag-action)
 
-(defun custom-tree-variable-tag-action (widget &rest ignore)
+(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)
+  :action 'custom-browse-face-tag-action)
 
-(defun custom-tree-face-tag-action (widget &rest ignore)
+(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 
@@ -1183,7 +1206,7 @@ item in another window.\n\n")
          (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)))))
@@ -1567,8 +1590,31 @@ and `face'."
   "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"))
@@ -1719,7 +1765,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
     (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))
@@ -2153,7 +2199,7 @@ Match frames with dark backgrounds.")
     (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))
@@ -2506,54 +2552,56 @@ and so forth.  The remaining group tags are shown with
        (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)
@@ -2563,7 +2611,6 @@ and so forth.  The remaining group tags are shown with
                              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)
                                      "   "
                                    " | "))
@@ -2572,17 +2619,18 @@ and so forth.  The remaining group tags are shown with
               (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.
@@ -2943,17 +2991,17 @@ Leave point at the location of the call, or after the last expression."
 (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")
index 98fa79a327ce41885f9f8b6171bbc7a0363aff20..d5783d07b17345584c7c52babb773779d9b5a488 100644 (file)
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9936
+;; Version: 1.9942
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -54,7 +54,7 @@
       "Character position of the end of event if that exists, or nil."
       (posn-point (event-end event))))
 
-(defalias 'widget-read-event (if (string-match "XEmacs" emacs-version)
+  (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version)
                                   'next-event
                                 'read-event))
 
           (or (memq 'click (event-modifiers event))
               (memq  'drag (event-modifiers event))))))
 
+  (unless (fboundp 'functionp)
+    ;; Missing from Emacs 19.34 and earlier.
+    (defun functionp (object)
+      "Non-nil of OBJECT is a type of object that can be called as a function."
+      (or (subrp object) (byte-code-function-p object)
+         (eq (car-safe object) 'lambda)
+         (and (symbolp object) (fboundp object)))))
+
   (unless (fboundp 'error-message-string)
     ;; Emacs function missing in XEmacs.
     (defun error-message-string (obj)
@@ -169,6 +177,28 @@ This exists as a variable so it can be set locally in certain buffers.")
   "Face used for editable fields."
   :group 'widget-faces)
 
+(defface widget-single-line-field-face '((((class grayscale color)
+                                          (background light))
+                                         (:background "gray85"))
+                                        (((class grayscale color)
+                                          (background dark))
+                                         (:background "dim gray"))
+                                        (t 
+                                         (:italic t)))
+  "Face used for editable fields spanning only a single line."
+  :group 'widget-faces)
+
+(defvar widget-single-line-display-table
+  (let ((table (make-display-table)))
+    (aset table 9  "^I")
+    (aset table 10 "^J")
+    table)
+  "Display table used for single-line editable fields.")
+
+(when (fboundp 'set-face-display-table)
+  (set-face-display-table 'widget-single-line-field-face
+                         widget-single-line-display-table))
+
 ;;; Utility functions.
 ;;
 ;; These are not really widget specific.
@@ -206,7 +236,7 @@ Larger menus are read through the minibuffer."
   :group 'widgets
   :type 'integer)
 
-(defcustom widget-menu-minibuffer-flag nil
+(defcustom widget-menu-minibuffer-flag (string-match "XEmacs" emacs-version)
   "*Control how to ask for a choice from the keyboard.
 Non-nil means use the minibuffer;
 nil means read a single character."
@@ -1816,6 +1846,9 @@ If END is omitted, it defaults to the length of LIST."
   (let ((size (widget-get widget :size))
        (value (widget-get widget :value))
        (from (point))
+       ;; This is changed to a real overlay in `widget-setup'.  We
+       ;; need the end points to behave differently until
+       ;; `widget-setup' is called.   
        (overlay (cons (make-marker) (make-marker))))
     (widget-put widget :field-overlay overlay)
     (insert value)
@@ -2873,6 +2906,7 @@ link for that string."
   "A regular expression."
   :match 'widget-regexp-match
   :validate 'widget-regexp-validate
+  :value-face 'widget-single-line-field-face
   :tag "Regexp")
 
 (defun widget-regexp-match (widget value)
@@ -2898,6 +2932,7 @@ It will read a file name from the minibuffer when invoked."
   :complete-function 'widget-file-complete
   :prompt-value 'widget-file-prompt-value
   :format "%{%t%}: %v"
+  :value-face 'widget-single-line-field-face
   :tag "File")
 
 (defun widget-file-complete ()