Mercurial > hg > xemacs-beta

comparison lisp/custom/wid-edit.el @ 167:85ec50267440 r20-3b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents 5a88923fcbfe
children 8eaf7971accc
comparison
equal deleted inserted replaced
166:7a77eb660975 167:85ec50267440
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: extensions 6 ;; Keywords: extensions
7 ;; Version: 1.9937 7 ;; Version: 1.9940
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
52 nil)) 52 nil))
53 (defun widget-event-point (event) 53 (defun widget-event-point (event)
54 "Character position of the end of event if that exists, or nil." 54 "Character position of the end of event if that exists, or nil."
55 (posn-point (event-end event)))) 55 (posn-point (event-end event))))
56 56
57 (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version) 57 (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version)
58 'next-event 58 'next-event
59 'read-event)) 59 'read-event))
60 60
61 ;; The following should go away when bundled with Emacs. 61 ;; The following should go away when bundled with Emacs.
62 (condition-case () 62 (condition-case ()
81 "Non-nil if EVENT is a mouse-button-release event object." 81 "Non-nil if EVENT is a mouse-button-release event object."
82 (and (eventp event) 82 (and (eventp event)
83 (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3)) 83 (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3))
84 (or (memq 'click (event-modifiers event)) 84 (or (memq 'click (event-modifiers event))
85 (memq 'drag (event-modifiers event)))))) 85 (memq 'drag (event-modifiers event))))))
86
87 (unless (fboundp 'functionp)
88 ;; Missing from Emacs 19.34 and earlier.
89 (defun functionp (object)
90 "Non-nil of OBJECT is a type of object that can be called as a function."
91 (or (subrp object) (byte-code-function-p object)
92 (eq (car-safe object) 'lambda)
93 (and (symbolp object) (fboundp object)))))
86 94
87 (unless (fboundp 'error-message-string) 95 (unless (fboundp 'error-message-string)
88 ;; Emacs function missing in XEmacs. 96 ;; Emacs function missing in XEmacs.
89 (defun error-message-string (obj) 97 (defun error-message-string (obj)
90 "Convert an error value to an error message." 98 "Convert an error value to an error message."
166 (:background "dim gray")) 174 (:background "dim gray"))
167 (t 175 (t
168 (:italic t))) 176 (:italic t)))
169 "Face used for editable fields." 177 "Face used for editable fields."
170 :group 'widget-faces) 178 :group 'widget-faces)
179
180 (defface widget-single-line-field-face '((((class grayscale color)
181 (background light))
182 (:background "gray85"))
183 (((class grayscale color)
184 (background dark))
185 (:background "dim gray"))
186 (t
187 (:italic t)))
188 "Face used for editable fields spanning only a single line."
189 :group 'widget-faces)
190
191 (defvar widget-single-line-display-table
192 (let ((table (make-display-table)))
193 (aset table 9 "^I")
194 (aset table 10 "^J")
195 table)
196 "Display table used for single-line editable fields.")
197
198 (when (fboundp 'set-face-display-table)
199 (set-face-display-table 'widget-single-line-field-face
200 widget-single-line-display-table))
171 201
172 ;;; Utility functions. 202 ;;; Utility functions.
173 ;; 203 ;;
174 ;; These are not really widget specific. 204 ;; These are not really widget specific.
175 205
1811 (defun widget-field-value-create (widget) 1841 (defun widget-field-value-create (widget)
1812 ;; Create an editable text field. 1842 ;; Create an editable text field.
1813 (let ((size (widget-get widget :size)) 1843 (let ((size (widget-get widget :size))
1814 (value (widget-get widget :value)) 1844 (value (widget-get widget :value))
1815 (from (point)) 1845 (from (point))
1846 ;; This is changed to a real overlay in `widget-setup'. We
1847 ;; need the end points to behave differently until
1848 ;; `widget-setup' is called.
1816 (overlay (cons (make-marker) (make-marker)))) 1849 (overlay (cons (make-marker) (make-marker))))
1817 (widget-put widget :field-overlay overlay) 1850 (widget-put widget :field-overlay overlay)
1818 (insert value) 1851 (insert value)
1819 (and size 1852 (and size
1820 (< (length value) size) 1853 (< (length value) size)
2868 2901
2869 (define-widget 'regexp 'string 2902 (define-widget 'regexp 'string
2870 "A regular expression." 2903 "A regular expression."
2871 :match 'widget-regexp-match 2904 :match 'widget-regexp-match
2872 :validate 'widget-regexp-validate 2905 :validate 'widget-regexp-validate
2906 :value-face 'widget-single-line-field-face
2873 :tag "Regexp") 2907 :tag "Regexp")
2874 2908
2875 (defun widget-regexp-match (widget value) 2909 (defun widget-regexp-match (widget value)
2876 ;; Match valid regexps. 2910 ;; Match valid regexps.
2877 (and (stringp value) 2911 (and (stringp value)
2893 "A file widget. 2927 "A file widget.
2894 It will read a file name from the minibuffer when invoked." 2928 It will read a file name from the minibuffer when invoked."
2895 :complete-function 'widget-file-complete 2929 :complete-function 'widget-file-complete
2896 :prompt-value 'widget-file-prompt-value 2930 :prompt-value 'widget-file-prompt-value
2897 :format "%{%t%}: %v" 2931 :format "%{%t%}: %v"
2932 :value-face 'widget-single-line-field-face
2898 :tag "File") 2933 :tag "File")
2899 2934
2900 (defun widget-file-complete () 2935 (defun widget-file-complete ()
2901 "Perform completion on file name preceding point." 2936 "Perform completion on file name preceding point."
2902 (interactive) 2937 (interactive)