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

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

Set table view data source to nil before autoreleasing window controller
so that the table view doesn't get any ideas about redrawing itself as
things are getting torn down.

File size: 4.9 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  (#/setDataSource: (slot-value self 'table-view) +null-ptr+)
61  (#/autorelease self))
62
63(objc:defmethod (#/sequenceDoubleClick: :void)
64    ((self sequence-window-controller) sender)
65  (let* ((n (#/clickedRow sender)))
66    (when (>= n 0)
67      (with-slots (sequence result-callback) self
68        (funcall result-callback (elt sequence n))))))
69
70(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger)
71    ((self sequence-window-controller) view)
72  (declare (ignore view))
73  (length (slot-value self 'sequence)))
74
75
76(objc:defmethod #/tableView:objectValueForTableColumn:row:
77    ((self sequence-window-controller) view column (row :<NSI>nteger))
78  (declare (ignore column view))
79  (with-slots (display sequence) self
80    (#/autorelease
81     (%make-nsstring (with-output-to-string (s)
82                       (funcall display (elt sequence row) s))))))
83
84(defmethod initialize-instance :after ((self sequence-window-controller) &key &allow-other-keys)
85  (let* ((window (#/window self)))
86    (with-slots (title) self
87      (when title (#/setTitle: window (%make-nsstring title))))
88    (#/reloadData (sequence-window-controller-table-view self))
89    (#/performSelectorOnMainThread:withObject:waitUntilDone:
90     self
91     (@selector #/showWindow:)
92     +null-ptr+
93     nil)))
94
95;;; Looks like a "util" to me ...
96(defun pathname-to-url (pathname)
97  (make-instance 'ns:ns-url
98                 :file-url-with-path
99                 (%make-nsstring (native-translated-namestring pathname))))
100
101(defun cgfloat (number)
102  (float number ccl::+cgfloat-zero+))
103
104(defun color-values-to-nscolor (red green blue alpha)
105  (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
106                                              (cgfloat red)
107                                              (cgfloat green)
108                                              (cgfloat blue)
109                                              (cgfloat alpha)))
110
111(defun windows ()
112  (let* ((win-arr (#/orderedWindows *NSApp*))
113         (ret nil))
114    (dotimes (i (#/count win-arr))
115      (push (#/objectAtIndex: win-arr i) ret))
116    (nreverse ret)))
117
118(defun log-debug (format-string &rest args)
119  (#_NSLog (ccl::%make-nsstring (apply #'format nil format-string args))))
120
121(defun assume-cocoa-thread ()
122  #+debug (assert (eq *current-process* *initial-process*)))
123
124(defmethod assume-not-editing ((whatever t)))
125
Note: See TracBrowser for help on using the repository browser.