annotate lisp/wid-browse.el @ 5724:ede80ef92a74

Make soft links in src for module source files, if built in to the executable. This ensures that those files are built with the same compiler flags as all other source files. See these xemacs-beta messages: <CAHCOHQn+q=Xuwq+y68dvqi7afAP9f-TdB7=8YiZ8VYO816sjHg@mail.gmail.com> <f5by5ejqiyk.fsf@calexico.inf.ed.ac.uk>
author Jerry James <james@xemacs.org>
date Sat, 02 Mar 2013 14:32:37 -0700
parents 308d34e9f07d
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
1 ;;; wid-browse.el --- Functions for browsing widgets.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
2 ;;
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
4 ;;
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
6 ;; Keywords: extensions
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
7 ;; Version: 1.9960
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
9
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 502
diff changeset
10 ;; This file is part of XEmacs.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
11
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
12 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
13 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
14 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
15 ;; option) any later version.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
16
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
20 ;; for more details.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
21
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 613
diff changeset
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
24
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
25 ;;; Commentary:
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
26 ;;
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
27 ;; Widget browser. See `widget.el'.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
28
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
29 ;;; Code:
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
30
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
31 (require 'easymenu)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
32 (require 'custom)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
33 (require 'wid-edit)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
34 (eval-when-compile (require 'cl))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
35
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
36 (defgroup widget-browse nil
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
37 "Customization support for browsing widgets."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
38 :group 'widgets)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
39
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
40 ;;; The Mode.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
41
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
42 (defvar widget-browse-mode-map nil
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
43 "Keymap for `widget-browse-mode'.")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
44
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
45 (unless widget-browse-mode-map
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
46 (setq widget-browse-mode-map (make-sparse-keymap))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
47 (set-keymap-parent widget-browse-mode-map widget-keymap)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
48 (define-key widget-browse-mode-map "q" 'bury-buffer))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
49
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
50 (easy-menu-define widget-browse-mode-customize-menu
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
51 widget-browse-mode-map
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
52 "Menu used in widget browser buffers."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
53 (customize-menu-create 'widgets))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
54
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
55 (easy-menu-define widget-browse-mode-menu
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
56 widget-browse-mode-map
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
57 "Menu used in widget browser buffers."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
58 '("Widget"
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
59 ["Browse" widget-browse t]
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
60 ["Browse At" widget-browse-at t]))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
61
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
62 (defcustom widget-browse-mode-hook nil
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
63 "Hook called when entering widget-browse-mode."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
64 :type 'hook
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
65 :group 'widget-browse)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
66
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
67 (defun widget-browse-mode ()
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
68 "Major mode for widget browser buffers.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
69
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
70 The following commands are available:
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
71
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
72 \\[widget-forward] Move to next button or editable field.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
73 \\[widget-backward] Move to previous button or editable field.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
74 \\[widget-button-click] Activate button under the mouse pointer.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
75 \\[widget-button-press] Activate button under point.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
76
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
77 Entry to this mode calls the value of `widget-browse-mode-hook'
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
78 if that value is non-nil."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
79 (kill-all-local-variables)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
80 (setq major-mode 'widget-browse-mode
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
81 mode-name "Widget")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
82 (use-local-map widget-browse-mode-map)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
83 (easy-menu-add widget-browse-mode-customize-menu)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
84 (easy-menu-add widget-browse-mode-menu)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
85 (run-hooks 'widget-browse-mode-hook))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
86
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
87 ;;; Commands.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
88
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
89 ;;;###autoload
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
90 (defun widget-browse-at (pos)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
91 "Browse the widget under point."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
92 (interactive "d")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
93 (let* ((field (get-char-property pos 'field))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
94 (button (get-char-property pos 'button))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
95 (doc (get-char-property pos 'widget-doc))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
96 (text (cond (field "This is an editable text area.")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
97 (button "This is an active area.")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
98 (doc "This is documentation text.")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
99 (t "This is unidentified text.")))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
100 (widget (or field button doc)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
101 (when widget
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
102 (widget-browse widget))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
103 (message text)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
104
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
105 (defvar widget-browse-history nil)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
106
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
107 ;;;###autoload
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
108 (defun widget-browse (widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
109 "Create a widget browser for WIDGET."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
110 (interactive (list (completing-read "Widget: "
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
111 obarray
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
112 (lambda (symbol)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
113 (get symbol 'widget-type))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
114 t nil 'widget-browse-history)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
115 (if (stringp widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
116 (setq widget (intern widget)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
117 (unless (if (symbolp widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
118 (get widget 'widget-type)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
119 (and (consp widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
120 (get (widget-type widget) 'widget-type)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
121 (error "Not a widget."))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
122 ;; Create the buffer.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
123 (if (symbolp widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
124 (let ((buffer (format "*Browse %s Widget*" widget)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
125 (kill-buffer (get-buffer-create buffer))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
126 (switch-to-buffer (get-buffer-create buffer)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
127 (kill-buffer (get-buffer-create "*Browse Widget*"))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
128 (switch-to-buffer (get-buffer-create "*Browse Widget*")))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
129 (widget-browse-mode)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
130
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
131 ;; Quick way to get out.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
132 ;; (widget-create 'push-button
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
133 ;; :action (lambda (widget &optional event)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
134 ;; (bury-buffer))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
135 ;; "Quit")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
136 ;; (widget-insert "\n")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
137
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
138 ;; Top text indicating whether it is a class or object browser.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
139 (if (listp widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
140 (widget-insert "Widget object browser.\n\nClass: ")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
141 (widget-insert "Widget class browser.\n\n")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
142 (widget-create 'widget-browse
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
143 :format "%[%v%]\n%d"
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
144 :doc (get widget 'widget-documentation)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
145 widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
146 (unless (eq (preceding-char) ?\n)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
147 (widget-insert "\n"))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
148 (widget-insert "\nSuper: ")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
149 (setq widget (get widget 'widget-type)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
150
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
151 ;; Now show the attributes.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
152 (let ((name (car widget))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
153 (items (cdr widget))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
154 key value printer)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
155 (widget-create 'widget-browse
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
156 :format "%[%v%]"
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
157 name)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
158 (widget-insert "\n")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
159 (while items
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
160 (setq key (nth 0 items)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
161 value (nth 1 items)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
162 printer (or (get key 'widget-keyword-printer)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
163 'widget-browse-sexp)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
164 items (cdr (cdr items)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
165 (widget-insert "\n" (symbol-name key) "\n\t")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
166 (funcall printer widget key value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
167 (widget-insert "\n")))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
168 (widget-setup)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
169 (goto-char (point-min)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
170
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
171 ;;;###autoload
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
172 (defun widget-browse-other-window (&optional widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
173 "Show widget browser for WIDGET in other window."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
174 (interactive)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
175 (let ((window (selected-window)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
176 (switch-to-buffer-other-window "*Browse Widget*")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
177 (if widget
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
178 (widget-browse widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
179 (call-interactively 'widget-browse))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
180 (select-window window)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
181
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
182
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
183 ;;; The `widget-browse' Widget.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
184
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
185 (define-widget 'widget-browse 'push-button
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
186 "Button for creating a widget browser.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
187 The :value of the widget shuld be the widget to be browsed."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
188 :format "%[[%v]%]"
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
189 :value-create 'widget-browse-value-create
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
190 :action 'widget-browse-action)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
191
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
192 (defun widget-browse-action (widget &optional event)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
193 ;; Create widget browser for WIDGET's :value.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
194 (widget-browse (widget-get widget :value)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
195
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
196 (defun widget-browse-value-create (widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
197 ;; Insert type name.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
198 (let ((value (widget-get widget :value)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
199 (cond ((symbolp value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
200 (insert (symbol-name value)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
201 ((consp value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
202 (insert (symbol-name (widget-type value))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
203 (t
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
204 (insert "strange")))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
205
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
206 ;;; Keyword Printer Functions.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
207
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
208 (defun widget-browse-widget (widget key value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
209 "Insert description of WIDGET's KEY VALUE.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
210 VALUE is assumed to be a widget."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
211 (widget-create 'widget-browse value))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
212
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
213 (defun widget-browse-widgets (widget key value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
214 "Insert description of WIDGET's KEY VALUE.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
215 VALUE is assumed to be a list of widgets."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
216 (while value
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
217 (widget-create 'widget-browse
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
218 (car value))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
219 (setq value (cdr value))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
220 (when value
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
221 (widget-insert " "))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
222
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
223 (defun widget-browse-sexp (widget key value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
224 "Insert description of WIDGET's KEY VALUE.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
225 Nothing is assumed about value."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
226 (let ((pp (condition-case signal
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 209
diff changeset
227 (declare-fboundp (pp-to-string value))
209
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
228 (error (prin1-to-string signal)))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
229 (when (string-match "\n\\'" pp)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
230 (setq pp (substring pp 0 (1- (length pp)))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
231 (if (cond ((string-match "\n" pp)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
232 nil)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
233 ((> (length pp) (- (window-width) (current-column)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
234 nil)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
235 (t t))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
236 (widget-insert pp)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
237 (widget-create 'push-button
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
238 :tag "show"
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
239 :action (lambda (widget &optional event)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
240 (with-output-to-temp-buffer
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
241 "*Pp Eval Output*"
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
242 (princ (widget-get widget :value))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
243 pp))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
244
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
245 (defun widget-browse-sexps (widget key value)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
246 "Insert description of WIDGET's KEY VALUE.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
247 VALUE is assumed to be a list of widgets."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
248 (let ((target (current-column)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
249 (while value
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
250 (widget-browse-sexp widget key (car value))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
251 (setq value (cdr value))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
252 (when value
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
253 (widget-insert "\n" (make-string target ?\ ))))))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
254
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
255 ;;; Keyword Printers.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
256
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
257 (put :parent 'widget-keyword-printer 'widget-browse-widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
258 (put :children 'widget-keyword-printer 'widget-browse-widgets)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
259 (put :buttons 'widget-keyword-printer 'widget-browse-widgets)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
260 (put :button 'widget-keyword-printer 'widget-browse-widget)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
261 (put :args 'widget-keyword-printer 'widget-browse-sexps)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
262
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
263 ;;; Widget Minor Mode.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
264
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
265 (defvar widget-minor-mode nil
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
266 "I non-nil, we are in Widget Minor Mode.")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
267 (make-variable-buffer-local 'widget-minor-mode)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
268
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
269 (defvar widget-minor-mode-map nil
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
270 "Keymap used in Widget Minor Mode.")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
271
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
272 (unless widget-minor-mode-map
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
273 (setq widget-minor-mode-map (make-sparse-keymap))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
274 (set-keymap-parent widget-minor-mode-map widget-keymap))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
275
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
276 ;;;###autoload
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
277 (defun widget-minor-mode (&optional arg)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
278 "Togle minor mode for traversing widgets.
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
279 With arg, turn widget mode on if and only if arg is positive."
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
280 (interactive "P")
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
281 (cond ((null arg)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
282 (setq widget-minor-mode (not widget-minor-mode)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
283 ((<= arg 0)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
284 (setq widget-minor-mode nil))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
285 (t
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
286 (setq widget-minor-mode t)))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
287 (force-mode-line-update))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
288
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
289 (add-to-list 'minor-mode-alist '(widget-minor-mode " Widget"))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
290
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
291 (add-to-list 'minor-mode-map-alist
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
292 (cons 'widget-minor-mode widget-minor-mode-map))
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
293
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
294 ;;; The End:
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
295
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
296 (provide 'wid-browse)
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
297
41ff10fd062f Import from CVS: tag r20-4b3
cvs
parents:
diff changeset
298 ;; wid-browse.el ends here