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

see changelog for Thu Oct 28 00:10:46 PDT 1993

parent dc58901f
No related branches found
No related tags found
No related merge requests found
from colin: Thu Oct 28 00:10:46 PDT 1993
clim/coordinate-sorted-set.lisp
- fixed bug which caused image to dump core
demo/demo-driver.lisp
- minor bug fix in handling of :background
-------------------------------------------------------------------------------
from colin: Mon Oct 25 20:19:08 PDT 1993 from colin: Mon Oct 25 20:19:08 PDT 1993
Makefile.defs Makefile.defs
......
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
;; $fiHeader: coordinate-sorted-set.lisp,v 1.8 1993/07/27 01:38:37 colin Exp $ ;; $fiHeader: coordinate-sorted-set.lisp,v 1.9 1993/10/26 03:21:33 colin Exp $
(in-package :clim-internals) (in-package :clim-internals)
...@@ -82,7 +82,7 @@ ...@@ -82,7 +82,7 @@
;; again the hard way. If these things were more ;; again the hard way. If these things were more
;; disciplined with respect to managing overlapping ;; disciplined with respect to managing overlapping
;; records, we wouldn't have to resort to this. ;; records, we wouldn't have to resort to this.
(position child vector)))) (position child vector :end fp))))
(declare (type fixnum old-index)) (declare (type fixnum old-index))
(when old-index (when old-index
(let ((new-index (coordinate-sorted-set-index-for-position (let ((new-index (coordinate-sorted-set-index-for-position
...@@ -95,7 +95,8 @@ ...@@ -95,7 +95,8 @@
;; operation. The removal operation would cause all ;; operation. The removal operation would cause all
;; indices to the right to be offset by one - so ;; indices to the right to be offset by one - so
;; when new-index is greater than old-index we must ;; when new-index is greater than old-index we must
;; decrement it in order to get the right place (cim) ;; decrement it in order to get the right place
;; (cim)
(when (> new-index old-index) (when (> new-index old-index)
(decf new-index)) (decf new-index))
(let ((d (signum (- new-index old-index)))) (let ((d (signum (- new-index old-index))))
...@@ -153,7 +154,7 @@ ...@@ -153,7 +154,7 @@
;; again the hard way. If these things were more ;; again the hard way. If these things were more
;; disciplined with respect to managing overlapping ;; disciplined with respect to managing overlapping
;; records, we wouldn't have to resort to this. ;; records, we wouldn't have to resort to this.
(position child coordinate-sorted-set)))) (position child coordinate-sorted-set :end fill-pointer))))
(cond (index (cond (index
(let ((new-fp (the fixnum (1- fill-pointer))) (let ((new-fp (the fixnum (1- fill-pointer)))
(vector coordinate-sorted-set)) (vector coordinate-sorted-set))
......
;;; -*- 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.28 1993/10/25 16:15:54 cer Exp $ ;; $fiHeader: demo-driver.lisp,v 1.29 1993/10/26 03:21:55 colin Exp $
(in-package :clim-demo) (in-package :clim-demo)
...@@ -50,15 +50,15 @@ ...@@ -50,15 +50,15 @@
(define-demo-driver-command (com-run-demo) (define-demo-driver-command (com-run-demo)
((demo 'demo :gesture :select)) ((demo 'demo :gesture :select))
(run-demo demo :port (port *application-frame*))) (run-demo demo :port (port *application-frame*) :background t))
(define-gesture-name :shift-select :pointer-button (:left :shift)) (define-gesture-name :shift-select :pointer-button (:left :shift))
(define-demo-driver-command (com-force-demo) (define-demo-driver-command (com-force-demo)
((demo 'demo :gesture :shift-select)) ((demo 'demo :gesture :shift-select))
(run-demo demo :port (port *application-frame*) :force t)) (run-demo demo :port (port *application-frame*) :force t :background t))
(defun run-demo (demo &key (port (find-port)) force (background t)) (defun run-demo (demo &key (port (find-port)) force background)
(flet ((do-it () (flet ((do-it ()
(let* ((entry (assoc port (demo-frames demo))) (let* ((entry (assoc port (demo-frames demo)))
(frame (cdr entry)) (frame (cdr entry))
...@@ -88,6 +88,6 @@ ...@@ -88,6 +88,6 @@
(let ((demo (make-instance 'demo (let ((demo (make-instance 'demo
:name "Demo Driver" :class 'demo-driver :name "Demo Driver" :class 'demo-driver
:initargs '(:left 0 :top 0)))) :initargs '(:left 0 :top 0))))
(defun start-demo (&rest args) (defun start-demo (&key (port (find-port)) (background t) force)
(apply #'run-demo demo args))) (run-demo demo :port port :background background :force force)))
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