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

Last change on this file since 7291 was 7291, checked in by jaj, 14 years ago

Add function windows that returns an ordered list of the windows that are open.

File size: 4.0 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  (let* ((w (new-cocoa-window :activate nil))
19         (contentview (#/contentView w))
20         (contentframe (#/frame contentview))
21         (scrollview (make-instance 'ns:ns-scroll-view :with-frame contentframe)))
22    (#/setWindow: self w)
23    (#/setHasVerticalScroller: scrollview t)
24    (#/setHasHorizontalScroller: scrollview t)
25    (#/setRulersVisible: scrollview nil)
26    (#/setAutoresizingMask: scrollview (logior
27                                        #$NSViewWidthSizable
28                                        #$NSViewHeightSizable))
29    (#/setAutoresizesSubviews: (#/contentView scrollview) t)
30    (let* ((table-view (make-instance 'ns:ns-table-view)))
31      (#/setDocumentView: scrollview table-view)
32      (setf (slot-value self 'table-view) table-view)
33      (let* ((column (make-instance 'ns:ns-table-column :with-identifier #@"")))
34        (#/setEditable: column nil)
35        (#/addTableColumn: table-view column))
36      (#/setAutoresizingMask: table-view (logior
37                                          #$NSViewWidthSizable
38                                          #$NSViewHeightSizable))
39      (#/sizeToFit table-view)
40      (#/setDataSource: table-view self)
41      (#/setTarget: table-view self)
42      (#/setHeaderView: table-view +null-ptr+)
43      (#/setUsesAlternatingRowBackgroundColors: table-view t)
44      (#/setDoubleAction: table-view (@selector #/sequenceDoubleClick:))
45      (#/addSubview: contentview scrollview)
46      self)))
47
48(objc:defmethod (#/sequenceDoubleClick: :void)
49    ((self sequence-window-controller) sender)
50  (let* ((n (#/clickedRow sender)))
51    (when (>= n 0)
52      (with-slots (sequence result-callback) self
53        (funcall result-callback (elt sequence n))))))
54
55(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger)
56    ((self sequence-window-controller) view)
57  (declare (ignore view))
58  (length (slot-value self 'sequence)))
59
60
61(objc:defmethod #/tableView:objectValueForTableColumn:row:
62    ((self sequence-window-controller) view column (row :<NSI>nteger))
63  (declare (ignore column view))
64  (with-slots (display sequence) self
65    (%make-nsstring (with-output-to-string (s)
66                      (funcall display (elt sequence row) s)))))
67
68(defmethod initialize-instance :after ((self sequence-window-controller) &key &allow-other-keys)
69  (let* ((window (#/window self)))
70    (with-slots (title) self
71      (when title (#/setTitle: window (%make-nsstring title))))
72    (#/reloadData (sequence-window-controller-table-view self))
73    (#/performSelectorOnMainThread:withObject:waitUntilDone:
74     self
75     (@selector #/showWindow:)
76     +null-ptr+
77     nil)))
78
79;;; Looks like a "util" to me ...
80(defun pathname-to-url (pathname)
81  (make-instance 'ns:ns-url
82                 :file-url-with-path
83                 (%make-nsstring (native-translated-namestring pathname))))
84
85(defun color-values-to-nscolor (red green blue alpha)
86  (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
87                                              (float red +cgfloat-zero+)
88                                              (float green +cgfloat-zero+)
89                                              (float blue +cgfloat-zero+)
90                                              (float alpha +cgfloat-zero+)))
91
92(defun windows ()
93  (let* ((win-arr (#/orderedWindows *NSApp*))
94         (ret nil))
95    (dotimes (i (#/count win-arr))
96      (push (#/objectAtIndex: win-arr i) ret))
97    (nreverse ret)))
Note: See TracBrowser for help on using the repository browser.