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

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

Changed the appearance of the Default Tool submenu and added an alphabetical index to CL-Documentation-CM

File size: 7.0 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;;;      8/31/9  version 0.1b1
18;;;              First cut.
19;;;
20;;; ----------------------------------------------------------------------------
21
22(defpackage "HEMLOCK-COMMANDS" (:nicknames "HCOM") (:use :cl :ccl))
23(in-package "HEMLOCK-COMMANDS")
24
25(require :context-menu-cm)
26(cmenu:check-hyperspec-availability "Hemlock-Commands-CM")
27
28(defparameter *hemlock-commands-menu* nil "The hemlock-commands-menu instance.")
29(defparameter *hemlock-commands-keyword-menu* nil "The hemlock-commands-keyword-menu instance.")
30
31;;; ----------------------------------------------------------------------------
32;;;
33(defclass HEMLOCK-COMMAND-MENU-ITEM (ns:ns-menu-item)
34  ((key-event :initform nil :accessor key-event))
35  (:documentation "Support for the hemlock-commands-menu.")
36  (:metaclass ns:+ns-object))
37
38
39;;; ----------------------------------------------------------------------------
40;;;
41(defclass HEMLOCK-COMMANDS-MENU (ns:ns-menu)
42  ((tool-menu :initform nil :accessor tool-menu)
43   (sub-title :initform "basic commands" :reader sub-title)
44   (doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*hemlock-commands-directory*) :reader doc-path)
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 :doc-file (doc-path 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    #|
80    (create-menu-item "Show Callers  (control-meta-c)"
81                      #k"control-meta-c")
82    |#
83    (create-menu-item "Goto Definition  (meta-.)"
84                      #k"meta-.")
85    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
86    (create-menu-item "Macroexpand-1 Expression  (control-m)"
87                      #k"control-m")
88    (create-menu-item "Macroexpand Expression  (control-x, control-m)" 
89                      #k"control-x control-m")
90    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
91    (create-menu-item "Editor Evaluate Defun  (control-x, control-e)" 
92                      #k"control-x control-e")
93    (create-menu-item "Editor Compile Defun  (control-x, control-c)" 
94                      #k"control-x control-c")
95    (create-menu-item "Editor Evaluate Region  (Enter)"
96                      #k"enter")
97    #|
98    (create-menu-item "Editor Compile Region  (unbound)"
99                      #k"enter")
100    (create-menu-item "Editor Evaluate Buffer  (unbound)"
101                      #k"enter")
102    (create-menu-item "Editor Compile Buffer File  (unbound)"
103                      #k"enter")
104    |#
105    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
106    (create-menu-item "Incremental Search  (control-s)"
107                      #k"control-s")
108    (create-menu-item "I-Search Repeat Forward  (control-s)"
109                      #k"control-s")
110    (create-menu-item "I-Search Repeat Backward  (control-r)"
111                      #k"control-r")
112    (create-menu-item "I-Search Abort  (control-g)"
113                      #k"control-g")
114    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
115    (create-menu-item "Kill Line  (control-k)"
116                      #k"control-k")
117    (create-menu-item "Un-Kill  (control-y)"
118                      #k"control-y")
119    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
120    (create-menu-item "Forward Character  (control-f)"
121                      #k"control-f")
122    (create-menu-item "Backward Character  (control-b)"
123                      #k"control-b")
124    (create-menu-item "Beginning of Line  (control-a)"
125                      #k"control-a")
126    (create-menu-item "End of Line  (control-e)"
127                      #k"control-e")
128    (create-menu-item "Previous Line  (control-p)"
129                      #k"control-p")
130    (create-menu-item "Next Line  (control-n)"
131                      #k"control-n")
132    (create-menu-item "Beginning of Buffer  (meta-<)"
133                      #k"meta-\<")
134    (create-menu-item "End of Buffer  (meta->)"
135                      #k"meta-\>")
136    (create-menu-item "Scroll Window Down  (control-v)"
137                      #k"control-v")
138    (create-menu-item "Scroll Window Up  (meta-v)"
139                      #k"meta-v")))
140
141(objc:defmethod (#/update :void) ((self hemlock-commands-menu))
142  (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self))
143  (call-next-method))
144
145(setq *hemlock-commands-menu* (make-instance 'hemlock-commands-menu))
146
147(defun get-hemlock-commands-menu (view event)
148  "Return the appropriate Hemlock Commands menu based on modifier keys."
149  (cond ((logtest #$NSCommandKeyMask (#/modifierFlags event))
150         (setf (text-view *hemlock-commands-menu*) view)           
151         *hemlock-commands-menu*)
152        (t
153         *hemlock-commands-keyword-menu*)))
154
155(cmenu:register-tool "Hemlock-Commands-CM" #'get-hemlock-commands-menu)
156
157
Note: See TracBrowser for help on using the repository browser.