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

Last change on this file since 13162 was 13162, checked in by rme, 10 years ago

Update from http://clozure.com/pipermail/openmcl-devel/2009-October/010665.html

File size: 5.1 KB
Line 
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;;;
6;;; LLGPL Copyright (c) Peter Paine 20080611
7;;; Maintainer: gmail: p2.edoc
8;;; To use: add (require :workpersistence) to your home:ccl-init.lisp file,
9;;          or (load ~this-file~)
10;;; Updates
11;;; 20091018: restore original window order
12;;;           option to save independently per platform and CLZ-version
13;;; 20090906: fix not saving closed windows, fix resizing in gui thread, save in home dir.
14;;; 20090928: re-select Listener
15;;; ToDo:
16;;;   - how to read window from buffer (without external search via path)?
17;;;   - if on quit, an unsaved buffers prompt, remember-hemlock-files not called (or doesn't save)
18;;;   - multiple choice menu of buffers to save
19;;;   - add auto backup process: auto save modified files as file name variant, check/restore on restart
20
21#-(and clozure-common-lisp hemlock) (error "Workpersistence only runs under CLZ ~
22                                           Hemlock Nextstep/Cocoa API")
23
24;; Allows separation of working file sets for different platform versions.
25(defvar *separate-ccl-working-file-sets-by-platform-p* T)
26
27;; Independently save working file sets by major/minor version of CLZ.
28(defvar *separate-ccl-working-file-sets-by-ccl-version-p* nil)
29
30(defun work-persistence-file (&optional version)
31  (setq version (if version (format nil "-~A" version) ""))
32  (let ((ccl-version
33         (if *separate-ccl-working-file-sets-by-ccl-version-p*
34           (format nil "-~D-~D" ccl::*openmcl-major-version* ccl::*openmcl-minor-version*)
35           "")))
36  (if *separate-ccl-working-file-sets-by-platform-p*
37    (format nil "home:.ccl-workpersistence-~A~A~A.text" (ccl::platform-description) ccl-version version)
38    (format nil "home:.ccl-workpersistence~A~A.text" ccl-version version))))
39
40(defvar *work-persistence-file* (work-persistence-file) "per user")
41;; (ed *work-persistence-file*)
42
43(defun copy-work-persistence ()
44  (when (probe-file *work-persistence-file*)
45    (copy-file *work-persistence-file* (work-persistence-file "copy") :if-exists :overwrite)))
46;; (ed (work-persistence-file "copy"))
47
48(defun remember-hemlock-files ()
49  (with-open-file (*standard-output*
50                   *work-persistence-file*
51                   :direction :output :if-exists :supersede)
52    (loop for buffer in (hi::all-buffers)
53      do (let* ((path (hi:buffer-pathname buffer)))
54           (when path 
55             (let ((frame (slot-value (find-file-buffer-window path) 'ns:_frame)))
56               (loop initially (format T "~&(")
57                 for fn in '(ns:ns-rect-x ns:ns-rect-y ns:ns-rect-width ns:ns-rect-height)
58                 do (format T "~5D " (floor (funcall fn frame)))
59                 finally (format T "~S)" path))))))))
60
61(defun find-file-buffer-window (path)
62   (loop with win-arr = (#/orderedWindows ccl::*NSApp*)
63     for i below (#/count win-arr)
64     for win = (#/objectAtIndex: win-arr i)
65     when (and (typep win '(and gui::hemlock-frame
66                                (not gui::hemlock-listener-frame)))
67               (equalp path (hi:buffer-pathname (hi:hemlock-view-buffer
68                                                 (gui::hemlock-view win)))))
69     return win))
70
71(defun find-listener () ; there must be a standard way to do this
72  ;; only saves first listener found
73  (loop with win-arr = (#/orderedWindows ccl::*NSApp*)
74    for i below (#/count win-arr)
75    for win = (#/objectAtIndex: win-arr i)
76    when (typep win 'gui::hemlock-listener-frame)
77    return win))
78
79(defun select-listener ()
80  (process-wait "Wait for Listener" 'find-listener)
81  (let ((listener (find-listener)))
82    (#/performSelectorOnMainThread:withObject:waitUntilDone:
83     listener (objc:@selector "makeKeyAndOrderFront:") nil nil)))
84
85(defun open-remembered-hemlock-files ()
86  (let (old-file-specs)
87    (with-open-file (buffer-persistence-stream
88                     *work-persistence-file*
89                     :direction :input :if-does-not-exist nil)
90      (when buffer-persistence-stream ;; reverse order
91        (loop for item = (read buffer-persistence-stream nil)
92                while item do (push item old-file-specs))))
93    (gui::execute-in-gui 
94     #'(lambda () 
95         (dolist (old-file-spec old-file-specs)
96           (destructuring-bind (posx posy width height path) old-file-spec
97             (when (probe-file path)
98               (gui::find-or-make-hemlock-view path)
99               (let ((window (find-file-buffer-window path))) ; round about way*
100                 ;;* how to get from hemlock-view
101                 (when window
102                   ;; should check whether coords are still in screen bounds
103                   ;; (could have changed screen realestate since)
104                   (let ((rect (ns:make-ns-rect posx posy width height)))
105                     (#/setFrame:display: window rect t)))))))
106         (select-listener)))))
107   
108         
109(pushnew 'remember-hemlock-files *lisp-cleanup-functions*)
110(pushnew 'open-remembered-hemlock-files *lisp-startup-functions*)
111
112;; (remember-hemlock-files)
113(open-remembered-hemlock-files)
Note: See TracBrowser for help on using the repository browser.