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