diff options
Diffstat (limited to 'progs/lib/X11/clx-patch.lisp')
| -rw-r--r-- | progs/lib/X11/clx-patch.lisp | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/progs/lib/X11/clx-patch.lisp b/progs/lib/X11/clx-patch.lisp new file mode 100644 index 0000000..fe2a5e3 --- /dev/null +++ b/progs/lib/X11/clx-patch.lisp @@ -0,0 +1,39 @@ +(lisp:in-package 'xlib) +(defmacro generate-lookup-functions (useless-name &body types) + `(within-definition (,useless-name generate-lookup-functions) + ,@(mapcar + #'(lambda (type) + `(defun ,(xintern 'lookup- type) + (display id) + (declare (type display display) + (type resource-id id)) + (declare (values ,type)) + ,(if (member type *clx-cached-types*) + `(let ((,type (lookup-resource-id display id))) + (cond ((null ,type) ;; Not found, create and s +ave it. + (setq ,type (,(xintern 'make- type) + :display display :id id)) + (save-id display id ,type)) + ;; Found. Check the type + ,(cond ((null '()) ;*type-check?*) + `(t ,type)) + ((member type '(window pixmap)) + `((type? ,type 'drawable) ,type) +) + (t `((type? ,type ',type) ,type)) +) + ,@(when '() ;*type-check?* + `((t (x-error 'lookup-error + :id id + :display display + :type ',type + :object ,type)))))) + ;; Not being cached. Create a new one each time. + `(,(xintern 'make- type) + :display display :id id)))) + types))) +(macroexpand + (generate-lookup-functions ignore + window)) + |