source: branches/working-0711/ccl/cocoa-ide/processes-window.lisp @ 7804

Last change on this file since 7804 was 7804, checked in by gb, 13 years ago

sync with trunk

File size: 5.1 KB
Line 
1;;;-*-Mode: LISP; Package: GUI -*-
2;;;
3;;;   Copyright (C) 2007 Clozure Associates
4
5(in-package "GUI")
6
7(defclass processes-window-controller (ns:ns-window-controller)
8  ((table-view :foreign-type :id :reader processes-window-table-view)
9   (toolbar :foreign-type :id :accessor processes-window-toolbar)
10   (processes :accessor processes-window-processes))
11  (:metaclass ns:+ns-object))
12
13(objc:defmethod #/init ((self processes-window-controller))
14  (setf (slot-value self 'processes) (coerce (all-processes) 'vector))
15  (#/initWithWindowNibName: self #@"processes"))
16
17(objc:defmethod (#/awakeFromNib :void) ((self processes-window-controller))
18  (with-slots (toolbar table-view) self
19    (#/setDoubleAction: table-view (@selector #/inspectSelectedProcess:))
20    (setf toolbar (make-instance 'ns:ns-toolbar
21                                 :with-identifier #@"processes-window-toolbar"))
22    (#/setDisplayMode: toolbar #$NSToolbarDisplayModeLabelOnly)
23    (#/setDelegate: toolbar self)
24    (#/setToolbar: (#/window self) toolbar)
25    (#/release toolbar)))
26
27
28
29;;; toolbar delegate methods
30
31(objc:defmethod #/toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:
32                ((self processes-window-controller)
33                 toolbar itemIdentifier (flag :<BOOL>))
34  (declare (ignore toolbar))
35  (let ((item +null-ptr+))
36    (cond
37     ((#/isEqualToString: itemIdentifier #@"kill")
38      (setf item (make-instance 'ns:ns-toolbar-item :with-item-identifier itemIdentifier))
39      (#/setLabel: item #@"Kill")
40      (#/setTarget: item self)
41      (#/setAction: item (@selector #/killSelectedProcess:)))
42     ((#/isEqualToString: itemIdentifier #@"refresh")
43      (setf item (make-instance 'ns:ns-toolbar-item :with-item-identifier itemIdentifier))
44      (#/setLabel: item #@"Refresh")
45      (#/setTarget: item self)
46      (#/setAction: item (@selector #/refresh:))))
47    (#/autorelease item)))
48
49(objc:defmethod #/toolbarDefaultItemIdentifiers:
50                ((self processes-window-controller) toolbar)
51  (declare (ignore toolbar))
52  (#/arrayWithObjects: ns:ns-array #@"kill"
53                       #&NSToolbarFlexibleSpaceItemIdentifier
54                       #@"refresh"
55                       +null-ptr+)) ; don't even think about putting nil here
56
57(objc:defmethod #/toolbarAllowedItemIdentifiers:
58                ((self processes-window-controller) toolbar)
59  (declare (ignore toolbar))
60  (#/arrayWithObjects: ns:ns-array #@"refresh"
61                       #&NSToolbarFlexibleSpaceItemIdentifier
62                       #@"refresh"
63                       +null-ptr+))
64
65(objc:defmethod (#/validateToolbarItem: :<BOOL>)
66                ((self processes-window-controller) item)
67  (let ((enable #$NO))
68    (cond
69     ((#/isEqualToString: (#/itemIdentifier item) #@"kill")
70      (when (plusp (#/numberOfSelectedRows (processes-window-table-view self)))
71        (setf enable #$YES)))
72     ((#/isEqualToString: (#/itemIdentifier item) #@"refresh")
73      (setf enable #$YES)))
74    enable))
75
76;;; actions
77
78(objc:defmethod (#/refresh: :void) ((self processes-window-controller) sender)
79  (declare (ignore sender))
80  (setf (slot-value self 'processes)
81        (coerce (all-processes) 'vector))
82  (#/reloadData (processes-window-table-view self)))
83
84(objc:defmethod (#/killSelectedProcess: :void) ((self processes-window-controller) sender)
85  (declare (ignore sender))
86  (let ((row (#/selectedRow (processes-window-table-view self)))
87        (p nil))
88    (unless (minusp row)
89      (setq p (svref (processes-window-processes self) row))
90      (process-kill p)
91      (#/refresh: self self))))
92
93(objc:defmethod (#/inspectSelectedProcess: :void) ((self processes-window-controller) sender)
94  (declare (ignore sender))
95  (with-slots (table-view processes) self
96    (let* ((row (#/clickedRow table-view))
97           (p nil))
98      (unless (minusp row)
99        (setq p (svref processes row))
100        (cinspect p)
101        (#/refresh: self self)))))
102
103;;; table view delegate methods
104
105(objc:defmethod (#/tableViewSelectionDidChange: :void)
106                ((self processes-window-controller) notification)
107  (declare (ignore notification))
108  (with-slots (toolbar) self
109    ;; Usually, we'd just update the one item in question,
110    ;; but since there aren't many items in the toolbar,
111    ;; just be lazy.
112    (#/validateVisibleItems toolbar)))
113
114;;; table view data source methods
115
116(objc:defmethod (#/numberOfRowsInTableView: :<NSI>nteger)
117                ((self processes-window-controller)
118                 table-view)
119  (declare (ignore table-view))
120  (length (slot-value self 'processes)))
121
122(objc:defmethod #/tableView:objectValueForTableColumn:row:
123                ((self processes-window-controller)
124                 table-view
125                 table-column
126                 (row :<NSI>nteger))
127  (declare (ignore table-view))
128  (with-slots (processes) self
129    (let ((fn nil)
130          (p (svref processes row)))
131      (cond
132       ((#/isEqualToString: (#/identifier table-column) #@"name")
133        (setq fn #'process-name))
134       ((#/isEqualToString: (#/identifier table-column) #@"state")
135        (setq fn #'process-whostate))
136       ((#/isEqualToString: (#/identifier table-column) #@"thread")
137        (setq fn #'process-thread))
138       ((#/isEqualToString: (#/identifier table-column) #@"suspend count")
139        (setq fn #'process-suspend-count)))
140      (if (and p fn)
141        (#/autorelease (%make-nsstring (format nil "~a" (funcall fn p))))
142        +null-ptr+))))
143
144#|
145(in-package "CCL")
146(load "~rme/processes-window")
147(setf *pwc* (make-instance 'processes-window-controller))
148(#/showWindow: *pwc* *pwc*)
149
150|#
Note: See TracBrowser for help on using the repository browser.