PageRenderTime 69ms CodeModel.GetById 27ms RepoModel.GetById 0ms app.codeStats 1ms

/modules/clx/new-clx/clx.f

https://github.com/ynd/clisp-branch--ynd-devel
FORTRAN Legacy | 8276 lines | 7155 code | 885 blank | 236 comment | 487 complexity | eebc37146486bb3f5d8a83c02c77d45a MD5 | raw file
Possible License(s): LGPL-2.0, GPL-2.0, BSD-3-Clause

Large files files are truncated, but you can click here to view the full file

    

  1. /* -*- C -*- vim:filetype=c
    2. 

  2. Copyright (c) 1996-1999 by Gilbert Baumann, distributed under GPL
    3. 

  3. Bruno Haible  1998-2000
    4. 

  4. Sam Steingold 2001-2008
    5. 

  5. ----------------------------------------------------------------------------
    6. 

    7. 

  7.    Title:       C implementation of CLX utilizing the Xlib
    8. 

  8.    Created:     Sat Dec  2 18:04:51 1995
    9. 

  9.    Author:      Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
    10. 

  10.    Copying:  (c) copyright 1996 by Gilbert Baumann distributed under GPL.
    11. 

    12. 

  12. ----------------------------------------------------------------------------
    13. 

    14. 

  14. Revision 1.24  1999-10-17  bruno
    15. 

  15. - Use allocate_bit_vector in place of allocate_byte_vector. Remove ->data
    16. 

  16.   indirection.
    17. 

    18. 

  18. Revision 1.23  1999-10-11  gilbert
    19. 

  19. - get_font_info_and_display: XGetAtomNames is a new X11R6 addition, use
    20. 

  20.   XGetAtomName instead.
    21. 

    22. 

  22. Revision 1.22  1999-06-06  bruno
    23. 

  23. - get_font_info_and_display now optionally returns the Lisp font.
    24. 

  24.   It also fills in the font's encoding.
    25. 

  25. - New function to_XChar2b, used to convert a character sequence to a font
    26. 

  26.   index sequence. Works for linear non-iso8859-1 fonts (unlike Motif!).
    27. 

  27.   Still needs work for chinese or japanese fonts.
    28. 

    29. 

  29. Revision 1.21  1999-05-30  bruno
    30. 

  30. - Add missing begin_callback() in `xlib_io_error_handler'.
    31. 

  31. - Save subr_self during some calls in xlib:change-property.
    32. 

  32. - Fix some obvious typos in `font_char_info'.
    33. 

  33. - Call XFree() when done with the result of XGetAtomName().
    34. 

  34. - Improved error handling in `get_font_info_and_display'.
    35. 

    36. 

  36. Revision 1.20  1999-04-04  bruno
    37. 

  37. - Modifications for UNICODE.
    38. 

    39. 

  39. Revision 1.19  1998-10-19  bruno
    40. 

  40. - Use the macro `nonreturning_function', not `nonreturning'.
    41. 

    42. 

  42. Revision 1.18  1997-06-22  bruno
    43. 

  43. - replace first preprocessing with CCMP2C; then only comments need to be
    44. 

  44.   stripped before e2d can be applied.
    45. 

  45. - compilation in WIDE mode works now (use `eq', not `==' to compare objects)
    46. 

  46. - fixed buggy ESLOT4 macro (make_xatom wants a `Display*', not an `object')
    47. 

  47. - DYNAMIC_ARRAY has 3 arguments since 1996-07-22
    48. 

  48. - allocate_byte_array is now exported from array.d
    49. 

  49. - typos and spaces here and there
    50. 

    51. 

  51. Revision 1.18  1997/06/12  00:23:35  gilbert
    52. 

  52. - nothing special
    53. 

    54. 

  54. Revision 1.17  1997/06/02  16:19:27  gilbert
    55. 

  55. - Lots of minor tweeks here and there
    56. 

  56. - First attempt to get the IMAGE implementation right
    57. 

  57. - Found memory leak in font handling code
    58. 

  58. - fixed bug in xpm::read-pixmap-from-file occured when shape-mask-p = t
    59. 

  59. - (xlib:open-display "localhost") works now
    60. 

    61. 

  61. Revision 1.16  1996/10/11  14:18:03  gilbert
    62. 

  62. - Some tweakings to get it smoother compiled under 07-22
    63. 

    64. 

  64. Revision 1.15  1996/10/11  10:15:52  gilbert
    65. 

  65. - removed all GETTEXTs because it does not compile on 07-22
    66. 

  66. - error hander now calls the Lisp error handler
    67. 

  67. - fixed invokation of DYNAMIC_ARRAY
    68. 

  68. - removed all 'reg?' decls
    69. 

  69. - lots of bug fixes
    70. 

  70. - changed outlook of xlib:%restore-gcontext-components.
    71. 

  71. - the clip mask and the dash list are now retrievable from a gcontext
    72. 

  72. So the gcontext chapter should be complete now. [sans cache-p]
    73. 

    74. 

  74. Revision 1.14  1996/10/09  09:03:42  gilbert
    75. 

  75. - lots of bug fixes
    76. 

  76. - changed outlook of xlib:%restore-gcontext-components.
    77. 

  77. - the clip mask and the dash list are now retrievable from a gcontext
    78. 

  78. So the gcontext chapter should be complete now. [sans cache-p]
    79. 

    80. 

  80. Revision 1.13  1996/10/05  01:00:50  gilbert
    81. 

  81. - begin_call / end_call should be finally added everwhere..
    82. 

  82. - fixed some serve bugs in XLIB:CHANGE-PROPERTY.
    83. 

  83. - providing {WINDOW,PIXMAP,DRAWABLE,FONT,COLORMAP}-LOOKUP
    84. 

    85. 

  85. Revision 1.12  1996/10/04  03:14:53  gilbert
    86. 

  86. - Introduced new macro 'STANDARD_XID_OBJECT_LOOK'.
    87. 

  87. - The {WINDOW,PIXMAP,DRAWABLE,FONT,COLORMAP}-{DISPLAY,PLIST,PLIST-SETTER,ID}
    88. 

  88.   functions now do proper type checking.
    89. 

  89.   The corresponding xx-EQUAL functions are based on the XID alone.
    90. 

  90.   Same needs to be done for PTR objects.
    91. 

  91. - The silly (and ineffient) 'general_p' function vanished.
    92. 

    93. 

  93. Revision 1.11  1996/10/03  03:37:12  gilbert
    94. 

  94. - all invocations of "TheFpointer()->fp_pointer"
    95. 

  95.   are now guarded by "fp_validp".
    96. 

    97. 

  97. Revision 1.10  1996/10/03  02:45:00  gilbert
    98. 

  98. - made the get_[su]int?? functions do type checking
    99. 

  99. - Got rid of get_string and get_stringable.
    100. 

    101. 

  101. Revision 1.9  1996/10/02  10:39:45  gilbert
    102. 

  102. - eliminated get_xatom_name due to GC vulnerability.
    103. 

  103. - got rid of most get_string due to the same reason
    104. 

  104. - as always some begin/end_calls added.
    105. 

    106. 

  106. Revision 1.8  1996/09/28  21:59:02  gilbert
    107. 

  107. - Only lots of code movements to gather stuff which belongs together
    108. 

  108.   also to appear together for better maintainability.
    109. 

    110. 

  110. Revision 1.7  1996/09/28  20:52:24  gilbert
    111. 

  111. - Redone the invoke stuff, because
    112. 

  112.   YOU HAVE TO SAVE YOUR FILE BEFORE YOU CHECK IT IN!
    113. 

  113.   [Emacs does not check this 8-{ Realy angry! $%^#@#%$@ ]
    114. 

    115. 

  115. Revision 1.6  1996/09/28  20:41:23  gilbert
    116. 

  116. - added type checking to get_{xid,ptr}_object
    117. 

  117. - got rid of display_of all now done with the get_foo_and_display
    118. 

  118.   functions, so get_font_info is now called get_font_info_and_display.
    119. 

  119. - also get rid of the 'invoke' function, it was considered too
    120. 

  120.   unportable.
    121. 

    122. 

  122. Revision 1.5  1996/09/28  01:45:06  gilbert
    123. 

  123. Converted all enum definitions into the DEF_ENUM macro for code size.
    124. 

    125. 

  125. Revision 1.4  1996/09/27  12:48:33  gilbert
    126. 

  126. Cleaned up event disassembling code
    127. 

    128. 

  128. Revision 1.3  1996/08/02  10:51:40  gilbert
    129. 

  129. Only for Bruno.
    130. 

    131. 

  131. Revision 1.2  1996/07/27  02:25:31  gilbert
    132. 

  132. *** empty log message ***
    133. 

    134. 

  134. Revision 1.1  1996/07/08  15:47:43  gilbert
    135. 

  135. Initial revision
    136. 

  136.   ^^^ That is not true! Coding this started actually in Dec 1995.
    137. 

  137.       (Just around a couple of days befor chrismas?)
    138. 

  138. */
    139. 

  139. 
    140. 

  140. /* --- TODO ---
    141. 

  141. - fake the REPORT-ASYNCHRONOUS-ERRORS slot on displays.
    142. 

    143. 

  143. - Garnet seems to loose exposure events from time to time, I do not know
    144. 

  144.   if it is my fault or a garnet bug? This thing is hard to trace, since
    145. 

  145.   it seems to depend on how fast the window gets mapped, or how fast the
    146. 

  146.   garnet code is!
    147. 

    148. 

  148. - the get_XXX functions *all* should do type checking
    149. 

    150. 

  150. - Most uses of 'fixnum' are wrong, since the actual type is somewhat more
    151. 

  151.   precise known. fixnums are only correct as indexes into sequences and
    152. 

  152.   such!
    153. 

    154. 

    155. 

  155. -------
    156. 

  156.   When passing #<XLIB:GCONTEXT #x00000160>  to FONT-ASCENT it says:
    157. 

  157.   "Error: XLIB:FONT-ASCENT: NIL is not of type XLIB:FONT"
    158. 

  158.   Why is two way wrong:
    159. 

  159.     a. A gcontext should be ok where a font is
    160. 

  160.     b. Why is dumped NIL and not the gcontext?
    161. 

  161.   O.k. this was due to the fact that the font was actually never set.
    162. 

  162.   fix that!
    163. 

    164. 

  164.   (Maybe we just pass the gcontext down to Xlib, since Xlib is supposed
    165. 

  165.   to do the same here.)
    166. 

  166. -------
    167. 

  167.   When a display is closed the host name and such sould not
    168. 

  168.   be available any longer
    169. 

  169. -------
    170. 

    171. 

  171. - there should be a function called closed-p, which checks wether an given
    172. 

  172.   xid or ptr object is closed or not. When re-incarnating CLISP all CLX
    173. 

  173.   objects should get closed. get_xxx functions should check on that.  But
    174. 

  174.   there a some nasty problems:
    175. 

  175.    a.) when I setup the XFree... request it is not yet at the server
    176. 

  176.    b.) There may be additional references in the servers queque.
    177. 

  177.   Maybe I open a pseudo window, just for sneeking for destruction events?
    178. 

    179. 

  179. - XLIB:TEXT-EXTENTS and XLIB:TEXT-WIDTH needs fixing for non simple
    180. 

  180.   string arguments.
    181. 

    182. 

  182. - Garnet accidentally used :on/:off for save under values
    183. 

  183.   [But only sometimes]
    184. 

    185. 

  185. - Scan for all funcalls and save subr_self prior to call.
    186. 

    187. 

  187. - Is it right that we make the list of displays public?
    188. 

    189. 

  189. - we should rethink a bit more the font handling stuff, because several
    190. 

  190.   situations could arise:
    191. 

    192. 

  192.    . A font may not have an fid, this implies, that the font could not be
    193. 

  193.      hashed, furthermore we should init a finializer to discard also the
    194. 

  194.      fontinfo when the font object becomes inaccessible.
    195. 

  195.    . A font may come without per-character information.
    196. 

  196.      (But only when it has a 0 font id, hence a pseudo font)
    197. 

  197.    . If we open a pseudo font, we should then enter it into the hash table.
    198. 

  198.    . ensure that the  font-name slot has some  valid value.
    199. 

  199.      (It is even  not guaranteed to be available.)
    200. 

    201. 

  201. - go thru' the whole source and find all error messages and check that they
    202. 

  202.   are given right. [error wants its arguments backwards!]
    203. 

    204. 

  204. - since some make_xxx functions use value1, I should generally push the
    205. 

  205.   return values onto the stack before actually returning.
    206. 

    207. 

  207. - since somebody could now create classes on top of window, check the xid we
    208. 

  208.   want to read, if it is unbound emit some reasonable error message.  [If it
    209. 

  209.   is unbound the slot-value function returns an error on its own already.]
    210. 

    211. 

  211. - What about the plist slot? (Should we bind it to a useful value?)
    212. 

    213. 

  213. - maybe we make the clos-instance representation optional? Since it eats
    214. 

  214.   some speed. (Fetching a slot value is not the fastest operation.)
    215. 

    216. 

  216. - several X11 functions, which return lists may actually pass NULL as  the
    217. 

  217.   empty sequence?!
    218. 

    219. 

  219. - some of the enumerating functions (list XListDepths etc) do not set the
    220. 

  220.   count_return on failure, so set it yourself to 0 before you make the call,
    221. 

  221.   so that we do not run into difficulties.
    222. 

    223. 

  223. - Maybe we dont put all those symbols in the XLIB package to be able to
    224. 

  224.   include the MIT-CLX also.  (Generally CLISP lacks some of the nice package
    225. 

  225.   features Symbolics Common LISP provided.  There were also anonymous or
    226. 

  226.   invisible packages.)
    227. 

    228. 

  228. - errors should be reported in a much more meaningful way.
    229. 

    230. 

  230. - the big export list in clx.lisp seems to export some superfluous symbols.
    231. 

    232. 

  232. - put also ptr objects into the hashtable.
    233. 

  233.   Is there any way to get 'em anyhow back?
    234. 

    235. 

  235. - the xlib:free-xxx routines should remove that object from the hashtable.
    236. 

  236.   (or shouldn`t they?)  What does the Xserver with free`ed objects?
    237. 

  237.   And also they might be still alive, if some other application uses it.
    238. 

  238.   [Well simply take a look at the MIT code.] [What about GC?!]
    239. 

    240. 

  240. - should DISPLAY be a class? What with VISUAL-INFO, COLOR an so on ...
    241. 

    242. 

  242. - We should really make DISPLAY-AFTER-FUNCTION to live.
    243. 

  243.   The is also a XAfterFunction or something like that on the C side of life.
    244. 

    245. 

  245. - What exactly is a drawable? a type? a class?
    246. 

    247. 

  247. - We should insert a lot more type checks?
    248. 

    249. 

  249. - Since type checks are rather expensive think about listening to SAFTY and
    250. 

  250.   SPEED ...
    251. 

  251. */
    252. 

  252. 

  253. 
    254. 

  254. /* --- DONE ----
    255. 

    256. 

  256. - some functions emit errors saying #xDDD using decimal notation!
    257. 

  257. - upon disconnection we simply get a broken pipe message and exit
    258. 

  258.   [This is not the disired way, since we want to handle such an error.]
    259. 

  259. - with-gcontext !!!
    260. 

  260. - rename the 'font-name' slot of font to 'name'.
    261. 

  261. - take a look at the CLUE code, what it does with the :xxx option to
    262. 

  262.   create-xxx functions?!
    263. 

  263. - DISPLAY-AFTER-FUNCTION setter is needed.
    264. 

  264. - make display/window/pixmap clos-instances (see the CLUE patches for that)
    265. 

  265. - put xids into the hashtable and do not build the object new on each
    266. 

  266.   request.
    267. 

  267. - plists (partly done)
    268. 

  268. - get_visual
    269. 

  269. - how to proceed with visuals? In CLX a visual is just a card29 in CLX it is
    270. 

  270.   a pointer to a structure.
    271. 

  271. - Together with the CLX implementation should go a wholine implementation.
    272. 

  272.   (partly there)
    273. 

  273. */
    274. 

  274. 
    275. 

  275. /* --- NOTE ---
    276. 

    277. 

  277.   This package is not actually optimized for speed, since my intent and BTW
    278. 

  278. the overall intent of CLISP is to make the whole beast small.
    279. 

  279. (Actually you gain speed due to reduced paging).
    280. 

  280. Also this code is at some places BFI!
    281. 

    282. 

  282.   The general idea behind writing this bunch of code, is to provide a CLX
    283. 

  283. implementation for CLISP, which is feasible of both speed and space.  I
    284. 

  284. actually use the libX library, because if you want to do graphics on your
    285. 

  285. machine, you will already have it in memory, so it adds no extra cost.  [One
    286. 

  286. disadvantage is that I am forced in some places to go into the internals of
    287. 

  287. the libX, since the CLX specification is more powerful at some places than
    288. 

  288. the libX implementation. This add another source of in-portability of CLISP,
    289. 

  289. so *please*, if you encounter compilation problems mail me,
    290. 

  290. so I could adjust the code ...]
    291. 

    292. 

  292.   CLX adds on my machines another ~700k of memory needs for CLISP, but this
    293. 

  293. implementation add only 70k [*I* know that I am telling lies here, since the
    294. 

  294. libX11 itself has a size of ~500k; But as long as I have no pure LISP OS but
    295. 

  295. need the UNIX to boot it ...]  and a great bunch of speed.
    296. 

    297. 

  297.   Also having this implemenation should gain a big plus against GCL.  (IMHO
    298. 

  298. gcl is very bad code compared to CLISP! [gcl is actually akcl]) flame,flame.
    299. 

    300. 

  300. BTW It should be fun to write the graph.d routines on top of CLX!
    301. 

  301. */
    302. 

  302. 
    303. 

  303. /* --- FUTURE ---
    304. 

    305. 

  305.  Xpm Support?
    306. 

    307. 

  307. We should also include support for the xpm library to have a nice access to
    308. 

  308. .xpm files, which is hardly needed, since I do not want to duplicate this
    309. 

  309. non-trivial code in Lisp.  But we have to think about a Lisp representation
    310. 

  310. for pixmaps. I could also imagine a `defpixmap` macro.  Just another
    311. 

  311. question is if we want to put the xpm routines into another package. (called
    312. 

  312. `x-pixmap` or just 'xpm'). I want also to write some documentation for the
    313. 

  313. then Lisp xpm routines. But since the xpm library seems to be a changing
    314. 

  314. thing it is also a question, how we cope with them.
    315. 

    316. 

  316.  Incorporation into the FFI?
    317. 

    318. 

  318. Since we use could convert now a WINDOW object into a libX11 Window object,
    319. 

  319. it may be worth offer this also to the FFI.  When I finished this work I
    320. 

  320. should take a look at the FFI.
    321. 

  321. */
    322. 

  322. 
    323. 

  323. /* --- IMPLEMENTATION NOTES ---------------------------------------------------
    324. 

    325. 

  325. The following types are only XID`s:
    326. 

  326.   window, drawable, font, pixmap, cursor, colormap, GContext, keysym
    327. 

    328. 

  328. No XID, but data-structures:
    329. 

  329.   color, display, screen, GC
    330. 

    331. 

    332. 

  332. First I define some data types by providing get_xxx, make_xxx and xxx_p
    333. 

  333. functions.  Note that this set is not complete, since not all functions are
    334. 

  334. actually needed.  The consistent name is crucial, since some macros I define
    335. 

  335. later take a "type" argument, which is concatenated with 'make_' or 'get_'.
    336. 

  336. This is done to make this file more dense; (Thus save me a lot of redundant
    337. 

  337. typing.)
    338. 

    339. 

    340. 

  340.   type     | dpy? | XID-P | hashed-p | Note
    341. 

  341.  ----------+------+-------+----------+------------------------------
    342. 

  342.   GCONTEXT |  T   | NIL   |   NIL    | Is really a pointer
    343. 

  343.   WINDOW   |  T   | T     |   T      |
    344. 

  344.   PIXMAP   |  T   | T     |   T      |
    345. 

  345.   CURSOR   |  T   | T     |   T      |
    346. 

  346.   COLORMAP |  T   | T     |   T      |
    347. 

  347.   FONT     |  T   | T/NIL |   T/NIL  |
    348. 

  348.   SCREEN   |  T   | NIL   | (should  | Could also been represented as index?
    349. 

  349.            |      |       |    be)   |
    350. 

  350.   DISPLAY  |  NIL | NIL   |   NIL    |
    351. 

    352. 

  352.   Class Hierarchy
    353. 

  353.  --------------------
    354. 

  354.     xlib-object --+--> xid-object --+--> DRAWABLE -+--> WINDOW
    355. 

  355.                   |                 |              +--> PIXMAP
    356. 

  356.                   |                 |--> CURSOR
    357. 

  357.                   |                 +--> COLORMAP
    358. 

  358.                   |                 +--> FONT
    359. 

  359.                   |
    360. 

  360.                   +--> ptr-object --+--> GCONTEXT
    361. 

  361.                                     |
    362. 

  362.                                     +--> DISPLAY
    363. 

    364. 

  364.  Just in case you prefer a textual representation:
    365. 

    366. 

  366.    (defclass xlib-object ()                      (plist display))
    367. 

  367.    (defclass xid-object  (xlib-object)           (xid))
    368. 

  368.    (defclass ptr-object  (xlib-object)           (ptr))
    369. 

    370. 

  370.    (defclass drawable    (xid-object)            ())
    371. 

  371.    (defclass window      (drawable)              ())
    372. 

  372.    (defclass pixmap      (drawable)                 ())
    373. 

  373.    (defclass cursor      (xid-object)            ())
    374. 

  374.    (defclass colormap    (xid-object)            ())
    375. 

  375.    (defclass gcontext    (ptr-object)            ())
    376. 

  376.    (defclass display     (ptr-object)            ())
    377. 

  377.    (defclass font        (xid-object)            (font-info name))
    378. 

  378. */
    379. 

  379. 

  380. 
    381. 

  381. /* -- NOTE --
    382. 

  382. For further for grepability I use the following tags in comments:
    383. 

    384. 

  384.  XXX            - really bad and a major risk to safety/usability.
    385. 

  385.  FIXME          - just fix me, something that ought to be done
    386. 

  386.                   before next release.
    387. 

  387.  TODO           - something, which should be done and is already
    388. 

  388.                   considered useful.
    389. 

  389.  FUTURE         - something which is just an idea and it is not yet
    390. 

  390.                   decided, if I ever implement it; It may also later
    391. 

  391.                   be considered silly.
    392. 

  392.                   I welcome discussion about those items.
    393. 

  393.  OK             - the opposite of XXX. Functions which are
    394. 

  394.                   considered to be totally finished and
    395. 

  395.                   had undergone a test are marked with this.
    396. 

  396.  UNDEFINED      - this is thought for undefined functions at whole
    397. 

  397.  NOTIMPLEMENTED - is thought for not implemented features
    398. 

  398.                   in an partly defined function.
    399. 

  399. */
    400. 

  400. 

  401. /* enough bla bla, let's start coding, we have a long long way before us ...*/
    402. 

  402. 

  403. 
    404. 

  404. #include "clisp.h"
    405. 

  405. #include <X11/Xlib.h>
    406. 

  406. #include <X11/Xutil.h>          /* XGetVisualInfo */
    407. 

  407. #include <X11/Xcms.h>   /* forXcmsCCCOfColormap() & XcmsVisualOfCCC() */
    408. 

  408. #include <X11/Xauth.h>
    409. 

  409. /* #include <X11/Xresource.h> */
    410. 

  410. #include <stdio.h>              /* sprintf() */
    411. 

  411. #include <string.h>             /* memcpy(), strchr(), strcpy() */
    412. 

  412. #include "config.h"
    413. 

  413. #if defined(TIME_WITH_SYS_TIME)
    414. 

  414. # include <sys/time.h>
    415. 

  415. # include <time.h>
    416. 

  416. #else
    417. 

  417. # if defined(HAVE_SYS_TIME_H)
    418. 

  418. #  include <sys/time.h>
    419. 

  419. # elif defined(HAVE_TIME_H)
    420. 

  420. #  include <time.h>
    421. 

  421. # endif
    422. 

  422. #endif
    423. 

  423. #if defined(HAVE_SYS_SOCKET_H)
    424. 

  424. # include <sys/socket.h>
    425. 

  425. #endif
    426. 

  426. #if defined(HAVE_NETDB_H)
    427. 

  427. # include <netdb.h>
    428. 

  428. #endif
    429. 

  429. #if defined(HAVE_NETINET_IN_H)
    430. 

  430. # include <netinet/in.h>
    431. 

  431. #endif
    432. 

  432. 

  433. ##if WANT_XSHAPE
    434. 

  434. /* must include this before DEFMODULE so that DEFCHECKER will work */
    435. 

  435. #include <X11/extensions/shape.h>
    436. 

  436. ##endif
    437. 

  437. 

  438. #define DEBUG_CLX 0
    439. 

  439. 

  440. #ifndef FOREIGN
    441. 

  441. #error FOREIGN is not defined.
    442. 

  442. #error CLX needs a CLISP built with the foreign pointer datatype support.
    443. 

  443. #error Go into the main CLISP makefile and add a -DFOREIGN=void*
    444. 

  444. #error to CFLAGS make variable and rebuild CLISP before coming back here.
    445. 

  445. #endif
    446. 

  446. 

  447. DEFMODULE(clx,"XLIB")
    448. 

  448. 

  449. /* ... But first we provide some prototypes for functions, which maybe worth
    450. 

  450.  included in libX11 and are defined at the end of this file. */
    451. 

  451. /* might also been called XVisualIDFromVisual**(-1) : */
    452. 

  452. static Visual *XVisualIDToVisual (Display *dpy, VisualID vid);
    453. 

  453. /* Find the screen index from a Screen* : */
    454. 

  454. static int XScreenNo (Display *dpy, Screen *screen);
    455. 

  455. 

  456. /* our own forward declaration */
    457. 

  457. static Display *pop_display (void);
    458. 

  458. static inline Display *get_display (object dpy)
    459. 

  459. { pushSTACK(dpy); return pop_display(); }
    460. 

  460. 

  461. /* Some fix-ups: */
    462. 

  462. 

  463. #define NOTIMPLEMENTED NOTREACHED
    464. 

  464. #define UNDEFINED NOTIMPLEMENTED
    465. 

  465. 

  466. 

  467. /* debug */
    468. 

  468. #if DEBUG_CLX
    469. 

  469. #define dprintf(x) do{ printf x; fflush(stdout); }while(0)
    470. 

  470. #else
    471. 

  471. #define dprintf(x) do{}while(0)
    472. 

  472. #endif
    473. 

  473. 

  474. /* it is not clear whether we can rely on `writing_to_subprocess' or
    475. 

  475.  must actually disable SIGPIPE - see src/spvw_sigpipe.d */
    476. 

  476. #define RELY_ON_WRITING_TO_SUBPROCESS
    477. 

  477. #if defined(RELY_ON_WRITING_TO_SUBPROCESS)
    478. 

  478. /* including <signal.h> just for the sake of SIGPIPE
    479. 

  479.    (which is always there anyway) is a total waste */
    480. 

  480. # if defined(HAVE_SIGNALS) /* && defined(SIGPIPE) */
    481. 

  481. extern
    482. 

  482. # endif
    483. 

  483. bool writing_to_subprocess;
    484. 

  484. # define begin_x_call() writing_to_subprocess=true;begin_call()
    485. 

  485. # define end_x_call()   end_call();writing_to_subprocess=false
    486. 

  486. #else
    487. 

  487. # define begin_x_call() begin_call()
    488. 

  488. # define end_x_call()   end_call()
    489. 

  489. extern void disable_sigpipe(void);
    490. 

  490. #endif
    491. 

  491. #define X_CALL(f) do{ begin_x_call(); f; end_x_call(); }while(0)
    492. 

  492. 
    493. 

  493. /* -------------------------------------------------------------------------
    494. 

  494.  *  General purpose utilities
    495. 

  495.  * ------------------------------------------------------------------------- */
    496. 

  496. 

  497. /* sugar for funcall (used in macros, so not a macro) */
    498. 

  498. static inline object funcall1 (object fun, object arg)
    499. 

  499. { pushSTACK(arg); funcall(fun,1); return value1; }
    500. 

  500. 

  501. nonreturning_function(static,my_type_error,(object type, object datum))
    502. 

  502. {
    503. 

  503.   pushSTACK(datum);             /* TYPE-ERROR slot DATUM */
    504. 

  504.   pushSTACK(type);              /* TYPE-ERROR slot TYPE */
    505. 

  505.   pushSTACK(type); pushSTACK(datum); pushSTACK(TheSubr(subr_self)->name);
    506. 

  506.   error (type_error, ("~S: ~S is not of type ~S"));
    507. 

  507. }
    508. 

  508. nonreturning_function (static, error_closed_display,
    509. 

  509.                        (object caller, object dpy)) {
    510. 

  510.   pushSTACK(`XLIB::CLOSED-DISPLAY`);
    511. 

  511.   pushSTACK(`:DISPLAY`); pushSTACK(dpy);
    512. 

  512.   pushSTACK(`:CALLER`); pushSTACK(caller);
    513. 

  513.   funcall(L(error),5);
    514. 

  514.   abort(); /* ERROR does not return: avoid a compiler warning */
    515. 

  515. }
    516. 

  516. 

  517. /* with_stringable_0 is much like with_string_0, but a symbol is also
    518. 

  518.  allowed as argument. This macro does type checking and may raise an error. */
    519. 

  519. #define with_stringable_0_tc(obj, encoding, cvar, body)  \
    520. 

  520.   do {                                                                 \
    521. 

  521.     object wsa0_temp =                                                 \
    522. 

  522.       (symbolp(obj) ? (object)Symbol_name (obj) : (object)(obj));      \
    523. 

  523.     if (stringp (wsa0_temp)) {                                         \
    524. 

  524.       with_string_0 (wsa0_temp, encoding, cvar, body);                 \
    525. 

  525.     } else my_type_error(`(OR STRING SYMBOL)`,obj);                    \
    526. 

  526.   } while(0)
    527. 

  527. 

  528. 
    529. 

  529. /* -----------------------------------------------------------------------
    530. 

  530.  *  Integer data types
    531. 

  531.  * ----------------------------------------------------------------------- */
    532. 

  532. 

  533. /* Huh?! These functions do not check the type?! */
    534. 

  534. #define make_uint8(i)    uint8_to_I (i)
    535. 

  535. #define make_uint16(i)   uint16_to_I (i)
    536. 

  536. #define make_uint29(ul)  UL_to_I (ul)
    537. 

  537. #define make_uint32(ul)  UL_to_I (ul)
    538. 

  538. 

  539. #define make_sint8(i)    sint8_to_I (i)
    540. 

  540. #define make_sint16(i)   sint16_to_I (i)
    541. 

  541. #define make_sint32(i)   L_to_I (i)
    542. 

  542. 

  543. #define get_bool(obj)   (!nullp(obj))
    544. 

  544. #define make_bool(b)    ((b)?(T):(NIL))
    545. 

  545. 

  546. #define pixel_p(obj)     integerp (obj)
    547. 

  547. #define get_pixel(obj)   get_uint32(obj)
    548. 

  548. #define make_pixel(obj)  make_uint32(obj)
    549. 

  549. 

  550. #define get_fixnum(obj)  fixnum_to_V (obj) /* WARNING: obj should be a variable (evaluated multiple), and no range check is performed */
    551. 

  551. 

  552. #if 0
    553. 

  553. #define get_uint8(obj)   I_to_uint8(obj)
    554. 

  554. #define get_uint16(obj)  I_to_uint16(obj)
    555. 

  555. #define get_uint29(obj)  I_to_UL (obj)
    556. 

  556. #define get_uint32(obj)  I_to_UL (obj)
    557. 

  557. 

  558. #define get_sint8(obj)   I_to_sint8(obj)
    559. 

  559. #define get_sint16(obj)  I_to_sint16(obj)
    560. 

  560. #define get_sint32(obj)  I_to_sint32(obj)
    561. 

  561. #else
    562. 

  562. 

  563. #define uint29_p uint32_p /* XXX the actual type checking code is just too weird! */
    564. 

  564. #define I_to_uint29 I_to_UL     /* XXX ditto */
    565. 

  565. 

  566. #define DEFINE_INTEGER_GETTER(type, lspnam)                     \
    567. 

  567.   static inline type get_##type (object obj) {                  \
    568. 

  568.     if (type##_p (obj))                                         \
    569. 

  569.       return I_to_##type (obj);                                 \
    570. 

  570.     else my_type_error(lspnam,obj);                             \
    571. 

  571.   }                                                             \
    572. 

  572.   static inline type get_##type##_0 (object obj) {              \
    573. 

  573.     return missingp(obj) ? 0 : get_##type(obj);                 \
    574. 

  574.   }
    575. 

  575. 

  576. DEFINE_INTEGER_GETTER (uint8,  `XLIB::CARD8`)
    577. 

  577. DEFINE_INTEGER_GETTER (uint16, `XLIB::CARD16`)
    578. 

  578. DEFINE_INTEGER_GETTER (uint29, `XLIB::CARD29`)
    579. 

  579. DEFINE_INTEGER_GETTER (uint32, `XLIB::CARD32`)
    580. 

  580. 

  581. DEFINE_INTEGER_GETTER (sint8,  `XLIB::INT8`)
    582. 

  582. DEFINE_INTEGER_GETTER (sint16, `XLIB::INT16`)
    583. 

  583. DEFINE_INTEGER_GETTER (sint32, `XLIB::INT32`)
    584. 

  584. #endif
    585. 

  585. 

  586. static uint32 get_aint32 (object obj)
    587. 

  587. { /* This is special routine, which accepts either an uint32 or a sint32.
    588. 

  588.  However returned is an uint32.
    589. 

  589.  Used by XLIB:CHANGE-PROPERTY */
    590. 

  590.   if (uint32_p (obj))
    591. 

  591.     return I_to_uint32 (obj);
    592. 

  592.   if (sint32_p (obj))
    593. 

  593.     return (uint32)I_to_sint32 (obj);
    594. 

  594.   else my_type_error(`(OR XLIB::INT32 XLIB::CARD32)`,obj);
    595. 

  595. }
    596. 

  596. 

  597. 
    598. 

  598. /* -----------------------------------------------------------------------
    599. 

  599.  *  Displays
    600. 

  600.  * ----------------------------------------------------------------------- */
    601. 

  601. 

  602. /* Objects of type DISPLAY are currently represented as structure; here are the
    603. 

  603.  slots: The actual defstruct definition in clx.lisp must match. There is a
    604. 

  604.  warning in the code. */
    605. 

  605. enum {
    606. 

  606.   slot_DISPLAY_FOREIGN_POINTER=1,
    607. 

  607.   slot_DISPLAY_HASH_TABLE,
    608. 

  608.   slot_DISPLAY_PLIST,
    609. 

  609.   slot_DISPLAY_AFTER_FUNCTION,
    610. 

  610.   slot_DISPLAY_ERROR_HANDLER,
    611. 

  611.   slot_DISPLAY_DISPLAY,
    612. 

  612.   display_structure_size
    613. 

  613. };
    614. 

  614. 

  615. /* The display contains a hash table. All XID objects are entered there, so
    616. 

  616.  that two XID objects, with equal XID are actually eq. */
    617. 

  617. static object make_display (Display *dpy, int display_number)
    618. 

  618. { /* Given the C representation of a display create the Lisp one and
    619. 

  619.  initialize it.  The newly created display is added to XLIB:*DISPLAYS*. */
    620. 

  620.   pushSTACK(`(XLIB::DISPLAY)`); pushSTACK(fixnum(display_structure_size));
    621. 

  621.   funcall(L(make_structure),2); pushSTACK(value1);
    622. 

  622.   TheStructure(STACK_0)->recdata[slot_DISPLAY_FOREIGN_POINTER]
    623. 

  623.     = allocate_fpointer (dpy);
    624. 

  624. #if oint_data_len<29
    625. 

  625.   pushSTACK(S(Ktest)); pushSTACK(S(stablehash_equal)); /* key is a cons */
    626. 

  626. #else
    627. 

  627.   pushSTACK(S(Ktest)); pushSTACK(S(stablehash_eq)); /* key is a fixnum */
    628. 

  628. #endif
    629. 

  629.   funcall (L(make_hash_table), 2);
    630. 

  630.   TheStructure(STACK_0)->recdata[slot_DISPLAY_HASH_TABLE]     = value1;
    631. 

  631.   TheStructure(STACK_0)->recdata[slot_DISPLAY_PLIST]          = NIL;
    632. 

  632.   TheStructure(STACK_0)->recdata[slot_DISPLAY_AFTER_FUNCTION] = NIL;
    633. 

  633.   TheStructure(STACK_0)->recdata[slot_DISPLAY_ERROR_HANDLER]  = NIL;
    634. 

  634.   TheStructure(STACK_0)->recdata[slot_DISPLAY_DISPLAY]  =
    635. 

  635.     make_uint8 (display_number);
    636. 

  636. 

  637.   /* Now enter the display into the list of all displays: */
    638. 

  638.   pushSTACK(STACK_0);
    639. 

  639.   pushSTACK(Symbol_value(`XLIB::*DISPLAYS*`));
    640. 

  640.   funcall (L(cons), 2);
    641. 

  641.   Symbol_value(`XLIB::*DISPLAYS*`) = value1;
    642. 

  642.   return value1 = popSTACK();
    643. 

  643. }
    644. 

  644. 

  645. static object find_display (Display *display)
    646. 

  646. { /* Searched the XLIB:*DISPLAY* variable for `display',
    647. 

  647.  return NIL, if display was not found.
    648. 

  648.  Used by the error handler, the only callback code here. */
    649. 

  649.   pushSTACK(Symbol_value (`XLIB::*DISPLAYS*`));
    650. 

  650.   for (;consp (STACK_0); STACK_0 = Cdr (STACK_0)) {
    651. 

  651.     if (get_display(Car(STACK_0)) == display)
    652. 

  652.       return Car(popSTACK());
    653. 

  653.   }
    654. 

  654.   skipSTACK(1);
    655. 

  655.   return NIL;
    656. 

  656. }
    657. 

  657. 

  658. static Bool ensure_living_display (gcv_object_t *objf)
    659. 

  659. { /* ensures that the object pointed to by 'objf' is really a display.
    660. 

  660.  Also the display must be 'alive', meaning that it does not contain
    661. 

  661.  a fptr from an previous incarnation of CLISP.
    662. 

  662.  If all that does not hold an error is signaled.
    663. 

  663.  Finally, returns an indicator of whether the display has been closed.
    664. 

  664.  'objf' should point into the stack due to GC. */
    665. 

  665.   if (typep_classname (*objf, `XLIB::DISPLAY`)) { /* Is it a display at all? */
    666. 

  666.     object fptr = TheStructure(*objf)->recdata[slot_DISPLAY_FOREIGN_POINTER];
    667. 

  667.     return (fpointerp(fptr) && fp_validp(TheFpointer(fptr))
    668. 

  668.             && (TheFpointer(fptr)->fp_pointer != NULL));
    669. 

  669.   }
    670. 

  670.   /* Fall through -- raise type error */
    671. 

  671.   my_type_error(`XLIB::DISPLAY`,*(objf));
    672. 

  672. }
    673. 

  673. 

  674. DEFUN(XLIB:CLOSED-DISPLAY-P, display)
    675. 

  675. {
    676. 

  676.   VALUES_IF(!ensure_living_display(&STACK_0));
    677. 

  677.   skipSTACK(1);
    678. 

  678. }
    679. 

  679. 

  680. /* display_hash_table -- return the hashtable of a display object
    681. 

  681.  > the display object
    682. 

  682.  < its hash table
    683. 

  683.  This function is somewhat silly, since it introduces double type checking! */
    684. 

  684. static object display_hash_table (object dpy)
    685. 

  685. {
    686. 

  686.   pushSTACK(dpy);
    687. 

  687.   if (!ensure_living_display(&(STACK_0)))
    688. 

  688.     error_closed_display(TheSubr(subr_self)->name,STACK_0);
    689. 

  689.   return TheStructure (popSTACK())->recdata[slot_DISPLAY_HASH_TABLE];
    690. 

  690. }
    691. 

  691. 

  692. /* pop_display --- return the C Display* of an display object
    693. 

  693.  > STACK_0: the Lisp DISPLAY object */
    694. 

  694. static Display *pop_display (void)
    695. 

  695. {
    696. 

  696.   if (!ensure_living_display(&(STACK_0)))
    697. 

  697.     error_closed_display(TheSubr(subr_self)->name,STACK_0);
    698. 

  698.   STACK_0 = TheStructure (STACK_0)->recdata[slot_DISPLAY_FOREIGN_POINTER];
    699. 

  699.   return (Display*) TheFpointer(popSTACK())->fp_pointer;
    700. 

  700. }
    701. 

  701. 

  702. 
    703. 

  703. /* -----------------------------------------------------------------------
    704. 

  704.  *  PTR and XID objects
    705. 

  705.  * ----------------------------------------------------------------------- */
    706. 

  706. 

  707. /*  First the ptr ones.
    708. 

    709. 

  709.   ptr_objs are screens and gcontexts, these objects are not hashed.
    710. 

  710.   (which is a bad idea btw).  But on the other hand for gcontexts it is
    711. 

  711.   not too bad, since you get `em only once.
    712. 

    713. 

  713.   Another story are the screen, these could be cached. Or we do not give the
    714. 

  714.   actual screen structure, but pass simply the index? */
    715. 

  715. static object make_ptr_obj (object type, object dpy, void *ptr)
    716. 

  716. { /* (make-instance type :display dpy :ptr ptr) */
    717. 

  717.   pushSTACK(type);
    718. 

  718.   pushSTACK(`:DISPLAY`);  pushSTACK(dpy);
    719. 

  719.   pushSTACK(`:PTR`);      pushSTACK(allocate_fpointer (ptr));
    720. 

  720.   funcall(S(make_instance),5);
    721. 

  721.   return value1;
    722. 

  722. }
    723. 

  723. 

  724. /* return the fp_pointer of the foreign slot
    725. 

  725.    value1 is set the slot value
    726. 

  726.  can trigger GC */
    727. 

  727. static void* foreign_slot (object obj, object slot) {
    728. 

  728.   pushSTACK(obj); pushSTACK(slot); funcall(L(slot_value), 2);
    729. 

  729.   return TheFpointer(value1 = check_fpointer(value1,false))->fp_pointer;
    730. 

  730. }
    731. 

  731. 

  732. static void *get_ptr_object_and_display (object type, object obj,
    733. 

  733.                                          Display **dpyf)
    734. 

  734. { /* 'obj' is the lisp object, whose C representation is returned.
    735. 

  735.  When 'dpyf' is non-0, the display of 'obj' is also returned and it is
    736. 

  736.  ensured that it lives. [Otherwise an error is signaled.]
    737. 

  737.  If 'obj' is not of type 'type', a symbol naming the desired class,
    738. 

  738.  an error is issued.
    739. 

  739.  Hence this function ensures, that a proper object is returned, or nothing. */
    740. 

  740.   pushSTACK(type);
    741. 

  741.   pushSTACK(obj);
    742. 

  742. 

  743.   if (typep_classname (STACK_0, STACK_1)) {
    744. 

  744.     if (dpyf) { /* do we want the display? */
    745. 

  745.       pushSTACK(STACK_0); pushSTACK(`XLIB::DISPLAY`);
    746. 

  746.       funcall(L(slot_value), 2); pushSTACK(value1);
    747. 

  747.       *dpyf = pop_display ();
    748. 

  748.     }
    749. 

  749.     { void * ret = foreign_slot(STACK_0/* 'obj' */,`XLIB::PTR`);
    750. 

  750.       skipSTACK(2);                    /* clean up */
    751. 

  751.       return ret;
    752. 

  752.     }
    753. 

  753.   } else my_type_error(STACK_1/*type*/,STACK_0/*obj*/);
    754. 

  754. }
    755. 

  755. 

  756. /* Now the XID objects */
    757. 

  757. 

  758. static object make_xid_obj_low (gcv_object_t *prealloc, gcv_object_t *type,
    759. 

  759.                                 gcv_object_t *dpy, XID xid)
    760. 

  760. {
    761. 

  761.   if (nullp (*prealloc)) {
    762. 

  762.     /* (make-instance type :display dpy :id xid) */
    763. 

  763.     pushSTACK(*type);
    764. 

  764.     pushSTACK(`:DISPLAY`);  pushSTACK(*dpy);
    765. 

  765.     pushSTACK(`:ID`);       pushSTACK(make_uint29 (xid));
    766. 

  766.     funcall(S(make_instance),5);
    767. 

  767.     return value1;
    768. 

  768.   } else {
    769. 

  769.     /* TODO: We should check the type of the preallocated object?!
    770. 

  770.              [Is is a bug or a feature?] */
    771. 

  771.     pushSTACK(*prealloc);
    772. 

  772.     pushSTACK(`XLIB::DISPLAY`);
    773. 

  773.     pushSTACK(*dpy);
    774. 

  774.     funcall (L(set_slot_value), 3);
    775. 

  775. 

  776.     pushSTACK(*prealloc);
    777. 

  777.     pushSTACK(`XLIB::ID`);
    778. 

  778.     pushSTACK(make_uint29 (xid));
    779. 

  779.     funcall (L(set_slot_value), 3);
    780. 

  780. 

  781.     return *prealloc;
    782. 

  782.   }
    783. 

  783. }
    784. 

  784. 

  785. #if oint_data_len<29
    786. 

  786. DEFVAR(xlib_a_cons,allocate_cons());
    787. 

  787. /* return the XID object for lookup (old) */
    788. 

  788. static inline object XID_to_object_old (XID xid) {
    789. 

  789.   Car (O(xlib_a_cons)) = make_uint16 (xid & 0xFFFF); /* lower halfword */
    790. 

  790.   Cdr (O(xlib_a_cons)) = make_uint16 (xid >> 16);    /* upper halfword */
    791. 

  791.   return O(xlib_a_cons);
    792. 

  792. }
    793. 

  793. /* return the XID object for creation (new) */
    794. 

  794. static inline object XID_to_object_new (XID xid) {
    795. 

  795.   pushSTACK(make_uint16 (xid & 0xFFFF)); /* lower halfword */
    796. 

  796.   pushSTACK(make_uint16 (xid >> 16));    /* upper halfword */
    797. 

  797.   funcall(L(cons),2);                    /* cons them */
    798. 

  798.   return value1;
    799. 

  799. }
    800. 

  800. #else
    801. 

  801. #define XID_to_object_old(xid)  fixnum(xid)
    802. 

  802. #define XID_to_object_new(xid)  fixnum(xid)
    803. 

  803. #endif
    804. 

  804. 

  805. /* find the resource in the display hash table
    806. 

  806.  < display object, XID number
    807. 

  807.  > returns dpy->hash-table if NOT found
    808. 

  808.            nullobj if found, in which case the object found is in value1 */
    809. 

  809. static object lookup_xid (object dpy, XID xid) {
    810. 

  810.   if (xid == 0) { /* This is trivial, but is it also right?! */
    811. 

  811.     VALUES1(NIL);
    812. 

  812.     return nullobj;
    813. 

  813.   } else {
    814. 

  814.     object ht = display_hash_table(dpy);
    815. 

  815.     value1 = gethash(XID_to_object_old(xid),ht,false);    /* look it up */
    816. 

  816.     if (!eq(value1,nullobj)) {  /* something found? */
    817. 

  817.       mv_count = 1;             /* simply return what we found */
    818. 

  818.       return nullobj;
    819. 

  819.     } else
    820. 

  820.       return ht;                /* return the hash-table */
    821. 

  821.   }
    822. 

  822. }
    823. 

  823. 

  824. /* set the ID to map to RESOURCE on display
    825. 

  825.  < display hash-table object, XID number, resource object
    826. 

  826.  can trigger GC */
    827. 

  827. static void set_resource_id (gcv_object_t *ht, XID xid,
    828. 

  828.                              gcv_object_t *resource) {
    829. 

  829.   value1 = XID_to_object_new(xid);
    830. 

  830.   pushSTACK(value1);                     /* key for puthash */
    831. 

  831.   pushSTACK(*ht);                        /* hashtable */
    832. 

  832.   pushSTACK(*resource);                  /* value */
    833. 

  833.   funcall (L(puthash), 3);               /* put it into the hashtable */
    834. 

  834. }
    835. 

  835. 

  836. /* delete the resource ID from the display
    837. 

  837.  < display hash-table object, XID number */
    838. 

  838. static Values delete_resource_id (gcv_object_t *ht, XID xid) {
    839. 

  839.   pushSTACK(XID_to_object_old(xid)); pushSTACK(*ht); funcall(L(remhash),2);
    840. 

  840. }
    841. 

  841. 

  842. static object make_xid_obj_2 (object type, object dpy, XID xid,
    843. 

  843.                               object prealloc)
    844. 

  844. { /* NOTE: - This code is not reentrant :-( But hence it saves consing
    845. 

  845.          - may be we want to check the most significant 3 bits in xid, since
    846. 

  846.            GC inquiry functions return those values, if slot has an unknown
    847. 

  847.            value.
    848. 

  848.          - We could add even more safty here
    849. 

  849.            1. bark if lookup succeed and prealloc was specified.
    850. 

  850.               [But this  situation  should  not be able  to   occurr,  since a
    851. 

  851.               prealloc is only given upon creation requests.]  However MIT-CLX
    852. 

  852.               does this  check  and raises a hash-error,   if something is not
    853. 

  853.               o.k.  with the  hash  table. [But only if  you  set a debug flag
    854. 

  854.               somewhere].
    855. 

  855.            2. If lookup succeeds we could also check the type.
    856. 

  856.            3. We should check the type of the preallocated object?!
    857. 

  857.               [Compare to make_ptr_obj] */
    858. 

  858.   object ht = lookup_xid(dpy,xid);
    859. 

  859.   if (!eq(ht,nullobj)) { /* allocate and enter object into the hashtable */
    860. 

  860.     pushSTACK(prealloc);        /* save is save */
    861. 

  861.     pushSTACK(type);            /* ditto */
    862. 

  862.     pushSTACK(dpy);             /* ditto */
    863. 

  863.     pushSTACK(ht);              /* hashtable */
    864. 

  864.     pushSTACK(make_xid_obj_low (&STACK_3, &STACK_2, &STACK_1, xid));
    865. 

  865.     set_resource_id(&STACK_1,xid,&STACK_0); /* enter it into the hashtable */
    866. 

  866.     VALUES1(popSTACK());        /* return freshly allocated structure */
    867. 

  867.     skipSTACK(4);               /* remove saved prealloc, type, dpy, ht */
    868. 

  868.   }
    869. 

  869.   return value1;
    870. 

  870. }
    871. 

  871. 

  872. static XID get_xid_object_and_display (object type, object obj, Display **dpyf)
    873. 

  873. {
    874. 

  874.   pushSTACK(type);
    875. 

  875.   pushSTACK(obj);
    876. 

  876. 

  877.   if (typep_classname (STACK_0, STACK_1)) {
    878. 

  878.     if (dpyf) {                 /* do we want the display? */
    879. 

  879.       pushSTACK(STACK_0); pushSTACK(`XLIB::DISPLAY`);
    880. 

  880.       funcall(L(slot_value), 2); pushSTACK(value1);
    881. 

  881.       *dpyf = pop_display();
    882. 

  882.     }
    883. 

  883. 

  884.     pushSTACK(STACK_0); /* obj already on stack */ pushSTACK(`XLIB::ID`);
    885. 

  885.     funcall(L(slot_value), 2);
    886. 

  886.     ASSERT(integerp (value1)); /* FIXME */
    887. 

  887.     skipSTACK(2);                                      /* clean up */
    888. 

  888.     return (XID)(get_uint29 (value1));                 /* all done */
    889. 

  889.   } else my_type_error(STACK_1/*type*/,STACK_0/*obj*/);
    890. 

  890. }
    891. 

  891. 

  892. static object get_display_obj_tc (object type, object obj)
    893. 

  893. {
    894. 

  894.   if (typep_classname (obj, type)) {
    895. 

  895.     pushSTACK(obj); pushSTACK(`XLIB::DISPLAY`);
    896. 

  896.     funcall(L(slot_value), 2); return value1;
    897. 

  897.   } else my_type_error(type,obj);
    898. 

  898. }
    899. 

  899. 

  900. static object get_display_obj (object obj)
    901. 

  901. { /* XXX type checking [Well on the other hand is it really necessary?]
    902. 

  902.        I want to use the combined function above. */
    903. 

  903.   pushSTACK(obj); pushSTACK(`XLIB::DISPLAY`);
    904. 

  904.   funcall(L(slot_value), 2); return value1;
    905. 

  905. }
    906. 

  906. 

  907. 
    908. 

  908. /* -----------------------------------------------------------------------
    909. 

  909.  *  Specializied getters/makers/predicates
    910. 

  910.  * ----------------------------------------------------------------------- */
    911. 

  911. 

  912. /* Simple Getters */
    913. 

  913. #define get_xid_object(type,obj) get_xid_object_and_display(type,obj,0)
    914. 

  914. #define get_ptr_object(type,obj) get_ptr_object_and_display(type,obj,0)
    915. 

  915. 

  916. #define get_gcontext(obj) ((GC)      get_ptr_object (`XLIB::GCONTEXT`, obj))
    917. 

  917. #define get_screen(obj)   ((Screen*) get_ptr_object (`XLIB::SCREEN`,   obj))
    918. 

  918. #define get_image(obj)    ((XImage*) get_ptr_object (`XLIB::IMAGE`,    obj))
    919. 

  919. #define get_window(obj)   ((Window)  get_xid_object (`XLIB::WINDOW`,   obj))
    920. 

  920. #define get_pixmap(obj)   ((Pixmap)  get_xid_object (`XLIB::PIXMAP`,   obj))
    921. 

  921. #define get_cursor(obj)   ((Cursor)  get_xid_object (`XLIB::CURSOR`,   obj))
    922. 

  922. #define get_colormap(obj) ((Colormap)get_xid_object (`XLIB::COLORMAP`, obj))
    923. 

  923. #define get_drawable(obj) ((Drawable)get_xid_object (`XLIB::DRAWABLE`, obj))
    924. 

  924. 

  925. /* Combined getters */
    926. 

  926. #define get_drawable_and_display(obj, dpyf) ((Drawable)get_xid_object_and_display (`XLIB::DRAWABLE`, obj, dpyf))
    927. 

  927. #define get_window_and_display(obj, dpyf)   ((Window)  get_xid_object_and_display (`XLIB::WINDOW`,   obj, dpyf))
    928. 

  928. #define get_pixmap_and_display(obj, dpyf)   ((Pixmap)  get_xid_object_and_display (`XLIB::PIXMAP`,   obj, dpyf))
    929. 

  929. #define get_cursor_and_display(obj, dpyf)   ((Cursor)  get_xid_object_and_display (`XLIB::CURSOR`,   obj, dpyf))
    930. 

  930. #define get_colormap_and_display(obj, dpyf) ((Colormap)get_xid_object_and_display (`XLIB::COLORMAP`, obj, dpyf))
    931. 

  931. #define get_gcontext_and_display(obj,dpyf)  ((GC)      get_ptr_object_and_display (`XLIB::GCONTEXT`, obj, dpyf))
    932. 

  932. #define get_screen_and_display(obj,dpyf)    ((Screen*) get_ptr_object_and_display (`XLIB::SCREEN`,   obj, dpyf))
    933. 

  933. #define get_font_and_display(obj, dpyf)     ((Font)    get_xid_object_and_display (`XLIB::FONT`,     obj, dpyf))
    934. 

  934. 

  935. /* Predicates */
    936. 

  936. #define drawable_p(obj) (typep_classname (obj, `XLIB::DRAWABLE`))
    937. 

  937. #define window_p(obj)   (typep_classname (obj, `XLIB::WINDOW`))
    938. 

  938. #define pixmap_p(obj)   (typep_classname (obj, `XLIB::PIXMAP`))
    939. 

  939. #define cursor_p(obj)   (typep_classname (obj, `XLIB::CURSOR`))
    940. 

  940. #define colormap_p(obj) (typep_classname (obj, `XLIB::COLORMAP`))
    941. 

  941. #define font_p(obj)     (typep_classname (obj, `XLIB::FONT`))
    942. 

  942. #define gcontext_p(obj) (typep_classname (obj, `XLIB::GCONTEXT`))
    943. 

  943. #define screen_p(obj)   (typep_classname (obj, `XLIB::SCREEN`))
    944. 

  944. #define display_p(obj)  (typep_classname (obj, `XLIB::DISPLAY`))
    945. 

  945. #define color_p(obj)    (typep_classname (obj, `XLIB::COLOR`))
    946. 

  946. 

  947. /* Simple Makers */
    948. 

  948. #define make_xid_obj(a,b,c) make_xid_obj_2(a,b,c,NIL)
    949. 

  949. 

  950. #define make_window(dpy,win)   (make_window_2(dpy,win,NIL))
    951. 

  951. #define make_pixmap(dpy,pix)   (make_pixmap_2(dpy,pix,NIL))
    952. 

  952. #define make_drawable(dpy,da)  (make_window (dpy, da))
    953. 

  953. #define make_cursor(dpy,cur)   (make_xid_obj (`XLIB::CURSOR`, dpy, cur))
    954. 

  954. #define make_colormap(dpy,cm)  (make_xid_obj (`XLIB::COLORMAP`, dpy, cm))
    955. 

  955. #define make_gcontext(dpy,gc)  (make_ptr_obj (`XLIB::GCONTEXT`, dpy, gc))
    956. 

  956. #define make_screen(dpy, srcn) (make_ptr_obj (`XLIB::SCREEN`, dpy, srcn))
    957. 

  957. 

  958. /* Makers with prealloc */
    959. 

  959. #define make_window_2(dpy, win, prealloc) (make_xid_obj_2 (`XLIB::WINDOW`, dpy, win, prealloc))
    960. 

  960. #define make_pixmap_2(dpy, pm, prealloc)  (make_xid_obj_2 (`XLIB::PIXMAP`, dpy, pm, prealloc))
    961. 

  961. 

  962. 

  963. static object make_font (object dpy, Font fn, object name)
    964. 

  964. { /* This looks much more like assembler, doesn't it? */
    965. 

  965.   pushSTACK(name);                                 /* save the name */
    966. 

  966.   pushSTACK(make_xid_obj (`XLIB::FONT`, dpy, fn)); /* make the xid-object and save it */
    967. 

  967. 

  968.   /* fetch old FONT-INFO slot */
    969. 

  969.   pushSTACK(STACK_0);                           /* xid-object */
    970. 

  970.   pushSTACK(`XLIB::FONT-INFO`);                 /* slot */
    971. 

  971.   funcall(L(slot_value), 2); /* (slot-value new-xid-object `font-info) */
    972. 

  972.   /* do not overwrite any already fetched font info */
    973. 

  973.   if (!fpointerp (value1)) {   /* allocate a new fpointer */
    974. 

  974.     pushSTACK(STACK_0);        /* the new xid-object */
    975. 

  975.     pushSTACK(`XLIB::FONT-INFO`);                       /* the slot */
    976. 

  976.     pushSTACK(allocate_fpointer (NULL));                /* new value */
    977. 

  977.     funcall (L(set_slot_value), 3); /* update the :font-info slot */
    978. 

  978.   }
    979. 

  979. 

  980.   if (!nullp (STACK_1)) {           /* name */
    981. 

  981.     pushSTACK(STACK_0);             /* the new xid-object */
    982. 

  982.     pushSTACK(`XLIB::NAME`);        /* the :name slot */
    983. 

  983.     pushSTACK(STACK_3);             /* [name] new value */
    984. 

  984.     funcall (L(set_slot_value), 3); /* update the :name slot */
    985. 

  985.   }
    986. 

  986. 

  987.   value1 = STACK_0;             /* return value = new xid-object */
    988. 

  988.   skipSTACK(2);                 /* clean up */
    989. 

  989.   return value1;
    990. 

  990. }
    991. 

  991. 

  992. static Font get_font (object obj);
    993. 

  993. 

  994. static XFontStruct *get_font_info_and_display (object obj, object* fontf,
    995. 

  995.                                                Display **dpyf)
    996. 

  996. { /* Fetches the font information from a font, if it isn't there
    997. 

  997.      already, query the server for it.
    998. 

  998.      Further more if a gcontext is passed in, fetch its font slot instead.
    999. 

  999.      Does type checking and raises error if unappropriate object passed in.
    1000. 

  1000.      If 'fontf' is non-0, also the font as a Lisp object is returned.
    1001. 

  1001.      If 'dpyf' is non-0, also the display of the font is returned and it is
    1002. 

  1002.      ensured that the display actually lives. */
    1003. 

  1003.   XFontStruct *info;
    1004. 

  1004.   Display *dpy;
    1005. 

  1005.   Font font;
    1006. 

  1006. 

  1007.   if (gcontext_p (obj)) {
    1008. 

  1008.     /* In all places where a font object is required, a gcontext should
    1009. 

  1009.        be accepted too, so fetch the font slot and go on ... */
    1010. 

  1010.     pushSTACK(obj); pushSTACK(NIL);
    1011. 

  1011.     funcall(``XLIB:GCONTEXT-FONT``,2);
    1012. 

  1012.     obj = value1;               /* Now we have the font [or nothing] */
    1013. 

  1013.   }
    1014. 

  1014. 

  1015.   if (!font_p (obj)) my_type_error(`XLIB::FONT`,obj);
    1016. 

  1016. 

  1017.   pushSTACK(obj);               /* save */
    1018. 

  1018. 

  1019.   info = (XFontStruct*) foreign_slot(obj,`XLIB::FONT-INFO`);
    1020. 

  1020.   if (!info) {
    1021. 

  1021.     /* We have no font information already, so go and ask the server for it. */
    1022. 

  1022. 

  1023.     pushSTACK(value1);   /* but first save what we found. */
    1024. 

  1024. 

  1025.     font = get_font_and_display (STACK_1, &dpy);
    1026. 

  1026.     X_CALL(info = XQueryFont (dpy, font));
    1027. 

  1027. 

  1028.     if (!info) {
    1029. 

  1029.       pushSTACK(STACK_1); pushSTACK(TheSubr (subr_self)->name);
    1030. 

  1030.       error(error_condition,"~S: Font ~S does not exist");
    1031. 

  1031.     }
    1032. 

  1032. 

  1033.     if (dpyf) *dpyf = dpy;
    1034. 

  1034. 

  1035.     /* Store it in the foreign pointer
    1036. 

  1036.        (foreign_slot ensures that STACK_0 is a foreign pointer) */
    1037. 

  1037.     TheFpointer(STACK_0)->fp_pointer = info;
    1038. 

  1038.     skipSTACK(1);
    1039. 

  1039. 

  1040. #  ifdef UNICODE
    1041. 

  1041.     { /* Determine the font's encoding, so we can correctly convert
    1042. 

  1042.          characters to indices.
    1043. 

  1043.          Call (XLIB:FONT-PROPERTY font "CHARSET_REGISTRY")
    1044. 

  1044.          and  (XLIB:FONT-PROPERTY font "CHARSET_ENCODING")
    1045. 

  1045.          and translate the resulting pairs to CLISP encodings. */
    1046. 

  1046.       Atom xatom;
    1047. 

  1047.       unsigned long rgstry;
    1048. 

  1048.       unsigned long encdng;
    1049. 

  1049.       begin_x_call();
    1050. 

  1050.       xatom = XInternAtom (dpy, "CHARSET_REGISTRY", 0);
    1051. 

  1051.       if (XGetFontProperty (info, xatom, &rgstry)) {
    1052. 

  1052.         xatom = XInternAtom (dpy, "CHARSET_ENCODING", 0);
    1053. 

  1053.         if (XGetFontProperty (info, xatom, &encdng)) {
    1054. 

  1054.           Atom xatoms[2];
    1055. 

  1055.           char* names[2];
    1056. 

  1056.           int status;
    1057. 

  1057. 

  1058.           xatoms[0] = rgstry;
    1059. 

  1059.           xatoms[1] = encdng;
    1060. 

  1060.           names[0] = NULL;
    1061. 

  1061.           names[1] = NULL;
    1062. 

  1062. #        if !defined(HAVE_XGETATOMNAMES)
    1063. 

  1063.           names[0] = XGetAtomName (dpy, xatoms[0]);
    1064. 

  1064.           names[1] = XGetAtomName (dpy, xatoms[1]);
    1065. 

  1065.           status = names[0] && names[1];
    1066. 

  1066. #        else
    1067. 

  1067.           status = XGetAtomNames (dpy, xatoms, 2, names); /* X11R6 */
    1068. 

  1068. #        endif
    1069. 

  1069.           if (status) {
    1070. 

  1070.             /* this encoding canonicalization was requested by
    1071. 

  1071.                Pascal J.Bourguignon <pjb@informatimago.com>
    1072. 

  1072.                in <http://article.gmane.org/gmane.lisp.clisp.general:7794> */
    1073. 

  1073.             char* whole = (char*) alloca(strlen(names[0])+strlen(names[1])+3);
    1074. 

  1074.             if (!strncasecmp(names[0],"iso",3) && names[0][3] != '-') {
    1075. 

  1075.               strcpy(whole,"ISO-");
    1076. 

  1076.               strcat(whole,names[0]+3);
    1077. 

  1077.             } else strcpy(whole,names[0]);
    1078. 

  1078.             strcat(whole,"-");
    1079. 

  1079.             strcat(whole,names[1]);
    1080. 

  1080.             end_x_call();
    1081. 

  1081.             pushSTACK(S(Kcharset));
    1082. 

  1082.             pushSTACK(asciz_to_string(whole,GLO(misc_encoding)));
    1083. 

  1083.             pushSTACK(S(Koutput_error_action));
    1084. 

  1084.             pushSTACK(fixnum(info->default_char));
    1085. 

  1085.             funcall(L(make_encoding),4);
    1086. 

  1086.             pushSTACK(STACK_0); /* obj */
    1087. 

  1087.             pushSTACK(`XLIB::ENCODING`);
    1088. 

  1088.             pushSTACK(value1);
    1089. 

  1089.             funcall(L(set_slot_value),3);
    1090. 

  1090.             begin_x_call();
    1091. 

  1091.           }
    1092. 

  1092.           if (names[0])
    1093. 

  1093.             XFree (names[0]);
    1094. 

  1094.           if (names[1])
    1095. 

  1095.             XFree (names[1]);
    1096. 

  1096.         }
    1097. 

  1097.       }
    1098. 

  1098.       end_x_call();
    1099. 

  1099.     }
    1100. 

  1100. #  endif
    1101. 

  1101.   } else if (dpyf) /* caller wants the display, so get it! */
    1102. 

  1102.     unused get_font_and_display (STACK_0, dpyf);
    1103. 

  1103. 

  1104.   if (fontf) *fontf = STACK_0;
    1105. 

  1105. 

  1106.   skipSTACK(1);
    1107. 

  1107.   return info;              /* all done */
    1108. 

  1108. }
    1109. 

  1109. 

  1110. static object get_font_name (object obj)
    1111. 

  1111. {
    1112. 

  1112.   pushSTACK(obj);                       /* the instance */
    1113. 

  1113.   pushSTACK(`XLIB::NAME`);              /* slot */
    1114. 

  1114.   funcall(L(slot_value), 2);            /* lookup the slot */
    1115. 

  1115.   return value1;
    1116. 

  1116. }
    1117. 

  1117. 

  1118. #define ENSURE_TYPE(datum,booli,type)  if (!booli) my_type_error(type,datum)
    1119. 

  1119. 

  1120. static object get_slot (object obj, object slot)
    1121. 

  1121. { /* like gethash(): return nullobj on unbound slot and slot value otherwise */
    1122. 

  1122.   pushSTACK(obj); pushSTACK(slot); /* save for SLOT-VALUE */
    1123. 

  1123.   pushSTACK(obj); pushSTACK(slot); funcall(L(slot_boundp),2);
    1124. 

  1124.   if (nullp(value1)) { skipSTACK(2); return nullobj; }
    1125. 

  1125.   funcall(L(slot_value),2); return value1;
    1126. 

  1126. }
    1127. 

  1127. 

  1128. static Font get_font (object self)
    1129. 

  1129. { /* Does type-checking. */
    1130. 

  1130.   object font_id;
    1131. 

  1131.   pushSTACK(self);              /* save */
    1132. 

  1132.   ENSURE_TYPE (STACK_0, font_p(STACK_0), `XLIB::FONT`);
    1133. 

  1133.   font_id = get_slot(STACK_0,`XLIB::ID`);
    1134. 

  1134.   if (!eq(font_id,nullobj)) { /* We have already a fid, so return it. */
    1135. 

  1135.     skipSTACK(1);               /* clean up */
    1136. 

  1136.     ASSERT(integerp(font_id));
    1137. 

  1137.     return (XID)(get_uint29(font_id));
    1138. 

  1138.   } else { /* No font id => lookup the name & open that font */
    1139. 

  1139.     object name = get_font_name(STACK_0/*self*/);
    1140. 

  1140.     if (boundp(name)) { /* Ok there is a name ... so try to open the font */
    1141. 

  1141.       Font font; Display *dpy = get_display(STACK_0);
    1142. 

  1142.       with_string_0 (name, GLO(misc_encoding), namez, { /* XXX */
    1143. 

  1143.           X_CALL(font = XLoadFont(dpy,namez));
    1144. 

  1144.         });
    1145. 

  1145.       if (font) { /* Hurra! We got a font id, so enter it */
    1146. 

  1146.         pushSTACK(`XLIB::ID`); pushSTACK(make_uint29(font));
    1147. 

  1147.         funcall(L(set_slot_value),3);
    1148. 

  1148.         /* XXX -- We should enter it also into the hash table! */
    1149. 

  1149.         return font;            /* all done */
    1150. 

  1150.       } else { /* We could not open the font, so emit an error message */
    1151. 

  1151.         pushSTACK(TheSubr(subr_self)->name);    /* function name */
    1152. 

  1152.         error(error_condition,"~S: Cannot open pseudo font ~S");
    1153. 

  1153.       }
    1154. 

  1154.     } else {                 /* We have no name, tell that the luser. */
    1155. 

  1155.       pushSTACK(TheSubr(subr_self)->name);     /* function name */
    1156. 

  1156.       error(error_condition,"~S: Cannot open pseudo font ~S, since it has no name associated with it.");
    1157. 

  1157.     }
    1158. 

  1158.   }
    1159. 

  1159. }
    1160. 

  1160. 

  1161. static Atom get_xatom_general (Display *dpy, object obj, int internp)
    1162. 

  1162. { /* Converts a symbol or a string to an xatom. If 'obj' is no symbol
    1163. 

  1163.      nor a string, an error is raised.  if 'internp' is non-0 the atom
    1164. 

  1164.      is interned on the server. */
    1165. 

  1165.   Atom xatom;
    1166. 

  1166. 

  1167.   with_stringable_0_tc (obj, GLO(misc_encoding), atom_name, {
    1168. 

  1168.       X_CALL(xatom = XInternAtom (dpy, atom_name, !internp));
    1169. 

  1169.     });
    1170. 

  1170. 

  1171.   return xatom;
    1172. 

  1172. }
    1173. 

  1173. 

  1174. #define get_xatom(dpy,obj)          get_xatom_general (dpy, obj, 1) /* interning version */
    1175. 

  1175. #define get_xatom_nointern(dpy,obj) get_xatom_general (dpy, obj, 0) /* non-interning version */
    1176. 

  1176. 

  1177. static object make_visual (Visual *visual)
    1178. 

  1178. {
    1179. 

  1179.   XID id;
    1180. 

  1180.   X_CALL(id = XVisualIDFromVisual (visual));
    1181. 

  1181.   return make_uint29 (id);
    1182. 

  1182. }
    1183. 

  1183. 

  1184. static Visual *get_visual (Display *dpy, object vid)
    1185. 

  1185. {
    1186. 

  1186.   /* no begin/end_call here XVisualIDToVisual is defined by us. */
    1187. 

  1187.   return XVisualIDToVisual (dpy, get_uint29 (vid));
    1188. 

  1188. }
    1189. 

  1189. 

  1190. 
    1191. 

  1191. /* -----------------------------------------------------------------------
    1192. 

  1192.  * Lots of enums
    1193. 

  1193.  * ----------------------------------------------------------------------- */
    1194. 

  1194. 

  1195. DEFCHECKER(get_map_state,default=,UNMAPPED=IsUnmapped                   \
    1196. 

  1196.            UNVIEWABLE=IsUnviewable VIEWABLE=IsViewable)
    1197. 

  1197. #define make_map_state get_map_state_reverse
    1198. 

  1198. DEFCHECKER(get_shape,default=,COMPLEX=Complex CONVEX=Convex \
    1199. 

  1199.            NON-CONVEX=Nonconvex)
    1200. 

  1200. DEFCHECKER(get_W_class,default=,:COPY=CopyFromParent INPUT-OUTPUT=InputOutput \
    1201. 

  1201.            INPUT-ONLY=InputOnly)
    1202. 

  1202. #define make_W_class get_W_class_reverse
    1203. 

  1203. DEFCHECKER(get_stack_mode,default=,ABOVE=Above BELOW=Below TOP-IF=TopIf \
    1204. 

  1204.            BOTTOM-IF=BottomIf OPPOSITE=Opposite)
    1205. 

  1205. #define make_stack_mode get_stack_mode_reverse
    1206. 

  1206. DEFCHECKER(get_arc_mode,default=,CHORD=ArcChord PIE-SLICE=ArcPieSlice)
    1207. 

  1207. #define make_arc_mode get_arc_mode_reverse
    1208. 

  1208. DEFCHECKER(get_line_style,default=,SOLID=LineSolid DASH=LineOnOffDash \
    1209. 

  1209.            DOUBLE-DASH=LineDoubleDash)
    1210. 

  1210. #define make_line_style get_line_style_reverse
    1211. 

  1211. DEFCHECKER(get_cap_style,default=,NOT-LAST=CapNotLast BUTT=CapButt    \
    1212. 

  1212.            ROUND=CapRound PROJECTING=CapProjecting)
    1213. 

  1213. #define make_cap_style get_cap_style_reverse
    1214. 

  1214. DEFCHECKER(get_join_style,default=, \
    1215. 

  1215.            MITER=JoinMiter ROUND=JoinRound BEVEL=JoinBevel)
    1216. 

  1216. #define make_join_style get_join_style_reverse
    1217. 

  1217. DEFCHECKER(get_fill_style,default=,SOLID=FillSolid TILED=FillTiled \
    1218. 

  1218.            STIPPLED=FillStippled OPAQUE-STIPPLED=FillOpaqueStippled)
    1219. 

  1219. #define make_fill_style get_fill_style_reverse
    1220. 

  1220. DEFCHECKER(get_fill_rule,default=, EVEN-ODD=EvenOddRule WINDING=WindingRule)
    1221. 

  1221. #define make_fill_rule get_fill_rule_reverse
    1222. 

  1222. DEFCHECKER(get_subwindow_mode,default=, \
    1223. 

  1223.            CLIP-BY-CHILDREN=ClipByChildren INCLUDE-INFERIORS=IncludeInferiors)
    1224. 

  1224. #define make_subwindow_mode get_subwindow_mode_reverse
    1225. 

  1225. DEFCHECKER(get_gravity,default=,FORGET=ForgetGravity                    \
    1226. 

  1226.            NORTH-WEST=NorthWestGravity NORTH=NorthGravity               \
    1227. 

  1227.            NORTH-EAST=NorthEastGravity WEST=WestGravity CENTER=CenterGravity \
    1228. 

  1228.            EAST=EastGravity SOUTH-WEST=SouthWestGravity SOUTH=SouthGravity \
    1229. 

  1229.            SOUTH-EAST=SouthEastGravity STATIC=StaticGravity)
    1230. 

  1230. #define make_gravity get_gravity_reverse
    1231. 

  1231. /* NIM: the :static gravity is not mentioned in the CLX manual. */
    1232. 

  1232. DEFCHECKER(get_visibility_state,default=, UNOBSCURED=VisibilityUnobscured \
    1233. 

  1233.            PARTLY-OBSCURED=VisibilityPartiallyObscured                  \
    1234. 

  1234.            FULLY-OBSCURED=VisibilityFullyObscured)
    1235. 

  1235. #define make_visibility_state get_visibility_state_reverse
    1236. 

  1236. DEFCHECKER(get_top_or_bottom,default=,TOP=PlaceOnTop BOTTOM=PlaceOnBottom)
    1237. 

  1237. #define make_top_or_bottom get_top_or_bottom_reverse
    1238. 

  1238. DEFCHECKER(get_new_value_or_deleted,default=, \
    1239. 

  1239.            NEW-VALUE=PropertyNewValue DELETED=PropertyDelete)
    1240. 

  1240. #define make_new_value_or_deleted get_new_value_or_deleted_reverse
    1241. 

  1241. DEFCHECKER(get_ordering,default=Unsorted, UNSORTED=Unsorted Y-SORTED=YSorted \
    1242. 

  1242.            YX-SORTED=YXSorted YX-BANDED=YXBanded)
    1243. 

  1243. DEFCHECKER(get_mapping_request…
    1244.

Large files files are truncated, but you can click here to view the full file