source: trunk/cocoa-ide-contrib/foy/hemlock-commands-cm/hemlock-commands-1.lisp @ 14985

Last change on this file since 14985 was 14985, checked in by gfoy, 9 years ago

Updates for ccl 1.7

File size: 10.3 KB
Line 
1;;;-*-Mode: LISP; Package: HEMLOCK-COMMANDS -*-
2
3;;; ----------------------------------------------------------------------------
4;;;
5;;;      hemlock-commands-1.lisp
6;;;
7;;;      copyright (c) 2009 Glen Foy
8;;;      (Permission is granted to Clozure Associates to distribute this file.)
9;;;
10;;;      This code adds a Hemlock Commands documentation tool to the Context-Menu
11;;;      mechanism.  Right-Click displays a listing of essential Hemlock Commands
12;;;      for the new users.  Selecting an entry executes the command.
13;;;
14;;;      See the NOTE: below about selecting the Help Menu or the Context-Menu.
15;;;
16;;;      This software is offered "as is", without warranty of any kind.
17;;;
18;;;      Mod History, most recent first:
19;;;      1/6/10  Editor Compile Defun and Editor Evaluate Defun bit the dust.
20;;;              Editor Execute Defun instead.
21;;;      9/2/9   Removed doc-path from hemlock-commands-menu.
22;;;      8/31/9  version 0.1b1
23;;;              First cut.
24;;;
25;;; ----------------------------------------------------------------------------
26
27(defPackage "HEMLOCK-COMMANDS" (:nicknames "HCOM") (:use :cl :ccl :hemlock-internals))
28(in-package "HEMLOCK-COMMANDS")
29
30(require :context-menu-cm)
31(cmenu:check-hyperspec-availability "Hemlock-Commands-CM")
32
33;;; NOTE:
34;;; If you want this utility in the context menu, uncomment the pushnew.
35;;; If you want it under the help menu, leave as is.
36;;; (pushnew :install-hemlock-doc-as-context-menu *features*)
37
38(defParameter *hemlock-commands-menu* nil "The hemlock-commands-menu instance.")
39(defParameter *hemlock-commands-keyword-menu* nil "The hemlock-commands-keyword-menu instance.")
40
41;;; ----------------------------------------------------------------------------
42;;;
43(defClass HEMLOCK-COMMAND-MENU-ITEM (ns:ns-menu-item)
44  ((key-event :initform nil :accessor key-event)
45   (name :initform nil :accessor name))
46  (:documentation "Support for the hemlock-commands-menu.")
47  (:metaclass ns:+ns-object))
48
49
50;;; ----------------------------------------------------------------------------
51;;;
52(defClass HEMLOCK-COMMANDS-MENU (ns:ns-menu)
53  ((tool-menu :initform nil :accessor tool-menu)
54   (sub-title :initform "basic commands" :reader sub-title)
55   (text-view :initform nil :accessor text-view))
56  (:documentation "A popup menu listing a useful subset of Hemlock commands: Hemlock's Greatest Hits, for new users.")
57  (:metaclass ns:+ns-object))
58
59(defun get-value-node-command (name)
60  (dotimes (index (hi::string-table-num-nodes hi::*command-names*))
61    (let* ((command (hi::value-node-value (aref (hi::string-table-value-nodes hi::*command-names*) index)))
62           (command-name (hi::command-%name command)))
63      (when (string-equal name command-name)
64        (return command)))))
65
66(objc:defmethod (#/hemlockCommandAction: :void) ((m hemlock-commands-menu) (sender :id))
67  (let* ((command (get-value-node-command (name sender))))
68    (when command (display-doc command))))
69#|
70    ;; *** do we really want to execute the command here??
71    (when (null (text-view m)) (setf (text-view m) (get-key-window-text-view)))
72    (when (text-view m)
73      (cond ((typep key-event 'hi::key-event)
74             (hi::handle-hemlock-event (gui::hemlock-view (text-view m)) key-event))
75            ((typep (key-event sender) 'simple-vector)
76             (hi::handle-hemlock-event (gui::hemlock-view (text-view m)) (aref key-event 0))
77             (hi::handle-hemlock-event (gui::hemlock-view (text-view m)) (aref key-event 1)))))))
78|#
79
80(defMethod initialize-instance :after ((menu hemlock-commands-menu) &key)
81  (flet ((create-menu-item (long-name name key-event)
82           (let ((menu-item (make-instance 'hemlock-command-menu-item))
83                 (attributed-string (#/initWithString:attributes:
84                                     (#/alloc ns:ns-attributed-string) 
85                                     (ccl::%make-nsstring long-name)
86                                     cmenu:*hemlock-menu-dictionary*)))
87             (#/setAttributedTitle: menu-item attributed-string)
88             (#/setAction: menu-item (ccl::@selector "hemlockCommandAction:"))
89             (#/setTarget: menu-item  menu)
90             (setf (key-event menu-item) key-event)
91             (setf (name menu-item) name)
92             (#/addItem: menu menu-item))))
93
94#+install-hemlock-doc-as-context-menu
95    (setf (tool-menu menu) (cmenu:add-default-tool-menu menu))
96   
97    ;;; Hemlock's Greatest Hits:
98    (create-menu-item "Inspect Symbol  (control-x, control-i)"
99                      "Inspect Symbol"
100                      #k"control-x control-i")
101    (create-menu-item "Symbol Documentation  (control-x, control-d)" 
102                      "Symbol Documentation"
103                      #k"control-x control-d")
104    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
105    (create-menu-item "Current Function Arglist  (control-x, control-a)"
106                      "Current Function Arglist"
107                      #k"control-x control-a")
108    (create-menu-item "Goto Definition  (meta-.)"
109                      "Goto Definition"
110                      #k"meta-.")
111    (create-menu-item "Show Callers  (control-meta-c)" 
112                      "Show Callers"
113                      #k"control-meta-c")
114    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
115    (create-menu-item "Editor Macroexpand-1 Expression  (control-m)"
116                      "Editor Macroexpand-1 Expression"
117                      #k"control-m")
118    (create-menu-item "Editor Macroexpand Expression  (control-x, control-m)" 
119                      "Editor Macroexpand Expression"
120                      #k"control-x control-m")
121    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
122    (create-menu-item "Editor Execute Defun  (control-x, control-c)"
123                      "Editor Execute Defun"
124                      #k"control-x control-c")
125    (create-menu-item "Editor Execute Expression  (control-x, control-e)"
126                      "Editor Execute Expression"
127                      #k"control-x control-e")
128#|
129    (create-menu-item "Editor Evaluate Region  (Enter)"
130                      "Editor Evaluate Region"
131                      #k"enter")
132    (create-menu-item "Editor Compile Region  (unbound)"
133                      #k"enter")
134    (create-menu-item "Editor Evaluate Buffer  (unbound)"
135                      #k"enter")
136    (create-menu-item "Editor Compile Buffer File  (unbound)"
137                      #k"enter")
138|#
139    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
140    (create-menu-item "Incremental Search  (control-s)"
141                      "Incremental Search"
142                      #k"control-s")
143    (create-menu-item "I-Search Repeat Forward  (control-s)"
144                      "I-Search Repeat Forward"
145                      #k"control-s")
146    (create-menu-item "I-Search Repeat Backward  (control-r)"
147                      "I-Search Repeat Backward"
148                      #k"control-r")
149    (create-menu-item "I-Search Abort  (control-g)"
150                      "I-Search Abort"
151                      #k"control-g")
152    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
153    (create-menu-item "Delete Next Character  (control-d)"
154                      "Delete Next Character"
155                      #k"control-d")
156    (create-menu-item "Delete Previous Character  (delete)"
157                      "Delete Previous Character"
158                      #k"delete")
159    (create-menu-item "Kill Next Word  (meta-d)"
160                      "Kill Next Word"
161                      #k"meta-d")
162    (create-menu-item "Kill Previous Word  (meta-delete)"
163                      "Kill Previous Word"
164                      #k"meta-delete")
165    (create-menu-item "Kill Line  (control-k)"
166                      "Kill Line"
167                      #k"control-k")
168    (create-menu-item "Un-Kill  (control-y)"
169                      "Un-Kill"
170                      #k"control-y")
171    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
172    (create-menu-item "Forward Character  (control-f)"
173                      "Forward Character"
174                      #k"control-f")
175    (create-menu-item "Backward Character  (control-b)"
176                      "Backward Character"
177                      #k"control-b")
178    (create-menu-item "Beginning of Line  (control-a)"
179                      "Beginning of Line"
180                      #k"control-a")
181    (create-menu-item "End of Line  (control-e)"
182                      "End of Line"
183                      #k"control-e")
184    (create-menu-item "Previous Line  (control-p)"
185                      "Previous Line"
186                      #k"control-p")
187    (create-menu-item "Next Line  (control-n)"
188                      "Next Line"
189                      #k"control-n")
190    (create-menu-item "Beginning of Buffer  (meta-<)"
191                      "Beginning of Buffer"
192                      #k"meta-\<")
193    (create-menu-item "End of Buffer  (meta->)"
194                      "End of Buffer"
195                      #k"meta-\>")
196    (create-menu-item "Scroll Window Down  (control-v)"
197                      "Scroll Window Down"
198                      #k"control-v")
199    (create-menu-item "Scroll Window Up  (meta-v)"
200                      "Scroll Window Up"
201                      #k"meta-v")))
202
203(objc:defmethod (#/update :void) ((self hemlock-commands-menu))
204  (when (tool-menu self)
205    (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self)))
206  (call-next-method))
207
208(setq *hemlock-commands-menu* (make-instance 'hemlock-commands-menu))
209
210#|
211(defun get-key-window-text-view ()
212  (let ((active-hemlock-window (cmenu:active-hemlock-window)))
213    (when active-hemlock-window
214      (slot-value (slot-value active-hemlock-window 'gui::pane) 'gui::text-view))))
215|#
216
217(defun get-hemlock-commands-menu (view event)
218  "Return the appropriate Hemlock Commands menu based on modifier keys."
219  (cond ((logtest #$NSCommandKeyMask (#/modifierFlags event))
220         (setf (text-view *hemlock-commands-menu*) view)           
221         *hemlock-commands-menu*)
222        (t
223         *hemlock-commands-keyword-menu*)))
224
225#-install-hemlock-doc-as-context-menu
226(defParameter *help-menu* 
227  (#/submenu (#/itemWithTitle: (#/mainMenu (ccl::application-ui-object ccl::*application*)) #@"Help")))
228
229#-install-hemlock-doc-as-context-menu
230(let ((menu-item (make-instance ns:ns-menu-item)))
231  (#/setTitle: menu-item (ccl::%make-nsstring "Hemlock, Basic Commands"))
232  (#/setSubmenu: menu-item *hemlock-commands-menu*)
233  (#/addItem: *help-menu* menu-item))
234
235#+install-hemlock-doc-as-context-menu
236(cmenu:register-tool "Hemlock-Commands-CM" #'get-hemlock-commands-menu)
237
238
Note: See TracBrowser for help on using the repository browser.