Mercurial > hg > xemacs-beta

comparison lisp/custom/wid-edit.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children d620409f5eb8
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
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.59 7 ;; Version: 1.63
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;;; Commentary: 10 ;;; Commentary:
11 ;; 11 ;;
12 ;; See `widget.el'. 12 ;; See `widget.el'.
731 (field (next-single-property-change (point-min) 'field))) 731 (field (next-single-property-change (point-min) 'field)))
732 (cond ((and button field) (goto-char (min button field))) 732 (cond ((and button field) (goto-char (min button field)))
733 (button (goto-char button)) 733 (button (goto-char button))
734 (field (goto-char field)) 734 (field (goto-char field))
735 (t 735 (t
736 (error "No buttons or fields found"))))))))) 736 (error "No buttons or fields found"))))))
737 (setq button (widget-at (point)))
738 (if (and button (widget-get button :tab-order)
739 (< (widget-get button :tab-order) 0))
740 (setq arg (1+ arg))))))
737 (while (< arg 0) 741 (while (< arg 0)
738 (if (= (point-min) (point)) 742 (if (= (point-min) (point))
739 (forward-char 1)) 743 (forward-char 1))
740 (setq arg (1+ arg)) 744 (setq arg (1+ arg))
741 (let ((previous (cond ((get-text-property (1- (point)) 'button) 745 (let ((previous (cond ((get-text-property (1- (point)) 'button)
765 (let ((button (previous-single-property-change (point) 'button)) 769 (let ((button (previous-single-property-change (point) 'button))
766 (field (previous-single-property-change (point) 'field))) 770 (field (previous-single-property-change (point) 'field)))
767 (cond ((and button field) 771 (cond ((and button field)
768 (goto-char (max button field))) 772 (goto-char (max button field)))
769 (button (goto-char button)) 773 (button (goto-char button))
770 (field (goto-char field))))) 774 (field (goto-char field)))
775 (setq button (widget-at (point)))
776 (if (and button (widget-get button :tab-order)
777 (< (widget-get button :tab-order) 0))
778 (setq arg (1- arg)))))
771 (widget-echo-help (point)) 779 (widget-echo-help (point))
772 (run-hooks 'widget-move-hook)) 780 (run-hooks 'widget-move-hook))
773 781
774 (defun widget-forward (arg) 782 (defun widget-forward (arg)
775 "Move point to the next field or button. 783 "Move point to the next field or button.
2326 ;;; The `color' Widget. 2334 ;;; The `color' Widget.
2327 2335
2328 (define-widget 'color-item 'choice-item 2336 (define-widget 'color-item 'choice-item
2329 "A color name (with sample)." 2337 "A color name (with sample)."
2330 :format "%v (%{sample%})\n" 2338 :format "%v (%{sample%})\n"
2331 :button-face-get 'widget-color-item-button-face-get) 2339 :sample-face-get 'widget-color-item-button-face-get)
2332 2340
2333 (defun widget-color-item-button-face-get (widget) 2341 (defun widget-color-item-button-face-get (widget)
2334 ;; We create a face from the value. 2342 ;; We create a face from the value.
2335 (require 'facemenu) 2343 (require 'facemenu)
2336 (condition-case nil 2344 (condition-case nil
2339 2347
2340 (define-widget 'color 'push-button 2348 (define-widget 'color 'push-button
2341 "Choose a color name (with sample)." 2349 "Choose a color name (with sample)."
2342 :format "%[%t%]: %v" 2350 :format "%[%t%]: %v"
2343 :tag "Color" 2351 :tag "Color"
2344 :value "default" 2352 :value "black"
2345 :value-create 'widget-color-value-create 2353 :value-create 'widget-color-value-create
2346 :value-delete 'widget-children-value-delete 2354 :value-delete 'widget-children-value-delete
2347 :value-get 'widget-color-value-get 2355 :value-get 'widget-color-value-get
2348 :value-set 'widget-color-value-set 2356 :value-set 'widget-color-value-set
2349 :action 'widget-color-action 2357 :action 'widget-color-action