/[cmucl]/src/motif/lisp/prototypes.lisp
ViewVC logotype

Contents of /src/motif/lisp/prototypes.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Sun Dec 20 04:22:54 1998 UTC (15 years, 4 months ago) by dtc
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, double-double-array-base, post-merge-intl-branch, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, snapshot-2003-10, snapshot-2004-10, release-18e-base, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, remove_negative_zero_not_zero, snapshot-2007-01, snapshot-2007-02, snapshot-2004-05, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, GIT-CONVERSION, double-double-init-ppc, release-19c, dynamic-extent-base, unicode-utf16-sync-2008-12, LINKAGE_TABLE, release-19c-base, cross-sol-x86-merged, label-2009-03-16, release-19f-base, PRE_LINKAGE_TABLE, merge-sse2-packed, mod-arith-base, sparc_gencgc_merge, merge-with-19f, snapshot-2004-12, snapshot-2004-11, intl-branch-working-2010-02-11-1000, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, release-18e-pre2, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, cold-pcl-base, RELEASE_20b, snapshot-2008-04, snapshot-2003-11, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, release-19a-base, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, sparc_gencgc, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2003-12, release-19a-pre1, release-19a-pre3, release-19a-pre2, pre-merge-intl-branch, release-19a, UNICODE-BASE, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, release-18e, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, cross-sol-x86-2010-12-20, double-double-init-x86, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2004-04, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, cross-sparc-branch-base, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, lisp-executable-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, release-18e-pre1, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, HEAD
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, mod-arith-branch, RELEASE-19F-BRANCH, portable-clx-branch, sparc_gencgc_branch, cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, dynamic-extent, UNICODE-BRANCH, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, lisp-executable, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, release-18e-branch, cold-pcl, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, release-19a-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.8: +5 -1 lines
Add CMUCL style file-comments; from Peter Van Eynde.
1 ;;;; -*- Mode: Lisp, Fill ; Package: Toolkit -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;; If you want to use this code or any part of CMU Common Lisp, please
7 ;;; contact Scott Fahlman or slisp-group@cs.cmu.edu.
8 ;;;
9 (ext:file-comment
10 "$Header: /tiger/var/lib/cvsroots/cmucl/src/motif/lisp/prototypes.lisp,v 1.9 1998/12/20 04:22:54 dtc Rel $")
11 ;;;
12 ;;; **********************************************************************
13 ;;;
14 ;;; Written by Michael Garland
15 ;;;
16 ;;; This file contains the prototyping code for RPC requests between the
17 ;;; Lisp client and the C server.
18 ;;;
19
20 (in-package "TOOLKIT")
21
22 ;;; This table is accessed at compile time so that we know the request ID as a
23 ;;; numeric constant, and thus don't have to close over it at load time. The
24 ;;; same updates are done in parallel at compile and load time.
25 ;;;
26 (eval-when (compile load eval)
27 (defparameter *request-table*
28 (make-array 50 :element-type 'simple-string
29 :adjustable t :fill-pointer 0)))
30
31 (declaim (vector *request-table*))
32
33
34
35 ;;;; Macros for defining toolkit request operations
36
37 (eval-when (compile eval)
38 (defmacro def-toolkit-request (string-name symbol-name options
39 doc-string args return &body forms)
40 (declare (simple-string string-name doc-string)
41 (list args return))
42 (let ((arg-list (mapcar #'car args))
43 (type-list (mapcar #'cadr args))
44 (code (fill-pointer *request-table*)))
45 `(progn
46 (eval-when (compile load eval)
47 (vector-push-extend (format nil "R~a" ,string-name) *request-table*))
48 (defun ,symbol-name ,arg-list
49 ,doc-string
50 ;; *** This generates lots of warnings at the moment
51 ;; (declare (inline toolkit-write-value))
52 ,(cons 'declare
53 (mapcar #'(lambda (arg type) (list 'type type arg))
54 arg-list type-list))
55 (let ((message (prepare-request ,code ,options ,(length args))))
56 ,(cons 'progn
57 (mapcar #'(lambda (arg)
58 (let ((name (first arg))
59 (type (third arg)))
60 (if type
61 (list 'toolkit-write-value 'message
62 name type)
63 (list 'toolkit-write-value 'message name))))
64 args))
65 (let ((reply (send-request-to-server message ,options)))
66 ,(if (eq options :confirm)
67 `(multiple-value-prog1
68 ,(ecase (length return)
69 (0)
70 (1 `(let ((result (toolkit-read-value reply)))
71 ,@forms
72 result))
73 (2 `(let* ((first (toolkit-read-value reply))
74 (second (toolkit-read-value reply)))
75 ,@forms
76 (values first second)))
77 (3 `(let* ((first (toolkit-read-value reply))
78 (second (toolkit-read-value reply))
79 (third (toolkit-read-value reply)))
80 ,@forms
81 (values first second third)))
82 (4 `(let* ((first (toolkit-read-value reply))
83 (second (toolkit-read-value reply))
84 (third (toolkit-read-value reply))
85 (fourth (toolkit-read-value reply)))
86 ,@forms
87 (values first second third fourth))))
88 (destroy-message reply))
89 '(declare (ignore reply)))))))))
90
91 ;;; This is for sending commands to the server, not requesting Motif
92 ;;; services. These calls take no arguments and return a value indicating
93 ;;; whether they were successful.
94
95 (defmacro def-toolkit-command (symbol-name options &body forms)
96 (let ((string-name (symbol-class symbol-name))
97 (code (fill-pointer *request-table*)))
98 `(progn
99 (eval-when (compile load eval)
100 (vector-push-extend ,string-name *request-table*)
101 (defun ,symbol-name ()
102 (let* ((message (prepare-request ,code ,options 0))
103 (reply (send-request-to-server message ,options)))
104 ,(if (eq options :confirm)
105 `(let ((result (toolkit-read-value reply)))
106 (destroy-message reply)
107 ,@forms
108 result)
109 '(declare (ignore reply)))))))))
110
111 ); eval-when (compile eval)
112
113
114
115 ;;;; Direct commands to server
116
117 (def-toolkit-command quit-server :no-confirm)
118
119 (def-toolkit-command terminate-callback :no-confirm)
120
121
122
123
124 ;;;; Request definitions for Xt Intrinsic functions
125
126 (def-toolkit-request "TransportEvent" transport-event :confirm
127 ""
128 ((event-handle (unsigned-byte 32))) ((alien xevent)))
129
130 (def-toolkit-request "XtAppCreateShell" %create-application-shell :confirm
131 ""
132 ((resources list :resource-list))
133 (widget)
134 (setf (widget-type result) :application-shell))
135
136 (def-toolkit-request "XtRealizeWidget" realize-widget :no-confirm
137 "Realizes the given widget."
138 ((widget widget)) ())
139
140 (def-toolkit-request "XtCreateManagedWidget" %create-managed-widget :confirm
141 ""
142 ((name simple-string) (widget-class keyword) (parent widget)
143 (resources list :resource-list))
144 (widget)
145 (setf (widget-type result) widget-class)
146 (widget-add-child parent result))
147
148 (def-toolkit-request "XtCreateWidget" %create-widget :confirm
149 ""
150 ((name simple-string) (widget-class keyword) (parent widget)
151 (resources list :resource-list))
152 (widget)
153 (setf (widget-type result) widget-class)
154 (widget-add-child parent result))
155
156 (def-toolkit-request "XtAddCallback" %add-callback :no-confirm
157 ""
158 ((widget widget) (name simple-string)) ())
159
160 (def-toolkit-request "XtRemoveCallback" %remove-callback :no-confirm
161 ""
162 ((widget widget) (name simple-string)) ())
163
164 (def-toolkit-request "XtSetValues" %set-values :no-confirm
165 ""
166 ((widget widget) (resources list :resource-list)) ())
167
168 (def-toolkit-request "XtGetValues" %get-values :confirm
169 ""
170 ((widget widget) (resource-names list :resource-names))
171 (list))
172
173 (def-toolkit-request "XtUnrealizeWidget" unrealize-widget :no-confirm
174 "Unrealizes the given widget."
175 ((widget widget)) ())
176
177 ;; Confirm because we rely on callbacks having been called by the time it
178 ;; returns so we can blithely free our copies of the widget(s)
179 (def-toolkit-request "XtDestroyWidget" %destroy-widget :confirm
180 ""
181 ((widget widget)) ())
182
183 (def-toolkit-request "XtMapWidget" map-widget :no-confirm
184 "Maps the X window associated with the given widget."
185 ((widget widget)) ())
186
187 (def-toolkit-request "XtUnmapWidget" unmap-widget :no-confirm
188 "Unmaps the X window associated with the given widget."
189 ((widget widget)) ())
190
191 (def-toolkit-request "XtSetSensitive" set-sensitive :no-confirm
192 "Sets the event sensitivity of the given widget."
193 ((widget widget) (sensitivep (member t nil))) ())
194
195 (def-toolkit-request "XtCreatePopupShell" %create-popup-shell :confirm
196 ""
197 ((name simple-string) (class keyword)
198 (parent widget) (resources list :resource-list))
199 (widget)
200 (setf (widget-type result) class)
201 (widget-add-child parent result))
202
203 (def-toolkit-request "XtPopup" popup :no-confirm
204 "Pops up a popup dialog shell."
205 ((shell widget) (grab-kind keyword)) ())
206
207 (def-toolkit-request "XtPopdown" popdown :no-confirm
208 "Pops down a popup dialog shell."
209 ((shell widget)) ())
210
211 (def-toolkit-request "XtManageChild" manage-child :no-confirm
212 "Manages the given child widget."
213 ((child widget)) ())
214
215 (def-toolkit-request "XtUnmanageChild" unmanage-child :no-confirm
216 "Unmanages the given child widget."
217 ((child widget)) ())
218
219 (def-toolkit-request "XtManageChildren" %manage-children :no-confirm
220 ""
221 ((child-list list :widget-list)) ())
222
223 (def-toolkit-request "XtUnmanageChildren" %unmanage-children :no-confirm
224 ""
225 ((child-list list :widget-list)) ())
226
227 (def-toolkit-request "XtParseTranslationTable" parse-translation-table :confirm
228 "Compiles a translation table string into its internal representation."
229 ((table simple-string)) (translations))
230
231 (def-toolkit-request "XtAugmentTranslations" augment-translations :no-confirm
232 "Augments the translation table of the specified widget with the given
233 translations."
234 ((w widget) (table translations)) ())
235
236 (def-toolkit-request "XtOverrideTranslations" override-translations :no-confirm
237 "Overrides the translation table of the specified widget with the given
238 translations."
239 ((w widget) (table translations)) ())
240
241 (def-toolkit-request "XtUninstallTranslations" uninstall-translations
242 :no-confirm
243 "Unintalls all translations on the given widget."
244 ((w widget)) ())
245
246 (def-toolkit-request "XtParseAcceleratorTable" parse-accelerator-table :confirm
247 "Parses an accelerator string into its internal representation."
248 ((source simple-string)) (accelerators))
249
250 (def-toolkit-request "XtInstallAccelerators" install-accelerators :no-confirm
251 "Installs accelerators from the source widget into the destination widget."
252 ((dest widget) (src widget)) ())
253
254 (def-toolkit-request "XtInstallAllAccelerators" install-all-accelerators
255 :no-confirm
256 "Installs all accelerators from the source widget into the destination
257 widget."
258 ((dest widget) (src widget)) ())
259
260 (def-toolkit-request "XtIsManaged" is-managed :confirm
261 "Returns a value indicating whether the specified widget is managed or not."
262 ((widget widget)) ((member t nil)))
263
264 (def-toolkit-request "XtPopupSpringLoaded" popup-spring-loaded :no-confirm
265 "Pops up a spring loaded popup dialog shell."
266 ((shell widget)) ())
267
268 (def-toolkit-request "XtIsRealized" is-realized :confirm
269 "Returns a value indicating whether the specified widget is realized or not."
270 ((widget widget)) ((member t nil)))
271
272 (def-toolkit-request "XtWindow" widget-window :confirm
273 "Returns the X window associated with the given widget."
274 ((widget widget)) (xlib:window))
275
276 (def-toolkit-request "XtName" widget-name :confirm
277 "Returns the name of the given widget."
278 ((widget widget)) (string))
279
280 (def-toolkit-request "XtIsSensitive" is-sensitive :confirm
281 "Returns the sensitivity state of the given widget."
282 ((widget widget)) ((member t nil)))
283
284 (defmacro def-xt-is-request (name)
285 (let* ((string-name (concatenate 'string "Xt" (symbol-class name)))
286 (class-name (subseq (symbol-class name) 2)))
287 `(def-toolkit-request ,string-name ,name :confirm
288 ,(concatenate 'string "is widget a subclass of " class-name)
289 ((widget widget)) ((member t nil)))))
290
291 (def-xt-is-request is-application-shell)
292 (def-xt-is-request is-composite)
293 (def-xt-is-request is-constraint)
294 (def-xt-is-request is-object)
295 (def-xt-is-request is-override-shell)
296 (def-xt-is-request is-rect-obj)
297 (def-xt-is-request is-shell)
298 (def-xt-is-request is-top-level-shell)
299 (def-xt-is-request is-transient-shell)
300 (def-xt-is-request is-vendor-shell)
301 (def-xt-is-request is-w-m-shell)
302
303 (def-toolkit-request "XtNameToWidget" name-to-widget :confirm
304 "find a widget by name"
305 ((widget widget) (name simple-string))
306 (widget))
307
308 (def-toolkit-request "XtParent" %widget-parent :confirm
309 ""
310 ((widget widget))
311 (widget)
312 (if (/= 0 (widget-id result))
313 (widget-add-child result widget)
314 ;; we leave the nil widget around so gets looked up faster in the future
315 ;; only potential problem should be that it might accumulate parent or
316 ;; child values in its slots or something
317 (setf result nil)
318 ))
319
320 (defun xt-widget-parent (widget)
321 "Parent of widget, even if unknown to lisp"
322 (or (widget-parent widget) (%widget-parent widget)))
323
324 (def-toolkit-request "XtAddEventHandler" %add-event-handler :no-confirm
325 ""
326 ((widget widget) (mask (unsigned-byte 32)) (nonmaskable_p (member t nil)))
327 ())
328
329 (def-toolkit-request "XtRemoveEventHandler" %remove-event-handler :no-confirm
330 ""
331 ((widget widget) (mask (unsigned-byte 32)) (nonmaskable_p (member t nil)))
332 ())
333
334 (def-toolkit-request "XtTranslateCoords" translate-coords :confirm
335 "Translates coordinates (x,y) in the window of the given widget into the
336 corresponding coordinates in the root window."
337 ((widget widget) (x fixnum) (y fixnum))
338 (fixnum fixnum))
339
340 (def-toolkit-request "XCreateFontCursor" create-font-cursor :confirm
341 "Creates an X cursor from the standard cursor font."
342 ((shape fixnum))
343 (xlib:cursor))
344
345
346
347 ;;;; Request definitions for Motif functions
348
349 ;; We will ask for confirmation here just to resync things
350 (def-toolkit-request "XmUpdateDisplay" update-display :confirm
351 "Processes all pending exposure events and synchronizes with the server."
352 ((w widget)) ())
353
354 (def-toolkit-request "XmIsMotifWMRunning" is-motif-wm-running :confirm
355 "Specifies if the MWM window manager is running."
356 ((shell widget)) ((member t nil)))
357
358 (def-toolkit-request "XmMenuPosition" %menu-position :no-confirm
359 ""
360 ((widget widget) (event-handle (unsigned-byte 32) :event)) ())
361
362 (def-toolkit-request "XmCreateMenuBar" %create-menu-bar :confirm
363 ""
364 ((parent widget) (name simple-string) (resources list :resource-list))
365 (widget)
366 (setf (widget-type result) :row-column)
367 (widget-add-child parent result))
368
369 (def-toolkit-request "XmCreateOptionMenu" %create-option-menu :confirm
370 ""
371 ((parent widget) (name simple-string) (resources list :resource-list))
372 (widget)
373 (setf (widget-type result) :row-column)
374 (widget-add-child parent result))
375
376 (def-toolkit-request "XmCreateRadioBox" %create-radio-box :confirm
377 ""
378 ((parent widget) (name simple-string) (resources list :resource-list))
379 (widget)
380 (setf (widget-type result) :row-column)
381 (widget-add-child parent result))
382
383 (macrolet ((def-double-widget-stub (name parent-class child-class)
384 (let ((strname (format nil "Xm~a"(symbol-class name)))
385 (fn-name (read-from-string
386 (format nil "%~a" name))))
387 `(def-toolkit-request ,strname ,fn-name :confirm
388 ""
389 ((parent widget) (name simple-string)
390 (resources list :resource-list))
391 (widget widget)
392 (setf (widget-type second) ,parent-class)
393 (setf (widget-type first) ,child-class)
394 (widget-add-child parent second)
395 (widget-add-child second first)))))
396
397 (def-double-widget-stub create-warning-dialog :dialog-shell :message-box)
398 (def-double-widget-stub create-bulletin-board-dialog :dialog-shell
399 :bulletin-board)
400 (def-double-widget-stub create-error-dialog :dialog-shell :message-box)
401 (def-double-widget-stub create-file-selection-dialog :dialog-shell
402 :file-selection-box)
403 (def-double-widget-stub create-form-dialog :dialog-shell :form)
404 (def-double-widget-stub create-information-dialog :dialog-shell
405 :message-box)
406 (def-double-widget-stub create-message-dialog :dialog-shell :message-box)
407 (def-double-widget-stub create-popup-menu :menu-shell :row-column)
408 (def-double-widget-stub create-prompt-dialog :dialog-shell :selection-box)
409 (def-double-widget-stub create-pulldown-menu :menu-shell :row-column)
410 (def-double-widget-stub create-question-dialog :dialog-shell :message-box)
411 (def-double-widget-stub create-scrolled-list :scrolled-window :list)
412 (def-double-widget-stub create-scrolled-text :scrolled-window :text)
413 (def-double-widget-stub create-selection-dialog :dialog-shell
414 :selection-box)
415 (def-double-widget-stub create-working-dialog :dialog-shell :message-box))
416
417 (def-toolkit-request "XmCommandAppendValue" command-append-value :no-confirm
418 "Appends the given string to the end of the string displayed in the
419 command area of the widget."
420 ((w widget) (command (or simple-string xmstring))) ())
421
422 (def-toolkit-request "XmCommandError" command-error :no-confirm
423 "Displays an error message in the Command widget."
424 ((w widget) (error (or simple-string xmstring))) ())
425
426 (def-toolkit-request "XmCommandSetValue" command-set-value :no-confirm
427 "Replaces the displayed string in a Command widget."
428 ((w widget) (c (or simple-string xmstring))) ())
429
430 (def-toolkit-request "XmScaleGetValue" scale-get-value :confirm
431 "Returns the current slider position."
432 ((w widget)) (fixnum))
433
434 (def-toolkit-request "XmScaleSetValue" scale-set-value :no-confirm
435 "Sets the current slider position."
436 ((w widget) (val fixnum)) ())
437
438 (def-toolkit-request "XmToggleButtonGetState" toggle-button-get-state :confirm
439 "Obtains the state of a ToggleButton."
440 ((w widget)) ((member t nil)))
441
442 (def-toolkit-request "XmToggleButtonSetState" toggle-button-set-state
443 :no-confirm
444 "Sets the state of a ToggleButton."
445 ((w widget) (state (member t nil)) (notify (member t nil))) ())
446
447 (def-toolkit-request "XmListAddItem" list-add-item :no-confirm
448 "Adds an item to the given List widget."
449 ((w widget) (item (or simple-string xmstring)) (pos fixnum)) ())
450
451 (def-toolkit-request "XmListAddItemUnselected" list-add-item-unselected
452 :no-confirm
453 "Adds an item to the List widget as an unselected entry."
454 ((w widget) (item (or simple-string xmstring)) (pos fixnum)) ())
455
456 (def-toolkit-request "XmListDeleteItem" list-delete-item :no-confirm
457 "Deletes an item from the given List widget."
458 ((w widget) (item (or simple-string xmstring))) ())
459
460 (def-toolkit-request "XmListDeletePos" list-delete-pos :no-confirm
461 "Deletes and item from a List widget at the specified position."
462 ((w widget) (pos fixnum)) ())
463
464 (def-toolkit-request "XmListDeselectAllItems" list-deselect-all-items
465 :no-confirm
466 "Unhighlights and removes all items from the selected list."
467 ((w widget)) ())
468
469 (def-toolkit-request "XmListDeselectItem" list-deselect-item :no-confirm
470 "Deselects the specified item from the selected list."
471 ((w widget) (item (or simple-string xmstring))) ())
472
473 (def-toolkit-request "XmListDeselectPos" list-deselect-pos :no-confirm
474 "Deselects an item at a specified position in a List widget."
475 ((w widget) (pos fixnum)) ())
476
477 (def-toolkit-request "XmListSelectItem" list-select-item :no-confirm
478 "Selects an item in the List widget."
479 ((w widget) (item (or simple-string xmstring)) (notify (member t nil))) ())
480
481 (def-toolkit-request "XmListSelectPos" list-select-pos :no-confirm
482 "Selects an item at a specified position in the List widget."
483 ((w widget) (pos fixnum) (notify (member t nil))) ())
484
485 (def-toolkit-request "XmListSetBottomItem" list-set-bottom-item :no-confirm
486 "Makes an existing item the last visible in the List widget."
487 ((w widget) (item (or simple-string xmstring))) ())
488
489 (def-toolkit-request "XmListSetBottomPos" list-set-bottom-pos :no-confirm
490 "Makes the item at the specified position the last visible item in the
491 given List widget."
492 ((w widget) (pos fixnum)) ())
493
494 (def-toolkit-request "XmListSetHorizPos" list-set-horiz-pos :no-confirm
495 "Scrolls to the specified position in the List widget."
496 ((w widget) (pos fixnum)) ())
497
498 (def-toolkit-request "XmListSetItem" list-set-item :no-confirm
499 "Makes an existing item the first visible in the List widget."
500 ((w widget) (item (or simple-string xmstring))) ())
501
502 (def-toolkit-request "XmListSetPos" list-set-pos :no-confirm
503 "Makes the item at the given position the first visible item in the List."
504 ((w widget) (pos fixnum)) ())
505
506 (def-toolkit-request "XmListAddItems" list-add-items :no-confirm
507 "Adds items to the given List widget."
508 ((w widget) (items list :xm-string-table) (pos fixnum)) ())
509
510 (def-toolkit-request "XmListDeleteAllItems" list-delete-all-items :no-confirm
511 "Deletes all items from the List widget."
512 ((w widget)) ())
513
514 (def-toolkit-request "XmListDeleteItems" list-delete-items :no-confirm
515 "Deletes specified items from the List widget."
516 ((w widget) (items list :xm-string-table)) ())
517
518 (def-toolkit-request "XmListDeleteItemsPos" list-delete-items-pos :no-confirm
519 "Deletes items from the list starting at the given position."
520 ((w widget) (item-count fixnum) (pos fixnum)) ())
521
522 (def-toolkit-request "XmListItemExists" list-item-exists :confirm
523 "Checks if a specified item is in the List widget."
524 ((w widget) (item (or simple-string xmstring))) ((member t nil)))
525
526 (def-toolkit-request "XmListItemPos" list-item-pos :confirm
527 "Returns the position of an item in the List widget."
528 ((w widget) (item (or simple-string xmstring))) (fixnum))
529
530 (def-toolkit-request "XmListReplaceItems" list-replace-items :no-confirm
531 "Replaces the specified elements in the list."
532 ((w widget) (old list :xm-string-table) (new list :xm-string-table)) ())
533
534 (def-toolkit-request "XmListReplaceItemsPos" list-replace-items-pos :no-confirm
535 "Replaces items in the list, starting at the given position."
536 ((w widget) (new-items list :xm-string-table) (pos fixnum)) ())
537
538 (def-toolkit-request "XmListSetAddMode" list-set-add-mode :no-confirm
539 "Sets the state of Add Mode in the list."
540 ((w widget) (mode (member t nil))) ())
541
542 (def-toolkit-request "XmListGetSelectedPos" list-get-selected-pos :confirm
543 "Returns the position of every selected item in the given List."
544 ((w widget))
545 (list (member t nil)))
546
547 (def-toolkit-request "XmAddTabGroup" add-tab-group :no-confirm
548 "Adds a manager or a primitive widget to the list of tab groups."
549 ((w widget)) ())
550
551 (def-toolkit-request "XmRemoveTabGroup" remove-tab-group :no-confirm
552 "Removes a manager or a primitive widget from the list of tab groups."
553 ((w widget)) ())
554
555 (def-toolkit-request "XmProcessTraversal" process-traversal :confirm
556 "Determines which component of a widget hierarchy receives keyboard
557 events when a widget has the keyboard focus."
558 ((w widget) (direction keyword)) ((member t nil)))
559
560 (def-toolkit-request "XmFontListAdd" font-list-add :confirm
561 "Adds a new font to a font-list and destroys the old list."
562 ((flist font-list) (font xlib:font) (charset simple-string))
563 (font-list))
564
565 (def-toolkit-request "XmFontListCreate" font-list-create :confirm
566 "Creates a new font-list with the specified font."
567 ((font xlib:font) (charset simple-string))
568 (font-list))
569
570 (def-toolkit-request "XmFontListFree" font-list-free :no-confirm
571 "Destroys the given font-list."
572 ((flist font-list)) ())
573
574 (def-toolkit-request "XmStringBaseline" compound-string-baseline :confirm
575 "Returns the number of pixels between the top of the character box and
576 the basline of the first line of text."
577 ((flist font-list) (string xmstring)) (fixnum))
578
579 (def-toolkit-request "XmStringByteCompare" compound-string-byte-compare
580 :confirm
581 "Indicates the result of a byte-by-byte comparison of two compound strings."
582 ((s1 xmstring) (s2 xmstring)) ((member t nil)))
583
584 (def-toolkit-request "XmStringCompare" compound-string-compare :confirm
585 "Indicates whether two compound strings are semantically equivalent."
586 ((s1 xmstring) (s2 xmstring)) ((member t nil)))
587
588 (def-toolkit-request "XmStringConcat" compound-string-concat :confirm
589 "Appends one compound string to another. The original strings are preserved."
590 ((s1 xmstring) (s2 xmstring)) (xmstring))
591
592 (def-toolkit-request "XmStringCopy" compound-string-copy :confirm
593 "Makes a copy of a compound string."
594 ((s xmstring)) (xmstring))
595
596 (def-toolkit-request "XmStringCreate" compound-string-create :confirm
597 "Creates a new compound string."
598 ((s simple-string) (charset simple-string)) (xmstring))
599
600 (def-toolkit-request "XmStringCreateLtoR" compound-string-create-ltor :confirm
601 "Creates a new compound string and translates newline characters into
602 line separators."
603 ((s simple-string) (charset simple-string)) (xmstring))
604
605 (def-toolkit-request "XmStringGetLtoR" compound-string-get-ltor :confirm
606 "Returns True if a segment can be found in the input compound string that
607 matches the specified character set."
608 ((string xmstring) (charset simple-string))
609 (simple-string (member t nil)))
610
611 (def-toolkit-request "XmStringCreateSimple" compound-string-create-simple
612 :confirm
613 "Creates a compound string in the language environment of a widget."
614 ((s simple-string)) (xmstring))
615
616 (def-toolkit-request "XmStringEmpty" compound-string-empty :confirm
617 "Provides information on the existence of non-zero length text components."
618 ((s xmstring)) ((member t nil)))
619
620 (def-toolkit-request "XmStringExtent" compound-string-extent :confirm
621 "Determines the size of the smallest rectangle that will enclose the
622 given compound string."
623 ((flist font-list) (x xmstring)) (fixnum fixnum))
624
625 (def-toolkit-request "XmStringFree" compound-string-free :no-confirm
626 "Recovers memory used by a compound string."
627 ((s xmstring)) ()
628 (remhash (xti::motif-object-id s)
629 (xti::motif-connection-id-table *motif-connection*)))
630
631 (def-toolkit-request "XmStringHasSubstring" compound-string-has-substring
632 :confirm
633 "Indicates whether one compound string is contained within another."
634 ((string xmstring) (substring xmstring)) ((member t nil)))
635
636 (def-toolkit-request "XmStringHeight" compound-string-height :confirm
637 "Returns the line height of the given compound string."
638 ((flist font-list) (string xmstring)) (fixnum))
639
640 (def-toolkit-request "XmStringLength" compound-string-length :confirm
641 "Obtains the length of a compound string."
642 ((string xmstring)) (fixnum))
643
644 (def-toolkit-request "XmStringLineCount" compound-string-line-count :confirm
645 "Returns the number of separators plus one in the provided compound string."
646 ((string xmstring)) (fixnum))
647
648 (def-toolkit-request "XmStringNConcat" compound-string-nconcat :confirm
649 "Appends a specified number of bytes to a compound string."
650 ((s1 xmstring) (s2 xmstring) (num_bytes fixnum)) (xmstring))
651
652 (def-toolkit-request "XmStringNCopy" compound-string-ncopy :confirm
653 "Copies a specified number of bytes into a new compound string."
654 ((s string) (num_bytes fixnum)) (xmstring))
655
656 (def-toolkit-request "XmStringSeparatorCreate" compound-string-separator-create
657 :confirm
658 "Creates a compound string with a single component, a separator."
659 () (xmstring))
660
661 (def-toolkit-request "XmStringWidth" compound-string-width :confirm
662 "Returns the width of the longest sequence of text components in a
663 compound string."
664 ((flist font-list) (s xmstring)) (fixnum))
665
666 (def-toolkit-request "XmTextClearSelection" text-clear-selection :no-confirm
667 "Clears the primary selection."
668 ((w widget)) ())
669
670 (def-toolkit-request "XmTextCopy" text-copy :confirm
671 "Copies the primary selection to the clipboard."
672 ((w widget)) ((member t nil)))
673
674 (def-toolkit-request "XmTextCut" text-cut :confirm
675 "Copies the primary selection to the clipboard and deletes the selected text."
676 ((w widget)) ((member t nil)))
677
678 (def-toolkit-request "XmTextGetBaseline" text-get-baseline :confirm
679 "Accesses the x position of the first baseline."
680 ((w widget)) (fixnum))
681
682 (def-toolkit-request "XmTextGetEditable" text-get-editable :confirm
683 "Accesses the edit permission state of the Text widget."
684 ((w widget)) ((member t nil)))
685
686 (def-toolkit-request "XmTextGetInsertionPosition" text-get-insertion-position
687 :confirm
688 "Accesses the positions of the insert cursor."
689 ((w widget)) (fixnum))
690
691 (def-toolkit-request "XmTextGetLastPosition" text-get-last-position :confirm
692 "Accesses the positio of the last text character."
693 ((w widget)) (fixnum))
694
695 (def-toolkit-request "XmTextGetMaxLength" text-get-max-length :confirm
696 "Accesses the value of the current maximum allowable length of a text
697 string entered from the keyboard."
698 ((w widget)) (fixnum))
699
700 (def-toolkit-request "XmTextGetSelection" text-get-selection :confirm
701 "Retrieves the value of the primary selection."
702 ((w widget)) (simple-string))
703
704 (def-toolkit-request "XmTextGetSelectionPosition" text-get-selection-position
705 :confirm
706 "Accesses the position of the primary selection."
707 ((w widget))
708 ((member t nil) fixnum fixnum))
709
710 (def-toolkit-request "XmTextGetString" text-get-string :confirm
711 "Accesses the string value of a Text widget."
712 ((w widget)) (simple-string))
713
714 (def-toolkit-request "XmTextGetTopCharacter" text-get-top-character :confirm
715 "Accesses the position of the first character displayed."
716 ((w widget)) (fixnum))
717
718 (def-toolkit-request "XmTextInsert" text-insert :no-confirm
719 "Inserts a character string into a Text widget."
720 ((w widget) (pos fixnum) (value simple-string)) ())
721
722 (def-toolkit-request "XmTextPaste" text-paste :confirm
723 "Inserts the clipboard selection."
724 ((w widget)) ((member t nil)))
725
726 (def-toolkit-request "XmTextPosToXY" text-pos-to-xy :confirm
727 "Accesses the x and y position of a character position."
728 ((w widget) (pos fixnum))
729 ((member t nil) fixnum fixnum))
730
731 (def-toolkit-request "XmTextRemove" text-remove :confirm
732 "Deletes the primary selection."
733 ((w widget)) ((member t nil)))
734
735 (def-toolkit-request "XmTextReplace" text-replace :no-confirm
736 "Replaces part of the text of a Text widget."
737 ((w widget) (from-pos fixnum) (to-pos fixnum) (value simple-string)) ())
738
739 (def-toolkit-request "XmTextScroll" text-scroll :no-confirm
740 "Scrolls the text of a Text widget."
741 ((w widget) (lines fixnum)) ())
742
743 (def-toolkit-request "XmTextSetAddMode" text-set-add-mode :no-confirm
744 "Sets the state of Add Mode."
745 ((w widget) (state (member t nil))) ())
746
747 (def-toolkit-request "XmTextSetEditable" text-set-editable :no-confirm
748 "Sets the edit permission on a Text widget."
749 ((w widget) (editable (member t nil))) ())
750
751 (def-toolkit-request "XmTextSetHighlight" text-set-highlight :no-confirm
752 "Highlights text."
753 ((w widget) (left fixnum) (right fixnum) (mode keyword)) ())
754
755 (def-toolkit-request "XmTextSetInsertionPosition" text-set-insertion-position
756 :no-confirm
757 "Sets position of the insert cursor."
758 ((w widget) (pos fixnum)) ())
759
760 (def-toolkit-request "XmTextSetMaxLength" text-set-max-length :no-confirm
761 "Sets the value of the current maximum allowable length of a text string
762 entered from the keyboard."
763 ((w widget) (max-length fixnum)) ())
764
765 (def-toolkit-request "XmTextSetSelection" text-set-selection :no-confirm
766 "Sets the primary selection of the Text widget."
767 ((w widget) (first fixnum) (last fixnum)) ())
768
769 (def-toolkit-request "XmTextSetString" text-set-string :no-confirm
770 "Sets the string value of a Text widget."
771 ((w widget) (value simple-string)) ())
772
773 (def-toolkit-request "XmTextSetTopCharacter" text-set-top-character :no-confirm
774 "Sets the position of the first character displayed."
775 ((w widget) (top-char fixnum)) ())
776
777 (def-toolkit-request "XmTextShowPosition" text-show-position :no-confirm
778 "Forces text at a given position to be displayed."
779 ((w widget) (pos fixnum)) ())
780
781 (def-toolkit-request "XmTextXYToPos" text-xy-to-pos :confirm
782 "Accesses the character position nearest an x and y position."
783 ((w widget) (x fixnum) (y fixnum)) (fixnum))
784
785 (def-toolkit-request "XmAddProtocolCallback" %add-protocol-callback
786 :no-confirm
787 ""
788 ((w widget) (property keyword :atom) (protocol keyword :atom)) ())
789
790 (def-toolkit-request "XmRemoveProtocolCallback" %remove-protocol-callback
791 :no-confirm
792 ""
793 ((w widget) (property keyword :atom) (protocol keyword :atom)) ())
794
795 (def-toolkit-request "XmSelectionBoxGetChild" selection-box-get-child :confirm
796 "Accesses a child component of a SelectionBox widget."
797 ((w widget) (child keyword)) (widget)
798 (widget-add-child w result)
799 (setf (widget-type result) :unknown))
800
801 (def-toolkit-request "XmFileSelectionBoxGetChild" file-selection-box-get-child
802 :confirm
803 "Accesses a child component of a FileSelectionBox widget."
804 ((w widget) (child keyword)) (widget)
805 (widget-add-child w result)
806 (setf (widget-type result) :unknown))
807
808 (def-toolkit-request "XmMessageBoxGetChild" message-box-get-child :confirm
809 "Accesses a child component of a MessageBox widget."
810 ((w widget) (child keyword)) (widget)
811 (widget-add-child w result)
812 (setf (widget-type result) :unknown))
813
814 (def-toolkit-request "XmCommandGetChild" command-get-child :confirm
815 "Accesses a child component of a Command widget."
816 ((w widget) (child keyword))
817 (widget)
818 (widget-add-child w result)
819 (setf (widget-type result) :unknown))
820
821 (def-toolkit-request "XmScrolledWindowSetAreas" scrolled-window-set-areas
822 :no-confirm
823 "Adds or changes a window work region and a horizontal or vertical
824 ScrollBar widget to the ScrolledWindow widget."
825 ((widget widget) (horiz-scroll (or null widget))
826 (vert-scroll (or null widget)) (work-region (or null widget)))
827 ())
828
829 (def-toolkit-request "XmTrackingLocate" tracking-locate :confirm
830 "Provides a modal interface for the selection of a component."
831 ((w widget) (cursor xlib:cursor) (confine-to (member t nil)))
832 (widget))
833
834 (def-toolkit-request "XmScrollBarGetValues" scroll-bar-get-values :confirm
835 "Returns the ScrollBar's increment values."
836 ((widget widget))
837 (fixnum fixnum fixnum fixnum))
838
839 (def-toolkit-request "XmScrollBarSetValues" scroll-bar-set-values :no-confirm
840 "Changes the ScrollBar's increments values and the slider's size and
841 position."
842 ((widget widget) (value fixnum) (slider-size fixnum)
843 (increment fixnum) (page-increment fixnum) (notify (member t nil)))
844 ())
845
846 (def-toolkit-request "SetItems" set-items :no-confirm
847 "Set the items of a List widget."
848 ((widget widget) (items list :xm-string-table)) ())
849
850 (def-toolkit-request "GetItems" get-items :confirm
851 "Get the items of a List widget."
852 ((widget widget))
853 (list))
854
855 (def-toolkit-request "ReturnTextCallbackDoit" return-text-callback-doit
856 :no-confirm
857 "Return a boolean value determining whether the proposed text action will
858 actually be performed."
859 ((doit (member t nil)))
860 ())

  ViewVC Help
Powered by ViewVC 1.1.5