Changeset 14247

Timestamp:

Sep 10, 2010, 1:41:33 PM (14 years ago)

Author:

R. Matthew Emerson

Message:

Add some contextual menu commands to Hemlock editor views.

There are two commands at the moment:

• If the selection designates a file name (as determined by the the function gui::pathname-for-namestring-fragment), then the menu will contain an item that will open the said file.
• If the selection looks like a symbol, there will be a menu item that will inspect the symbol.

This could be elaborated substantially, but it's a stake in the
ground, so to speak.

File:

• trunk/source/cocoa-ide/cocoa-editor.lisp (modified) (2 diffs)

trunk/source/cocoa-ide/cocoa-editor.lisp

@@ -1799 +1799 @@
   (text-view-context-menu))
 
+(defun pathname-for-namestring-fragment (string)
+  "Return a pathname that STRING might designate."
+  ;; We could get fancy here, but for now just be stupid.
+  (let ((pathname (ignore-errors (probe-file string))))
+    (if (and (pathnamep pathname)
+             (not (directory-pathname-p pathname)))
+      pathname)))
+
+;;; If we get here, we've already checked that the selection represents
+;;; a valid pathname.
+(objc:defmethod (#/openSelection: :void) ((self hemlock-text-view) sender)
+  (declare (ignore sender))
+  (let* ((text (#/string self))
+         (selection (#/substringWithRange: text (#/selectedRange self)))
+         (pathname (pathname-for-namestring-fragment
+                    (lisp-string-from-nsstring selection))))
+    (ed pathname)))
+
+;;; If we get here, we've already checked that the selection represents
+;;; a valid symbol name.
+(objc:defmethod (#/inspectSelection: :void) ((self hemlock-text-view) sender)
+  (declare (ignore sender))
+  (let* ((text (#/string self))
+         (selection (#/substringWithRange: text (#/selectedRange self)))
+         (symbol-name (string-upcase (lisp-string-from-nsstring selection))))
+    (inspect (find-symbol symbol-name))))
+
 ;;; If we don't override this, NSTextView will start adding Google/
 ;;; Spotlight search options and dictionary lookup when a selection
@@ -1804 +1831 @@
 (objc:defmethod #/menuForEvent: ((self hemlock-text-view) event)
   (declare (ignore event))
-  (#/menu self))
+  (let* ((text (#/string self))
+         (selection (#/substringWithRange: text (#/selectedRange self)))
+         (s (lisp-string-from-nsstring selection))
+         (menu (if (> (length s) 0)
+                 (#/copy (#/menu self))
+                 (#/retain (#/menu self)))))
+    (when (find-symbol (string-upcase s))
+      (let* ((title (#/stringByAppendingString: #@"Inspect " selection))
+             (item (make-instance 'ns:ns-menu-item :with-title title
+                     :action (@selector #/inspectSelection:)
+                     :key-equivalent #@"")))
+        (#/setTarget: item self)
+        (#/insertItem:atIndex: menu item 0)
+        (#/release item)))
+    (when (pathname-for-namestring-fragment s)
+      (let* ((title (#/stringByAppendingString: #@"Open " selection))
+             (item (make-instance 'ns:ns-menu-item :with-title title
+                     :action (@selector #/openSelection:)
+                     :key-equivalent #@"")))
+        (#/setTarget: item self)
+        (#/insertItem:atIndex: menu item 0)
+        (#/release item)))
+
+    (#/autorelease menu)))
 
 (defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color style)