source: trunk/source/contrib/paine/workpersistence.lisp @ 12619

Last change on this file since 12619 was 12619, checked in by gz, 10 years ago

Contrib from Peter Paine

File size: 2.8 KB
RevLine 
[12619]1(in-package :cl-user)
2
3;;; Clozure CL Hemlock editor windows persistence
4;;; ie. on restart of CCL re-open (and position) the last session's open files.
5;;; LGPL   c/o Peter Paine 20080611
6
7(defvar *work-persistence-file* "ccl:.workpersistence.text")
8;; perhaps use (user-homedir-pathname)?
9;; (ed *work-persistence-file*)
10
11(defun remember-hemlock-files ()
12   (with-open-file (*standard-output*
13                    *work-persistence-file*
14                    :direction :output :if-exists :supersede)
15     (let* ((win-arr (#/orderedWindows ccl::*NSApp*)))
16       (loop for i below (#/count win-arr)
17         for win = (#/objectAtIndex: win-arr i)
18         when (typep win '(and gui::hemlock-frame
19                               (not gui::hemlock-listener-frame)))
20         do (let* ((buffer (hi:hemlock-view-buffer
21                            (gui::hemlock-view win)))
22                   (path (hi:buffer-pathname buffer)))
23              (when path
24                (let ((frame (slot-value win 'ns:_frame)))
25                  (loop initially (format T "~&(")
26                    for fn in '(ns:ns-rect-x ns:ns-rect-y ns:ns-rect-width ns:ns-rect-height)
27                    do (format T "~5D " (floor (funcall fn frame)))
28                    finally (format T "~S)" path)))))))))
29
30(defun find-file-buffer (path)
31   (loop with win-arr = (#/orderedWindows ccl::*NSApp*)
32     for i below (#/count win-arr)
33     for win = (#/objectAtIndex: win-arr i)
34     when (and (typep win '(and gui::hemlock-frame
35                                (not gui::hemlock-listener-frame)))
36               (equalp path (hi:buffer-pathname (hi:hemlock-view-buffer
37                                                 (gui::hemlock-view win)))))
38     return win))
39
40(defun open-remembered-hemlock-files ()
41   (with-open-file (buffer-persistence-stream
42                    *work-persistence-file*
43                    :direction :input :if-does-not-exist nil)
44     (when buffer-persistence-stream
45       (loop for item = (read buffer-persistence-stream nil)
46         while item
47         do (destructuring-bind (posx posy width height path) item
48              (when (probe-file path)
49                (gui::execute-in-gui #'(lambda () (gui::find-or-make-hemlock-view path)))
50                (let ((window (find-file-buffer path))) ; round about way*
51                  ;;* how to get from hemlock-view
52                  (when window
53                    ;; should check whether coords are still in screen bounds
54                    ;; (could have changed screen realestate since)
55                    (let ((rect (ns:make-ns-rect posx posy width height)))
56                      (#/setFrame:display: window rect t))))))))))
57
58(pushnew 'remember-hemlock-files *lisp-cleanup-functions*)
59(pushnew 'open-remembered-hemlock-files *lisp-startup-functions*)
60
61;; (remember-hemlock-files)
62;; (open-remembered-hemlock-files)
Note: See TracBrowser for help on using the repository browser.