diff --git a/clim/frames.lisp b/clim/frames.lisp index 6d58e6aab2ec3458c502d78eed60c709daa5a8a4..633e732914b0a02058ac9711b520608709c065d4 100644 --- a/clim/frames.lisp +++ b/clim/frames.lisp @@ -1278,7 +1278,9 @@ (re-enable-menu-items ,frame))) (defmethod execute-frame-command ((frame standard-application-frame) command) - (when (listp command) ;NOTE workaround for command == :timeout + ;; NOTE WORKAROUND added a when clause because demo sometimes passes :timeout + ;; as `command', which is obviously not a list. -- jacek.zlydach, 2017-05-14 + (when (listp command) (apply (command-name command) (command-arguments command))) #+ignore ;; from jeff on 4/8/99 (with-menu-disabled frame @@ -1495,6 +1497,9 @@ (frame-top-level-sheet frame))) (defmethod frame-standard-output ((frame standard-application-frame)) + ;; NOTE WORKAROUND returning `*standard-output*' instead of executing the following block, + ;; because the value found by it (during initialization of the demo) causes a "app pane not a stream" + ;; error. *standard-output* ;; commented out because it causes frame-not-a-stream error #+nil(if (not (member '*standard-output* (slot-value frame diff --git a/clim/window-stream.lisp b/clim/window-stream.lisp index f4b47035f3ba9ce593508f83876e5dc5e73400da..0adeef1c2a506ed3be318a372d139139247295ac 100644 --- a/clim/window-stream.lisp +++ b/clim/window-stream.lisp @@ -32,6 +32,8 @@ nil) +;;; NOTE disabled for sbcl and ccl because :silica seems not to be in features anyway, +;;; and this print-object is presently broken. -- jacek.zlydach 2017-05-14 #- (or silica sbcl ccl) ;--- no such slots in Silica (defmethod print-object ((window window-stream) stream) (print-unreadable-object (window stream :type t :identity t) @@ -41,6 +43,8 @@ (bottom (safe-slot-value window 'bottom))) (format stream "/x ~D:~D y ~D:~D/" left right top bottom)))) +;;; NOTE FIXME this needs a proper implementation. +;;; -- jacek.zlydach 2017-05-14 #+ (or silica sbcl ccl) (defmethod print-object ((window window-stream) stream) (print-unreadable-object (window stream :type t :identity t) diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp index 3d6c007ca3119770a121b67b712ef81b6ce1865a..5ac68b3b903a8d61b4f92411bb418586f344cf0b 100644 --- a/demo/demo-driver.lisp +++ b/demo/demo-driver.lisp @@ -48,7 +48,11 @@ ;; which occurs while printing the demos name. ;; In particular, this can occur when listing ;; the Japanese graphics-editor when the correct - ;; Japanese fonts are not accessible. + ;; Japanese fonts are not accessible. + + ;; NOTE WORKAROUND added #'error clause for non-Allegro Lisps, because + ;; that seems to be the closest equivalent as far as I can tell without access + ;; to Allegro environment. -- jacek.zlydach, 2017-05-14 (let ((result (catch #-allegro 'error #+Allegro 'excl::printer-error (with-output-as-presentation (stream demo 'demo) (format stream "~A~%" name)) @@ -103,11 +107,6 @@ (let ((bt:*default-special-bindings* `((*package* . ',*package*)))) (bt:make-thread #'do-it :name (demo-name demo))) (do-it)))) - -;; (mp:process-run-function -;; `(:name ,(demo-name demo) -;; :initial-bindings ((*package* . ',*package*))) -;; #'do-it) (defvar *demo-frame* nil) diff --git a/demo/listener.lisp b/demo/listener.lisp index 161b070878014304b241f4f339abc3e4055df594..971543ee77cc61f6330db375f7d4e753519cd515 100644 --- a/demo/listener.lisp +++ b/demo/listener.lisp @@ -653,6 +653,7 @@ (define-demo "Lisp Listener" lisp-listener :width 600 :height 500) +;;; NOTE WORKAROUND deleted the \210 literal character, because it broke the SBCL reader for me. -- jacek.zlydach, 2017-05-14 #+Genera (define-genera-application lisp-listener :pretty-name "CLIM Lisp Listener" diff --git a/silica/db-box.lisp b/silica/db-box.lisp index 38ed260d8fc8500c6e372550ba431f76a6539c1c..ae10bc1869339673c4c414339503195514ff2a82 100644 --- a/silica/db-box.lisp +++ b/silica/db-box.lisp @@ -21,16 +21,19 @@ (defmethod initialize-instance :after ((pane box-pane) &key contents &allow-other-keys) (dolist (child contents) - (typecase child ;FIXME temporarily changed etypecase to typecase -- jacek.zlydach, 2017-05-14 + ;;NOTE WORKAROUND temporarily changed etypecase to typecase, to avoid a runtime error in demo. + ;; Should be restored to etypecase after the source of that error is found. + ;; -- jacek.zlydach, 2017-05-14 + (typecase child (number) ((member :fill)) (pane (sheet-adopt-child pane child)) (cons - ;; Handle top-down layout syntax - (unless (and (typep (first child) '(or (member :fill) (real 0 *))) - (panep (second child))) - (error "Invalid box child: ~S" child)) - (sheet-adopt-child pane (second child))))) + ;; Handle top-down layout syntax + (unless (and (typep (first child) '(or (member :fill) (real 0 *))) + (panep (second child))) + (error "Invalid box child: ~S" child)) + (sheet-adopt-child pane (second child))))) (setf (slot-value pane 'contents) contents)) (defmethod handle-event :after ((pane box-pane) (event pointer-motion-event)) @@ -59,7 +62,10 @@ (minor-max most-positive-fixnum) scale) (dolist (entry contents) - (when entry ;<-- added as a null prevention + ;; NOTE WORKAROUND wrapped the whole cond in a when block, to avoid error caused + ;; by `entry' being NIL for some reason during initialization of the demo. + ;; -- jacek.zlydach, 2017-05-14 + (when entry (cond ((eq entry :fill) (incf major+ +fill+)) ((numberp entry) (incf major entry)) (t @@ -176,10 +182,12 @@ (let ((space-requirement (compose-space box-pane :width width :height height))) (flet ((compose (x) - (cond ((null x) :fill) ;NOTE added as a safeguard for NIL - ((atom x) (compose-space x :width width)) - ((eq (car x) :fill) :fill) - (t (car x))))) + (cond + ;;NOTE WORKAROUND added null clause as a safeguard for NIL showing up during initialization of the demo -- jacek.zlydach, 2017-05-14 + ((null x) :fill) + ((atom x) (compose-space x :width width)) + ((eq (car x) :fill) :fill) + (t (car x))))) (declare (dynamic-extent #'compose)) (let* ((adjust (* spacing (1- (length (sheet-children box-pane))))) (sizes diff --git a/silica/scroll-pane.lisp b/silica/scroll-pane.lisp index 3516fb240c0af5c060fe43820e524146d09a42a1..84e3bfebb1893546a21bd322dc0222e0332fe1b9 100644 --- a/silica/scroll-pane.lisp +++ b/silica/scroll-pane.lisp @@ -239,6 +239,17 @@ (:horizontal (- right left)) (:vertical (- bottom top)))))) +;;; NOTE WORKAROUND +;;; The following methods requires 4 parameters. Added `workaround' parameter for that, +;;; but the methods should be further reviewed for correctness. +;;; - scroll-up-line-callback +;;; - scroll-down-line-callback +;;; - scroll-up-page-callback +;;; - scroll-down-page-callback +;;; - scroll-to-top-callback +;;; - scroll-to-bottom-callback +;;; +;;; -- jacek.zlydach 2017-05-14 (defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) (with-slots (current-size current-value port) scroll-bar (with-slots (viewport contents) scroller-pane