[Openmcl-cvs-notifications] r12735 - in /trunk/source/contrib/foy: cl-documentation-cm/ context-menu-cm/ hemlock-commands-cm/ list-definitions-cm/
gfoy at clozure.com
gfoy at clozure.com
Wed Sep 2 09:51:36 EDT 2009
Author: gfoy
Date: Wed Sep 2 09:51:35 2009
New Revision: 12735
Log:
Changed the appearance of the Default Tool submenu and added an alphabetica=
l index to CL-Documentation-CM
Added:
trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-2.lisp
Modified:
trunk/source/contrib/foy/cl-documentation-cm/ReadMe.rtf
trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-cm.lisp
trunk/source/contrib/foy/cl-documentation-cm/cl-documentation.lisp
trunk/source/contrib/foy/context-menu-cm/NewTools.rtf
trunk/source/contrib/foy/context-menu-cm/ReadMe.rtf
trunk/source/contrib/foy/context-menu-cm/context-menu-cm.lisp
trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-1.lisp
trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-2.lisp
trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-new.lisp
trunk/source/contrib/foy/hemlock-commands-cm/hemlock-documentation-dial=
og.lisp
trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp
trunk/source/contrib/foy/list-definitions-cm/list-definitions.lisp
Modified: trunk/source/contrib/foy/cl-documentation-cm/ReadMe.rtf
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/cl-documentation-cm/ReadMe.rtf (original)
+++ trunk/source/contrib/foy/cl-documentation-cm/ReadMe.rtf Wed Sep 2 09:5=
1:35 2009
@@ -14,13 +14,14 @@
=
\b Features
\b0 :\
-CL-Documentation-CM adds a contextual popup menu to Hemlock. It is a ridi=
culously simple tool, but surprisingly useful. All it does is partition :C=
L functions into functional groups. There is, for example, a "cons" submen=
u which lists all the :CL list manipulation functions. Selecting one of th=
e functions opens a documentation dialog with a HyperSpec button. \
+CL-Documentation-CM adds a contextual popup menu to Hemlock. It is a ridi=
culously simple tool, but surprisingly useful. There are two menus. The f=
irst sorts :CL functions into functional groups. The second is an alphabet=
ical index. Selecting a function opens a documentation dialog with a Hype=
rSpec button. \
\cf2 Right-Click\cf0 --> produces the listing of functional groups.\
+ \cf2 Command-Right-Click \cf0 --> produces an alphabetical index of :C=
L functions.\
\
\pard\pardeftab720\ql\qnatural
=
\b \cf0 HyperSpec
-\b0 \cf2 : \cf0 Cl-Documentation requires the HyperSpec. See the Context-=
Menus/ReadMe.\
+\b0 \cf2 : \cf0 Cl-Documentation requires the HyperSpec. See the Context-=
Menus-CM/ReadMe.\
\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200=
\tx7920\tx8640\ql\qnatural\pardirnatural
\cf0 \
\
Added: trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-2.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-2.lisp (a=
dded)
+++ trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-2.lisp We=
d Sep 2 09:51:35 2009
@@ -1,0 +1,105 @@
+;;;-*-Mode: LISP; Package: HEMLOCK-COMMANDS -*-
+
+;;; ----------------------------------------------------------------------=
------
+;;;
+;;; cl-documentation-2.lisp
+;;;
+;;; copyright (c) 2009 Glen Foy
+;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
+;;;
+;;; This code adds an alphabetical index of :CL commands to the Conte=
xt-Menu =
+;;; mechanism. Command-Right-Click displays a list of letter submenu=
s.
+;;; Popping the submenu displays entries for all Hemlock Commands sta=
rting with
+;;; that letter. Selecting an entry opens a documentation dialog.
+;;;
+;;; This software is offered "as is", without warranty of any kind.
+;;;
+;;; Mod History, most recent first:
+;;; 9/2/9 version 0.1b1
+;;; First cut.
+;;;
+;;; ----------------------------------------------------------------------=
------
+
+(in-package "CL-DOCUMENTATION") =
+
+
+;;; ----------------------------------------------------------------------=
------
+;;;
+(defclass CL-ALPHABETICAL-MENU-ITEM (ns:ns-menu-item)
+ ((symbol :initarg :symbol :accessor item-symbol))
+ (:documentation "Support for the CL alphabetical menu.")
+ (:metaclass ns:+ns-object))
+
+(defun populate-submenu (menu symbol-list)
+ "Make menu-items for all symbols in SYMBOL-LIST, and add them to MENU"
+ (dolist (symbol (reverse symbol-list))
+ (let* ((menu-item (make-instance 'cl-alphabetical-menu-item :symbol sy=
mbol))
+ (attributed-string (#/initWithString:attributes:
+ (#/alloc ns:ns-attributed-string) =
+ (ccl::%make-nsstring (string-downcase (stri=
ng symbol)))
+ cmenu:*hemlock-menu-dictionary*)))
+; (setf (item-symbol menu-item) symbol)
+ (#/setAttributedTitle: menu-item attributed-string)
+ (#/setAction: menu-item (ccl::@selector "clAlphabeticalDocAction:"))
+ (#/setTarget: menu-item *cl-alphabetical-menu*)
+ (#/addItem: menu menu-item))))
+
+(defun make-submenu-item (title symbol-list)
+ "Create a menu-item with a submenu, and populate the submenu with the sy=
mbols in SYMBOL-LIST."
+ (let ((menu-item (make-instance ns:ns-menu-item))
+ (attributed-string (#/initWithString:attributes:
+ (#/alloc ns:ns-attributed-string) =
+ (ccl::%make-nsstring title)
+ cmenu:*hemlock-menu-dictionary*))
+ (submenu (make-instance ns:ns-menu)))
+ (#/setAttributedTitle: menu-item attributed-string)
+ (#/setSubmenu: menu-item submenu)
+ (populate-submenu submenu symbol-list)
+ menu-item))
+
+(defparameter *ABCs* "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+
+;;; ----------------------------------------------------------------------=
------
+;;;
+(defclass CL-ALPHABETICAL-MENU (ns:ns-menu)
+ ((tool-menu :initform nil :accessor tool-menu)
+ (text-view :initform nil :accessor text-view)
+ (sub-title :initform "alphabetical" :reader sub-title))
+ (:documentation "A popup menu with alphabetically ordered letter submenu=
s.")
+ (:metaclass ns:+ns-object))
+
+(objc:defmethod (#/clAlphabeticalDocAction: :void) ((m cl-alphabetical-men=
u) (sender :id))
+ (display-cl-doc (item-symbol sender) (text-view m)))
+
+(defmethod initialize-instance :after ((menu cl-alphabetical-menu) &key)
+ (setf (tool-menu menu) (cmenu:add-default-tool-menu menu)))
+
+(defmethod add-submenus ((menu cl-alphabetical-menu))
+ (let* ((letter-array-length (length *ABCs*))
+ (letter-array (make-array letter-array-length :initial-element ni=
l))
+ miscellaneous first-letter index)
+ (dolist (sym (apply #'append *cl-symbol-lists*))
+ (setq first-letter (elt (string sym) 0))
+ (setq index (position first-letter *ABCs* :test #'char-equal))
+ (if index
+ (push sym (aref letter-array index))
+ (push sym miscellaneous)))
+ (dotimes (idx letter-array-length)
+ (let ((submenu-item (make-submenu-item (elt *ABCs* idx) (coerce (are=
f letter-array idx) 'list))))
+ (#/addItem: menu submenu-item)))
+ (when miscellaneous
+ (#/addItem: menu (#/separatorItem ns:ns-menu-item)) =
+ (let ((submenu-item (make-submenu-item "Other:" miscellaneous)))
+ (#/addItem: menu submenu-item)))))
+
+(objc:defmethod (#/update :void) ((self cl-alphabetical-menu))
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))
+ (call-next-method))
+
+(setq *cl-alphabetical-menu* (make-instance 'cl-alphabetical-menu))
+
+(add-submenus *cl-alphabetical-menu*)
+
+
+
+
Modified: trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-cm.=
lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-cm.lisp (=
original)
+++ trunk/source/contrib/foy/cl-documentation-cm/cl-documentation-cm.lisp W=
ed Sep 2 09:51:35 2009
@@ -11,7 +11,8 @@
*load-pathname*
*loading-file-source-=
file*)))
(defParameter *cl-documentation-files* =
- (list (merge-pathnames ";cl-documentation.lisp" *cl-documentation-dire=
ctory*))))
+ (list (merge-pathnames ";cl-documentation.lisp" *cl-documentation-dire=
ctory*)
+ (merge-pathnames ";cl-documentation-2.lisp" *cl-documentation-di=
rectory*))))
=
(dolist (file *cl-documentation-files*)
(load file))
Modified: trunk/source/contrib/foy/cl-documentation-cm/cl-documentation.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/cl-documentation-cm/cl-documentation.lisp (ori=
ginal)
+++ trunk/source/contrib/foy/cl-documentation-cm/cl-documentation.lisp Wed =
Sep 2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; cl-documentation.lisp
;;;
-;;; copyright =C2=A9 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code is moronically simple, but surprisingly useful.
@@ -16,6 +16,7 @@
;;; This software is offered "as is", without warranty of any kind.
;;;
;;; Mod History, most recent first:
+;;; 9/2/9 Added a second menu, providing an alphabetical index.
;;; 8/31/9 version 0.1b1
;;; First cut.
;;;
@@ -28,12 +29,14 @@
(cmenu:check-hyperspec-availability "CL-Documentation-CM")
=
(defparameter *cl-documentation-menu* nil "The cl-documentation-menu insta=
nce.")
+(defparameter *cl-alphabetical-menu* nil "The cl-alphabetical-menu instanc=
e.")
=
=
;;; ----------------------------------------------------------------------=
------
;;;
(defClass CL-DOCUMENTATION-MENU (ns:ns-menu) =
((tool-menu :initform nil :accessor tool-menu)
+ (sub-title :initform "functional groups" :reader sub-title)
(doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*cl-documen=
tation-directory*) :reader doc-path)
(text-view :initform nil :accessor text-view))
(:documentation "A menu containing CL functions sorted into functional g=
roups.")
@@ -43,7 +46,7 @@
(display-cl-doc (item-symbol sender) (text-view m)))
=
(objc:defmethod (#/update :void) ((m cl-documentation-menu))
- (cmenu:update-tool-menu m (tool-menu m))
+ (cmenu:update-tool-menu m (tool-menu m) :sub-title (sub-title m))
(call-next-method))
=
(defmethod initialize-instance :after ((m cl-documentation-menu) &key)
@@ -459,8 +462,11 @@
(add-cl-documentation-submenus *cl-documentation-menu*)
=
(defun get-cl-documentation-menu (view event) =
- (declare (ignore event))
- (setf (text-view *cl-documentation-menu*) view)
- *cl-documentation-menu*)
+ (cond ((logtest #$NSCommandKeyMask (#/modifierFlags event))
+ (setf (text-view *cl-alphabetical-menu*) view) =
+ *cl-alphabetical-menu*)
+ (t
+ (setf (text-view *cl-documentation-menu*) view) =
+ *cl-documentation-menu*)))
=
(cmenu:register-tool "CL-Documentation-CM" #'get-cl-documentation-menu)
Modified: trunk/source/contrib/foy/context-menu-cm/NewTools.rtf
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/context-menu-cm/NewTools.rtf (original)
+++ trunk/source/contrib/foy/context-menu-cm/NewTools.rtf Wed Sep 2 09:51:=
35 2009
@@ -90,12 +90,15 @@
\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200=
\tx7920\tx8640\ql\qnatural\pardirnatural
=
\f1\fs20 \cf2 (objc:defmethod (#/update :void) ((self list-definitions-men=
u))\
- (cmenu:update-tool-menu self (tool-menu self))\
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))\
(call-next-method))\
+\
\
\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200=
\tx7920\tx8640\ql\qnatural\pardirnatural
=
-\f0\fs26 \cf0 This will update the =
+\f0\fs26 \cf0 (sub-title self) is optional. If your tool has multiple men=
us selected with modifier keys, you can insert a descriptive sub-title as s=
hown. See list-definitions.lisp\
+\
+The update method will update the =
\b Default
\b0 =
\b Tool
Modified: trunk/source/contrib/foy/context-menu-cm/ReadMe.rtf
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/context-menu-cm/ReadMe.rtf (original)
+++ trunk/source/contrib/foy/context-menu-cm/ReadMe.rtf Wed Sep 2 09:51:35=
2009
@@ -71,7 +71,7 @@
\cf0 Then (but only as a last resort) read the documentation for each tool=
.\
\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200=
\tx7920\tx8640\ql\qnatural\pardirnatural
\cf0 \
-Context-Menu and the other tools are also available at: www.clairvaux.or=
g/downloads/\
+Context-Menu-CM and the other tools are also available at: www.clairvaux=
.org/downloads/\
But updating the contribs directory and then requiring what you need works=
nicely.\
\
\
Modified: trunk/source/contrib/foy/context-menu-cm/context-menu-cm.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/context-menu-cm/context-menu-cm.lisp (original)
+++ trunk/source/contrib/foy/context-menu-cm/context-menu-cm.lisp Wed Sep =
2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; context-menu-cm.lisp
;;;
-;;; copyright =C2=A9 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code provides a mechanism for switching the tool that has ac=
cess to =
@@ -16,6 +16,7 @@
;;; This software is offered "as is", without warranty of any kind.
;;;
;;; Mod History, most recent first:
+;;; 9/2/9 Changed the appearance of the Default Tool submenu.
;;; 8/31/9 version 0.1b1
;;; First cut
;;; Numerous User Interface suggestions, Rainer Joswig
@@ -145,19 +146,15 @@
(defun add-default-tool-menu (menu &key doc-file)
"Add the default tool submenu and possibly a documentation menu-item to =
MENU."
(let ((default-item (make-instance ns:ns-menu-item))
- (attributed-string (#/initWithString:attributes:
- (#/alloc ns:ns-attributed-string) =
- (ccl::%make-nsstring (format nil "TOOL: ~S" (d=
efault-tool *menu-manager*)))
- *tool-label-dictionary*))
(tool-menu (make-instance 'default-tool-menu)))
- (#/setAttributedTitle: default-item attributed-string)
+ ;; Title is set by update method.
(#/setSubmenu: default-item tool-menu)
(#/insertItem:atIndex: menu default-item 0)
(cond (doc-file
(let ((doc-item (make-instance 'default-tool-doc-menu-item))
(attributed-string (#/initWithString:attributes:
(#/alloc ns:ns-attributed-string) =
- (ccl::%make-nsstring (format nil "doc=
..." (default-tool *menu-manager*)))
+ (ccl::%make-nsstring (format nil " =
doc..." (default-tool *menu-manager*)))
*tool-doc-dictionary*)))
(#/setAttributedTitle: doc-item attributed-string)
(#/setAction: doc-item (ccl::@selector "hemlockDefaultToolDoc=
Action:"))
@@ -169,12 +166,15 @@
(#/insertItem:atIndex: menu (#/separatorItem ns:ns-menu-item) 1=
)))
tool-menu))
=
-(defun update-tool-menu (menu default-menu)
+(defun update-tool-menu (menu default-menu &key sub-title)
"Update MENU's Tool submenu."
(let ((first-item (#/itemAtIndex: menu 0))
(attributed-string (#/initWithString:attributes:
(#/alloc ns:ns-attributed-string) =
- (ccl::%make-nsstring (format nil "TOOL: ~S" (d=
efault-tool *menu-manager*)))
+ (if sub-title
+ (ccl::%make-nsstring (format nil "~S
+ (~A)" (default-tool *menu-manager*) sub-title))
+ (ccl::%make-nsstring (format nil "~S" (defau=
lt-tool *menu-manager*))))
*tool-label-dictionary*)))
(#/setAttributedTitle: first-item attributed-string)
(populate-menu default-menu)))
Modified: trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-1.l=
isp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-1.lisp (o=
riginal)
+++ trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-1.lisp We=
d Sep 2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; hemlock-commands-1.lisp
;;;
-;;; copyright =C2=A9 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code adds a Hemlock Commands documentation tool to the Conte=
xt-Menu =
@@ -40,6 +40,7 @@
;;;
(defclass HEMLOCK-COMMANDS-MENU (ns:ns-menu)
((tool-menu :initform nil :accessor tool-menu)
+ (sub-title :initform "basic commands" :reader sub-title)
(doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*hemlock-co=
mmands-directory*) :reader doc-path)
(text-view :initform nil :accessor text-view))
(:documentation "A popup menu listing a useful subset of Hemlock command=
s: Hemlock's Greatest Hits, for new users.")
@@ -138,7 +139,7 @@
#k"meta-v")))
=
(objc:defmethod (#/update :void) ((self hemlock-commands-menu))
- (cmenu:update-tool-menu self (tool-menu self))
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))
(call-next-method))
=
(setq *hemlock-commands-menu* (make-instance 'hemlock-commands-menu))
Modified: trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-2.l=
isp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-2.lisp (o=
riginal)
+++ trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-2.lisp We=
d Sep 2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; hemlock-commands-2.lisp
;;;
-;;; copyright =C2=A9 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code adds a Hemlock Commands documentation tool to the Conte=
xt-Menu =
@@ -104,6 +104,7 @@
;;;
(defclass HEMLOCK-COMMANDS-KEYWORD-MENU (ns:ns-menu)
((tool-menu :initform nil :accessor tool-menu)
+ (sub-title :initform "keyword filters" :reader sub-title)
(doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*hemlock-co=
mmands-directory*) :reader doc-path))
(:documentation "A popup menu with keyword submenus for filtering Hemloc=
k commands.")
(:metaclass ns:+ns-object))
@@ -141,7 +142,7 @@
=
=
(objc:defmethod (#/update :void) ((self hemlock-commands-keyword-menu))
- (cmenu:update-tool-menu self (tool-menu self))
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))
(call-next-method))
=
=
Modified: trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-new=
.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-new.lisp =
(original)
+++ trunk/source/contrib/foy/hemlock-commands-cm/hemlock-commands-new.lisp =
Wed Sep 2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; hemlock-commands-new.lisp
;;;
-;;; copyright =C3=AF=C2=BF=C2=BD 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code implements a two new Hemlock commands.
@@ -128,7 +128,7 @@
(hemlock-view (hi::current-view))
(pane (when hemlock-view (hi::hemlock-view-pane hemlock-view)))
(text-view (when pane (gui::text-pane-text-view pane))))
- (cond (sym
+ (cond ((and sym text-view)
(cond ((eq (symbol-package sym) (find-package :common-lisp))
(or (display-ccl-doc sym text-view)
(display-mcl-doc sym text-view)
Modified: trunk/source/contrib/foy/hemlock-commands-cm/hemlock-documentatio=
n-dialog.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/hemlock-commands-cm/hemlock-documentation-dial=
og.lisp (original)
+++ trunk/source/contrib/foy/hemlock-commands-cm/hemlock-documentation-dial=
og.lisp Wed Sep 2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; hemlock-documentation-dialog.lisp
;;;
-;;; copyright =C2=A9 2009 Glen Foy
+;;; copyright =C3=82=C2=A9 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; A documentation dialog for Hemlock commands, CL function, symbols=
, etc.
@@ -265,13 +265,13 @@
(make-button #@"Okay" (if *graphic-p* 520 370) 10 80 32
(ccl::@selector "closeAction:")))
(setf (source-button dialog)
- (make-button #@"Source=C3=89" (if *graphic-p* 420 270) 10 90 32
+ (make-button #@"Source=C3=83=C2=89" (if *graphic-p* 420 270) 10=
90 32
(ccl::@selector "commandSourceAction:")))
(setf (inspect-button dialog)
- (make-button #@"Inspect=C3=89" (if *graphic-p* 320 170) 10 90 32
+ (make-button #@"Inspect=C3=83=C2=89" (if *graphic-p* 320 170) 1=
0 90 32
(ccl::@selector "inspectSymbolAction:")))
(setf (hyperspec-button dialog)
- (make-button #@"HyperSpec=C3=89" (if *graphic-p* 180 30) 10 130=
32
+ (make-button #@"HyperSpec=C3=83=C2=89" (if *graphic-p* 180 30) =
10 130 32
(ccl::@selector "hyperSpecAction:"))))))
=
=
Modified: trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp (origin=
al)
+++ trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp Wed Sep=
2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; history-lists.lisp
;;;
-;;; copyright =C3=AF=C2=BF=C2=BD 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code supports file and position history lists.
@@ -269,7 +269,8 @@
;;; ----------------------------------------------------------------------=
------
;;;
(defclass POSITIONS-MENU (ns:ns-menu)
- ((tool-menu :initform nil :accessor tool-menu))
+ ((tool-menu :initform nil :accessor tool-menu)
+ (sub-title :initform "position history" :reader sub-title))
(:documentation "A popup menu of most-recently-visited definition positi=
ons.")
(:metaclass ns:+ns-object))
=
@@ -288,7 +289,7 @@
(clear-position-history-list))
=
(objc:defmethod (#/update :void) ((self positions-menu))
- (cmenu:update-tool-menu self (tool-menu self))
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))
(call-next-method))
=
(defun positions-context-menu ()
@@ -353,7 +354,8 @@
;;; ----------------------------------------------------------------------=
------
;;;
(defclass FILE-MENU (ns:ns-menu)
- ((tool-menu :initform nil :accessor tool-menu))
+ ((tool-menu :initform nil :accessor tool-menu)
+ (sub-title :initform "file history" :reader sub-title))
(:documentation "A popup menu of most-recently-visited files.")
(:metaclass ns:+ns-object))
=
@@ -368,7 +370,7 @@
(move-entry-to-front *file-history-list* (file-path sender)))=
))))
=
(objc:defmethod (#/update :void) ((self file-menu))
- (cmenu:update-tool-menu self (tool-menu self))
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))
(call-next-method))
=
(objc:defmethod (#/clearFileHistoryAction: :void) ((m file-menu) (sender :=
id))
Modified: trunk/source/contrib/foy/list-definitions-cm/list-definitions.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/list-definitions-cm/list-definitions.lisp (ori=
ginal)
+++ trunk/source/contrib/foy/list-definitions-cm/list-definitions.lisp Wed =
Sep 2 09:51:35 2009
@@ -4,7 +4,7 @@
;;;
;;; list-definitionsisp
;;;
-;;; copyright =C2=A9 2009 Glen Foy
+;;; copyright (c) 2009 Glen Foy
;;; (Permission is granted to Clozure Associates to distribute this f=
ile.)
;;;
;;; This code adds a dynamic contextual popup menu to Hemlock.
@@ -66,7 +66,8 @@
((text-view :initarg :menu-text-view :reader menu-text-view)
(path :initarg :menu-path :reader menu-path) ; *** history-path
(doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*list-defin=
itions-directory-string*) :reader doc-path)
- (tool-menu :initform nil :accessor tool-menu))
+ (tool-menu :initform nil :accessor tool-menu)
+ (sub-title :initform nil :initarg :sub-title :reader sub-title))
(:documentation "The definitions popup menu.")
(:metaclass ns:+ns-object))
=
@@ -74,8 +75,8 @@
(display-position (menu-text-view m) (item-mark sender))
(maybe-add-history-entry *position-history-list* (item-info sender) (men=
u-path m)))
=
-(objc:defmethod (#/update :void) ((self list-definitions-menu))
- (cmenu:update-tool-menu self (tool-menu self))
+ (objc:defmethod (#/update :void) ((self list-definitions-menu))
+ (cmenu:update-tool-menu self (tool-menu self) :sub-title (sub-title self=
))
(call-next-method))
=
(defun display-position (text-view mark)
@@ -145,6 +146,7 @@
(defun list-definitions-context-menu (text-view &optional alpha-p)
"Construct the list-definitions popup menu."
(let* ((menu (make-instance 'list-definitions-menu =
+ :sub-title (if alpha-p "alphabetical" "positional")
:menu-text-view text-view =
:menu-path (window-path (#/window text-view))))
(window (active-hemlock-window))
@@ -153,7 +155,10 @@
current-class menu-item)
(ns:with-ns-size (icon-size 16 16)
(#/setSize: class-icon icon-size))
- (setf (tool-menu menu) (cmenu:add-default-tool-menu menu :doc-file (do=
c-path menu)))
+ (setf (tool-menu menu) =
+ (if alpha-p
+ (cmenu:add-default-tool-menu menu :doc-file (doc-path menu))
+ (cmenu:add-default-tool-menu menu)))
(dolist (entry alist)
(let* ((def-info (car entry))
(def-type (first def-info))
More information about the Openmcl-cvs-notifications
mailing list