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

Last change on this file since 7621 was 7621, checked in by rme, 13 years ago

Fix some Cocoa object leaks.

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