source: trunk/source/contrib/foy/context-menu-cm/context-menu-dialogs.lisp @ 12778

Last change on this file since 12778 was 12778, checked in by gfoy, 10 years ago

New file.

File size: 2.5 KB
Line 
1;;; ----------------------------------------------------------------------------
2;;;
3;;;      context-menu-dialogs.lisp
4;;;
5;;;      copyright (c) 2009 Glen Foy
6;;;      (Permission is granted to Clozure Associates to distribute this file.)
7;;;
8;;;      Utilities and dialogs for the Context-Menu tool set.
9;;;
10;;;      The API for writing new tools is described in the accompanying NewTools file.
11;;;
12;;;      This software is offered "as is", without warranty of any kind.
13;;;
14;;;      Mod History, most recent first:
15;;;      9/14/9  First cut
16;;;
17;;; ----------------------------------------------------------------------------
18
19(defpackage "CONTEXT-MENU" (:nicknames "CMENU") (:use :cl :ccl))
20(in-package "CONTEXT-MENU")
21
22(export '(notify window-with-path active-hemlock-window window-path echo-msg))
23
24(defun active-hemlock-window ()
25  "Return the active hemlock-frame."
26  (gui::first-window-satisfying-predicate 
27   #'(lambda (w)
28       (and (typep w 'gui::hemlock-frame)
29            (not (typep w 'gui::hemlock-listener-frame))
30            (#/isKeyWindow w)))))
31
32(defun window-path (w)
33  "Return the window's path."
34  (let* ((pane (slot-value w 'gui::pane))
35         (hemlock-view (when pane (gui::text-pane-hemlock-view pane)))
36         (buffer (when hemlock-view (hi::hemlock-view-buffer hemlock-view))))
37    (when buffer (hi::buffer-pathname buffer))))
38
39;;; This includes a work-around for what appears to be a bug in the hemlock-frame
40;;; #/close method.  After a #/close, the window remains on the (#/orderedWindows *NSApp*)
41;;; list, but (hi::buffer-document buffer) in NIL.  Therefore the extra tests:
42(defun window-with-path (path)
43  "If a window with PATH is open, return it."
44  (gui::first-window-satisfying-predicate 
45   #'(lambda (w)
46       (when (and (typep w 'gui::hemlock-frame)
47                  (not (typep w 'gui::hemlock-listener-frame)))
48         (let* ((pane (slot-value w 'gui::pane))
49                (text-view (gui::text-pane-text-view pane))
50                (buffer (gui::hemlock-buffer text-view))
51                (document (when buffer (hi::buffer-document buffer)))
52                (p (hi::buffer-pathname buffer)))
53           (when (and document p) (string-equal path p)))))))
54
55(defun echo-msg (string &rest args)
56  (let* ((window (cmenu:active-hemlock-window))
57         (hemlock-view (when window (gui::hemlock-view window))))
58    (when hemlock-view
59      (let ((hi::*current-view* hemlock-view))
60        (hi::message string args)))))
61
62(defun notify (message)
63  "FYI"
64  (gui::alert-window :title "Notification" :message message))
65
66
67
68
Note: See TracBrowser for help on using the repository browser.