data-objects/topgui.lisp at master · dbmcclain/data-objects · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
;; topgui.lisp -- Convenience defs for toplevel application GUI's
;; These helpers allow toplevel application GUI's to either run within
;; an existing session, or to startup and shutdown properly when run as
;; standalone applications.
;;
;; DM/MCFA  10/01
;; ----------------------------------------------------

(in-package "TOPGUI")

(defclass <toplevel-app-interface> (capi:interface)
  ((app-killch
    :accessor app-killch
    :initarg :app-killch
    :initform nil)))

(defmethod initialize-instance :after ((self <toplevel-app-interface>)
                                       &rest args
                                       &key &allow-other-keys)
  (declare (ignore args))
  (let ((dcb (capi:interface-destroy-callback self)))
    (setf (capi:interface-destroy-callback self)
          #'(lambda (intf)
              (let ((ch (app-killch intf)))
                (when dcb
                  (funcall dcb intf))
                (when ch
                  (rch:send ch t))))
          )))


(defmacro define-toplevel-app-interface (name superclasses &rest rest)
  ;; put <toplevel-app-interface> superclass as last one so that
  ;; all other superclasses get to establish the destroy-callback before
  ;; the final wrapup provided by <toplevel-app-interface>.
  `(capi:define-interface ,name (,@superclasses <toplevel-app-interface>)
     ,@rest))

(defun run-interface (intf before after)
  (when before
    (funcall before intf))
  (capi:display intf)
  (when after
    (funcall after intf)))

(defun run-toplevel-app-interface-with-killch (intfname before after)
  (let* ((ch   (rch:make-channel))
         (intf (make-instance intfname
                              :app-killch ch)))
    (run-interface intf before after)
    (rch:recv ch)
    (lw:quit :status 0)))

(defun run-toplevel-app-interface (intfname &key before after)
  (if (mp:list-all-processes)
      (let ((intf (make-instance intfname)))
        (run-interface intf before after)
        intf)
    (progn
      (push `("Toplevel App Launcher"
              nil
              run-toplevel-app-interface-with-killch
              ,intfname ,before ,after)
            mp:*initial-processes*)
      (mp:initialize-multiprocessing))
    ))

#|
;; Example of use....

(topgui:define-toplevel-app-interface interface-1 ()
  ((image  :accessor interface-image :initform nil))  ;; slots
  (:panes
   .... ;; etc just like capi:define-interface
   ))

(defun doit ()
  (labels
      ((before (intf)
               .... ;; whatever you want after intf is created but before being displayed
               )
       (after (intf)
              ... ;; whatever you want after intf is created and displayed
              ))

    (topgui:run-toplevel-app-interface 'interface-1
                                       :before #'before
                                       :after #'after)))

|#