Changeset 13162
- Timestamp:
- Nov 2, 2009, 6:02:06 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/contrib/paine/workpersistence.lisp
r12771 r13162 3 3 ;;; Clozure CL Hemlock editor windows persistence 4 4 ;;; ie. on restart of CCL re-open (and position) the last session's open files. 5 ;;; LGPL c/o Peter Paine 20080611 6 ;;; Update 20090906: fix not saving closed windows, fix resizing in gui thread, save in home dir. 7 ;;; ToDo: how to read window from buffer (without external search via path)? 8 ;;; To use: add (load ~this-file~) to your home:ccl-init.lisp file. 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 9 20 10 ;; Allows separation of working file sets for different CLZ versions. 11 (defvar *separate-ccl-working-file-sets-p* T)21 #-(and clozure-common-lisp hemlock) (error "Workpersistence only runs under CLZ ~ 22 Hemlock Nextstep/Cocoa API") 12 23 13 (defvar *work-persistence-file* 14 (if *separate-ccl-working-file-sets-p* 15 (format nil "home:.ccl-workpersistence-~A.text" (ccl::platform-description)) 16 "home:.ccl-workpersistence.text") 17 "per user") 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") 18 41 ;; (ed *work-persistence-file*) 19 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 20 48 (defun remember-hemlock-files () 21 22 23 24 25 26 27 28 29 30 31 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)))))))) 32 60 33 61 (defun find-file-buffer-window (path) … … 41 69 return win)) 42 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 43 85 (defun open-remembered-hemlock-files () 44 (with-open-file (buffer-persistence-stream 45 *work-persistence-file* 46 :direction :input :if-does-not-exist nil) 47 (when buffer-persistence-stream 48 (loop for item = (read buffer-persistence-stream nil) 49 while item 50 do (destructuring-bind (posx posy width height path) item 51 (when (probe-file path) 52 (gui::execute-in-gui #'(lambda () (gui::find-or-make-hemlock-view path))) 53 (let ((window (find-file-buffer-window path))) ; round about way* 54 ;;* how to get from hemlock-view 55 (when window 56 ;; should check whether coords are still in screen bounds 57 ;; (could have changed screen realestate since) 58 (let ((rect (ns:make-ns-rect posx posy width height))) 59 (gui::execute-in-gui 60 #'(lambda () 61 (#/setFrame:display: window rect t)))))))))))) 62 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 63 109 (pushnew 'remember-hemlock-files *lisp-cleanup-functions*) 64 110 (pushnew 'open-remembered-hemlock-files *lisp-startup-functions*)
Note: See TracChangeset
for help on using the changeset viewer.