source: trunk/ccl/cocoa-ide/cocoa-utils.lisp @ 7698

Last change on this file since 7698 was 7698, checked in by gz, 14 years ago

A new package and a reorg:

I put all the cocoa-ide files (except for a greatly stripped-down
cocoa.lisp and cocoa-application.lisp) in a new package named "GUI".

The package is defined in defsystem.lisp, which also defines a
function to load all the files explicitly, putting the fasls in
cocoa-ide;fasls; I stripped out all pretense that the files can or
should be loaded individually. Also, it is no longer necessary or
appropriate to compile hemlock separately, as it now compiles as
needed as part of the normal loading sequence. (Over time I am hoping
to get hemlock more and more integrated into the IDE, and having to
maintain it as if it still were a separate package is an unnecessary
burden).

Updated the README file appropriately.

File size: 4.8 KB
Line 
1; -*- Mode: Lisp; Package: GUI; -*-
2
3(in-package "GUI")
4
5(defclass sequence-window-controller (ns:ns-window-controller)
6    ((table-view :foreign-type :id :reader sequence-window-controller-table-view)
7     (sequence :initform nil :initarg :sequence :type sequence :reader sequence-window-controller-sequence)
8     (result-callback :initarg :result-callback)
9     (display :initform #'(lambda (item stream) (prin1 item stream)) :initarg :display)
10     (title :initform "Sequence dialog" :initarg :title))
11  (:metaclass ns:+ns-object))
12
13
14(objc:defmethod #/init ((self sequence-window-controller))
15  (call-next-method)
16  (let* ((w (new-cocoa-window :activate nil))
17         (contentview (#/contentView w))
18         (contentframe (#/frame contentview))
19         (scrollview (make-instance 'ns:ns-scroll-view :with-frame contentframe)))
20    (#/setWindow: self w)
21    (#/setDelegate: w self)
22    (#/setWindowController: w self)
23    (#/setHasVerticalScroller: scrollview t)
24    (#/setHasHorizontalScroller: scrollview t)
25    (#/setAutohidesScrollers: scrollview t)
26    (#/setRulersVisible: scrollview nil)
27    (#/setAutoresizingMask: scrollview (logior
28                                        #$NSViewWidthSizable
29                                        #$NSViewHeightSizable))
30    (#/setAutoresizesSubviews: (#/contentView scrollview) t)
31    (let* ((table-view (make-instance 'ns:ns-table-view)))
32      (#/setDocumentView: scrollview table-view)
33      (#/release table-view)
34      (#/setColumnAutoresizingStyle: table-view #$NSTableViewUniformColumnAutoresizingStyle)
35      (setf (slot-value self 'table-view) table-view)
36      (let* ((column (make-instance 'ns:ns-table-column :with-identifier #@"")))
37        (#/setEditable: column nil)
38        (#/setResizingMask: column #$NSTableColumnAutoresizingMask)
39        (#/addTableColumn: table-view column)
40        (#/release column))
41      (#/setAutoresizingMask: table-view (logior
42                                          #$NSViewWidthSizable
43                                          #$NSViewHeightSizable))
44      (#/sizeToFit table-view)
45      (#/setDataSource: table-view self)
46      (#/setTarget: table-view self)
47      (#/setHeaderView: table-view +null-ptr+)
48      (#/setUsesAlternatingRowBackgroundColors: table-view t)
49      (#/setDoubleAction: table-view (@selector #/sequenceDoubleClick:))
50      (#/addSubview: contentview scrollview)
51      (#/release scrollview)
52      self)))
53
54(objc:defmethod (#/dealloc :void) ((self sequence-window-controller))
55  (call-next-method))
56
57(objc:defmethod (#/windowWillClose: :void) ((self sequence-window-controller)
58                                            notification)
59  (declare (ignore notification))
60  (#/autorelease self))
61
62(objc:defmethod (#/sequenceDoubleClick: :void)
63    ((self sequence-window-controller) sender)
64  (let* ((n (#/clickedRow sender)))
65    (when (>= n 0)
66      (with-slots (sequence result-callback) self
67        (funcall result-callback (elt sequence n))))))
68
69(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger)
70    ((self sequence-window-controller) view)
71  (declare (ignore view))
72  (length (slot-value self 'sequence)))
73
74
75(objc:defmethod #/tableView:objectValueForTableColumn:row:
76    ((self sequence-window-controller) view column (row :<NSI>nteger))
77  (declare (ignore column view))
78  (with-slots (display sequence) self
79    (#/autorelease
80     (%make-nsstring (with-output-to-string (s)
81                       (funcall display (elt sequence row) s))))))
82
83(defmethod initialize-instance :after ((self sequence-window-controller) &key &allow-other-keys)
84  (let* ((window (#/window self)))
85    (with-slots (title) self
86      (when title (#/setTitle: window (%make-nsstring title))))
87    (#/reloadData (sequence-window-controller-table-view self))
88    (#/performSelectorOnMainThread:withObject:waitUntilDone:
89     self
90     (@selector #/showWindow:)
91     +null-ptr+
92     nil)))
93
94;;; Looks like a "util" to me ...
95(defun pathname-to-url (pathname)
96  (make-instance 'ns:ns-url
97                 :file-url-with-path
98                 (%make-nsstring (native-translated-namestring pathname))))
99
100(defun cgfloat (number)
101  (float number ccl::+cgfloat-zero+))
102
103(defun color-values-to-nscolor (red green blue alpha)
104  (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
105                                              (cgfloat red)
106                                              (cgfloat green)
107                                              (cgfloat blue)
108                                              (cgfloat alpha)))
109
110(defun windows ()
111  (let* ((win-arr (#/orderedWindows *NSApp*))
112         (ret nil))
113    (dotimes (i (#/count win-arr))
114      (push (#/objectAtIndex: win-arr i) ret))
115    (nreverse ret)))
116
117(defun log-debug (format-string &rest args)
118  (#_NSLog (ccl::%make-nsstring (apply #'format nil format-string args))))
119
120(defun assume-cocoa-thread ()
121  #+debug (assert (eq *current-process* *initial-process*)))
122
123(defmethod assume-not-editing ((whatever t)))
124
Note: See TracBrowser for help on using the repository browser.