source: trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-1.lisp @ 12745

Last change on this file since 12745 was 12745, checked in by gfoy, 11 years ago

Added 'Show Callers', control-meta-c

File size: 6.9 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;;;      This software is offered "as is", without warranty of any kind.
15;;;
16;;;      Mod History, most recent first:
17;;;      9/2/9   Removed doc-path from hemlock-commands-menu.
18;;;      8/31/9  version 0.1b1
19;;;              First cut.
20;;;
21;;; ----------------------------------------------------------------------------
22
23(defpackage "HEMLOCK-COMMANDS" (:nicknames "HCOM") (:use :cl :ccl))
24(in-package "HEMLOCK-COMMANDS")
25
26(require :context-menu-cm)
27(cmenu:check-hyperspec-availability "Hemlock-Commands-CM")
28
29(defparameter *hemlock-commands-menu* nil "The hemlock-commands-menu instance.")
30(defparameter *hemlock-commands-keyword-menu* nil "The hemlock-commands-keyword-menu instance.")
31
32;;; ----------------------------------------------------------------------------
33;;;
34(defclass HEMLOCK-COMMAND-MENU-ITEM (ns:ns-menu-item)
35  ((key-event :initform nil :accessor key-event))
36  (:documentation "Support for the hemlock-commands-menu.")
37  (:metaclass ns:+ns-object))
38
39
40;;; ----------------------------------------------------------------------------
41;;;
42(defclass HEMLOCK-COMMANDS-MENU (ns:ns-menu)
43  ((tool-menu :initform nil :accessor tool-menu)
44   (sub-title :initform "basic commands" :reader sub-title)
45   (text-view :initform nil :accessor text-view))
46  (:documentation "A popup menu listing a useful subset of Hemlock commands: Hemlock's Greatest Hits, for new users.")
47  (:metaclass ns:+ns-object))
48
49(objc:defmethod (#/hemlockCommandAction: :void) ((m hemlock-commands-menu) (sender :id))
50  (let ((key-event (key-event sender))) ; can be a vector of events
51    (cond ((typep key-event 'hi::key-event)
52           (hi::handle-hemlock-event (gui::hemlock-view (text-view m)) key-event))
53          ((typep (key-event sender) 'simple-vector)
54           (hi::handle-hemlock-event (gui::hemlock-view (text-view m)) (aref key-event 0))
55           (hi::handle-hemlock-event (gui::hemlock-view (text-view m)) (aref key-event 1))))))
56
57(defmethod initialize-instance :after ((menu hemlock-commands-menu) &key)
58  (flet ((create-menu-item (name key-event)
59           (let ((menu-item (make-instance 'hemlock-command-menu-item))
60                 (attributed-string (#/initWithString:attributes:
61                                     (#/alloc ns:ns-attributed-string) 
62                                     (ccl::%make-nsstring name)
63                                     cmenu:*hemlock-menu-dictionary*)))
64             (#/setAttributedTitle: menu-item attributed-string)
65             (#/setAction: menu-item (ccl::@selector "hemlockCommandAction:"))
66             (#/setTarget: menu-item  menu)
67             (setf (key-event menu-item) key-event)
68             (#/addItem: menu menu-item))))
69    (setf (tool-menu menu) (cmenu:add-default-tool-menu menu))
70   
71    ;;; Hemlock's Greatest Hits:
72    (create-menu-item "Inspect Symbol  (control-x, control-i)" 
73                      #k"control-x control-i")
74    (create-menu-item "Symbol Documentation  (control-x, control-d)" 
75                      #k"control-x control-d")
76    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
77    (create-menu-item "Current Function Arglist  (control-x, control-a)" 
78                      #k"control-x control-a")
79    (create-menu-item "Goto Definition  (meta-.)"
80                      #k"meta-.")
81    (create-menu-item "Show Callers  (control-meta-c)" 
82                      #k"control-meta-c")
83    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
84    (create-menu-item "Macroexpand-1 Expression  (control-m)"
85                      #k"control-m")
86    (create-menu-item "Macroexpand Expression  (control-x, control-m)" 
87                      #k"control-x control-m")
88    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
89    (create-menu-item "Editor Evaluate Defun  (control-x, control-e)" 
90                      #k"control-x control-e")
91    (create-menu-item "Editor Compile Defun  (control-x, control-c)" 
92                      #k"control-x control-c")
93    (create-menu-item "Editor Evaluate Region  (Enter)"
94                      #k"enter")
95    #|
96    (create-menu-item "Editor Compile Region  (unbound)"
97                      #k"enter")
98    (create-menu-item "Editor Evaluate Buffer  (unbound)"
99                      #k"enter")
100    (create-menu-item "Editor Compile Buffer File  (unbound)"
101                      #k"enter")
102    |#
103    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
104    (create-menu-item "Incremental Search  (control-s)"
105                      #k"control-s")
106    (create-menu-item "I-Search Repeat Forward  (control-s)"
107                      #k"control-s")
108    (create-menu-item "I-Search Repeat Backward  (control-r)"
109                      #k"control-r")
110    (create-menu-item "I-Search Abort  (control-g)"
111                      #k"control-g")
112    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
113    (create-menu-item "Kill Line  (control-k)"
114                      #k"control-k")
115    (create-menu-item "Un-Kill  (control-y)"
116                      #k"control-y")
117    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
118    (create-menu-item "Forward Character  (control-f)"
119                      #k"control-f")
120    (create-menu-item "Backward Character  (control-b)"
121                      #k"control-b")
122    (create-menu-item "Beginning of Line  (control-a)"
123                      #k"control-a")
124    (create-menu-item "End of Line  (control-e)"
125                      #k"control-e")
126    (create-menu-item "Previous Line  (control-p)"
127                      #k"control-p")
128    (create-menu-item "Next Line  (control-n)"
129                      #k"control-n")
130    (create-menu-item "Beginning of Buffer  (meta-<)"
131                      #k"meta-\<")
132    (create-menu-item "End of Buffer  (meta->)"
133                      #k"meta-\>")
134    (create-menu-item "Scroll Window Down  (control-v)"
135                      #k"control-v")
136    (create-menu-item "Scroll Window Up  (meta-v)"
137                      #k"meta-v")))
138
139(objc:defmethod (#/update :void) ((self hemlock-commands-menu))
140  (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self))
141  (call-next-method))
142
143(setq *hemlock-commands-menu* (make-instance 'hemlock-commands-menu))
144
145(defun get-hemlock-commands-menu (view event)
146  "Return the appropriate Hemlock Commands menu based on modifier keys."
147  (cond ((logtest #$NSCommandKeyMask (#/modifierFlags event))
148         (setf (text-view *hemlock-commands-menu*) view)           
149         *hemlock-commands-menu*)
150        (t
151         *hemlock-commands-keyword-menu*)))
152
153(cmenu:register-tool "Hemlock-Commands-CM" #'get-hemlock-commands-menu)
154
155
Note: See TracBrowser for help on using the repository browser.