Changeset 13162

Timestamp:

Nov 2, 2009, 6:02:06 PM (12 years ago)

Author:

rme

Message:

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

File:

• trunk/source/contrib/paine/workpersistence.lisp (modified) (2 diffs)

trunk/source/contrib/paine/workpersistence.lisp

@@ -3 +3 @@
 ;;; Clozure CL Hemlock editor windows persistence
 ;;; ie. on restart of CCL re-open (and position) the last session's open files.
-;;; LGPL   c/o Peter Paine 20080611
-;;; Update 20090906: fix not saving closed windows, fix resizing in gui thread, save in home dir.
-;;; ToDo: how to read window from buffer (without external search via path)?
-;;; To use: add (load ~this-file~) to your home:ccl-init.lisp file.
+;;;
+;;; LLGPL Copyright (c) Peter Paine 20080611 
+;;; Maintainer: gmail: p2.edoc 
+;;; To use: add (require :workpersistence) to your home:ccl-init.lisp file,
+;;          or (load ~this-file~)
+;;; Updates 
+;;; 20091018: restore original window order
+;;;           option to save independently per platform and CLZ-version
+;;; 20090906: fix not saving closed windows, fix resizing in gui thread, save in home dir.
+;;; 20090928: re-select Listener
+;;; ToDo: 
+;;;   - how to read window from buffer (without external search via path)?
+;;;   - if on quit, an unsaved buffers prompt, remember-hemlock-files not called (or doesn't save)
+;;;   - multiple choice menu of buffers to save
+;;;   - add auto backup process: auto save modified files as file name variant, check/restore on restart 
 
-;; Allows separation of working file sets for different CLZ versions.
-(defvar *separate-ccl-working-file-sets-p* T)
+#-(and clozure-common-lisp hemlock) (error "Workpersistence only runs under CLZ ~
+                                           Hemlock Nextstep/Cocoa API")
 
-(defvar *work-persistence-file*
-  (if *separate-ccl-working-file-sets-p*
-    (format nil "home:.ccl-workpersistence-~A.text" (ccl::platform-description))
-    "home:.ccl-workpersistence.text")
-  "per user")
+;; Allows separation of working file sets for different platform versions.
+(defvar *separate-ccl-working-file-sets-by-platform-p* T)
+
+;; Independently save working file sets by major/minor version of CLZ.
+(defvar *separate-ccl-working-file-sets-by-ccl-version-p* nil)
+
+(defun work-persistence-file (&optional version)
+  (setq version (if version (format nil "-~A" version) ""))
+  (let ((ccl-version
+         (if *separate-ccl-working-file-sets-by-ccl-version-p*
+           (format nil "-~D-~D" ccl::*openmcl-major-version* ccl::*openmcl-minor-version*)
+           "")))
+  (if *separate-ccl-working-file-sets-by-platform-p*
+    (format nil "home:.ccl-workpersistence-~A~A~A.text" (ccl::platform-description) ccl-version version)
+    (format nil "home:.ccl-workpersistence~A~A.text" ccl-version version))))
+
+(defvar *work-persistence-file* (work-persistence-file) "per user")
 ;; (ed *work-persistence-file*)
 
+(defun copy-work-persistence ()
+  (when (probe-file *work-persistence-file*)
+    (copy-file *work-persistence-file* (work-persistence-file "copy") :if-exists :overwrite)))
+;; (ed (work-persistence-file "copy"))
+
 (defun remember-hemlock-files ()
-    (with-open-file (*standard-output*
-                     *work-persistence-file*
-                     :direction :output :if-exists :supersede)
-      (loop for buffer in (hi::all-buffers)
-         do (let* ((path (hi:buffer-pathname buffer)))
-              (when path 
-                (let ((frame (slot-value (find-file-buffer-window path) 'ns:_frame)))
-                  (loop initially (format T "~&(")
-                    for fn in '(ns:ns-rect-x ns:ns-rect-y ns:ns-rect-width ns:ns-rect-height)
-                    do (format T "~5D " (floor (funcall fn frame)))
-                    finally (format T "~S)" path))))))))
+  (with-open-file (*standard-output*
+                   *work-persistence-file*
+                   :direction :output :if-exists :supersede)
+    (loop for buffer in (hi::all-buffers)
+      do (let* ((path (hi:buffer-pathname buffer)))
+           (when path 
+             (let ((frame (slot-value (find-file-buffer-window path) 'ns:_frame)))
+               (loop initially (format T "~&(")
+                 for fn in '(ns:ns-rect-x ns:ns-rect-y ns:ns-rect-width ns:ns-rect-height)
+                 do (format T "~5D " (floor (funcall fn frame)))
+                 finally (format T "~S)" path))))))))
 
 (defun find-file-buffer-window (path)
@@ -41 +69 @@
      return win))
 
+(defun find-listener () ; there must be a standard way to do this
+  ;; only saves first listener found
+  (loop with win-arr = (#/orderedWindows ccl::*NSApp*)
+    for i below (#/count win-arr)
+    for win = (#/objectAtIndex: win-arr i)
+    when (typep win 'gui::hemlock-listener-frame)
+    return win))
+
+(defun select-listener ()
+  (process-wait "Wait for Listener" 'find-listener)
+  (let ((listener (find-listener)))
+    (#/performSelectorOnMainThread:withObject:waitUntilDone:
+     listener (objc:@selector "makeKeyAndOrderFront:") nil nil)))
+
 (defun open-remembered-hemlock-files ()
-   (with-open-file (buffer-persistence-stream
-                    *work-persistence-file*
-                    :direction :input :if-does-not-exist nil)
-     (when buffer-persistence-stream
-       (loop for item = (read buffer-persistence-stream nil)
-         while item
-         do (destructuring-bind (posx posy width height path) item
-              (when (probe-file path)
-                (gui::execute-in-gui #'(lambda () (gui::find-or-make-hemlock-view path)))
-                (let ((window (find-file-buffer-window path))) ; round about way*
-                  ;;* how to get from hemlock-view
-                  (when window
-                    ;; should check whether coords are still in screen bounds
-                    ;; (could have changed screen realestate since)
-                    (let ((rect (ns:make-ns-rect posx posy width height)))
-                      (gui::execute-in-gui 
-                       #'(lambda () 
-                           (#/setFrame:display: window rect t))))))))))))
-
+  (let (old-file-specs)
+    (with-open-file (buffer-persistence-stream
+                     *work-persistence-file*
+                     :direction :input :if-does-not-exist nil)
+      (when buffer-persistence-stream ;; reverse order
+        (loop for item = (read buffer-persistence-stream nil)
+                while item do (push item old-file-specs))))
+    (gui::execute-in-gui 
+     #'(lambda () 
+         (dolist (old-file-spec old-file-specs)
+           (destructuring-bind (posx posy width height path) old-file-spec
+             (when (probe-file path)
+               (gui::find-or-make-hemlock-view path)
+               (let ((window (find-file-buffer-window path))) ; round about way*
+                 ;;* how to get from hemlock-view
+                 (when window
+                   ;; should check whether coords are still in screen bounds
+                   ;; (could have changed screen realestate since)
+                   (let ((rect (ns:make-ns-rect posx posy width height)))
+                     (#/setFrame:display: window rect t)))))))
+         (select-listener)))))
+    
+         
 (pushnew 'remember-hemlock-files *lisp-cleanup-functions*)
 (pushnew 'open-remembered-hemlock-files *lisp-startup-functions*)