Sync with 1.84.

lisp/cus-face.el

@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.71
+;; Version: 1.84
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -39,7 +39,7 @@
 
 (eval-and-compile
   (unless (fboundp 'frame-property)
-    ;; XEmacs function missing in Emacs 19.34.
+    ;; XEmacs function missing in Emacs.
     (defun frame-property (frame property &optional default)
       "Return FRAME's value for property PROPERTY."
       (or (cdr (assq property (frame-parameters frame)))
@@ -49,44 +49,13 @@
     ;; XEmacs function missing in Emacs.
     (defun face-doc-string (face)
       "Get the documentation string for FACE."
-      (get face 'face-doc-string)))
+      (get face 'face-documentation)))
 
   (unless (fboundp 'set-face-doc-string)
     ;; XEmacs function missing in Emacs.
     (defun set-face-doc-string (face string)
       "Set the documentation string for FACE to STRING."
-      (put face 'face-doc-string string)))
-
-  (when (and (not (fboundp 'set-face-stipple))
-	     (fboundp 'set-face-background-pixmap))
-    ;; Emacs function missing in XEmacs 19.15.
-    (defun set-face-stipple (face pixmap &optional frame)
-      ;; Written by Kyle Jones.
-      "Change the stipple pixmap of face FACE to PIXMAP.
-PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
-
-Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
-where WIDTH and HEIGHT are the size in pixels,
-and DATA is a string, containing the raw bits of the bitmap.  
-
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-      (while (not (find-face face))
-	(setq face (signal 'wrong-type-argument (list 'facep face))))
-      (while (cond ((stringp pixmap)
-		    (unless (file-readable-p pixmap)
-		      (setq pixmap (vector 'xbm ':file pixmap)))
-		    nil)
-		   ((and (consp pixmap) (= (length pixmap) 3))
-		    (setq pixmap (vector 'xbm ':data pixmap))
-		    nil)
-		   (t t))
-	(setq pixmap (signal 'wrong-type-argument
-			     (list 'stipple-pixmap-p pixmap))))
-      (while (and frame (not (framep frame)))
-	(setq frame (signal 'wrong-type-argument (list 'framep frame))))
-      (set-face-background-pixmap face pixmap frame))))
+      (put face 'face-documentation string))))
 
 (unless (fboundp 'x-color-values)
   ;; Emacs function missing in XEmacs 19.14.
@@ -410,7 +379,7 @@ If FRAME is nil, use the default face."
     "Return the size of the font of FACE as a string."
     (let* ((font (apply 'custom-face-font-name face args))
 	   (fontobj (font-create-object font)))
-      (format "%d" (font-size fontobj))))
+      (format "%s" (font-size fontobj))))
 
   (defun custom-set-face-font-family (face family &rest args)
     "Set the font of FACE to FAMILY."
@@ -425,17 +394,23 @@ If FRAME is nil, use the default face."
 	   (fontobj (font-create-object font)))
       (font-family fontobj)))
 
-  (nconc custom-face-attributes
-	 '((:family (editable-field :format "Font Family: %v"
-				    :help-echo "\
+  (setq custom-face-attributes
+	(append '((:family (editable-field :format "Font Family: %v"
+					  :help-echo "\
 Name of font family to use (e.g. times).") 
-		    custom-set-face-font-family
-		    custom-face-font-family)
-	   (:size (editable-field :format "Size: %v"
-				  :help-echo "\
+			  custom-set-face-font-family
+			  custom-face-font-family)
+		  (:size (editable-field :format "Size: %v"
+					 :help-echo "\
 Text size (e.g. 9pt or 2mm).")
-		  custom-set-face-font-size
-		  custom-face-font-size))))
+			 custom-set-face-font-size
+			 custom-face-font-size)
+		  (:strikethru (toggle :format "Strikethru: %[%v%]\n"
+				      :help-echo "\
+Control whether the text should be strikethru.")
+			       set-face-strikethru-p
+			       face-strikethru-p))
+		custom-face-attributes)))
 
 ;;; Frames.
 

lisp/custom.el

@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.71
+;; Version: 1.84
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -23,16 +23,26 @@
 
 (define-widget-keywords :prefix :tag :load :link :options :type :group)
 
+(defvar custom-define-hook nil
+  ;; Customize information for this option is in `cus-edit.el'.
+  "Hook called after defining each customize option.")
+
 ;;; The `defcustom' Macro.
 
 (defun custom-declare-variable (symbol value doc &rest args)
   "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
-  (unless (and (default-boundp symbol)
-	       (not (get symbol 'saved-value)))
+  ;; Bind this variable unless it already is bound.
+  (unless (default-boundp symbol)
+    ;; Use the saved value if it exists, otherwise the factory setting.
     (set-default symbol (if (get symbol 'saved-value)
 			    (eval (car (get symbol 'saved-value)))
 			  (eval value))))
+  ;; Remember the factory setting.
   (put symbol 'factory-value (list value))
+  ;; Maybe this option was rogue in an earlier version.  It no longer is.
+  (when (get symbol 'force-value)
+    ;; It no longer is.    
+    (put symbol 'force-value nil))
   (when doc
     (put symbol 'variable-documentation doc))
   (while args 
@@ -262,23 +272,23 @@ the default value for the SYMBOL."
 		(value (nth 1 entry))
 		(now (nth 2 entry)))
 	    (put symbol 'saved-value (list value))
-	    (when now 
-	      (put symbol 'force-value t)
-	      (set-default symbol (eval value)))
+	    (cond (now 
+		   ;; Rogue variable, set it now.
+		   (put symbol 'force-value t)
+		   (set-default symbol (eval value)))
+		  ((default-boundp symbol)
+		   ;; Something already set this, overwrite it.
+		   (set-default symbol (eval value))))
 	    (setq args (cdr args)))
 	;; Old format, a plist of SYMBOL VALUE pairs.
+	(message "Warning: old format `custom-set-variables'")
+	(ding)
+	(sit-for 2)
 	(let ((symbol (nth 0 args))
 	      (value (nth 1 args)))
 	  (put symbol 'saved-value (list value)))
 	(setq args (cdr (cdr args)))))))
 
-;;; Meta Customization
-
-(defcustom custom-define-hook nil
-  "Hook called after defining each customize option."
-  :group 'customize
-  :type 'hook)
-
 ;;; The End.
 
 (provide 'custom)

lisp/wid-browse.el

@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.71
+;; Version: 1.84
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -29,7 +29,13 @@
   
 (unless widget-browse-mode-map
   (setq widget-browse-mode-map (make-sparse-keymap))
-  (set-keymap-parent widget-browse-mode-map widget-keymap))
+  (set-keymap-parent widget-browse-mode-map widget-keymap)
+  (define-key widget-browse-mode-map "q" 'bury-buffer))
+
+(easy-menu-define widget-browse-mode-customize-menu 
+    widget-browse-mode-map
+  "Menu used in widget browser buffers."
+  (customize-menu-create 'widgets))
 
 (easy-menu-define widget-browse-mode-menu 
     widget-browse-mode-map
@@ -59,6 +65,7 @@ if that value is non-nil."
   (setq major-mode 'widget-browse-mode
 	mode-name "Widget")
   (use-local-map widget-browse-mode-map)
+  (easy-menu-add widget-browse-mode-customize-menu)
   (easy-menu-add widget-browse-mode-menu)
   (run-hooks 'widget-browse-mode-hook))
 
@@ -82,6 +89,7 @@ if that value is non-nil."
 
 (defvar widget-browse-history nil)
 
+;;;###autoload
 (defun widget-browse (widget)
   "Create a widget browser for WIDGET."
   (interactive (list (completing-read "Widget: " 
@@ -106,11 +114,11 @@ if that value is non-nil."
   (widget-browse-mode)
   
   ;; Quick way to get out.
-  (widget-create 'push-button
-		 :action (lambda (widget &optional event)
-			   (bury-buffer))
-		 "Quit")
-  (widget-insert "\n")
+;;  (widget-create 'push-button
+;;		 :action (lambda (widget &optional event)
+;;			   (bury-buffer))
+;;		 "Quit")
+;;  (widget-insert "\n")
 
   ;; Top text indicating whether it is a class or object browser.
   (if (listp widget)
@@ -145,6 +153,18 @@ if that value is non-nil."
   (widget-setup)
   (goto-char (point-min)))
 
+;;;###autoload
+(defun widget-browse-other-window (&optional widget)
+  "Show widget browser for WIDGET in other window."
+  (interactive)
+  (let ((window (selected-window)))
+    (switch-to-buffer-other-window "*Browse Widget*")
+    (if widget
+	(widget-browse widget)
+      (call-interactively 'widget-browse))
+    (select-window window)))
+
+
 ;;; The `widget-browse' Widget.
 
 (define-widget 'widget-browse 'push-button

lisp/wid-edit.el

@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.71
+;; Version: 1.84
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -1238,13 +1238,14 @@ With optional ARG, move across that many fields."
 (define-widget 'push-button 'item
   "A pushable button."
   :value-create 'widget-push-button-value-create
+  :text-format "[%s]"
   :format "%[%v%]")
 
 (defun widget-push-button-value-create (widget)
   ;; Insert text representing the `on' and `off' states.
   (let* ((tag (or (widget-get widget :tag)
 		  (widget-get widget :value)))
-	 (text (concat "[" tag "]"))
+	 (text (format (widget-get widget :text-format) tag))
 	 (gui (cdr (assoc tag widget-push-button-cache))))
     (if (and (fboundp 'make-gui-button)
 	     (fboundp 'make-glyph)
@@ -2374,7 +2375,7 @@ It will read a directory name from the minibuffer when activated."
 (defun widget-vector-match (widget value) 
   (and (vectorp value)
        (widget-group-match widget
-			   (widget-apply :value-to-internal widget value))))
+			   (widget-apply widget :value-to-internal value))))
 
 (define-widget 'cons 'group
   "A cons-cell."

lisp/widget.el

@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.71
+;; Version: 1.84
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -27,8 +27,8 @@
 	     (set (car keywords) (car keywords)))
 	 (setq keywords (cdr keywords)))))))
 
-(define-widget-keywords :deactivate :active :inactive :activate
-  :sibling-args :delete-button-args
+(define-widget-keywords :text-format :deactivate :active :inactive 
+  :activate :sibling-args :delete-button-args
   :insert-button-args :append-button-args :button-args 
   :tag-glyph :off-glyph :on-glyph :valid-regexp
   :secret :sample-face :sample-face-get :case-fold :widget-doc 
@@ -50,6 +50,7 @@
   (autoload 'widget-create "wid-edit")
   (autoload 'widget-insert "wid-edit")
   (autoload 'widget-browse "wid-browse" nil t)
+  (autoload 'widget-browse-other-window "wid-browse" nil t)
   (autoload 'widget-browse-at "wid-browse" nil t))
 
 (defun define-widget (name class doc &rest args)