Mercurial > hg > xemacs-beta

comparison lisp/w3/widget.el @ 14:9ee227acff29 r19-15b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents 376386a54a3c
children 0293115a14e9 6a378aca36af
comparison
equal deleted inserted replaced
13:13c6d0aaafe5 14:9ee227acff29
2 ;; 2 ;;
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, extensions, faces, hypermedia 6 ;; Keywords: help, extensions, faces, hypermedia
7 ;; Version: 0.4 7 ;; Version: 1.13
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
8 9
9 ;;; Commentary: 10 ;;; Commentary:
10 ;; 11 ;;
11 ;; The documentation for the unbundled version of this library is 12 ;; If you want to use this code, please visit the URL above.
12 ;; available in `custom.texi'.
13 ;; 13 ;;
14 ;; This file only contain the code needed to define new widget types. 14 ;; This file only contain the code needed to define new widget types.
15 ;; Everything else is autoloaded from `widget-edit.el'. 15 ;; Everything else is autoloaded from `widget-edit.el'.
16 16
17 ;;; Code: 17 ;;; Code:
18 18
19 (eval-when-compile (require 'cl)) 19 (eval-when-compile (require 'cl))
20 20
21 (let ((keywords 21 (defmacro define-widget-keywords (&rest keys)
22 '(:create :convert-widget :format :value-create :tag :doc :from :to 22 (`
23 :args :value :value-from :value-to :action :value-set 23 (eval-and-compile
24 :value-delete :match :parent :delete :menu-tag-get 24 (let ((keywords (quote (, keys))))
25 :value-get :choice :void :menu-tag :on :off :on-type 25 (while keywords
26 :off-type :notify :entry-format :button :children 26 (or (boundp (car keywords))
27 :buttons :insert-before :delete-at :format-handler 27 (set (car keywords) (car keywords)))
28 :widget :value-pos :value-to-internal :indent 28 (setq keywords (cdr keywords)))))))
29 :help-echo
30 :value-to-external :validate :error :directory :must-match
31 :initial :type-error :value-inline :inline :match-inline
32 :greedy :button-face :value-face :keymap :size)))
33 (while keywords
34 (or (boundp (car keywords))
35 (set (car keywords) (car keywords)))
36 (setq keywords (cdr keywords))))
37 29
30 (define-widget-keywords :case-fold :widget-doc
31 :create :convert-widget :format :value-create :offset :extra-offset
32 :tag :doc :from :to :args :value :value-from :value-to :action
33 :value-set :value-delete :match :parent :delete :menu-tag-get
34 :value-get :choice :void :menu-tag :on :off :on-type :off-type
35 :notify :entry-format :button :children :buttons :insert-before
36 :delete-at :format-handler :widget :value-pos :value-to-internal
37 :indent :size :value-to-external :validate :error :directory
38 :must-match :type-error :value-inline :inline :match-inline :greedy
39 :button-face-get :button-face :value-face :keymap :entry-from
40 :entry-to :help-echo :documentation-property :hide-front-space
41 :hide-rear-space)
42
43 ;; These autoloads should be deleted when the file is added to Emacs.
44 (autoload 'widget-create "widget-edit")
45 (autoload 'widget-insert "widget-edit")
46
47 ;;;###autoload
38 (defun define-widget (name class doc &rest args) 48 (defun define-widget (name class doc &rest args)
39 "Define a new widget type named NAME from CLASS. 49 "Define a new widget type named NAME from CLASS.
40 50
41 NAME and CLASS should both be symbols, CLASS should be one of the 51 NAME and CLASS should both be symbols, CLASS should be one of the
42 existing widget types, or nil to create the widget from scratch. 52 existing widget types, or nil to create the widget from scratch.
50 60
51 The third argument DOC is a documentation string for the widget." 61 The third argument DOC is a documentation string for the widget."
52 (put name 'widget-type (cons class args)) 62 (put name 'widget-type (cons class args))
53 (put name 'widget-documentation doc)) 63 (put name 'widget-documentation doc))
54 64
55 (autoload 'widget-create "widget-edit")
56 (autoload 'widget-insert "widget-edit")
57
58 (defun define-widget-group (name class doc &rest args)
59 "Define a new widget group named NAME.
60
61 CLASS should be nil, it is reserved for future use.
62
63 MATCH should be a function taking a widget group and a list of match
64 types as an argument, and returning the remaining part of the list if
65 the widget group matches the beginning of the list, or throwing
66 `no-match' if not.
67
68 CREATE should be a function taking a widget group and a list of values
69 as arguments, and returning a cons whose car is a list of widgets
70 representing the matches values and whose cdr is the remaining
71 unmatched values."
72 (put name 'widget-group (cons class args)))
73
74 ;;; The End. 65 ;;; The End.
75 66
76 (provide 'widget) 67 (provide 'widget)
77 68
78 ;; widget.el ends here 69 ;; widget.el ends here