source: trunk/source/contrib/krueger/InterfaceProjects/Utilities/lisp-doc-controller.lisp @ 13390

Last change on this file since 13390 was 13390, checked in by plkrueger, 11 years ago

New contrib from Paul Krueger

File size: 5.9 KB
Line 
1;; lisp-doc-controller.lisp
2
3#|
4The MIT license.
5
6Copyright (c) 2010 Paul L. Krueger
7
8Permission is hereby granted, free of charge, to any person obtaining a copy of this software
9and associated documentation files (the "Software"), to deal in the Software without restriction,
10including without limitation the rights to use, copy, modify, merge, publish, distribute,
11sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
12furnished to do so, subject to the following conditions:
13
14The above copyright notice and this permission notice shall be included in all copies or substantial
15portions of the Software.
16
17THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
18LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
20WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
23|#
24
25(require :menu-utils)
26
27(defpackage :interface-utilities
28  (:nicknames :iu)
29  (:export lisp-doc-controller))
30
31(in-package :iu)
32
33;; demonstration code for creating a Cocoa document class in lisp that can be required
34;; and loaded into a standard running CCL IDE (i.e. does not require a stand-alone program).
35
36;; lisp-doc-controller class
37;; This class does some of the same things that the shared NSDocumentController instance
38;; does for stand-alone application programs. We use it so that we don't have to mess
39;; with CCL's existing interfaces to or its NSApplication delegate objects et. We will
40;; create specific menu-items that target an instance of this class to create new documents
41;; of a specified type that the CCL IDE knows nothing about. We will tell the shared
42;; NSDocumentController about our documents so that it can manage things like saving and
43;; closing them. This class will also handle opening files of a specified type.
44;; The creator of one of these objects can also specify a name to use for inserting
45;; "New <menu-class>" and "Open <menu-class>" menuitems which will target this instance.
46
47(defclass lisp-doc-controller (ns:ns-object)
48  ((document-class :accessor document-class :initarg :doc-class)
49   (menu-class-name :accessor menu-class-name :initarg :menu-class)
50   (file-ext :accessor file-ext :initarg :file-ext)
51   (doc-ctrlr :accessor doc-ctrlr)
52   (open-panel :accessor open-panel)
53   (type-ns-str :accessor type-ns-str)
54   (ext-ns-str :accessor ext-ns-str)
55   (type-array :accessor type-array)
56   (documents :accessor documents :initform nil))
57  (:default-initargs 
58    :doc-class nil
59    :menu-class nil
60    :file-ext nil)
61  (:metaclass ns:+ns-object))
62
63(defmethod initialize-instance :after ((self lisp-doc-controller) 
64                                       &key menu-class file-ext &allow-other-keys)
65  (ccl:terminate-when-unreachable self)
66  (when menu-class
67    (setf (type-ns-str self) (ccl::%make-nsstring menu-class))
68    (setf (ext-ns-str self) (ccl::%make-nsstring file-ext))
69    (setf (doc-ctrlr self) (#/sharedDocumentController ns:ns-document-controller))
70    (setf (open-panel self) (make-instance ns:ns-open-panel))
71    (#/retain (open-panel self))
72    (setf (type-array self)
73          (#/arrayByAddingObject: (make-instance ns:ns-array) (ext-ns-str self)))
74    (make-and-install-menuitems-after "File" "New"
75                                      (list (concatenate 'string "New " menu-class) 
76                                            "newDoc"
77                                            nil
78                                            self))
79    (make-and-install-menuitems-after "File" "Open..."
80                                      (list (concatenate 'string "Open " menu-class "...") 
81                                            "openDoc"
82                                            nil
83                                            self))
84    (make-and-install-menuitems-after "File" "Print..."
85                                      (list (concatenate 'string "Print " menu-class "...") 
86                                            (concatenate 'string "print" menu-class ":")
87                                            nil
88                                            nil))))
89
90(defmethod ccl:terminate ((self lisp-doc-controller))
91  (#/release (type-ns-str self))
92  (#/release (ext-ns-str self))
93  (#/release (type-array self))
94  (#/release (open-panel self)))
95
96(objc:defmethod (#/newDoc :void)
97                ((self lisp-doc-controller))
98  (let ((new-doc (make-instance (document-class self))))
99    (push new-doc (documents self))
100    ;; register the document with the shared controller so that things like
101    ;; "save" and "close" will work properly
102    (#/addDocument: (doc-ctrlr self) new-doc)
103    (#/makeWindowControllers new-doc)
104    (#/showWindows new-doc)))
105
106(objc:defmethod (#/openDoc :void)
107                ((self lisp-doc-controller))
108  (let ((result (#/runModalForTypes: (open-panel self) (type-array self))))
109    (when (eql result 1)
110      (let ((urls (#/URLs (open-panel self))))
111        (dotimes (i (#/count urls))
112          (let ((doc (make-instance (document-class self))))
113            (setf doc (#/initWithContentsOfURL:ofType:error: 
114                       doc
115                       (#/objectAtIndex: urls i)
116                       (type-ns-str self)
117                       (%null-ptr)))
118            (if doc
119              (progn
120                (pushnew doc (documents self))
121                (#/addDocument: (doc-ctrlr self) doc)
122                (#/makeWindowControllers doc)
123                (#/showWindows doc))
124              (#_NSRunAlertPanel #@"ALERT" 
125                                 #@"Could not open specified file ... ignoring it."
126                                 #@"OK" 
127                                 (%null-ptr)
128                                 (%null-ptr)))))))))
129
130(provide :lisp-doc-controller)
Note: See TracBrowser for help on using the repository browser.