*** empty log message ***

[gnus] / lisp / custom-edit.el

diff --git a/lisp/custom-edit.el b/lisp/custom-edit.el
index 1145a05..047f8e7 100644 (file)
--- a/lisp/custom-edit.el
+++ b/lisp/custom-edit.el
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 0.98
+;; Version: 0.995
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -15,6 +15,7 @@
 
 (require 'custom)
 (require 'widget-edit)
+(require 'easymenu)
 
 (define-widget-keywords :custom-show :custom-magic
   :custom-state :custom-level :custom-form
@@ -34,10 +35,6 @@
       sexp
     (list 'quote sexp)))
 
-(defun custom-unimplemented (&rest ignore)
-  "Apologize for my laziness."
-  (error "Sorry, not implemented"))
-
 ;;; Modification of Basic Widgets.
 ;;
 ;; We add extra properties to the basic widgets needed here.  This is
@@ -135,15 +132,15 @@ MAGIC is a string used to present that state.
 FACE is a face used to present the state.
 
 The list should be sorted most significant first."
-  :type '(repeat (list (choice (item nil)
-                              (item unknown)
-                              (item hidden)
-                              (item invalid)
-                              (item modified)
-                              (item applied)
-                              (item saved)
-                              (item rogue)
-                              (item factory))
+  :type '(repeat (list (choice (const nil)
+                              (const unknown)
+                              (const hidden)
+                              (const invalid)
+                              (const modified)
+                              (const applied)
+                              (const saved)
+                              (const rogue)
+                              (const factory))
                       string face))
   :group 'customize)
 
@@ -186,6 +183,16 @@ The list should be sorted most significant first."
 
 ;;; The `custom' Widget.
 
+(defvar custom-save-needed-p nil
+  "Non-nil if any customizations need to be saved.")
+
+(add-hook 'kill-emacs-hook 'custom-save-maybe)
+
+(defun custom-save-maybe ()
+  (and custom-save-needed-p
+       (y-or-n-p "You have unsaved customizations, save them now? ")
+       (custom-save)))
+
 (define-widget 'custom 'default
   "Customize a user option."
   :convert-widget 'widget-item-convert-widget
@@ -203,8 +210,7 @@ The list should be sorted most significant first."
 
 (defun custom-format-handler (widget escape)
   ;; We recognize extra escape sequences.
-  (let* ((symbol (widget-get widget :value))
-        (buttons (widget-get widget :buttons))
+  (let* ((buttons (widget-get widget :buttons))
         (level (widget-get widget :custom-level)))
     (cond ((eq escape ?l)
           (when level 
@@ -280,10 +286,14 @@ The list should be sorted most significant first."
         (form (widget-get widget :custom-form))
         (state (widget-get widget :custom-state))
         (symbol (widget-get widget :value))
+        (options (get symbol 'custom-options))
         (child-type (or (get symbol 'custom-type) 'sexp))
-        (type (if (listp child-type)
-                  child-type
-                (list child-type)))
+        (type (let ((tmp (if (listp child-type)
+                             child-type
+                           (list child-type))))
+                (when options
+                  (widget-put tmp :options options))
+                tmp))
         (conv (widget-convert type))
         (value (if (boundp symbol)
                    (symbol-value symbol)
@@ -403,7 +413,7 @@ Optional EVENT is the location for the menu."
     (cond ((eq state 'hidden)
           (error "Cannot apply hidden variable."))
          ((setq val (widget-apply child :validate))
-          (error "Invalid %S"))
+          (error "Invalid %S" val))
          ((eq form 'lisp)
           (set symbol (eval (widget-value child))))
          (t
@@ -421,11 +431,13 @@ Optional EVENT is the location for the menu."
     (cond ((eq state 'hidden)
           (error "Cannot apply hidden variable."))
          ((setq val (widget-apply child :validate))
-          (error "Invalid %S"))
+          (error "Invalid %S" val))
          ((eq form 'lisp)
+          (setq custom-save-needed-p (cons symbol custom-save-needed-p))
           (put symbol 'saved-value (list (widget-value child)))
           (set symbol (eval (widget-value child))))
          (t
+          (setq custom-save-needed-p (cons symbol custom-save-needed-p))
           (put symbol
                'saved-value (list (custom-quote (widget-value
                                                  child))))
@@ -446,9 +458,10 @@ Optional EVENT is the location for the menu."
   "Restore the factory setting for the variable being edited by WIDGET."
   (let ((symbol (widget-value widget)))
     (if (get symbol 'factory-value)
-       (set symbol (car (get symbol 'factory-value)))
+       (set symbol (eval (car (get symbol 'factory-value))))
       (error "No factory default for %S" symbol))
     (when (get symbol 'saved-value)
+      (setq custom-save-needed-p (cons symbol custom-save-needed-p))
       (put symbol 'saved-value nil))
     (widget-put widget :custom-state 'unknown)
     (custom-redraw widget)))
@@ -530,7 +543,7 @@ Optional EVENT is the location for the menu."
     (cond ((eq escape ?s)
           (setq child (widget-create-child-and-convert 
                        widget 'custom-level
-                       :format "(%[sample%])\n"
+                       :format "(%[show%])\n"
                        :button-face symbol)))
          (t 
           (custom-format-handler widget escape)))
@@ -607,7 +620,7 @@ Optional EVENT is the location for the menu."
         (child (car (widget-get widget :children))))
     (unless (get symbol 'saved-face)
       (error "No saved value for this face")
-      (widget-value-set child (get symbol 'saved-face)))))
+    (widget-value-set child (get symbol 'saved-face)))))
 
 (defun custom-face-factory (widget)
   "Restore WIDGET to the face's factory settings."
@@ -624,7 +637,8 @@ Optional EVENT is the location for the menu."
 (define-widget 'face 'default
   "Select and customize a face."
   :convert-widget 'widget-item-convert-widget
-  :format "%[%t%]%v"
+  :format "%[%t%]: %v"
+  :tag "Face"
   :value 'default
   :value-create 'widget-face-value-create
   :value-delete 'widget-radio-value-delete
@@ -638,8 +652,8 @@ Optional EVENT is the location for the menu."
   (let* ((symbol (widget-value widget))
         (child (widget-create-child-and-convert
                 widget 'custom-face
+                :format "%t %s%m %h%v"
                 :custom-level nil
-                :tag ""
                 :value symbol)))
     (custom-magic-reset child)
     (widget-put widget :children (list child))))
@@ -657,8 +671,30 @@ Optional EVENT is the location for the menu."
                                 'face-history)))
     (unless (zerop (length answer))
       (widget-value-set widget (intern answer))
+      (widget-apply widget :notify widget event)
       (widget-setup))))
 
+;;; The `hook' Widget.
+
+(define-widget 'hook 'list
+  "A emacs lisp hook"
+  :convert-widget 'custom-hook-convert-widget
+  :tag "Hook")
+
+(defun custom-hook-convert-widget (widget)
+  ;; Handle `:custom-options'.
+  (let* ((options (widget-get widget :options))
+        (other `(editable-list :inline t (function :format "%v")))
+        (args (if options
+                  (list `(checklist :inline t
+                                    ,@(mapcar (lambda (entry)
+                                                `(function-item ,entry))
+                                              options))
+                        other)
+                (list other))))
+    (widget-put widget :args args)
+    widget))
+
 ;;; The `custom-group' Widget.
 
 (define-widget 'custom-group 'custom
@@ -825,6 +861,7 @@ Leave point at the location of the call, or after the last expression."
   (interactive)
   (custom-save-variables)
   (custom-save-faces)
+  (setq custom-save-needed-p nil)
   (save-excursion
     (set-buffer (find-file-noselect custom-file))
     (save-buffer)))