diff --git a/Makefile b/Makefile index 739b668a1104294e02075197c312b1d9919ba14e..d47d4eef1221f0683135deea1ef11cc555a31744 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# $fiHeader: Makefile,v 1.46 92/09/22 19:37:54 cer Exp Locker: cer $ +# $fiHeader: Makefile,v 1.47 92/09/24 09:40:17 cer Exp Locker: cer $ # # Makefile for CLIM 2.0 # @@ -82,7 +82,7 @@ XLIBS= $(XTLIB) $(XLIB) OLCOPYLIB=/usr/tech/cer/stuff/clim-2.0/tk/lib2 OLXLIBS=$(OLCOPYLIB)/libXt.a $(OLCOPYLIB)/libX11.a LIBXOL=$(OLCOPYLIB)/libXol.a -LIBXOL_d=$(OLCOPYLIB)/libXol.a +LIBXOL_d=$(LIBXOL) # This has to be kept consistent with xlib.lisp UNDEFS=misc/undefinedsymbols @@ -96,7 +96,11 @@ XM_UNDEFS=misc/undefinedsymbols.motif # This should be the same as load-ol OL_UNDEFS=misc/undefinedsymbols.olit -CLIMFASLS= climg.fasl climol.fasl climxm.fasl clim-debug.fasl climps.fasl +# These are the fasls and the .o that form the product + +CLIMFASLS= climg.fasl climol.fasl climxm.fasl clim-debug.fasl clim-debugol.fasl \ + clim-debugxm.fasl climps.fasl climgg.fasl + CLIMOBJS= clim-motif_d.o clim-olit_d.o clim-motif.o clim-olit.o stub-xt.o stub-x.o \ xlibsupport.o MyDrawingA.o \ olsupport.o xtsupport.o @@ -129,10 +133,10 @@ MALLOCOBJS = # DEBUG-OBJS = xlib/ffi.fasl xlib/xlib-defs.fasl xlib/xlib-funs.fasl \ xlib/x11-keysyms.fasl xlib/last.fasl \ - tk/xt-defs.fasl tk/xm-defs.fasl tk/xt-funs.fasl tk/xm-funs.fasl -# These should be there also -# tk/ol-defs.fasl tk/ol-funs.fasl + tk/xt-defs.fasl tk/xt-funs.fasl +XM-DEBUG-OBJS = tk/xm-defs.fasl tk/xm-funs.fasl +OL-DEBUG-OBJS = tk/ol-defs.fasl tk/ol-funs.fasl # # "Load time objects" -- these go into clim.fasl @@ -238,6 +242,9 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \ clim/item-list-manager.fasl \ clim/stream-trampolines.fasl +GENERIC-GADGETS = clim/db-menu.fasl clim/db-text.fasl silica/db-button.fasl \ + silica/db-slider.fasl + XLIB-CLIM-OBJS = xlib/pkg.fasl xlib/load-xlib.fasl @@ -519,9 +526,9 @@ compile-ol: $(CLIMOBJS) FORCE # Concatenation cat: cat-xm cat-ol -cat-g: climg.fasl clim-debug.fasl climps.fasl -cat-xm: cat-g climxm.fasl -cat-ol: cat-g climol.fasl +cat-g: climg.fasl clim-debug.fasl climps.fasl climgg.fasl +cat-xm: cat-g climxm.fasl clim-debugxm.fasl +cat-ol: cat-g climol.fasl clim-debugol.fasl climg.fasl : $(GENERIC-OBJS) $(XLIB-CLIM-OBJS) $(CAT) $(GENERIC-OBJS) $(XLIB-CLIM-OBJS) > $(TMP)/clim.fasl_`whoami` @@ -529,6 +536,13 @@ climg.fasl : $(GENERIC-OBJS) $(XLIB-CLIM-OBJS) ls -lt climg.fasl >> Clim-sizes.n ls -lt climg.fasl +climgg.fasl : $(GENERIC-GADGETS) + $(CAT) $(GENERIC-GADGETS) > $(TMP)/clim.fasl_`whoami` + $(MV) $(TMP)/clim.fasl_`whoami` climgg.fasl + ls -lt climgg.fasl >> Clim-sizes.n + ls -lt climgg.fasl + + climxm.fasl : $(MOTIF-OBJS) $(XLIB-CLIM-OBJS) $(CAT) $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami` $(MV) $(TMP)/clim.fasl_`whoami` climxm.fasl @@ -550,6 +564,18 @@ clim-debug.fasl: $(DEBUG-OBJS) ls -lt clim-debug.fasl >> Clim-sizes.n ls -lt clim-debug.fasl +clim-debugxm.fasl: $(XM-DEBUG-OBJS) + $(CAT) $(XM-DEBUG-OBJS) > $(TMP)/clim-debugxm.fasl_`whoami` + $(MV) $(TMP)/clim-debugxm.fasl_`whoami` clim-debugxm.fasl + ls -lt clim-debugxm.fasl >> Clim-sizes.n + ls -lt clim-debugxm.fasl + +clim-debugol.fasl: $(OL-DEBUG-OBJS) + $(CAT) $(OL-DEBUG-OBJS) > $(TMP)/clim-debugol.fasl_`whoami` + $(MV) $(TMP)/clim-debugol.fasl_`whoami` clim-debugol.fasl + ls -lt clim-debugol.fasl >> Clim-sizes.n + ls -lt clim-debugol.fasl + climps.fasl: $(POSTSCRIPT_CLIM) $(CAT) $(POSTSCRIPT_CLIM) > $(TMP)/climps.fasl_`whoami` $(MV) $(TMP)/climps.fasl_`whoami` climps.fasl @@ -577,7 +603,7 @@ clim-xm: FORCE $(CLIMOBJS) ls -lLt $(CLIM) echo CLIM-XM built!!!! -clim-ol: FORCE +clim-ol: FORCE $(CLIMOBJS) # -$(RM) $(CLIM) $(ECHO) " \ (setq sys::*libxt-pathname* \"$(XTLIB)\") \ diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp index 5409484afa4ccf0ff5b54fb7d5acf8c0ef4a2883..335ce6e105dfbf17d206224593363cb1441e70d3 100644 --- a/clim/accept-values.lisp +++ b/clim/accept-values.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: accept-values.lisp,v 1.34 92/09/22 19:37:04 cer Exp Locker: cer $ +;; $fiHeader: accept-values.lisp,v 1.35 92/09/24 09:38:22 cer Exp Locker: cer $ (in-package :clim-internals) @@ -1205,7 +1205,7 @@ :resynchronize resynchronize))) (make-pane 'push-button :label (if (stringp prompt) - stream + prompt ;;--- Perhaps we should create a pixmap (with-output-to-string (stream) (funcall prompt stream))) diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp index 1d07ff37ecbf612a735ff0c056aa9a2851748f5a..36b3758dfe835a54cecec708710c905aade16e26 100644 --- a/clim/db-stream.lisp +++ b/clim/db-stream.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: db-stream.lisp,v 1.30 92/09/22 19:37:09 cer Exp Locker: cer $ +;; $fiHeader: db-stream.lisp,v 1.31 92/09/24 09:38:39 cer Exp Locker: cer $ (in-package :clim-internals) @@ -402,6 +402,7 @@ (setf (window-visibility stream) t)) ;;--- Is there any way to do this? + (defmethod (setf window-label) (label (stream clim-stream-sheet)) nil) diff --git a/clim/excl-presentations.lisp b/clim/excl-presentations.lisp index e32b880fe81d6c881e9d0343bc0edbf41be94bfd..7e8d6ec866a37b14f94cd44704a49d0cb86031d3 100644 --- a/clim/excl-presentations.lisp +++ b/clim/excl-presentations.lisp @@ -21,7 +21,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: excl-presentations.lisp,v 1.10 92/08/21 16:33:46 cer Exp $ +;; $fiHeader: excl-presentations.lisp,v 1.11 92/09/08 15:17:42 cer Exp Locker: cer $ (in-package :clim-internals) @@ -59,11 +59,9 @@ ;; Record initialized with :object, :type maybe -(defvar *gross-output-history-stack* nil) - (defmethod excl::set-io-record-pos1 ((stream output-recording-mixin) record) (let ((current-output-position - (stream-output-history-position stream))) + (stream-output-history-position stream))) (multiple-value-bind (px py) (point-position current-output-position) (declare (type coordinate px py)) @@ -75,7 +73,7 @@ (output-record-set-start-cursor-position record x y) (stream-close-text-output-record stream) (push (list (stream-current-output-record stream) px py) - *gross-output-history-stack*) + (stream-excl-presentation-stack stream)) (setf (point-x current-output-position) cursor-x (point-y current-output-position) cursor-y (stream-current-output-record stream) record)))))) @@ -83,16 +81,16 @@ (defmethod excl::set-io-record-pos2 ((stream output-recording-mixin) record) (stream-close-text-output-record stream) (let ((current-output-position - (stream-output-history-position stream))) + (stream-output-history-position stream))) (destructuring-bind (parent abs-x abs-y) - (pop *gross-output-history-stack*) + (stream-excl-presentation-stack stream) (unless parent (setq parent (stream-output-history stream))) (multiple-value-bind (end-x end-y) (stream-cursor-position stream) (declare (type coordinate end-x end-y)) (output-record-set-end-cursor-position - record (- end-x abs-x) (- end-y abs-y))) + record (- end-x abs-x) (- end-y abs-y))) (setf (point-x current-output-position) abs-x (point-y current-output-position) abs-y (stream-current-output-record stream) parent) diff --git a/clim/frames.lisp b/clim/frames.lisp index d6c49759d080524eab36aa5424c636caeb28095c..3d7864758c15af788ea7baf0deb4f5e47889f5e3 100644 --- a/clim/frames.lisp +++ b/clim/frames.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: frames.lisp,v 1.41 92/09/22 19:37:10 cer Exp Locker: cer $ +;; $fiHeader: frames.lisp,v 1.42 92/09/24 09:38:46 cer Exp Locker: cer $ (in-package :clim-internals) @@ -20,7 +20,7 @@ ;; One of T, NIL, or a command-table; used by the menu-bar (menu-bar :initarg :menu-bar :initform nil) (histories :initform nil) - (frame-manager :accessor frame-manager) + (frame-manager :initform nil :accessor frame-manager) (calling-frame :reader frame-calling-frame :initarg :calling-frame) ;; PANES is the description of all of the named panes, ;; ALL-PANES is an alist that stores all of the named panes that @@ -96,7 +96,6 @@ (port (find-frame-manager :port parent)) (graft (find-frame-manager :port (port parent))) (sheet (frame-manager (pane-frame parent)))))) - (setf (slot-value frame 'frame-manager) frame-manager) (when frame-manager (adopt-frame frame-manager frame)))) @@ -1388,3 +1387,6 @@ (defmethod bury-frame ((frame standard-application-frame)) (bury-sheet (frame-top-level-sheet frame))) + +(defmethod port-note-frame-adopted ((port port) (frame standard-application-frame)) + nil) diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp index 96259843451b4d670d752514e86cebef6183959d..73d0d1f860060a6e8b5fa97c1ef6798bbf4f176e 100644 --- a/clim/gadget-output.lisp +++ b/clim/gadget-output.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: gadget-output.lisp,v 1.28 92/09/22 19:37:13 cer Exp Locker: cer $ +;; $fiHeader: gadget-output.lisp,v 1.29 92/09/24 09:38:49 cer Exp Locker: cer $ (in-package :clim-internals) @@ -231,7 +231,9 @@ (defmethod note-output-record-attached :after ((record gadget-output-record) stream) (declare (ignore stream)) - (when (output-record-gadget record) + (when (and (output-record-gadget record) + ;;--- Why? + (port (output-record-gadget record))) (update-gadget-position record) (update-output-record-gadget-state record t))) diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp index 76b8be0547f4e71c9e3f5a6dcf7a8f11e17365b3..8877c72bddf65acc45388feab41bafb25e7f62da 100644 --- a/clim/input-protocol.lisp +++ b/clim/input-protocol.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: input-protocol.lisp,v 1.25 92/09/22 19:37:18 cer Exp Locker: cer $ +;; $fiHeader: input-protocol.lisp,v 1.26 92/09/24 09:39:04 cer Exp Locker: cer $ (in-package :clim-internals) @@ -412,11 +412,13 @@ (setq gesture (stream-read-gesture (or *original-stream* stream))) (when (and (characterp gesture) (ordinary-char-p gesture)) (return-from stream-read-char gesture)) - ;;--- Probably wrong. It prevents the input editor from ever seeing - ;;--- mouse clicks, for example. + #+ignore (when (and (typep gesture 'key-press-event) (characterp (keyboard-event-character gesture))) (return-from stream-read-char (slot-value gesture 'character))) + ;;--- Probably wrong. It prevents the input editor from ever seeing + ;;--- mouse clicks, for example. + #+ignore (beep stream)))) (defmethod stream-unread-char ((stream input-protocol-mixin) character) diff --git a/clim/stream-class-defs.lisp b/clim/stream-class-defs.lisp index 147d95c4cc654a9b237751ec92b89fefb3195e6e..a8a11f113d0efa2b5733855558cb42b7a075664e 100644 --- a/clim/stream-class-defs.lisp +++ b/clim/stream-class-defs.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: stream-class-defs.lisp,v 1.9 92/08/18 17:25:36 cer Exp $ +;; $fiHeader: stream-class-defs.lisp,v 1.10 92/09/08 15:18:35 cer Exp Locker: cer $ (in-package :clim-internals) @@ -64,7 +64,11 @@ (text-output-record :initform nil :accessor stream-text-output-record) (highlighted-presentation :initform nil - :accessor stream-highlighted-presentation)) + :accessor stream-highlighted-presentation) + #+Allegro + ;; Support for allegro presentations + (excl-presentation-stack :initform nil + :accessor stream-excl-presentation-stack)) (:default-initargs :draw-p t :record-p t ;!!! :output-record (make-instance 'standard-tree-output-history))) diff --git a/clim/table-formatting.lisp b/clim/table-formatting.lisp index 6593f196e899004640da0b432810474bd048a041..874ae460ae18e3921fe71dd5bb4283f5d86f059b 100644 --- a/clim/table-formatting.lisp +++ b/clim/table-formatting.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: table-formatting.lisp,v 1.10 92/08/19 18:05:04 cer Exp Locker: cer $ +;; $fiHeader: table-formatting.lisp,v 1.11 92/09/22 19:37:25 cer Exp Locker: cer $ (in-package :clim-internals) @@ -254,6 +254,7 @@ (incf nrows) (setq cells 0) (map-over-row-cells #'count-cells row) + (when (zerop cells) (error "Row or column in table does not contain any cells")) (cond ((null ncells) (setq ncells cells)) (t @@ -620,6 +621,7 @@ (incf ncells)))) (declare (dynamic-extent #'count-cells)) (map-over-menu-cells menu #'count-cells)) + ;;--- Perhaps we should check that ncells is non zero ;;--- PREFERRED-GEOMETRY isn't used yet ;; What's the preferred orientation of the menu? (unless (or nrows ncolumns) diff --git a/demo/bitmap-editor.lisp b/demo/bitmap-editor.lisp index 7d77d2e0be27ba74ab7d2355e7db511e4fdd94a0..120e45c9bc40f60dbb63becdb1ed0fa0498c928c 100644 --- a/demo/bitmap-editor.lisp +++ b/demo/bitmap-editor.lisp @@ -21,7 +21,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: bitmap-editor.lisp,v 1.2 92/09/22 19:37:43 cer Exp Locker: cer $ +;; $fiHeader: bitmap-editor.lisp,v 1.3 92/09/24 09:40:04 cer Exp Locker: cer $ (in-package :clim-demo) @@ -207,7 +207,7 @@ (erase-output-record presentation stream) (display-cell frame stream i j) (display-pattern frame))))) -<<<<<<< bitmap-editor.lisp + (define-presentation-to-command-translator toggle-cell (bitmap-editor-cell com-toggle-cell bitmap-editor @@ -235,30 +235,3 @@ (run-frame-top-level frame))) (define-demo "Bitmap Editor" do-bitmap-editor) -======= - - -(defvar *bitmap-editors* nil) - -(defun do-bitmap-editor (&key (port (find-port)) (force nil)) - (let* ((framem (find-frame-manager :port port)) - (frame - (let* ((entry (assoc port *bitmap-editors*)) - (frame (cdr entry))) - (when (or force (null frame)) - (setq frame (make-application-frame 'bitmap-editor - :frame-manager framem))) - (if entry - (setf (cdr entry) frame) - (push (cons port frame) *bitmap-editors*)) - frame))) - (run-frame-top-level frame))) - -(define-demo "Bitmap Editor" do-bitmap-editor) - - - - - - ->>>>>>> 1.2 diff --git a/demo/browser.lisp b/demo/browser.lisp index c6acfe7eb1a71e9ecff1622ed017f9a6dcd02dde..afe80f4c11dfa5d04b24094fbe8d90a79d6900b2 100644 --- a/demo/browser.lisp +++ b/demo/browser.lisp @@ -3,7 +3,7 @@ ;;; Simple extensible browser ;;; Scott McKay -;; $fiHeader: browser.lisp,v 1.9 92/07/27 11:03:29 cer Exp $ +;; $fiHeader: browser.lisp,v 1.10 92/08/18 17:26:13 cer Exp Locker: cer $ (in-package :clim-browser) @@ -715,45 +715,46 @@ ;;; The browser itself (define-application-frame browser () - ((graph-type :initform :graphical) - (browser-type :initform nil) - (browser-subtype :initform nil) - (browser-ptype :initform nil) - (browser-options :initform nil) - (node-maker :initform #'false) - (root-node-maker :initform #'false) - (grapher-args :initform nil) - (tree-depth :initform 1) - (merge-duplicate-nodes :initform t) - (root-nodes :initform nil) - (all-nodes :initform nil) - (auto-snapshot :initform t) - (snapshots :initform nil)) + ((graph-type :initform :graphical) + (browser-type :initform nil) + (browser-subtype :initform nil) + (browser-ptype :initform nil) + (browser-options :initform nil) + (node-maker :initform #'false) + (root-node-maker :initform #'false) + (grapher-args :initform nil) + (tree-depth :initform 1) + (merge-duplicate-nodes :initform t) + (root-nodes :initform nil) + (all-nodes :initform nil) + (auto-snapshot :initform t) + (snapshots :initform nil)) (:command-definer t) (:command-table (browser :inherit-from (accept-values-pane))) (:panes - #+++ignore - (title :application - :display-after-commands t - :display-function 'display-title-pane - :default-text-style '(:sans-serif :bold :large)) - (graph :application - :display-function 'display-graph-pane - :display-after-commands t - :incremental-redisplay t - :scroll-bars :both) - (interactor :interactor :height '(5 :line)) - (control-panel :application - :height :compute - :display-function - '(accept-values-pane-displayer - :displayer accept-call-graph-options))) + #+++ignore + (title :application + :display-after-commands t + :display-function 'display-title-pane + :default-text-style '(:sans-serif :bold :large)) + (graph :application + :display-function 'display-graph-pane + :display-after-commands t + :incremental-redisplay t + :scroll-bars :both) + (interactor :interactor :height '(5 :line)) + (control-panel :accept-values + :height :compute + :display-function + '(accept-values-pane-displayer + :displayer accept-call-graph-options))) (:layouts - (default - (vertically () - (3/4 graph) - (horizontally () - interactor control-panel))))) + (default + (vertically () + (3/4 graph) + (:fill + (horizontally () + interactor control-panel)))))) @@ -1006,7 +1007,8 @@ (fresh-line stream) (accept type :stream stream :default default - :query-identifier query-id :prompt prompt))) + :query-identifier query-id + :prompt prompt))) (declare (dynamic-extent #'accept)) (multiple-value-bind (new-type ignore type-changed) (accept `(member ,@*browser-types*) (or browser-type (first *browser-types*)) @@ -1091,7 +1093,6 @@ (window-clear (get-frame-pane *application-frame* 'graph)))) (define-browser-command (com-redisplay :menu t) () - (window-clear (get-frame-pane *application-frame* 'graph)) (redisplay-frame-pane *application-frame* 'graph :force-p t)) (define-browser-command (com-hardcopy-graph :name t :menu "Hardcopy") diff --git a/demo/cload-demos.lisp b/demo/cload-demos.lisp index d0c1c1d3493f1d03622e10c5b6731d7c134be4a4..7957d5a66266b398bf9a74485798d8e9af818c19 100644 --- a/demo/cload-demos.lisp +++ b/demo/cload-demos.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: cload-demos.cl,v 1.1 91/07/25 19:03:22 cer Exp $ +;; $fiHeader: cload-demos.lisp,v 1.1 92/06/02 08:26:29 cer Exp Locker: cer $ (defvar *demo-files* '("packages" @@ -32,7 +32,13 @@ "listener" "navfun" "navdata" - "puzzle")) + "puzzle" + "plot" + "color-editor" + "graphics-editor" + "bitmap-editor" + "ico" + "process-browser")) (defun compile-and-load-demos (&key forcep (directory diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp index 0c2bf15cef207b4a8c9febd9725c1f84068097d0..3def5fa652c63fb988baff086ee0a70fe1a7d2cc 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.12 92/07/20 16:01:17 cer Exp $ +;; $fiHeader: demo-driver.lisp,v 1.13 92/08/19 10:24:12 cer Exp Locker: cer $ (in-package :clim-demo) @@ -30,13 +30,19 @@ (defun start-demo (&key (port (find-port))) (let ((*application-frame* (make-application-frame 'standard-application-frame - :frame-manager (find-frame-manager :port port)))) + :frame-manager + (typecase port + (frame-manager port) + (t + (find-frame-manager :port port)))))) (labels ((demo-menu-drawer (stream type &rest args) (declare (dynamic-extent args)) (with-text-style (stream '(:serif :roman :large)) (apply #'draw-standard-menu stream type args))) (demo-menu-choose (list) - (with-menu (menu (find-graft :port port)) + (with-menu (menu (typecase port + (frame-manager (graft port)) + (t (find-graft :port port)))) (setf (window-label menu) '("Clim Demonstrations" :text-style (:fix :bold :normal))) (menu-choose-from-drawer diff --git a/demo/navfun.lisp b/demo/navfun.lisp index 082850002d96eb7496a591c34135595d5a5c5498..7af6dcbe5d9031c9692e8e31575d4b035bfe97c2 100644 --- a/demo/navfun.lisp +++ b/demo/navfun.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*- -;; $fiHeader: navfun.lisp,v 1.14 92/07/20 16:01:28 cer Exp $ +;; $fiHeader: navfun.lisp,v 1.15 92/09/24 09:40:10 cer Exp Locker: cer $ (in-package :clim-demo) @@ -1022,13 +1022,13 @@ ;;; Flight-Planner user interface (define-application-frame flight-planner () - () + () (:panes - (display :application) - (interactor :interactor :height '(5 :line))) + (display :application) + (interactor :interactor :height '(5 :line))) (:layouts - (default - (vertically () (3/4 display) interactor)))) + (default + (vertically () (3/4 display) (:fill interactor))))) (define-flight-planner-command (com-zoom-in :name t :menu t) () (multiple-value-bind (longitude latitude) diff --git a/demo/plot.lisp b/demo/plot.lisp index b489da88fe7b94c85b7aa9680dfeb48cb0681b18..3cda439b4493cb9f573f40e3e82c3977a95ebaad 100644 --- a/demo/plot.lisp +++ b/demo/plot.lisp @@ -21,7 +21,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: plot.lisp,v 1.8 92/09/22 19:37:49 cer Exp Locker: cer $ +;; $fiHeader: plot.lisp,v 1.9 92/09/24 09:40:12 cer Exp Locker: cer $ (in-package :clim-demo) @@ -703,8 +703,19 @@ (describe region)) (define-plot-demo-command (com-redisplay :name t) () - (window-clear (get-frame-pane *application-frame* 'graph-window)) - (window-clear (get-frame-pane *application-frame* 'data-window))) + (redisplay-frame-pane *application-frame* + (get-frame-pane *application-frame* 'graph-window) + :force-p t) + (redisplay-frame-pane *application-frame* + (get-frame-pane *application-frame* + 'data-window) + :force-p t)) + +(define-plot-demo-command (com-change-background :name t) () + (with-sheet-medium (medium (get-frame-pane *application-frame* 'graph-window)) + (setf (medium-background medium) + (nth (random 3) (list +pink+ +khaki+ +blue-violet+))))) + (define-plot-demo-command (com-add-new-column :name t) () (with-slots (plot-data y-labels) *application-frame* diff --git a/demo/process-browser.lisp b/demo/process-browser.lisp index 8f4475fedf7f568a6cb4c1611a25b2d56514cf73..affee16bec3bf2f260f4c89775115ec48e3fecd9 100644 --- a/demo/process-browser.lisp +++ b/demo/process-browser.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader$ +;; $fiHeader: process-browser.lisp,v 1.1 92/09/08 10:39:08 cer Exp Locker: cer $ (in-package :clim-demo) @@ -49,8 +49,9 @@ (with-accessors ((timer process-browser-timer) (delay process-browser-delay)) frame (when timer (clim-utils::delete-timer timer)) - (setq timer (clim-internals::make-command-timer frame 'com-update-process-browser nil - delay)))) + (setq timer (clim-internals::make-command-timer frame + '(com-update-process-browser) + :delay delay)))) (define-process-browser-command (com-change-delay-browser :menu t) () diff --git a/misc/dev-load-1.lisp b/misc/dev-load-1.lisp index 8bc560d9d768d64fc77b269789bc5acbb7f02a2a..192d015abcfbc9af395dd633ab96837ed310f1fd 100644 --- a/misc/dev-load-1.lisp +++ b/misc/dev-load-1.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: dev-load-1.lisp,v 1.12 92/09/08 15:19:10 cer Exp Locker: cer $ +;; $fiHeader: dev-load-1.lisp,v 1.13 92/09/22 19:37:59 cer Exp Locker: cer $ ;;;; This should not matter ;;;; (setq *ignore-package-name-case* t) @@ -51,11 +51,13 @@ (motif-clim (load "climg.fasl") (load "climxm.fasl") - (load "clim-debug.fasl")) + (load "clim-debug.fasl") + (load "clim-debugxm.fasl")) (openlook-clim (load "climg.fasl") (load "climol.fasl") - (load "clim-debug.fasl"))) + (load "clim-debug.fasl") + (load "clim-debugol.fasl"))) #+ignore (clim-defsys::load-system sys))) diff --git a/silica/event.lisp b/silica/event.lisp index 16adea12ae0835636741412d8836f816340726e7..c632c75a97c2bc0e2bf3a4fea958cec4119911d4 100644 --- a/silica/event.lisp +++ b/silica/event.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: event.lisp,v 1.22 92/09/22 19:36:45 cer Exp Locker: cer $ +;; $fiHeader: event.lisp,v 1.23 92/09/24 09:37:37 cer Exp Locker: cer $ (in-package :silica) @@ -471,7 +471,7 @@ (map-sheet-position-to-child child new-x new-y)) (setq sheet child) (vector-push-extend child v)))))))) ->>>>>>> 1.21 + ;;; Event distribution diff --git a/silica/framem.lisp b/silica/framem.lisp index 0b0c99d0d99f8a33746b1530adc91253f636e366..5befe6895eb50c33f35f20215cf3b029e5589896 100644 --- a/silica/framem.lisp +++ b/silica/framem.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: framem.lisp,v 1.15 92/09/22 19:36:47 cer Exp Locker: cer $ +;; $fiHeader: framem.lisp,v 1.16 92/09/24 09:37:39 cer Exp Locker: cer $ (in-package :silica) @@ -87,6 +87,10 @@ (declare (ignore frame)) pane) +(defmethod adopt-frame :before ((framem standard-frame-manager) frame) + (assert (null (frame-manager frame))) + (setf (frame-manager frame) framem)) + (defmethod adopt-frame ((framem standard-frame-manager) frame) (generate-panes framem frame) (when (frame-panes frame) @@ -109,13 +113,18 @@ (defmethod adopt-frame :after ((framem standard-frame-manager) frame) (setf (frame-manager-frames framem) - (nconc (frame-manager-frames framem) (list frame)))) + (nconc (frame-manager-frames framem) (list frame))) + (port-note-frame-adopted (port frame) frame)) (defmethod disown-frame ((framem standard-frame-manager) frame) + (case (frame-state frame) + (:enabled (disable-frame frame))) + (assert (eq (frame-manager frame) framem)) (let ((top (frame-top-level-sheet frame))) (when top (sheet-disown-child (sheet-parent top) top) (setf (frame-top-level-sheet frame) nil + (slot-value frame 'clim-internals::all-panes) nil (frame-state frame) :disowned)))) (defmethod disown-frame :after ((framem standard-frame-manager) frame) diff --git a/silica/layout.lisp b/silica/layout.lisp index 917aba01174e26ea64c81affb0233819c4110603..fb8cfbe7671f08352106fb6b3aff64a24a2968ed 100644 --- a/silica/layout.lisp +++ b/silica/layout.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: layout.lisp,v 1.25 92/09/08 15:16:44 cer Exp $ +;; $fiHeader: layout.lisp,v 1.26 92/09/24 09:37:43 cer Exp Locker: cer $ (in-package :silica) diff --git a/silica/pixmaps.lisp b/silica/pixmaps.lisp index 3ee9608cc4caa7a7318098d18d5ca622ab748087..df59aaa8d58edf1271fe58dce9d0a4400a0c32fa 100644 --- a/silica/pixmaps.lisp +++ b/silica/pixmaps.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: pixmaps.lisp,v 1.9 92/09/08 15:16:49 cer Exp $ +;; $fiHeader: pixmaps.lisp,v 1.10 92/09/24 09:37:48 cer Exp Locker: cer $ (in-package :silica) @@ -131,3 +131,7 @@ (defun deallocate-pixmap (pixmap) (port-deallocate-pixmap (port pixmap) pixmap)) +(defmethod handle-repaint ((pane pixmap-sheet) region) + (declare (ignore region)) + nil) + diff --git a/test/test-suite.lisp b/test/test-suite.lisp index de04b433ef6fdea5d5e9b8e845502a2add4ff8b9..e5f275b3360f32efd0a7d72ee1d24cde3d32f648 100644 --- a/test/test-suite.lisp +++ b/test/test-suite.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader: test-suite.lisp,v 1.35 92/09/22 19:37:36 cer Exp Locker: cer $ +;; $fiHeader: test-suite.lisp,v 1.36 92/09/24 09:39:41 cer Exp Locker: cer $ (in-package :clim-user) @@ -1674,7 +1674,7 @@ Luke Luck licks the lakes Luke's duck likes.")) (draw-\\-diagonal t) (line-thickness 1) (line-thickness-units :normal)) - (accepting-values (stream :own-window own-window) + (accepting-values (stream :own-window own-window :label "Graphics Dialog") (setq square-dimension (accept 'number :stream stream :prompt "Size of square" :default square-dimension)) diff --git a/tk-silica/ol-frames.lisp b/tk-silica/ol-frames.lisp index 1e34453a2e52372e165a774319a3644bc8910ecf..e8640bc7e19b9fa0d90c05a791691ffcffbc01ec 100644 --- a/tk-silica/ol-frames.lisp +++ b/tk-silica/ol-frames.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: ol-frames.lisp,v 1.11 92/08/21 16:34:27 cer Exp $ +;; $fiHeader: ol-frames.lisp,v 1.12 92/09/08 15:19:12 cer Exp Locker: cer $ (in-package :xm-silica) @@ -32,20 +32,16 @@ (defmethod make-frame-manager ((port openlook-port) &key) (make-instance 'openlook-frame-manager :port port)) +;;-- Port-note-frame-adopted -(defmethod adopt-frame :after ((framem openlook-frame-manager) - (frame standard-application-frame)) - (when (frame-panes frame) - (establish-wm-protocol-callbacks framem frame))) - -(defmethod establish-wm-protocol-callbacks ((framem openlook-frame-manager) frame) +(defmethod port-note-frame-adopted :after ((port openlook-port) (frame standard-application-frame)) (let ((shell (frame-shell frame))) (tk::add-ol-callback - shell - (ff::string-to-char* "wmProtocol") - :wm-protocol - 'ol-frame-wm-protocol-callback - frame))) + shell + (ff::string-to-char* "wmProtocol") + :wm-protocol + 'ol-frame-wm-protocol-callback + frame))) (defun ol-frame-wm-protocol-callback (shell value frame) (when (eq value :wm-delete-window) diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp index 896b8a03b3bfef8c66da4ce4a14990145c2f1431..4b45f8755f2e9e50091eb3a83032f68f78c2a102 100644 --- a/tk-silica/ol-gadgets.lisp +++ b/tk-silica/ol-gadgets.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: ol-gadgets.lisp,v 1.25 92/09/22 19:38:04 cer Exp Locker: cer $ +;; $fiHeader: ol-gadgets.lisp,v 1.26 92/09/24 09:40:20 cer Exp Locker: cer $ (in-package :xm-silica) @@ -1032,13 +1032,13 @@ (vsb-sr (and vsb (compose-space vsb))) (hsb (silica::scroller-pane-horizontal-scroll-bar fr)) (hsb-sr (and hsb (compose-space hsb)))) - (when vsb-sr (maxf height (+ spacing (space-requirement-min-height vsb-sr)))) + (when vsb-sr (maxf height (+ spacing (space-requirement-height vsb-sr)))) (when hsb-sr (incf height (+ spacing (space-requirement-height hsb-sr)))) (when vsb-sr (maxf min-height (+ spacing (space-requirement-min-height vsb-sr)))) (when hsb-sr (incf min-height (+ spacing (space-requirement-height hsb-sr)))) (maxf max-height height) - (when hsb-sr (maxf width (+ spacing (space-requirement-min-width hsb-sr)))) + (when hsb-sr (maxf width (+ spacing (space-requirement-width hsb-sr)))) (when vsb-sr (incf width (+ spacing (space-requirement-width vsb-sr)))) (when hsb-sr (maxf min-width (+ spacing (space-requirement-min-width hsb-sr)))) (when vsb-sr (incf min-width (+ spacing (space-requirement-width vsb-sr)))) @@ -1321,75 +1321,71 @@ ;;-- Perhaps we need a way of representing them in the clim world (call-next-method)) -(defmethod frame-manager-notify-user ((framem motif-frame-manager) +(defmethod frame-manager-notify-user ((framem openlook-frame-manager) message-string &key (style :inform) text-style (frame nil frame-p) (associated-window - (if frame-p - (frame-top-level-sheet frame) - (graft framem))) + (if frame-p + (frame-top-level-sheet frame) + (graft framem))) (title "Notify user") documentation (exit-boxes - '(:exit - :abort - :help)) + '(:exit + :abort + :help)) (name title)) - (let ((dialog (make-instance (ecase style - (:inform 'tk::xm-information-dialog) - (:error 'tk::xm-error-dialog) - (:question 'tk::xm-question-dialog) - (:warning 'tk::xm-warning-dialog)) - :dialog-style :primary-application-modal - :managed nil - :parent (if (typep associated-window 'xt::xt-root-class) - associated-window - (sheet-mirror associated-window)) - :name name - :dialog-title title - :message-string message-string - )) - (result nil)) - (multiple-value-bind - (ok-button cancel-button help-button) - (get-message-box-child dialog :ok :cancel :help) - (flet ((set-it (widget r) - (declare (ignore widget)) - (setq result (list r))) - (display-help (widget ignore) - (declare (ignore widget ignore)) - (frame-manager-notify-user - framem - documentation - :associated-window associated-window))) - (tk::add-callback dialog :ok-callback #'set-it t) - (tk::add-callback dialog :cancel-callback #'set-it nil) - - (flet ((set-button-state (name button) - (unless (dolist (x exit-boxes nil) - (cond ((eq x name) (return t)) - ((atom x)) - ((eq (car x) name) - (tk::set-values button :label-string (second x)) - (return t)))) - (tk::unmanage-child button)))) - (set-button-state :exit ok-button) - (set-button-state :abort cancel-button) - (set-button-state :help help-button) - - (if documentation - (tk::add-callback help-button :activate-callback #'display-help) - (xt::set-sensitive help-button nil))) - - (unwind-protect - (progn - (tk::manage-child dialog) - (wait-for-callback-invocation - (port framem) - #'(lambda () (or result (not (tk::is-managed-p dialog)))) - "Waiting for dialog")) - (tk::destroy-widget dialog)) - (car result))))) + + (let* ((shell (make-instance + 'tk::notice-shell + :parent (sheet-shell associated-window)))) + (multiple-value-bind (text-area control-area) + (tk::get-values shell :text-area :control-area) + (tk::set-values text-area :string message-string) + (let ((done nil)) + (flet ((done (widget value) + (declare (ignore widget)) + (setq done (list value)))) + (dolist (exit-box exit-boxes) + (multiple-value-bind (name label) + (if (consp exit-box) (values (first exit-box) + (second exit-box)) exit-box) + (let ((button (make-instance 'xt::oblong-button + :parent control-area + :label (or label (string name))))) + (case name + (:exit (tk::add-callback button :select #'done t)) + (:abort (tk::add-callback button :select #'done nil)))))) + (tk::popup shell) + (wait-for-callback-invocation (port framem) #'(lambda () done)) + (car done)))))) + +;;--- We could export this to handle the default case. +;;--- It definitely needs work though. + +(defmethod frame-manager-select-file + ((framem openlook-frame-manager) &rest options + &key (frame nil frame-p) + (associated-window + (if frame-p + (frame-top-level-sheet frame) + (graft framem))) + (title "Select File") + documentation + file-search-proc + directory-list-label + file-list-label + (exit-boxes '(:exit :abort :help)) + (name title)) + (let ((pathname nil) + (stream (frame-top-level-sheet frame))) + (accepting-values (stream :own-window t :label title :exit-boxes exit-boxes) + (setf pathname + (if pathname + (accept 'pathname :prompt "Pathname" :default pathname + :stream stream) + (accept 'pathname :prompt "Pathname" + :stream stream)))))) diff --git a/tk-silica/xm-frames.lisp b/tk-silica/xm-frames.lisp index ec07be020a85118c2a28a7c1bf2b8ef2a7d4e7a7..ee778ca4a2eda85bd2b7a4471b2b24f5467b7c91 100644 --- a/tk-silica/xm-frames.lisp +++ b/tk-silica/xm-frames.lisp @@ -18,7 +18,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xm-frames.lisp,v 1.30 92/09/22 19:38:08 cer Exp Locker: cer $ +;; $fiHeader: xm-frames.lisp,v 1.31 92/09/24 09:40:23 cer Exp Locker: cer $ (in-package :xm-silica) @@ -31,19 +31,27 @@ (defmethod make-frame-manager ((port motif-port) &key) (make-instance 'motif-frame-manager :port port)) -(defmethod adopt-frame :after ((framem motif-frame-manager) - (frame standard-application-frame)) +(defmethod port-note-frame-adopted :after ((port motif-port) (frame standard-application-frame)) (when (frame-panes frame) - (establish-wm-protocol-callbacks framem frame))) + (let ((shell (frame-shell frame))) + (tk::set-values shell :delete-response :do-nothing) + (tk::add-wm-protocol-callback + shell + :wm-delete-window + 'frame-wm-protocol-callback + frame)))) -(defmethod establish-wm-protocol-callbacks ((framem motif-frame-manager) frame) - (let ((shell (frame-shell frame))) - (tk::set-values shell :delete-response :do-nothing) - (tk::add-wm-protocol-callback - shell - :wm-delete-window - 'frame-wm-protocol-callback - frame))) +(defmethod note-frame-enabled :after ((framem motif-frame-manager) frame) + ;;-- Doing this gets around the problem with motif-menu bars coming + ;;-- up the wrong size. + ;;-- This is because the :resize-width/height are true + ;;-- ManagedSetChanged allows the widget to be resized. + ;;-- Conversely querygeoetry will return bogus results otherwise. + (flet ((fix-sheet (sheet) + (when (typep sheet 'motif-menu-bar) + (silica::update-mirror-region (port sheet) sheet)))) + (declare (dynamic-extent #'fix-sheet)) + (map-over-sheets #'fix-sheet (frame-top-level-sheet frame)))) ;;; Definitions of the individual classes @@ -61,6 +69,7 @@ ;;---- This seems important but why ;;---- At a guess I would say its because the query-geometry gets ;;---- all stupid if these resources are NIL + ;;---- These are actually the default values (list :resize-height t :resize-width t)))) @@ -226,6 +235,8 @@ :associated-window widget)) +;;--- Perhaps port-update-frame-settings ? + (defmethod update-frame-settings ((framem motif-frame-manager) (frame t)) ;;--- Lets see how this works out (let ((shell (sheet-shell (frame-top-level-sheet frame)))) diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp index 494edc07d3d543aad779b8012492dd8a992a11d9..7d0690628c0fd14e9e4025c41eb812f70111dbb7 100644 --- a/tk-silica/xm-gadgets.lisp +++ b/tk-silica/xm-gadgets.lisp @@ -18,7 +18,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xm-gadgets.lisp,v 1.47 92/09/22 19:38:12 cer Exp Locker: cer $ +;; $fiHeader: xm-gadgets.lisp,v 1.48 92/09/24 09:40:24 cer Exp Locker: cer $ (in-package :xm-silica) @@ -418,7 +418,7 @@ ()) (defmethod add-sheet-callbacks :after ((port motif-port) - (sheet motif-top-level-sheet) + (sheet top-level-sheet) (widget tk::xm-my-drawing-area)) (tk::add-callback widget :resize-callback 'sheet-mirror-resized-callback @@ -426,7 +426,7 @@ (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port) (parent t) - (sheet motif-top-level-sheet)) + (sheet top-level-sheet)) (cond ;;--- hack alert ;; Seems that we need to use a bulletin board so that everything @@ -446,7 +446,8 @@ :name (string (frame-name (pane-frame sheet))) :margin-width 0 :margin-height 0))))) -;;; +;;;;;;;;;;;;;;;; + (defmethod add-sheet-callbacks :after ((port motif-port) (sheet t) (widget tk::xm-bulletin-board)) @@ -688,6 +689,7 @@ (values 'tk::xm-row-column nil)) + ;; Frame-viewport that we need because a sheet can have (defclass xm-frame-viewport-mixin (sheet-single-child-mixin diff --git a/tk-silica/xt-gadgets.lisp b/tk-silica/xt-gadgets.lisp index ccb246a860b4c90eba7c577da2dc024a52979997..0c7ca4a30c7197898ae27b5fa927e277ca4e4e39 100644 --- a/tk-silica/xt-gadgets.lisp +++ b/tk-silica/xt-gadgets.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-gadgets.lisp,v 1.20 92/09/22 19:38:16 cer Exp Locker: cer $ +;; $fiHeader: xt-gadgets.lisp,v 1.21 92/09/24 09:40:27 cer Exp Locker: cer $ (in-package :xm-silica) @@ -134,7 +134,9 @@ ()) (defclass xt-top-level-sheet (top-level-sheet) - ((accelerator-gestures :initform nil))) + ((accelerator-gestures :initform nil :reader top-level-sheet-accelerator-gestures))) + +(defmethod top-level-sheet-accelerator-gestures ((sheet top-level-sheet)) nil) (defmethod sheet-disown-child :after ((sheet xt-top-level-sheet) (child basic-sheet)) (setf (slot-value sheet 'accelerator-gestures) nil)) @@ -186,4 +188,6 @@ (and frame (some #'(lambda (gesture) (clim-internals::keyboard-event-matches-gesture-name-p event gesture port)) - (slot-value (frame-top-level-sheet frame) 'accelerator-gestures))))) + (top-level-sheet-accelerator-gestures (frame-top-level-sheet frame)))))) + + diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp index 5629200c7442c03ea4ef73ac0317405c222cce13..fd800279d926729cde0d1ccb81e0dec98850e903 100644 --- a/tk-silica/xt-graphics.lisp +++ b/tk-silica/xt-graphics.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-graphics.lisp,v 1.39 92/09/22 19:38:17 cer Exp Locker: cer $ +;; $fiHeader: xt-graphics.lisp,v 1.40 92/09/24 09:40:30 cer Exp Locker: cer $ (in-package :tk-silica) @@ -201,14 +201,12 @@ (defmethod (setf medium-background) :after (ink (medium xt-medium)) (declare (ignore ink)) (recompute-gcs medium) - ;;--- Some things are missing REPAINT-SHEET methods... - #+ignore (repaint-sheet (medium-sheet medium) medium +everywhere+)) + ;;--- This should be a in silica method + (repaint-sheet (medium-sheet medium) medium +everywhere+)) (defmethod (setf medium-foreground) :after (ink (medium xt-medium)) (declare (ignore ink)) - (recompute-gcs medium) - ;;--- Some things are missing REPAINT-SHEET methods... - #+ignore (repaint-sheet (medium-sheet medium) medium +everywhere+)) + (recompute-gcs medium)) (defmethod (setf medium-ink) :after (ink (medium xt-medium)) (declare (ignore ink)) diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp index fd8781b6e9a1a28b62be9af6e92b63f96ac9090c..551d31ba780fc1c73721499aa706408c6740fb5f 100644 --- a/tk-silica/xt-silica.lisp +++ b/tk-silica/xt-silica.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: xt-silica.lisp,v 1.45 92/09/22 19:38:19 cer Exp Locker: cer $ +;; $fiHeader: xt-silica.lisp,v 1.46 92/09/24 09:40:32 cer Exp Locker: cer $ (in-package :xm-silica) @@ -597,14 +597,7 @@ ;;-- This may be misguided, but it'll almost certainly help us ;;-- in the short run. ;;-- This code copied from clx-mirror. - ;;-- This seems to break stuff. - ;;-- It fails because newline is a standard-character - ;;-- and so the event is #\newline which - ;;-- port-canonicalize-gesture does not know what to - ;;-- do with. It returns NIL. In comparision #\return - ;;-- is nonstandard so no one gets confused. - (char (cond #+this-does-not-work - ((and (eq keysym ':return) + (char (cond ((and (eq keysym ':return) (or (zerop modifier-state) (= modifier-state (make-modifier-state :shift)))) @@ -694,7 +687,9 @@ (multiple-value-bind (class initargs) (find-shell-class-and-initargs port sheet) (let ((frame (pane-frame sheet))) - (when frame (setf (getf initargs :name) (string (frame-name frame))))) + (when frame + (setf (getf initargs :name) (string (frame-name frame)) + (getf initargs :title) (frame-pretty-name frame)))) (apply #'make-instance class :parent (find-shell-parent port sheet) initargs)) (sheet-mirror-for-parenting ma)))) diff --git a/tk/event.lisp b/tk/event.lisp index 469c5b0a5de7290feaa06294760ffb64b12bf5fd..453ad6b05f15122a431c9fe20039a815758d4838 100644 --- a/tk/event.lisp +++ b/tk/event.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: event.lisp,v 1.12 92/09/08 15:16:21 cer Exp Locker: cer $ +;; $fiHeader: event.lisp,v 1.13 92/09/22 19:36:31 cer Exp Locker: cer $ (in-package :tk) diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp index babd2c12ab9d18606e21ade54c869b0a6b2219af..bcb504e1d22bd615b6296fbf2f168a9fe501e7dd 100644 --- a/tk/make-classes.lisp +++ b/tk/make-classes.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: make-classes.lisp,v 1.24 92/08/18 17:23:20 cer Exp Locker: cer $ +;; $fiHeader: make-classes.lisp,v 1.25 92/08/18 17:53:38 cer Exp Locker: cer $ (in-package :tk) @@ -192,6 +192,9 @@ (format excl:*initial-terminal-io* ";; Initializing class ~s~%" class-ep) (let ((h (get-foreign-variable-value class-ep))) (push (list h class-ep) clist) + ;;--- Perhaps we can just do this when we want to grab the resources. + ;;--- In this way we would only have to do one the display is + ;;--- opened and the toolkit initialized etc etc. (xt_initialize_widget_class h))) (setq clist (nreverse clist)) diff --git a/utils/packages.lisp b/utils/packages.lisp index 809462e380e5dcab014f39b3c80bf2ff7804ca65..9d474ad0af77b85fc112637cb418ce12a7dbca0a 100644 --- a/utils/packages.lisp +++ b/utils/packages.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader: packages.lisp,v 1.28 92/09/22 19:36:53 cer Exp Locker: cer $ +;; $fiHeader: packages.lisp,v 1.29 92/09/24 09:38:03 cer Exp Locker: cer $ (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) @@ -3523,6 +3523,7 @@ port-invoke-with-pointer-grabbed port-mirror->sheet-table port-note-cursor-change + port-note-frame-adopted port-note-gadget-activated port-note-gadget-deactivated port-process