diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp index 7a92ec8332be206c8fa414334b109c172d387de1..12bf61083b98f7336c8fbe20a948b4963d308cfe 100644 --- a/demo/demo-driver.lisp +++ b/demo/demo-driver.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: demo-driver.lisp,v 1.21 92/12/14 15:02:36 cer Exp $ +;; $fiHeader: demo-driver.lisp,v 1.22 92/12/16 16:47:23 cer Exp $ (in-package :clim-demo) @@ -25,7 +25,7 @@ (when (fboundp 'clim-user::do-test-suite) (clim-user::do-test-suite :port port :force force))) -(defun start-demo (&key (port (find-port))) +(defun start-demo (&key (port (find-port)) force) (let* ((framem (typecase port (frame-manager port) (t (find-frame-manager :port port)))) @@ -53,7 +53,7 @@ ((functionp demo-fcn) (funcall demo-fcn)) (t - (funcall demo-fcn :port port)))))))) + (funcall demo-fcn :port port :force force)))))))) (defparameter *color-stream-p* t) (defun color-stream-p (stream) diff --git a/misc/dump.lisp b/misc/dump.lisp index 488329b98774f231bc8ef3620dc361c71cfcd10f..6c59bd9d6e7779572aad33332094857565661095 100644 --- a/misc/dump.lisp +++ b/misc/dump.lisp @@ -20,14 +20,12 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: dump.lisp,v 1.3 92/03/04 16:23:13 cer Exp Locker: cer $ +;; $fiHeader: dump.lisp,v 1.4 92/03/24 19:38:34 cer Exp $ ;; Assuming CLIM is loaded, dump it into /usr/tmp/clim.temp_$USER. (room t) (sys:resize-areas :global-gc t :old 1000000 :new 500000) (room t) -(dumplisp :name (concatenate 'simple-string "/tmp/clim.temp_" - (sys:getenv "USER")) - :checkpoint nil) +(dumplisp :name sys::*clim-dump-name* :checkpoint nil) diff --git a/tk/foreign.lisp b/tk/foreign.lisp index 9c8bd81ed9cb08ac8a43cad09ab670eae66f7e31..7d3c8375aeecc4a5306e2da69879242b96eedea5 100644 --- a/tk/foreign.lisp +++ b/tk/foreign.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: foreign.lisp,v 1.12 92/05/22 19:26:19 cer Exp $ +;; $fiHeader: foreign.lisp,v 1.13 92/08/18 17:53:33 cer Exp $ (in-package :tk) @@ -83,3 +83,16 @@ (setf (foreign-pointer-address d) (or display (apply #'open-display args)))) + +(defun display-database (display) + (make-instance 'resource-database + :foreign-address (xt_database display))) + + +(defun get-application-name-and-class (display) + (with-ref-par ((name 0) + (class 0)) + (xt_get_application_name_and_class display name class) + (values (char*-to-string (aref name 0)) + (char*-to-string (aref class 0))))) + diff --git a/tk/xt-defs.lisp b/tk/xt-defs.lisp index a5331fba54d9ec8d222b57244282a5371395118d..72923a2d76f12227204456023f22243c62afcb19 100644 --- a/tk/xt-defs.lisp +++ b/tk/xt-defs.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-defs.lisp,v 1.6 92/11/20 08:46:24 cer Exp $ +;; $fiHeader: xt-defs.lisp,v 1.7 92/12/01 09:46:58 cer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. @@ -44,17 +44,6 @@ (def-c-typedef xt-dimension :unsigned-short) (def-c-typedef xt-pointer * char) -(def-c-type (xrm-resource :no-defuns) :struct - (name xrm-quark) - (class xrm-quark) - (type xrm-quark) - (size :cardinal) - (offset :long) - (default-type xrm-quark) - (default-addr * :char)) - -(def-c-type (xrm-resource-array :no-defuns) 1 xrm-resource) - (def-c-type (xt-class :no-defuns) :struct (superclass :long) (name * :char) @@ -85,7 +74,7 @@ (version xt-version-type) (callback-private * :char)) -(def-c-type (x-resource :no-defuns) :struct +(def-c-type (xt-resource :no-defuns) :struct (name * :char) (class * :char) (type * :char) @@ -96,8 +85,6 @@ ) ;; Horrible internal stuff - - (def-c-type (xt-offset-rec :no-defuns) :struct (next * :char) @@ -117,7 +104,7 @@ (widget-class :unsigned-long) ) -(def-c-type (x-resource-list :in-foreign-space :no-defuns) 1 x-resource) +(def-c-type (xt-resource-list :in-foreign-space :no-defuns) 1 xt-resource) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp index 0a2758a4abd2a0741cfc3fb0dd18b4a2b9456c71..d149a3d0943b42c9895c7d53311d4227d2c5a005 100644 --- a/tk/xt-funs.lisp +++ b/tk/xt-funs.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-funs.lisp,v 1.14 92/11/13 14:47:04 cer Exp $ +;; $fiHeader: xt-funs.lisp,v 1.15 92/12/14 15:04:17 cer Exp $ ;; ;; This file contains compile time only code -- put in clim-debug.fasl. @@ -94,6 +94,29 @@ :arg-checking nil :return-type :unsigned-integer) +(defforeign 'xt_database + :entry-point (ff:convert-to-lang "XtDatabase") + :call-direct t + :arguments '(foreign-address) + :arg-checking nil + :return-type :unsigned-integer) + +(defforeign 'xt_get_application_name_and_class + :entry-point (ff:convert-to-lang "XtGetApplicationNameAndClass") + :call-direct t + :arguments '(foreign-address foreign-address foreign-address) + :arg-checking nil + :return-type :unsigned-integer) + + +(defforeign 'xt_convert_and_store + :entry-point (ff:convert-to-lang "XtConvertAndStore") + :call-direct t + :arguments '(foreign-address foreign-address foreign-address + foreign-address foreign-address) + :arg-checking nil + :return-type :unsigned-integer) + (defforeign 'xt_app_create_shell :entry-point (ff:convert-to-lang "XtAppCreateShell") :call-direct t @@ -205,7 +228,21 @@ :arguments '(foreign-address) :arg-checking nil :return-type :unsigned-integer) - + +(defforeign 'xt_name + :entry-point (ff:convert-to-lang "XtName") + :call-direct t + :arguments '(foreign-address) + :arg-checking nil + :return-type :unsigned-integer) + +(defforeign 'xt_class + :entry-point (ff:convert-to-lang "XtClass") + :call-direct t + :arguments '(foreign-address) + :arg-checking nil + :return-type :unsigned-integer) + (defforeign 'xt_query_geometry :entry-point (ff:convert-to-lang "XtQueryGeometry") :call-direct t