With MCLGUI, pattern objects are initialized at run-time (by mclgui:i…

…nitialize), so *object-connection-draw-mode* and *normal-connection-draw-mode* have to be initialized lazily.

loader.lisp

@@ -152,6 +152,7 @@
                                    :debug-focused-view
                                    :debug-streams
                                    :debug-text
+                                   :debug-trace
                                    patchwork.builder::no-cocoa
                                    patchwork.builder::use-apple-events
                                    patchwork.builder::cocoa-midi-player
@@ -170,6 +171,7 @@
 ;; (pushnew :debug-focused-view   *features*)
 ;; (pushnew :debug-event          *features*)/Users/pjb/Desktop/patchwork-10.1-0.836-ccl-1.11_r16635_darwinx8664-darwin-apple-10.12.4-x86-64/Patchwork.app/Contents/MacOS/Patchwork
 ;; (pushnew :debug-text           *features*)
+   (pushnew :debug-trace          *features*)
 ;; (pushnew 'patchwork.builder::no-cocoa          *features*)
 ;; (pushnew 'patchwork.builder::use-apple-events  *features*)
 ;; (pushnew 'patchwork.builder::cocoa-midi-player *features*)
@@ -265,10 +267,12 @@ DO:         Prints each expression and their values.
     (handler-case
         (progn
           #+swank (setf *trace-output* *slime-output*)
-          (ui:format-trace 'start-patchwork 'pw::initialize-patchwork)
           (unless (typep ui:*application* 'pw::patchwork-application)
+            (ui:format-trace 'start-patchwork "change-class application")
             (change-class ui:*application* 'pw::patchwork-application))
+          (ui:format-trace 'start-patchwork 'ui:initialize)
           (ui:initialize)
+          (ui:format-trace 'start-patchwork 'pw::initialize-patchwork)
           (pw::initialize-patchwork ui:*application*))
       (error (err)
         (format *error-output* "~A~%" err)))))

notes.txt

@@ -1,6 +1,6 @@
 # -*- mode:org; coding:utf-8 -*-
 * TODO [#A] Patchwork Project                                     :patchwork:
-** TODO [#A] debug Patchwork and produce a release                      :bug:
+** IN-PROGRESS [#A] debug Patchwork and produce a release               :bug:
    CLOCK: [2016-02-08 Mon 00:16]--[2016-02-08 Mon 00:56] =>  0:40
    :DEADLINE: <2016-03-01 -3m>
 
@@ -47,7 +47,9 @@ Use com.informatimago.manifest.lisp in Patchwork (generate-application).
 12. Quickdraw           : 119/179 fonctions implémentées [ 66%]
 13. Files               :  18/ 18 fonctions implémentées [100%]
 14. Divers              : 257/258 fonctions implémentées [ 99%]
-*** Bugs https://gitlab.com/groups/patchwork/issues
+*** Bugs / Patchwork Issues  https://framagit.org/patchwork/patchwork/issues
+**** TODO [#C] #12 Gather online documentation and hook it in.      :feature:
+"PW-HELP-DOC:**;NUMBOX.pw"
 **** IN-PROGRESS [#A] 00007 Text Edit                               :feature:
    :DEADLINE: <2016-03-01 -3m>
    - State "IN-PROGRESS" from "DONE"       [2014-10-07 Tue 09:25] \\
@@ -63,7 +65,6 @@ Les chiffres ne s’inscrivent dans les objets que par l’intermédiaire de la
 
 - offset of yellow text-edit box: cf. editable-text-dialog-item as subview of a view.
 
-*** Patchwork Issues https://gitlab.com/patchwork/patchwork/issues
 **** TODO [#A] 00014 doublons sur opt-clic                              :bug:
 pOn génère une entrée supplémentaire pour certains objets avec alt-clic
 
@@ -90,28 +91,28 @@ On doit verrouiller en cliquant sur un petit rond au centre de l’objet
 qui se transforme alors en croix, pour dévérouiller on clique sur
 cette croix qui redevient alors un petit rond.
 
-**** TODO [#A] 00024 growing while editing                                   :bug:
+**** TODO [#A] 00024 growing while editing                              :bug:
 - Open for editing a text field.
 - Try to grow the patch.
 Growing fails, the patch box size becomes slightly smaller.
 
-**** TODO [#A] 00010 Qque fois il y a eu impossibilité d’évaluation.         :bug:
+**** TODO [#A] 00010 Qque fois il y a eu impossibilité d’évaluation.    :bug:
 En fait je crois qu’il n’y a pas d’impossibilité d’évaluation, je
 crois plutôt que - pour une raison inconnue - la fenêtre du Listener
 en fonction devient inactive, en activant une nouvelle fenêtre de
 Listener l’évaluation est à nouveau possible…
 
-**** TODO [#A] 00004 Les patchs complexes sont lents à charger.          :feature:
+**** TODO [#A] 00004 Les patchs complexes sont lents à charger.      :feature:
 Le patch (d/s/R x 5) ci-joint dont j’ai le plus besoin actuellement ne s’ouvre pas non plus, c’est ma priorité.
 <d:s:R x 5>*
-**** TODO [#A] 00027 numbox click-and-drag w/ opt/cmd aphazadical.           :bug:
+**** TODO [#A] 00027 numbox click-and-drag w/ opt/cmd aphazadical.      :bug:
 Note: option-click and command-click have specific meanings.
-**** TODO [#A] 00031 the first menus must berenamed                         :port:
+**** TODO [#A] 00031 the first menus must berenamed                    :port:
 The application menu should be Patchwork instead of Clozure CL
 The next menu should be Apps instead of Patchwork.
-**** TODO [#A] 00032 multi-bpf breaks                                        :bug:
-**** TODO [#A] 00033 bpf-lib breaks                                          :bug:
-**** TODO [#A] 00035 pw-patch drag bar line off-by-1                         :bug:
+**** TODO [#A] 00032 multi-bpf breaks                                   :bug:
+**** TODO [#A] 00033 bpf-lib breaks                                     :bug:
+**** TODO [#A] 00035 pw-patch drag bar line off-by-1                    :bug:
 The line of the drag bar of pw-patch is drawn one pixel beyond the right border some times.
 *** Done
 **** DONE 00000 Classes that need to be implemented satisfactorily: editable-text-dialog-item

src/application.lisp

@@ -82,6 +82,8 @@
   (:method ((self patchwork-application)) (dpb (slot-value self '%flags) (byte 1 0) 1)))
 (defgeneric set-%initialized (application)
   (:method ((self patchwork-application)) (dpb (slot-value self '%flags) (byte 1 1) 1)))
+(defgeneric reset-%initialized (application)
+  (:method ((self patchwork-application)) (dpb (slot-value self '%flags) (byte 1 1) 0)))
 
 (defun shortest-package-nickname (package)
   "Return the shortest nickname of PACKAGE."
@@ -101,18 +103,18 @@
 (defun initialize-patchwork (application)
   "Initialize the Patchwork application.
 Must be called on the main thread."
-  (unless (%initialized application)
-    (setf *package*       (find-package "PATCHWORK")
-          #+ccl ccl::*listener-prompt-format* #+ccl "~/pw::fmt-package/~:* ~[?~:;~:*~d >~] ")
-    (ui::reporting-errors (initialize-mn-editor))
-    (ui::reporting-errors (initialize-menus))
-    (ui::reporting-errors (reset-application-name))
-    (ui::reporting-errors (initialize-beat-measure-line))
-    (ui::reporting-errors (initialize-directories))
-    ;;#-(and)(ui::reporting-errors (installapple-event-handlers)
-    (set-%initialized application))
+  (setf *package*       (find-package "PATCHWORK")
+        #+ccl ccl::*listener-prompt-format* #+ccl "~/pw::fmt-package/~:* ~[?~:;~:*~d >~] ")
+  (ui::reporting-errors (initialize-mn-editor))
+  (ui::reporting-errors (initialize-menus))
+  (ui::reporting-errors (reset-application-name))
+  (ui::reporting-errors (initialize-beat-measure-line))
+  (ui::reporting-errors (initialize-directories))
+  ;;#-(and)(ui::reporting-errors (installapple-event-handlers)
+  (set-%initialized application)
   (values))
 
+
 (defgeneric show-welcome (application)
   (:method ((application patchwork-application))
     (unless (%did-show-welcome application)

src/pw-kernel/box-creation/pw-patch.lisp

@@ -66,6 +66,22 @@
 (defvar *object-connection-draw-mode* *gray-pattern*)
 (defvar *normal-connection-draw-mode* *black-pattern*)
 
+;; NOTE: with current MCLGUI, *GRAY-PATTERN* and *BLACK-PATTERN* are
+;;       not set until run-time, after (UI:INITIALIZE).  Therefore
+;;       we set them lazily with PATTERN-FOR-DRAW-MODE.
+
+(defun pattern-for-draw-mode (erase-mode control)
+  (unless *object-connection-draw-mode*
+    (setf *object-connection-draw-mode* *gray-pattern*))
+  (unless *normal-connection-draw-mode*
+    (setf *normal-connection-draw-mode* *black-pattern*))
+  (cond
+    ((eql erase-mode *white-pattern*)
+     erase-mode)
+    ((pw-object-p (type-list control))
+     *object-connection-draw-mode*)
+    (t
+     *normal-connection-draw-mode*)))
 
 (defclass C-pw-outrect (BUTTON-DIALOG-ITEM)
   ((fill-state :initform nil :accessor %outrect-fill-state)))
@@ -416,10 +432,7 @@
                      (not (eql ctrl (pop pw-controls))))
             (when (atom ctrl)(setq ctrl (list ctrl))) ; for nargs
             (while ctrl
-              (unless (eql erase-mode *white-pattern*)
-                (setq erase-mode (if (pw-object-p (type-list (car ctrl)))
-                                     *object-connection-draw-mode* *normal-connection-draw-mode*)))
-              (with-pen-state (:pattern erase-mode)
+              (with-pen-state (:pattern (pattern-for-draw-mode erase-mode (car ctrl)))
                 (setq x1 (mid-x (out-put (car ctrl))))
                 (setq y1 (mid-y (out-put (pop ctrl))))
                 (setq xi (+ x-self (car in-xs)))
@@ -485,11 +498,7 @@
                        (or (null from-patches) (member ctrl from-patches :test #'eq)))
               (if (atom ctrl) (setq ctrl (list ctrl))) ; for nargs
               (while ctrl
-                (unless (eql erase-mode *white-pattern*)
-                  (setq erase-mode (if (pw-object-p (type-list (car ctrl)))
-                                       *object-connection-draw-mode*
-                                       *normal-connection-draw-mode*)))
-                (with-pen-state (:pattern erase-mode)
+                (with-pen-state (:pattern (pattern-for-draw-mode erase-mode (car ctrl)))
                   (setq x1 (mid-x (out-put (car ctrl))))
                   (setq y1 (mid-y (out-put (pop ctrl))))
                   (setq xi (+ x-self (car in-xs)))

version.data

@@ -1 +1 @@
-(10. 1. 0.81700236)
+(10. 1. 0.7980026)