/[cmucl]/src/motif/lisp/xt-types.lisp
ViewVC logotype

Contents of /src/motif/lisp/xt-types.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Fri Aug 22 20:49:29 1997 UTC (16 years, 7 months ago) by pw
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.3: +8 -2 lines
From Timothy Miller:

Here are a bunch of fixes and enhancements to motif, including
implementations of the XtIs* functions, XtNameToWidget, an xt-widget-parent
that will find the parent even if it's not known to lisp (eg, was created by
the motif library implicitly), a fix for get-values on big-endian machines
when the resource size is less than an int, a fix to the hashtable mapping
motif widget ids to lisp records of them, addition of certain resource type
definitions, fixing many callbacks to prevent null-dereferencing which
causes crashes on IRIX, a hack to treat the size of booleans more correctly
because they aren't necessarily ints (a design problem prevents an easy,
cleaner fix), and a fix to prevent motifd leaving children on HPUX.
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 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/motif/lisp/xt-types.lisp,v 1.4 1997/08/22 20:49:29 pw Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Written by Michael Garland
13 ;;;
14 ;;; This file defines the data types allowed in communication between the
15 ;;; Lisp client and the C server.
16 ;;;
17
18 (in-package "TOOLKIT")
19
20 (declaim (simple-vector *type-table*))
21
22 (defparameter *class-table*
23 (make-array 40 :element-type 'cons
24 :adjustable t :fill-pointer 0))
25 (declaim (vector *class-table*))
26
27 (defparameter next-type-tag 0)
28
29
30
31 ;;;; Functions for defining data types
32
33 ;;; enumeration values will have a :enum-value on the symbol plist
34 (defun def-toolkit-enum (type values)
35 ;; Values begin at zero by default and increase by one each time
36 (let ((current 0)
37 (values-alist)
38 (main-value))
39 (declare (fixnum current))
40 (dolist (value values)
41 (setf main-value value)
42 (when (listp value)
43 (when (numberp (car value))
44 (setf current (car value))
45 (setf value (cdr value)))
46 (setf main-value (car value))
47 (dolist (synonym (cdr value))
48 (setf (get synonym :enum-value) current)))
49 (setf (get main-value :enum-value) current)
50 (push (cons current main-value) values-alist)
51 (incf current))
52 (setf (gethash type *enum-table*) values-alist)))
53
54 (defun def-toolkit-types (types)
55 (dolist (type types)
56 (let ((name (first type))
57 (kind (second type)))
58 (setf (get name :xtk-type-tag) next-type-tag)
59 (when (eq kind :enum) (setf kind name))
60 (setf (svref *type-table* next-type-tag) (cons name kind))
61 (incf next-type-tag))))
62
63
64
65 ;;;; Defining of widget classes
66
67 (defun def-motif-classes (shells motif-shells classes)
68 (flet ((register-shell (name format-arg)
69 (setf (get name :widget-class) (fill-pointer *class-table*))
70 (vector-push-extend
71 (cons name (format nil format-arg (symbol-resource name)))
72 *class-table*))
73 (register-class (name format-arg)
74 (setf (get name :widget-class) (fill-pointer *class-table*))
75 (vector-push-extend
76 (cons name (format nil format-arg (symbol-class name)))
77 *class-table*)))
78 (dolist (shell shells)
79 (register-shell shell "~aWidgetClass"))
80 (dolist (motif-shell motif-shells)
81 (register-class motif-shell "xm~aWidgetClass"))
82 (dolist (thing classes)
83 (let ((widget (first thing))
84 (gadget (second thing)))
85 (register-class widget "xm~aWidgetClass")
86 (when gadget
87 (register-class gadget "xm~aClass"))))))
88
89
90
91 ;;;; Widget classes
92
93 (def-motif-classes
94 ;; These are the generic Xt shell widget classes
95 '(:override-shell :transient-shell :top-level-shell :application-shell)
96 ;;
97 ;; These are specific Motif shell widget classes
98 '(:dialog-shell :menu-shell)
99 ;;
100 ;; These are the various other widget classes (all Motif)
101 '((:label :label-gadget)
102 (:arrow-button :arrow-button-gadget)
103 (:push-button :push-button-gadget)
104 (:toggle-button :toggle-button-gadget)
105 (:cascade-button :cascade-button-gadget)
106 (:separator :separator-gadget)
107 (:drawn-button)
108 (:menu-shell)
109 (:drawing-area)
110 (:dialog-shell)
111 (:bulletin-board)
112 (:command)
113 (:file-selection-box)
114 (:form)
115 (:message-box)
116 (:selection-box)
117 (:scroll-bar)
118 (:text)
119 (:text-field)
120 (:row-column)
121 (:scale)
122 (:frame)
123 (:list)
124 (:main-window)
125 (:scrolled-window)
126 (:paned-window)))
127
128
129
130 ;;;; Motif data types
131 ;;;
132 ;;; The types MUST be listed in alphabetical order
133 ;;;
134
135 (def-toolkit-types
136 '((:accelerator-table :accelerator-table) (:alignment :enum)
137 (:arrow-direction :enum) (:atom :atom) (:attachment :enum)
138 (:bitmap :xid) (:bool :boolean) (:boolean :boolean) (:callback-reason :enum)
139 (:cardinal :int) (:char :short) (:color :color) (:colormap :xid)
140 (:command-window-location :enum) (:cursor :xid) (:default-button-type :enum)
141 (:dialog-style :enum) (:dialog-type :enum) (:dimension :short)
142 (:edit-mode :enum) (:enum :enum) (:event :event) (:file-type-mask :enum)
143 (:float :float) (:font :xid) (:font-list :font-list)
144 (:function :function) (:grab-kind :enum) (:highlight-mode :enum)
145 (:horizontal-dimension :short) (:horizontal-int :int)
146 (:horizontal-position :short)
147 (:indicator-type :enum) (:initial-state :int) (:int :int)
148 (:int-list :int-list) (:keyboard-focus-policy :enum) (:label-type :enum)
149 (:list-size-policy :enum) (:multi-click :enum) (:navigation-type :enum)
150 (:packing :enum) (:pixel :int) (:pixmap :xid) (:pointer :int)
151 (:position :short) (:processing-direction :enum) (:resize-policy :enum)
152 (:resource-list :resource-list) (:resource-names :resource-names)
153 (:row-column-type :enum) (:scroll-bar-display-policy :enum)
154 (:scroll-bar-placement :enum) (:scrolling-policy :enum)
155 (:selection-policy :enum) (:separator-type :enum) (:shadow-type :enum)
156 (:shell-horiz-dim :short) (:shell-horiz-pos :short) (:shell-vert-dim :short)
157 (:shell-vert-pos :short)
158 (:short :short) (:string :string) (:string-direction :enum)
159 (:string-table :string-table) (:string-token :string-token)
160 (:translation-table :translation-table) (:traversal-direction :enum)
161 (:unit-type :enum) (:unsigned-char :short)
162 (:vertical-dimension :short) (:vertical-int :int)
163 (:vertical-position :short)(:visual-policy :enum)
164 (:widget :widget) (:widget-class :widget-class)
165 (:widget-list :widget-list) (:window :xid) (:xm-string :xm-string)
166 (:xm-string-table :xm-string-table)))
167
168 (def-toolkit-enum :arrow-direction
169 '(:arrow-up :arrow-down :arrow-left :arrow-right))
170
171 (def-toolkit-enum :shadow-type
172 '((5 :shadow-etched-in :etched-in) (:shadow-etched-out :etched-out)
173 (:shadow-in :in) (:shadow-out :out)))
174
175 (def-toolkit-enum :alignment
176 '((:alignment-beginning :beginning) (:alignment-center :center)
177 (:alignment-end :end)))
178
179 (def-toolkit-enum :attachment
180 '((:attach-none :none) :attach-form
181 (:attach-opposite-form :opposite-form) (:attach-widget :widget)
182 (:attach-opposite-widget :opposite-widget) (:attach-position :position)
183 (:attach-self :self)))
184
185 (def-toolkit-enum :resize-policy
186 '((:resize-none :none) (:resize-grow :grow) (:resize-any :any)))
187
188 (def-toolkit-enum :separator-type
189 '(:no-line :single-line :double-line :single-dashed-line
190 :double-dashed-line :shadow-etched-in :shadow-etched-out))
191
192 (def-toolkit-enum :keyboard-focus-policy
193 '(:explicit :pointer))
194
195 (def-toolkit-enum :row-column-type
196 '(:work-area :menu-bar :menu-pulldown :menu-popup :menu-option))
197
198 (def-toolkit-enum :orientation
199 '(:no-orientation :vertical :horizontal))
200
201 (def-toolkit-enum :grab-kind
202 '(:grab-none :grab-nonexclusive :grab-exclusive))
203
204 (def-toolkit-enum :edit-mode
205 '(:multi-line-edit :single-line-edit))
206
207 (def-toolkit-enum :callback-reason
208 '(:cr-none :cr-help :cr-value-changed :cr-increment :cr-decrement
209 :cr-page-increment :cr-page-decrement :cr-to-top :cr-to-bottom :cr-drag
210 :cr-activate :cr-arm :cr-disarm (16 :cr-map) :cr-unmap :cr-focus
211 :cr-losing-focus :cr-modifying-text-value :cr-moving-insert-cursor
212 :cr-execute :cr-single-select :cr-multiple-select :cr-extended-select
213 :cr-browse-select :cr-default-action :cr-clipboard-data-request
214 :cr-clipboard-data-delete :cr-cascading :cr-ok :cr-cancel (34 :cr-apply)
215 :cr-no-match :cr-command-entered :cr-command-changed :cr-expose
216 :cr-resize :cr-input :cr-gain-primary :cr-lose-primary :cr-create
217 (6666 :cr-protocols)))
218
219 (def-toolkit-enum :default-button-type
220 '(:dialog-none :dialog-apply-button :dialog-cancel-button
221 :dialog-default-button :dialog-ok-button :dialog-filter-label
222 :dialog-filter-text :dialog-help-button
223 (:dialog-list :dialog-history-list :dialog-file-list)
224 (:dialog-list-label :dialog-file-list-label) :dialog-message-label
225 (:dialog-selection-label :dialog-prompt-label) :dialog-symbol-label
226 (:dialog-text :dialog-value-text :dialog-command-text)
227 :dialog-separator :dialog-dir-list :dialog-dir-list-label))
228
229 (def-toolkit-enum :dialog-style
230 '((:dialog-modeless :dialog-work-area)
231 (:dialog-primary-application-modal :dialog-application-modal)
232 (:dialog-full-application-modal) (:dialog-system-modal)))
233
234 (def-toolkit-enum :dialog-type
235 '(:dialog-work-area
236 (:dialog-error :dialog-prompt)
237 (:dialog-information :dialog-selection)
238 (:dialog-message :dialog-command)
239 (:dialog-question :dialog-file-selection)
240 :dialog-warning :dialog-working))
241
242 (def-toolkit-enum :file-type-mask
243 '((1 :file-directory) :file-regular :file-any-type))
244
245 (def-toolkit-enum :command-window-location
246 '(:command-above-workspace :command-below-workspace))
247
248 (def-toolkit-enum :multi-click '(:multiclick-discard :multiclick-keep))
249
250 (def-toolkit-enum :navigation-type
251 '(:none :tab-group :sticky-tab-group :exclusive-tab-group))
252
253 (def-toolkit-enum :processing-direction
254 '(:max-on-top :max-on-bottom :max-on-left :max-on-right))
255
256 (def-toolkit-enum :list-size-policy '(:variable :constant :resize-if-possible))
257
258 (def-toolkit-enum :unit-type
259 '(:pixels :100th-millimeters :1000th-inches :100th-points :100th-font-units))
260
261 (def-toolkit-enum :indicator-type '((1 :n-of-many) :one-of-many))
262
263 (def-toolkit-enum :selection-policy
264 '(:single-select :multiple-select :extended-select :browse-select))
265
266 (def-toolkit-enum :string-direction
267 '(:string-direction-l-to-r :string-direction-r-to-l))
268
269 (def-toolkit-enum :scroll-bar-display-policy '(:static :as-needed))
270
271 (def-toolkit-enum :scroll-bar-placement
272 '(:bottom-right :top-right :bottom-left :top-left))
273
274 (def-toolkit-enum :scrolling-policy '(:automatic :application-defined))
275
276 (def-toolkit-enum :visual-policy '(:variable :constant))
277
278 (def-toolkit-enum :label-type '((1 :pixmap) :string))
279
280 (def-toolkit-enum :packing
281 '(:no-packing :pack-tight :pack-column :pack-none))
282
283 (def-toolkit-enum :traversal-direction
284 '(:traverse-current :traverse-next :traverse-next :traverse-prev
285 :traverse-home :traverse-next-tab-group :traverse-prev-tab-group
286 :traverse-up :traverse-down :traverse-left :traverse-right))
287
288 (def-toolkit-enum :highlight-mode
289 '(:highlight-normal :highlight-selected :highlight-secondary-selected))

  ViewVC Help
Powered by ViewVC 1.1.5