source: branches/ide-1.0/ccl/cocoa-ide/cocoa-utils.lisp @ 6866

Last change on this file since 6866 was 6866, checked in by gb, 15 years ago

Moved here.

File size: 3.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  (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+)))
Note: See TracBrowser for help on using the repository browser.