Skip to content
Snippets Groups Projects
Commit f944ffd4 authored by colin's avatar colin
Browse files

Makefile

misc/dump.lisp
- added DUMP-CLIM and sys::*clim-dump-name* - support for dumping a
  clim image somewhere other than /tmp

clim/output-protocol.lisp
- engraft-medium :after changes text-style only if not already set

demo/demo-driver.lisp
- added :force argument to start-demo

silica/classes.lisp
- wrapped a print-unreadable-object around print-object method for
  window-event

silica/medium.lisp
- initform for text-style in foreground-background-and-text-style-mixin
  changed from *default-text-style* to nil (#+allegro)

test/test-suite.lisp
- changed "Colored patterns" test to draw a different polygon so that
  pattern used as ink is visible (and not clipped out of existance as
  before)

tk/foreign.lisp
- added functions display-database and get-application-name-and-class

tk/xt-defs.lisp
tk/make-classes.lisp
- changed class x-resource to xt-resource and all references

tk/resources.lisp
- added a convert-resource-in for 'alignment

tk/widget.lisp
- app-create-shell sets up application name and class as "clim", "Clim"
- initialize-toolkit passes on initargs to app-create-shell
- added functions xt-name and  xt-class
- added function widget-resource-name-and-class

tk/xlib.lisp
- added class resource-database
- added functions get-resource and convert-string
- added parse-color

tk/xt-defs.lisp
- removed xrm-resource and xrm-resource-array
- changed x-resource to xt-resource

tk/xt-funs.lisp
- added xt_database, xt_get_application_name_and_class,
  xt_convert_and_store, xt_name and xt_class

xtk.lisp removed (no longer used)

tk-silica/xm-frames.lisp
- realize-mirror :around method on menu-bar queries textStyle resource

tk-silica/xm-gadgets.lisp
- removed make-pane-class method on scroller-pane and put it in
  main make-pane-class method on motif-frame-manager
- find-widget-class-and-initargs-for-sheet on xm-viewport sets up
  :name resource

tk-silica/xt-gadgets.lisp
- find-widget-class-and-initargs-for-sheet :around method on
  foreground-background-and-text-style-mixin queries textStyle
  resource

tk-silica/xt-graphics.lisp
- find-named-color uses parse-color rather than lookup-color (so that
  #rgb works - in R5 should be able to use lookup-color again)
- changed refs to tk::x-colormap-error to tk::x-colormap-full
- changed text-style-{width,height,ascent,descent} to specialize on
  (text-style t) rather than standard-text-style. This makes them work
  for device-fonts.
- added decode-contrasting-ink (avoids some code duplication)
- on monochrome made luminosity == 0.5 decode to white rather than
  black (makes contrasting ink work better)

tk-silica/xt-silica.lisp
- added a bunch of define-xt-keysyms and fixed some wrong ones
- removed default-from-mirror-resources
- added default-from-resources - queries the resource database to get
  background, foreground and text-style
parent 0cbb8955
No related branches found
No related tags found
No related merge requests found
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- ;;; -*- 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) (in-package :clim-demo)
...@@ -25,7 +25,7 @@ ...@@ -25,7 +25,7 @@
(when (fboundp 'clim-user::do-test-suite) (when (fboundp 'clim-user::do-test-suite)
(clim-user::do-test-suite :port port :force force))) (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 (let* ((framem (typecase port
(frame-manager port) (frame-manager port)
(t (find-frame-manager :port port)))) (t (find-frame-manager :port port))))
...@@ -53,7 +53,7 @@ ...@@ -53,7 +53,7 @@
((functionp demo-fcn) ((functionp demo-fcn)
(funcall demo-fcn)) (funcall demo-fcn))
(t (t
(funcall demo-fcn :port port)))))))) (funcall demo-fcn :port port :force force))))))))
(defparameter *color-stream-p* t) (defparameter *color-stream-p* t)
(defun color-stream-p (stream) (defun color-stream-p (stream)
......
...@@ -20,14 +20,12 @@ ...@@ -20,14 +20,12 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable. ;; 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. ;; Assuming CLIM is loaded, dump it into /usr/tmp/clim.temp_$USER.
(room t) (room t)
(sys:resize-areas :global-gc t :old 1000000 :new 500000) (sys:resize-areas :global-gc t :old 1000000 :new 500000)
(room t) (room t)
(dumplisp :name (concatenate 'simple-string "/tmp/clim.temp_" (dumplisp :name sys::*clim-dump-name* :checkpoint nil)
(sys:getenv "USER"))
:checkpoint nil)
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable. ;; 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) (in-package :tk)
...@@ -83,3 +83,16 @@ ...@@ -83,3 +83,16 @@
(setf (foreign-pointer-address d) (setf (foreign-pointer-address d)
(or display (or display
(apply #'open-display args)))) (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)))))
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable. ;; 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. ;; This file contains compile time only code -- put in clim-debug.fasl.
...@@ -44,17 +44,6 @@ ...@@ -44,17 +44,6 @@
(def-c-typedef xt-dimension :unsigned-short) (def-c-typedef xt-dimension :unsigned-short)
(def-c-typedef xt-pointer * char) (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 (def-c-type (xt-class :no-defuns) :struct
(superclass :long) (superclass :long)
(name * :char) (name * :char)
...@@ -85,7 +74,7 @@ ...@@ -85,7 +74,7 @@
(version xt-version-type) (version xt-version-type)
(callback-private * :char)) (callback-private * :char))
(def-c-type (x-resource :no-defuns) :struct (def-c-type (xt-resource :no-defuns) :struct
(name * :char) (name * :char)
(class * :char) (class * :char)
(type * :char) (type * :char)
...@@ -96,8 +85,6 @@ ...@@ -96,8 +85,6 @@
) )
;; Horrible internal stuff ;; Horrible internal stuff
(def-c-type (xt-offset-rec :no-defuns) :struct (def-c-type (xt-offset-rec :no-defuns) :struct
(next * :char) (next * :char)
...@@ -117,7 +104,7 @@ ...@@ -117,7 +104,7 @@
(widget-class :unsigned-long) (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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable. ;; 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. ;; This file contains compile time only code -- put in clim-debug.fasl.
...@@ -94,6 +94,29 @@ ...@@ -94,6 +94,29 @@
:arg-checking nil :arg-checking nil
:return-type :unsigned-integer) :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 (defforeign 'xt_app_create_shell
:entry-point (ff:convert-to-lang "XtAppCreateShell") :entry-point (ff:convert-to-lang "XtAppCreateShell")
:call-direct t :call-direct t
...@@ -205,7 +228,21 @@ ...@@ -205,7 +228,21 @@
:arguments '(foreign-address) :arguments '(foreign-address)
:arg-checking nil :arg-checking nil
:return-type :unsigned-integer) :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 (defforeign 'xt_query_geometry
:entry-point (ff:convert-to-lang "XtQueryGeometry") :entry-point (ff:convert-to-lang "XtQueryGeometry")
:call-direct t :call-direct t
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment