diff lisp/custom/wid-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 8eaf7971accc
line wrap: on
line diff
--- a/lisp/custom/wid-edit.el	Mon Aug 13 09:44:44 2007 +0200
+++ b/lisp/custom/wid-edit.el	Mon Aug 13 09:45:46 2007 +0200
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9937
+;; Version: 1.9940
 ;; 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))
 
@@ -84,6 +84,14 @@
 	   (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 @@
   "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.
@@ -1813,6 +1843,9 @@
   (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)
@@ -2870,6 +2903,7 @@
   "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)
@@ -2895,6 +2929,7 @@
   :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 ()