legacy-dotfiles/emacs.d/nxhtml/util/winsav.el
Tom Willemsen 94d2fc1815 Django, org
* Added nxhtml, mostly for django support.

  * Changed some org settings.
2011-03-07 09:04:49 +01:00

1585 lines
60 KiB
EmacsLisp

;;; winsav.el --- Save and restore window structure
;;
;; Author: Lennart Borgman
;; Created: Sun Jan 14 2007
(defconst winsav:version "0.77") ;;Version: 0.77
;; Last-Updated: 2009-08-04 Tue
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;; None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; This library contains both user level commands and options and
;; functions for use in other elisp libraries.
;;
;;;; User level commands and options
;;
;; The user level commands and options are for saving frame, windows
;; and buffers between Emacs sessions. To do that you can customize
;; the options `desktop-save-mode' and `winsav-save-mode' or put this
;; at the end of your .emacs:
;;
;; (desktop-save-mode 1)
;; (winsav-save-mode 1)
;;
;; You can also save configurations that you later switch between.
;; For more information see the command `winsav-save-mode'.
;;
;; (There is also a command in this library for rotating window
;; borders in a frame, `winsav-rotate'. It is here just because the
;; needed support functions lives here.)
;;
;;
;;
;;;; Commands for other elisp libraries
;;
;; This library was orignally written to solve the problem of adding a
;; window to the left of some windows in a frame like the one below
;;
;; ___________
;; | | |
;; | 1 | 2 |
;; |____|____|
;; | |
;; | 3 |
;; |_________|
;;
;; so that the window structure on the frame becomes
;;
;; ___________
;; | | | |
;; | | 1| 2 |
;; | B|__|___|
;; | A| |
;; | R| 3 |
;; |__|______|
;;
;;
;; This problem can be solved by this library. However the solution in
;; this library is a bit more general: You first copy the window
;; structure and then restore that into another window. To do the
;; above you first copy the window structure in the first frame above
;; with `winsav-get-window-tree'. Then you create windows like this:
;;
;; ___________
;; | | |
;; | | |
;; | B| |
;; | A| |
;; | R| |
;; |__|______|
;;
;;
;; Finally you use `winsav-put-window-tree' to put the window
;; structure into the right window. (Of course you could have put BAR
;; above, under etc.)
;;
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Bugs and limitations:
;;
;; Juanma Barranquero has pointed out there is a serious limitation in
;; this way of doing it when overlays with 'window properties are
;; used. The problem is that any pointers to windows are made invalid
;; since they are deleted. So in fact any code that relies on saved
;; pointers to windows will have problem if the window is one of those
;; that are involved here.
;;
;; To overcome this problem when doing something like inserting a BAR
;; window (see above) a new window has to be inserted in the existing
;; window tree on a frame in a way that is currently not supported in
;; Emacs.
;;
;; It would be nice to be have primitives to manipulate the window
;; tree more generally from elisp. That requires implementation of
;; them at the C level of course.
;;
;; However it is probably much easier to implement it quite a bit less
;; general. The concept of splitting is maybe then the right level to
;; search for primitives at.
;;
;; My conclusion is that it will take some time to find suitable
;; primitives for this.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; Version 0.72:
;;
;; - Format of window structure changed in Emacs 23. Adopted to that.
;; - Added save and restore of frame/window configurations between
;; Emacs sessions.
;; - Added named winsav configurations for save and restore of frames,
;; windows, buffers and files.
;;
;; Version 0.71:
;;
;; - Added rotation of window structure.
;;
;; Version 0.70:
;;
;; - Support for save and restore from file.
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (require 'cl))
(eval-and-compile (require 'desktop))
;; (defun winsav-upper-left-window(&optional frame w)
;; (let* ((tree (if w w (car (window-tree frame))))
;; (is-split (not (windowp tree))))
;; (if (not is-split)
;; tree
;; (winsav-upper-left-window frame (nth 2 tree)))))
(defcustom winsav-after-get-hook nil
"Hook to run after at the end of `winsav-get-window-tree'.
The functions in this hook are called with one parameter which is
the same as the return value from the function above."
:type 'hook
:group 'winsav)
(defcustom winsav-after-put-hook nil
"Hook to run after at the end of `winsav-put-window-tree'.
The functions in this hook are called with one parameter which is
a list where each element is a list \(old-win new-win) where
OLD-WIN are the window from `winsav-get-window-tree' and NEW-WIN
is the newly created corresponding window. This list is the same
as the return value from the function above."
:type 'hook
:group 'winsav)
(defun winsav-get-window-tree(&optional frame)
"Get window structure.
This returns an object with current windows with values, buffers,
points and the selected window.
FRAME is the frame to save structure from. If nil use selected.
At the very end of this function the hook `winsav-after-get' is
run."
;;(let* ((upper-left (winsav-upper-left-window frame))
(let* ((upper-left (frame-first-window frame))
(num -1)
sel-num)
(dolist (w (window-list frame nil upper-left))
(setq num (1+ num))
(when (eq w (selected-window))
(setq sel-num num)))
(let ((ret (list sel-num
(winsav-get-window-tree-1 frame nil))))
(run-hook-with-args 'winsav-after-get-hook ret)
ret)))
;; Fix-me: add window-hscroll
(defun winsav-get-window-tree-1(frame w)
(let ((tree (if w w (car (window-tree frame)))))
(if (windowp tree)
;; Note: Desktop is used for saving buffers.
(with-current-buffer (window-buffer tree)
(list (window-buffer tree)
;; buffer
(buffer-name)
(buffer-file-name)
;;buffer-read-only
;;(if mumamo-multi-major-mode mumamo-multi-major-mode major-mode)
;;minor-modes
;;buffer locals
;;(cons (+ 0 (mark-marker)) (mark-active))
;; window
(window-point tree)
(window-edges tree)
(window-scroll-bars tree)
(window-fringes tree)
(window-margins tree)
(window-hscroll tree)
;; misc
(window-dedicated-p tree)
(when (fboundp 'window-redisplay-end-trigger)
(window-redisplay-end-trigger tree))
(window-start tree)
tree))
(let* ((dir (nth 0 tree))
(split (nth 1 tree))
(wt (cddr tree))
(wsubs (mapcar (lambda(wc)
(winsav-get-window-tree-1 nil wc))
wt)))
(append (list dir split) wsubs)))))
;;;###autoload
(defun winsav-put-window-tree (saved-tree window &optional copy-win-ovl win-ovl-all-bufs)
"Put window structure SAVED-TREE into WINDOW.
Restore a structure SAVED-TREE returned from
`winsav-get-window-tree' into window WINDOW.
If COPY-WIN-OVL is non-nil then overlays having a 'window
property pointing to one of the windows in SAVED-TREE where this
window still is shown will be copied to a new overlay with
'window property pointing to the corresponding new window.
If WIN-OVL-ALL-BUFS is non-nil then all buffers will be searched
for overlays with a 'window property of the kind above.
At the very end of this function the hook `winsav-after-put' is
run."
(let* ((sel-num (nth 0 saved-tree))
(tree (nth 1 saved-tree))
nsiz
nh
nw
osiz
oh
ow
scale-w
scale-h
first-win
winsav-put-return)
(unless (or (bufferp (car tree))
(eq 'buffer (car tree)))
(setq nsiz (window-edges window))
(setq nh (- (nth 3 nsiz) (nth 1 nsiz)))
(setq nw (- (nth 2 nsiz) (nth 0 nsiz)))
(setq osiz (cadr tree))
(setq oh (- (nth 3 osiz) (nth 1 osiz)))
(setq ow (- (nth 2 osiz) (nth 0 osiz)))
(setq scale-w (unless (= ow nw) (/ nw (float ow))))
(setq scale-h (unless (= oh nh) (/ nh (float oh)))))
(setq first-win (winsav-put-window-tree-1 tree window scale-w scale-h t 1))
(select-window first-win)
(when sel-num (other-window sel-num))
(winsav-fix-win-ovl winsav-put-return copy-win-ovl win-ovl-all-bufs)
(run-hook-with-args 'winsav-after-put-hook winsav-put-return)
winsav-put-return))
(defun winsav-put-window-tree-1 (saved-tree window scale-w scale-h first-call level)
"Helper for `winsav-put-window-tree'.
For the arguments SAVED-TREE and WINDOW see that function.
The arguments SCALE-W and SCALE-H are used to make the saved
window config fit into its new place. FIRST-CALL is a state
variable telling if this is the first round. LEVEL helps
debugging by tells how far down we are in the call chain."
(if (or (bufferp (car saved-tree))
;;(not (car saved-tree))
(eq 'buffer (car saved-tree))
)
(let ((buffer (nth 0 saved-tree))
;; buffer
(bufnam (nth 1 saved-tree))
(filnam (nth 2 saved-tree))
;;(mark (nth 3 saved-tree))
;; window
(point (nth 3 saved-tree))
(edges (nth 4 saved-tree))
(scroll (nth 5 saved-tree))
(fringe (nth 6 saved-tree))
(margs (nth 7 saved-tree))
(hscroll (nth 8 saved-tree))
(dedic (nth 9 saved-tree))
(trigger (nth 10 saved-tree))
(start (nth 11 saved-tree))
(ovlwin (nth 12 saved-tree))
scr2
(misbuf " *Winsav information: Buffer is gone*"))
(or (windowp ovlwin)
(not ovlwin)
(error "Parameter mismatch, ovlwin not window: %s" ovlwin))
(when first-call
(add-to-list 'winsav-put-return (list ovlwin window))
(when (eq 'buffer buffer)
(when filnam
(setq buffer (winsav-find-file-noselect filnam)))
(if (buffer-live-p buffer)
(or (string= bufnam (buffer-name buffer))
(eq (string-to-char bufnam) 32) ;; Avoid system buffer names
(rename-buffer bufnam))
(when (eq (string-to-char bufnam) 32)
(setq bufnam " *Winsav dummy buffer*"))
;; Fix-me, this might need some tweaking: Don't restore
;; buffers without a file name and without
;; content. (desktop-mode will make that when
;; necessary.) Just show the scratch buffer instead.
(setq buffer (get-buffer bufnam))
(unless (and buffer
(< 0 (buffer-size buffer)))
(setq buffer (get-buffer-create "*scratch*")))))
(set-window-buffer window buffer)
(set-window-dedicated-p window dedic)
;; Strange incompatibility in scroll args:
(setq scr2 (list (nth 0 scroll) (nth 2 scroll) (nth 3 scroll)))
(apply 'set-window-scroll-bars (append (list window) scr2))
(apply 'set-window-fringes (append (list window) fringe))
(set-window-margins window (car margs) (cdr margs))
(set-window-hscroll window hscroll)
(unless (>= emacs-major-version 23)
(with-no-warnings
(set-window-redisplay-end-trigger window trigger))))
(let* ((nsiz (window-edges window))
(nh (- (nth 3 nsiz) (nth 1 nsiz)))
(nw (- (nth 2 nsiz) (nth 0 nsiz)))
(osiz edges) ;(nth 2 saved-tree))
(oh (- (nth 3 osiz) (nth 1 osiz)))
(ow (- (nth 2 osiz) (nth 0 osiz)))
(diff-w (- (if scale-w
(round (* scale-w ow))
ow)
nw))
(diff-h (- (if scale-h
(round (* scale-h oh))
oh)
nh)))
;; Avoid rounding naggings:
(when (> (abs diff-h) 1)
(bw-adjust-window window diff-h nil))
(when (> (abs diff-w) 1)
(bw-adjust-window window diff-w t)))
;; Fix-me: there were some problems getting point correctly. Don't know why...
(with-selected-window window
(with-current-buffer (window-buffer window)
(goto-char point))
(set-window-point window point)
;;(unless (buffer-live-p buffer) (setq point 1) (setq start 1))
(set-window-start window start)
;; Maybe point got off screen?
(when (/= point (window-point window))
(set-window-point window point)))
window)
(let* ((ver (car saved-tree))
(wtree (list (cons window (caddr saved-tree))))
(nwin window)
pwin
pdelta
(first-win nwin))
;; First split to get it in correct order
(when first-call
(dolist (subtree (cdddr saved-tree))
(setq pwin nwin)
;;(message "nwin edges=%s, ver=%s" (window-edges nwin) ver)
(let ((split-err nil)
(window-min-height 1)
(window-min-width 1))
(setq nwin (split-window nwin nil (not ver))))
;; Make the previous window as small as permitted to allow
;; splitting as many times as possible
(setq pdelta (-
(if ver
window-min-height
window-min-width)
(if ver
(window-width pwin)
(window-height pwin))))
;;(message "pwin=%s, edges=%s, pdelta=%s, ver=%s" pwin (window-edges pwin) pdelta ver)
;; No reason to fail here:
(condition-case err
(adjust-window-trailing-edge pwin pdelta (not ver))
(error
;;(message "awt=>%s" (error-message-string err))
nil
))
;; Add to traverse
(add-to-list 'wtree
(cons nwin subtree)
t)))
;; Now traverse. Sizing is a bit tricky, multiple runs have to
;; be done (as in balance-windows).
(let (tried-sizes
last-sizes
(windows (window-list (selected-frame))))
(while (not (member last-sizes tried-sizes))
(when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
(setq last-sizes (mapcar (lambda (w)
(window-edges w))
windows))
(dolist (wsub (reverse wtree))
(select-window (car wsub))
(winsav-put-window-tree-1 (cdr wsub) (selected-window)
scale-w scale-h
first-call
(1+ level)
))
(setq first-call nil)
))
first-win)))
(defun winsav-fix-win-ovl(win-list copy-win-ovl win-ovl-all-bufs)
(let ((oldwins (mapcar (lambda(elt)
(car elt))
win-list))
ovlwin
window)
(let (buffers)
(if win-ovl-all-bufs
(setq buffers (buffer-list))
(mapc (lambda(w)
(when (window-live-p w)
(add-to-list 'buffers (window-buffer w))))
oldwins))
(dolist (buf buffers)
(with-current-buffer buf
(save-restriction
(widen)
(dolist (overlay (overlays-in (point-min) (point-max)))
(when (setq ovlwin (car (memq (overlay-get overlay 'window) oldwins)))
(setq window (cadr (assoc ovlwin win-list)))
;; If the old window is still alive then maybe copy
;; overlay, otherwise change the 'window prop. However
;; copy only if COPY-WIN-OVL is non-nil.
(if (not (and (window-live-p ovlwin)
(window-frame ovlwin)))
(overlay-put overlay 'window window)
(when copy-win-ovl
(let* ((props (overlay-properties overlay))
(start (overlay-start overlay))
(end (overlay-end overlay))
;; Fix-me: start and end marker props
(newovl (make-overlay start end)))
(while props
(let ((key (car props))
(val (cadr props)))
(setq props (cddr props))
(when (eq key 'window)
(setq val window))
(overlay-put newovl key val))))))))))))))
(defun winsav-transform-edges (edges)
"Just rotate the arguments in EDGES to make them fit next function."
(let ((le (nth 0 edges))
(te (nth 1 edges))
(re (nth 2 edges))
(be (nth 3 edges)))
(list te le be re)))
(defun winsav-transform-1 (tree mirror transpose)
"Mirroring of the window tree TREE.
MIRROR could be 'mirror-top-bottom or 'mirror-left-right which I
think explain what it does here. TRANSPOSE shifts the tree
between a horisontal and vertical tree."
(let* ((vertical (nth 0 tree))
(edges (nth 1 tree))
(subtrees (nthcdr 2 tree))
)
;;(winsav-log "tree 1" tree)
(when transpose
(cond
((eq vertical nil)
(setcar tree t))
((eq vertical t)
(setcar tree nil))
(t
(error "Uh? vertical=%S" vertical))))
(setcar (nthcdr 1 tree) (winsav-transform-edges edges))
(dolist (subtree subtrees)
(if (bufferp (car subtree))
(when transpose
(let ((edges (nth 4 subtree)))
;;(winsav-log "subtree 1" subtree)
(setcar (nthcdr 4 subtree) (winsav-transform-edges edges))
;;(winsav-log "subtree 2" subtree)
))
(winsav-transform-1 subtree mirror transpose)))
(when (case mirror
('mirror-top-bottom vertical)
('mirror-left-right (not vertical))
(nil) ;; Don't mirror
(t
(error "Uh? mirror=%s" mirror)))
(setcdr (nthcdr 1 tree) (reverse subtrees))
)
))
(defun winsav-find-file-noselect (filename)
"Read file FILENAME into a buffer and return the buffer.
Like `find-file-noselect', but if file is not find then creates a
buffer with a message about that."
(let ((buf (find-file-noselect filename)))
(unless buf
(setq buf (generate-new-buffer filename))
(with-current-buffer buf
(insert "Winsav could not find the file " filename)
(set-buffer-modified-p nil)))
buf))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Session saving and restore etc
;;;###autoload
(defgroup winsav nil
"Save frames and windows when you exit Emacs."
:group 'frames)
;;;###autoload
(define-minor-mode winsav-save-mode
"Toggle winsav configuration saving mode.
With numeric ARG, turn winsav saving on if ARG is positive, off
otherwise.
When this mode is turned on, winsav configurations are saved from
one session to another. A winsav configuration consists of
frames, windows and visible buffers configurations plus
optionally buffers and files managed by the functions used by
option `desktop-save-mode'
By default this is integrated with `desktop-save-mode'. If
`desktop-save-mode' is on and `winsav-handle-also-desktop' is
non-nil then save and restore also desktop.
See the command `winsav-switch-config' for more information and
other possibilities.
Note: If you want to avoid saving when you exit just turn off
this minor mode.
For information about what is saved and restored and how to save
and restore additional information see the function
`winsav-save-configuration'."
:global t
:group 'winsav)
(defun winsav-save-mode-on ()
"Ensable option `winsav-save-mode'. Provided for use in hooks."
(winsav-save-mode 1))
(defun winsav-save-mode-off ()
"Disable option `winsav-save-mode'. Provided for use in hooks."
(winsav-save-mode -1))
(defcustom winsav-save 'ask-if-new
"Specifies whether the winsav config should be saved when it is killed.
A winsav config \(winsav frame configuration) is killed when the
user changes winsav directory or quits Emacs.
Possible values are:
t -- always save.
ask -- always ask.
ask-if-new -- ask if no winsav file exists, otherwise just save.
ask-if-exists -- ask if winsav file exists, otherwise don't save.
if-exists -- save if winsav file exists, otherwise don't save.
nil -- never save.
The winsav config is never saved when the option `winsav-save-mode' is nil.
The variables `winsav-dirname' and `winsav-base-file-name'
determine where the winsav config is saved."
:type
'(choice
(const :tag "Always save" t)
(const :tag "Always ask" ask)
(const :tag "Ask if winsav file is new, else do save" ask-if-new)
(const :tag "Ask if winsav file exists, else don't save" ask-if-exists)
(const :tag "Save if winsav file exists, else don't" if-exists)
(const :tag "Never save" nil))
:group 'winsav)
(defcustom winsav-handle-also-desktop t
"If this is non-nil then desktop is also saved and restored.
See option `winsav-save-mode' for more information."
:type 'boolean
:group 'winsav)
(defcustom winsav-base-file-name
(convert-standard-filename ".emacs.winsav")
"Base name of file for Emacs winsav, excluding directory part.
The actual file name will have a system identifier added too."
:type 'file
:group 'winsav)
(defvar winsav-dirname nil
"The directory in which the winsav file should be saved.")
(defun winsav-current-default-dir ()
"Current winsav configuration directory."
(or winsav-dirname "~/"))
;;(find-file (winsav-full-file-name))
(defun winsav-default-file-name ()
"Default winsav save file name.
The file name consist of `winsav-base-file-name' with a system
identifier added. This will be '-nw' for a terminal and '-' +
the value of `window-system' otherwise."
(let ((sys-id (if (not window-system)
"nw"
(format "%s" window-system))))
(concat winsav-base-file-name "-" sys-id)))
(defun winsav-full-file-name (&optional dirname)
"Return the full name of the winsav session file in DIRNAME.
DIRNAME omitted or nil means use `~'.
The file name part is given by `winsav-default-file-name'."
;; Fix-me: Different frames in different files? Can multi-tty be handled??
(expand-file-name (winsav-default-file-name) (or dirname
(winsav-current-default-dir))))
(defun winsav-serialize (obj)
"Return a string with the printed representation of OBJ.
This should be possible to eval and get a similar object like OBJ
again."
;;(message "winsav-serialize a")
(prin1-to-string obj)
;;(message "winsav-serialize b")
)
(defcustom winsav-before-save-configuration-hook nil
"Hook called before saving frames.
Hook for writing elisp code at the beginning of a winsav
configuration file. When this hook is called the current buffer
and point is where the code should be written.
This is a normal hook. For more information see
`winsav-save-configuration'."
:type 'hook
:group 'winsav)
(defcustom winsav-after-save-configuration-hook nil
"Hook called after saving frames.
Hook for writing elisp code at the end of a winsav configuration
file. When this hook is called the current buffer and point is
where the code should be written.
This is a normal hook. For more information see
`winsav-save-configuration'."
:type 'hook
:group 'winsav)
(defcustom winsav-after-save-frame-hook nil
"Hook called when saving a frame after saving frame data.
Hook for writing elisp code in a winsav configuration file after
each frame creation. When this hook is called code for restoring
a frame has been written and code that sets
`winsav-last-loaded-frame' to point to it. Point is in the
configuration file buffer right after this.
This is a normal hook. For more information see
`winsav-save-configuration'."
:type 'hook
:group 'winsav)
(defvar winsav-loaded-frames nil)
(defvar winsav-last-loaded-frame nil)
(defun winsav-restore-frame (frame-params
window-tree-params
use-minibuffer-frame
window-state
window-visible)
"Restore a frame with specified values.
If this is a minibuffer only frame then just apply the frame
parameters FRAME-PARAMS. Otherwise create a new frame using
FRAME-PARAMS and set up windows and buffers according to
WINDOW-TREE-PARAMS. Also, if USE-MINIBUFFER-FRAME let the new
frame have this minibuffer frame.
WINDOW-STATE is 1 for minimized, 2 for normal and 3 for
maximized."
(let* ((default-minibuffer-frame use-minibuffer-frame)
(frame-name (cdr (assoc 'name frame-params)))
(minibuffer-val (cdr (assoc 'minibuffer frame-params)))
(minibuffer-only (eq 'only minibuffer-val))
(mini-frames
(delq nil (mapcar (lambda (frm)
(when (eq 'only (frame-parameter frm 'minibuffer))
frm))
(frame-list))))
(frame-with-that-name
(when (and frame-name minibuffer-only)
(catch 'frame
(dolist (frame (frame-list))
(when (string= frame-name (frame-parameter frame 'name))
(throw 'frame frame))))))
;; If this is a minibuffer only frame then if it is already
;; there under a correct name then do not create it because
;; there might be variables pointing to it; just set the
;; parameters. Perhaps even better: if it is not already
;; there give an error - because it might be impossible to
;; set things up correctly then.
(frame-with-that-name-has-mini
(when frame-with-that-name
(eq 'only
(frame-parameter frame-with-that-name 'minibuffer))))
(this-mini-frame (when minibuffer-only
(or frame-with-that-name
(and (= 1 (length mini-frames))
(car mini-frames)))))
(create-new
(if minibuffer-only
(if this-mini-frame ;frame-with-that-name-has-mini
nil
(error "Winsav: Can't find minibuffer only frame with name %s"
frame-name))
t))
(this-frame (if create-new
(make-frame frame-params)
this-mini-frame))
(win (frame-first-window this-frame)))
;;(message "create-new=%s, frame-with-that-name=%s" create-new frame-with-that-name)
;; (when was-max
;; (winsav-set-maximized-size this-frame)
;; ;; Wait for maximize to occur so horizontal scrolling gets ok.
;; (sit-for 1.5)
;; )
(case window-state
(1 (winsav-set-minimized-state this-frame))
(3 (winsav-set-maximized-state this-frame)))
(unless window-visible
(make-frame-invisible this-frame))
(if create-new
(winsav-put-window-tree window-tree-params win)
(modify-frame-parameters this-frame frame-params))
(setq winsav-last-loaded-frame this-frame)
(setq winsav-loaded-frames (cons this-frame winsav-loaded-frames))
))
(defcustom winsav-frame-parameters-to-save
'(
;;explicit-name
;;name
;;parent-id
;;title
alpha
auto-lower
auto-raise
background-color
background-mode
border-color
border-width
buffer-predicate
cursor-color
cursor-type
font
font-backend
foreground-color
fullscreen
icon-name
icon-type
icon-left
icon-top
internal-border-width
left-fringe
line-spacing
menu-bar-lines
modeline
mouse-color
right-fringe
screen-gamma
scroll-bar-width
tool-bar-lines
top left width height
tty-color-mode ;; ??
unsplittable
user-position
user-size
vertical-scroll-bars
visibility
)
"Parameters saved for frames by `winsav-save-configuration'.
Parameters are those returned by `frame-parameters'."
:type '(repeat (symbol :tag "Frame parameter"))
:group 'winsav)
(defun frame-visible-really-p (frame)
"Return t if FRAME is visible.
This tries to be more corrent on w32 than `frame-visible-p'."
(cond ((fboundp 'w32-frame-placement)
(< 0 (nth 4 (w32-frame-placement frame))))
(t
(frame-visible-p frame))))
(defun frame-maximized-p (frame)
"Return t if it is known that frame is maximized."
(cond ((fboundp 'w32-frame-placement)
(= 3 (abs (nth 4 (w32-frame-placement frame)))))
(t nil)))
(defun frame-minimized-p (frame)
"Return t if it is known that frame is minimized."
(cond ((fboundp 'w32-frame-placement)
(= 3 (abs (nth 4 (w32-frame-placement frame)))))
(t nil)))
;;(winsav-set-restore-size nil)
;; (defun winsav-set-restore-size (frame)
;; (when (fboundp 'w32-send-sys-command)
;; (let ((cur-frm (selected-frame)))
;; (select-frame-set-input-focus frame)
;; (w32-send-sys-command #xf120)
;; ;; Note: sit-for must be used, not sleep-for. Using the latter
;; ;; prevents the fetching of the new size (for some reason I do not
;; ;; understand).
;; (sit-for 1.5)
;; (select-frame-set-input-focus cur-frm))
;; t))
(defun winsav-set-maximized-state (frame)
(when (fboundp 'w32-send-sys-command)
(select-frame-set-input-focus frame)
(w32-send-sys-command #xf030)
(sit-for 1.0)
t))
(defun winsav-set-minimized-state (frame)
(when (fboundp 'w32-send-sys-command)
(select-frame-set-input-focus frame)
(w32-send-sys-command #xf020)
(sit-for 1.0)
t))
(defun winsav-save-frame (frame mb-frm-nr buffer)
"Write into buffer BUFFER elisp code to recreate frame FRAME.
If MB-FRM-NR is a number then it is the order number of the frame
whose minibuffer should be used."
(message "winsav-save-frame buffer=%s" buffer)
(message "winsav-save-frame buffer 2=%s" (current-buffer))
(let* ((start nil)
(end nil)
(obj (winsav-get-window-tree frame))
(dummy (message "winsav-save-frame buffer 3=%s" (current-buffer)))
(frm-size-now (cons (frame-pixel-height frame)
(frame-pixel-width frame)))
(dummy (message "winsav-save-frame buffer 4=%s" (current-buffer)))
(placement (when (fboundp 'w32-frame-placement) (w32-frame-placement frame)))
;; (was-max (and frm-size-rst
;; (not (equal frm-size-now frm-size-rst))))
(window-state (abs (nth 4 placement)))
;; (frm-size-rst (when (winsav-set-restore-size frame)
;; (cons (frame-pixel-height frame)
;; (frame-pixel-width frame))))
;;(frm-size-rst (when was-max))
;;(frm-size-rst (when (= 3 (abs (nth 4 placement)))))
(dummy (message "winsav-save-frame buffer 5=%s" (current-buffer)))
(frm-par (frame-parameters frame))
(dummy (message "winsav-save-frame buffer 6=%s" (current-buffer)))
)
(message "winsav-save-frame a1 cb=%s" (current-buffer))
(with-current-buffer buffer
;;(y-or-n-p (format "was-max=%s" was-max))
(message "winsav-save-frame a2 cb=%s" (current-buffer))
(setq frm-par
(delq nil
(mapcar (lambda (elt)
(cond
((memq (car elt) winsav-frame-parameters-to-save)
elt)
((eq (car elt) 'minibuffer)
(let ((val (cdr elt)))
(if (not (windowp val))
elt
(if (eq (window-frame val) frame)
nil
(cons 'minibuffer nil)))))))
frm-par)))
(message "winsav-save-frame b cb=%s" (current-buffer))
(insert "(winsav-restore-frame\n'"
;;make-frame-params
(winsav-serialize frm-par))
(message "winsav-save-frame b.0.1")
;;window-tree-params
(setq start (point))
(insert "'" (winsav-serialize obj) "\n")
(message "winsav-save-frame b.0.2")
(setq end (copy-marker (point) t))
(message "winsav-save-frame b.0.3")
(message "winsav-save-frame b.1")
;; (replace-regexp (rx "#<buffer "
;; (1+ (not (any ">")))
;; (1+ ">")) ;; 1+ for indirect buffers ...
;; "buffer"
;; nil start end)
(goto-char start)
(while (re-search-forward (rx "#<buffer "
(1+ (not (any ">")))
(1+ ">")) ;; 1+ for indirect buffers ...
end t)
(replace-match "buffer" nil t))
(message "winsav-save-frame b.2")
;; (replace-regexp (rx "#<window "
;; (1+ (not (any ">")))
;; (1+ ">"))
;; "nil"
;; nil start end)
(goto-char start)
(while (re-search-forward (rx "#<window "
(1+ (not (any ">")))
(1+ ">")) ;; 1+ for indirect buffers ...
end t)
(replace-match "nil" nil t))
(message "winsav-save-frame c")
(goto-char end)
;;use-minibuffer-frame
(insert (if mb-frm-nr
(format "(nth %s (reverse winsav-loaded-frames))" mb-frm-nr)
"nil")
(format " %s" window-state)
(if (frame-visible-really-p frame) " t " " nil ")
")\n\n")
(insert " ;; ---- before after-save-frame-hook ----\n")
;; (dolist (fun winsav-after-save-frame-hook)
;; (funcall fun frame (current-buffer)))
(run-hooks winsav-after-save-frame-hook)
(message "winsav-save-frame d")
(insert " ;; ---- after after-save-frame-hook ----\n")
;;(insert " )\n\n\n")
)))
(defvar winsav-file-version "1"
"Version number of winsav file format.
Written into the winsav file and used at winsav read to provide
backward compatibility.")
;; fix-me: This should be in desktop.el
;; Fix-me: incomplete, not ready.
(defun winsav-restore-indirect-file-buffer (file name)
"Make indirect buffer from file buffer visiting file FILE.
Give it the name NAME."
(let* ((fbuf (find-file-noselect file)))
(when fbuf
(make-indirect-buffer fbuf name))))
(defun winsav-save-indirect-buffers (to-buffer)
"Save information about indirect buffers.
Only file visiting buffers currently. Clone the base buffers."
(with-current-buffer to-buffer
(dolist (buf (buffer-list))
(when (buffer-base-buffer buf)
(let* ((base-buf (buffer-base-buffer buf))
(file (buffer-file-name base-buf)))
(when file
(insert "(winsav-restore-indirect-file-buffer \""
file "\" \"" (buffer-name buf) "\")\n")))))))
;; Fix-me: test
;; (defun winsav-restore-minibuffer (frame-num frm-num win-num)
;; (let* ((frame (nth (1- frame-num) winsav-loaded-frames))
;; (mini-frm (nth (1- frm-num) winsav-loaded-frames))
;; (mini-win (nth (1- win-num) (reverse (window-list mini-frm))))
;; )
;; (with-selected-frame frame
;; (set-minibuffer-window mini-win))))
(defvar winsav-minibuffer-alist nil)
(defun winsav-save-minibuffers (sorted-frames to-buffer)
"Save information about minibuffer frames.
SORTED-FRAMES should be a list of all frames sorted using
`winsav-frame-sort-predicate'."
(with-current-buffer to-buffer
(setq winsav-minibuffer-alist nil)
(dolist (frame sorted-frames)
(let* ((num-frames (length sorted-frames))
(mini-win (minibuffer-window frame))
(mini-frm (window-frame mini-win))
(win-num (length
(memq mini-win
(window-list mini-frm t (frame-first-window mini-frm)))))
(frm-num (- num-frames (length (memq mini-frm sorted-frames))))
(frame-num (- num-frames (length (memq frame sorted-frames)))))
(unless (and (eq mini-frm frame)
(= win-num 1))
;; Not the normal minibuffer window
;;(insert (format ";;(winsav-restore-minibuffer %s %s %s)\n"
;;(insert (format "'(%s %s)\n" frame-num frm-num)
(setq winsav-minibuffer-alist (cons (list frame-num frm-num) winsav-minibuffer-alist))
)))
(insert "(setq winsav-minibuffer-alist '"
(winsav-serialize winsav-minibuffer-alist)
")\n")))
(defun winsav-restore-dedicated-window (frame-num win-num dedicate-flag)
"Set dedicated window flag.
On frame number FRAME-NUM in `winsav-loaded-frames' set the
dedicated flag on window number WIN-NUM to DEDICATE-FLAG."
(let* ((frame (nth (1- frame-num) winsav-loaded-frames))
(win (nth (1- win-num) (reverse (window-list frame t
(frame-first-window frame))))))
(set-window-dedicated-p win dedicate-flag)))
(defun winsav-save-dedicated-windows (sorted-frames)
"Save information about dedicated windows on frames in SORTED-FRAMES.
Write this to current buffer."
(dolist (frame sorted-frames)
(dolist (win (window-list frame))
(when (window-dedicated-p win)
(let ((frame-num (length (memq frame sorted-frames)))
(win-num (length
(memq win
(window-list frame t (frame-first-window frame)))))
(flag (window-dedicated-p win)))
(insert (format "(winsav-restore-dedicated-window %s %s %S)\n" frame-num win-num flag))
)))))
(defun winsav-restore-ecb (frame-num layout-ecb)
"Restore ECB.
On frame number FRAME-NUM-ECB in `winsav-loaded-frames' restore
ECB layout LAYOUT-ECB."
(when (boundp 'ecb-minor-mode)
(let* ((frame (nth (1- frame-num) winsav-loaded-frames)))
(select-frame frame)
(unless (string= layout-ecb ecb-layout-name)
(setq ecb-layout-name layout-ecb))
(ecb-minor-mode 1))))
(defun winsav-save-ecb (frame-ecb layout-ecb sorted-frames)
"Save information about ECB layout on frames in SORTED-FRAMES.
Write this in current buffer."
(dolist (frame sorted-frames)
(when (eq frame frame-ecb)
(let ((frame-num (length (memq frame sorted-frames))))
(insert (format "(winsav-restore-ecb %s %S)\n" frame-num layout-ecb))))))
;; (make-frame '((minibuffer)))
;; (sort (frame-list) 'winsav-frame-sort-predicate)
(defun winsav-frame-sort-predicate (a b)
"Compare frame A and B for sorting.
Sort in the order frames can be created.
- Frames without minibuffers will come later since the need to
refer to the minibuffer frame when they are created.
- Invisible frames comes last since there must be at least one
visible frame from the beginning."
(let* ((a-mbw (minibuffer-window a))
(a-mbw-frm (window-frame a-mbw))
(b-mbw (minibuffer-window b))
(b-mbw-frm (window-frame b-mbw))
(a-visible (frame-visible-really-p a))
(b-visible (frame-visible-really-p b))
)
;;(message "a-mbw-frm=%s, b=%s" a-mbw-frm b)
;;(message "b-mbw-frm=%s, a=%s" a-mbw-frm b)
(when (or (not b-visible)
(eq a-mbw-frm b)
(not (eq b-mbw-frm b)))
;;(message "a > b")
t
)))
(defun winsav-can-read-config (config-version)
"Return t we can read config file version CONFIG-VERSION."
(when (<= config-version 1)
t))
(defvar winsav-file-modtime nil)
;; Like desktop-save, fix-me
(defun winsav-save-configuration (&optional dirname release)
"Write elisp code to recreate all frames.
Write into the file name computed by `winsav-full-file-name'
given the argument DIRNAME.
The information that is saved for each frame is its size and
position, the window configuration including buffers and the
parameters in `winsav-frame-parameters-to-save'. If you want save
more information for frames you can do that in the hook
`winsav-after-save-frame-hook'.
See also the hook variables
`winsav-before-save-configuration-hook' and
`winsav-after-save-configuration-hook'.
Fix-me: RELEASE is not implemented."
(winsav-save-config-to-file (winsav-full-file-name dirname)))
(defun winsav-save-config-to-file (conf-file)
"Write elisp code to recreate all frames to CONF-FILE."
(let (start
end
(sorted-frames (sort (frame-list) 'winsav-frame-sort-predicate))
(frm-nr 0)
frame-ecb
layout-ecb)
;; Recreating invisible frames hits Emacs bug 3859
(setq sorted-frames
(delq nil
(mapcar (lambda (f)
(when (frame-parameter f 'visibility) f))
sorted-frames)))
(when (and (boundp 'ecb-minor-mode) ecb-minor-mode)
(when (frame-live-p ecb-frame)
(setq layout-ecb ecb-layout-name)
(setq frame-ecb ecb-frame))
(ecb-minor-mode -1)
(sit-for 0) ;; Fix-me: is this needed?
)
(message "winsav-save-config:here a")
(with-temp-buffer
(let ((this-buffer (current-buffer)))
(message "winsav-save-config:here b")
;;(erase-buffer)
(insert
";; -*- mode: emacs-lisp; coding: utf-8; -*-\n"
";; --------------------------------------------------------------------------\n"
";; Winsav File for Emacs\n"
";; --------------------------------------------------------------------------\n"
";; Created " (current-time-string) "\n"
";; Winsav file format version " winsav-file-version "\n"
";; Emacs version " emacs-version "\n\n"
"(if (not (winsav-can-read-config " winsav-file-version "))\n\n"
" (message \"Winsav: Can't read config file with version " winsav-file-version "\")\n")
(message "winsav-save-config:here c")
(insert ";; ---- indirect buffers ------------------------\n")
(winsav-save-indirect-buffers this-buffer)
(message "winsav-save-config:here c.1")
;;(insert ";; ---- special minibuffers ------------------------\n")
(winsav-save-minibuffers sorted-frames this-buffer)
(message "winsav-save-config:here c.2")
(insert "(setq winsav-loaded-frames nil)\n")
(insert ";; ---- before winsav-before-save-configuration-hook ------------------------\n")
(run-hooks 'winsav-before-save-configuration-hook)
(message "winsav-save-config:here c.2a cb=%s" (current-buffer))
(insert ";; ---- after winsav-before-save-configuration-hook ------------------------\n\n")
(dolist (frm sorted-frames)
(let ((mb-frm-nr (cadr (assoc frm-nr winsav-minibuffer-alist)))
;;(mb-frm (when mb-frm-nr (nth mb-frm-nr sorted-frames)))
)
(message "winsav-save-config:here c.2b.1 tb=%s cb=%s frm=%s" this-buffer (current-buffer) frm)
(winsav-save-frame frm mb-frm-nr this-buffer)
(message "winsav-save-config:here c.2b.2")
(setq frm-nr (1+ frm-nr))))
(message "winsav-save-config:here c.2c cb=%s" (current-buffer))
(insert ";; ---- dedicated windows ------------------------\n")
(winsav-save-dedicated-windows sorted-frames)
(message "winsav-save-config:here c.3")
(insert ";; ---- ECB --------------------------------------\n")
(winsav-save-ecb frame-ecb layout-ecb sorted-frames)
(message "winsav-save-config:here c.4")
(insert "\n\n;; ---- before winsav-after-save-configuration-hook ------------------------\n")
(run-hooks 'winsav-after-save-configuration-hook)
(message "winsav-save-config:here c.5")
(insert "\n\n;; ---- before winsav-after-save-configuration-hook ------------------------\n")
(run-hooks 'winsav-after-save-configuration-hook)
(message "winsav-save-config:here c.6")
(insert ";; ---- after winsav-after-save-configuration-hook ------------------------\n")
(insert "\n)\n")
(message "winsav-save-config:here d")
;; For pp-buffer:
(let (emacs-lisp-mode-hook
after-change-major-mode-hook
change-major-mode-hook)
(font-lock-mode -1)
(emacs-lisp-mode))
(message "winsav-save-config:here e")
(pp-buffer)
(message "winsav-save-config:here f")
(indent-region (point-min) (point-max))
(message "winsav-save-config:here g")
;;(save-buffer 0) ;; No backups
;;(kill-buffer)
;;(with-current-buffer (find-file-noselect file)
(let ((coding-system-for-write 'utf-8))
(write-region (point-min) (point-max) conf-file nil 'nomessage))
(setq winsav-file-modtime (nth 5 (file-attributes conf-file)))
(setq winsav-dirname (file-name-as-directory (file-name-directory conf-file)))
(message "winsav-save-config:here h")
))))
(defvar winsav-current-config-name nil)
;;(winsav-restore-configuration)
;;(winsav-full-file-name "~")
;; (defun winsav-restore-winsav-configuration ()
;; )
(defcustom winsav-after-restore-hook nil
"Normal hook run after a successful `winsav-restore-configuration'."
:type 'hook
:group 'winsav)
;; Like desktop-read, fix-me
(defun winsav-restore-configuration (&optional dirname)
"Restore frames from default file in directory DIRNAME.
The default file is given by `winsav-default-file-name'.
The file was probably written by `winsav-save-configuration'.
Delete the frames that were used before."
;;(message "winsav-restore-configuration %s" dirname)
(winsav-restore-config-from-file (winsav-full-file-name dirname)))
(defun winsav-restore-config-from-file (conf-file)
"Restore frames from configuration file CONF-FILE.
The file was probably written by `winsav-save-configuration'.
Delete the frames that were used before."
(let ((old-frames (sort (frame-list) 'winsav-frame-sort-predicate))
(num-old-deleted 0)
;; Avoid winsav saving during restore.
(winsav-save nil))
;;(message "winsav:conf-file=%s" conf-file)
(if (or (not conf-file)
(not (file-exists-p conf-file)))
(progn
(message (propertize "Winsav: No default configuration file found"
'face 'secondary-selection))
t) ;; Ok
(setq debug-on-error t) ;; fix-me
(if (file-exists-p conf-file)
(progn
(load conf-file nil nil t)
(setq winsav-file-modtime (nth 5 (file-attributes conf-file)))
(setq winsav-dirname (file-name-as-directory (file-name-directory conf-file)))
(when (< 0 (length winsav-loaded-frames))
(dolist (old (reverse old-frames))
(unless (eq 'only (frame-parameter old 'minibuffer))
(setq num-old-deleted (1+ num-old-deleted))
(delete-frame old)))
)
(message "winsav-after-restore-hook =%S" winsav-after-restore-hook)
(run-hooks 'winsav-after-restore-hook)
(message "Winsav: %s frame(s) restored" (length winsav-loaded-frames))
t)
;; No winsav file found
;;(winsav-clear)
(message "No winsav file: %s" conf-file)
nil))))
;; (defcustom winsav-add-to-desktop nil
;; "Set this to let desktop save and restore also winsav configurations."
;; :type 'boolean
;; :set (lambda (sym val)
;; (set-default sym val)
;; (if value
;; (progn
;; (add-hook 'desktop-after-read-hook 'winsav-restore-configuration)
;; (add-hook 'desktop-save-hook 'winsav-save-configuration))
;; (remove-hook 'desktop-after-read-hook 'winsav-restore-configuration)
;; (remove-hook 'desktop-save-hook 'winsav-save-configuration)) )
;; :group 'winsav)
(defun winsav-restore-configuration-protected (&optional dirname)
"Like `winsav-restore-configuration' but protect for errors.
DIRNAME has the same meaning."
(condition-case err
(winsav-restore-configuration dirname)
(error
(message "winsav-restore-configuration: %s" err))))
(defun winsav-relative-~-or-full (dirname)
(let* ((rel-dir (file-relative-name dirname
(file-name-directory
(winsav-full-file-name "~"))))
(confname (if (string= ".." (substring rel-dir 0 2))
winsav-dirname
(if (string= rel-dir "./")
"(default)"
(concat "~/" rel-dir)))))
confname))
(defun winsav-tell-configuration ()
"Tell which winsav configuration that is used."
(interactive)
(save-match-data ;; runs in timer
(let ((confname (if (not winsav-dirname)
"(none)"
(winsav-relative-~-or-full winsav-dirname))))
(if t ;;(called-interactively-p)
(message (propertize (format "Current winsav config is '%s'" confname)
'face 'secondary-selection))
(save-window-excursion
(delete-other-windows)
(set-window-buffer (selected-window)
(get-buffer-create " *winsav*"))
(with-current-buffer (window-buffer)
(momentary-string-display
(propertize
(format "\n\n\n Current winsav config is '%s'\n\n\n\n" confname)
'face 'secondary-selection)
(window-start)
(kill-buffer))))))))
(defun winsav-tell-configuration-request ()
"Start an idle timer to call `winsav-tell-configuration'."
(run-with-idle-timer 1 nil 'winsav-tell-configuration))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Startup and shut down
;; Run after desktop at startup so that desktop has loaded files and
;; buffers.
(defun winsav-after-init ()
"Restore frames and windows.
Run this once after Emacs startup, after desktop in the
`after-init-hook'."
;; Turn off with --no-deskttop:
(unless desktop-save-mode (winsav-save-mode -1))
(when winsav-save-mode
;;(run-with-idle-timer 0.1 nil 'winsav-restore-configuration-protected)
;;(message "winsav-after-init")
;;(winsav-restore-configuration-protected)
;; In case of error make sure winsav-save-mode is turned off
(setq inhibit-startup-screen t)
(winsav-save-mode -1)
(winsav-restore-configuration)
(winsav-save-mode 1)
))
(add-hook 'after-init-hook 'winsav-after-init t)
(add-hook 'kill-emacs-hook 'winsav-kill)
;;(remove-hook 'kill-emacs-hook 'winsav-kill)
(defun winsav-kill ()
"Save winsav frame configuration.
Run this before Emacs exits."
;; (when winsav-save-mode
;; (let ((conf-dir (when winsav-current-config-name
;; (winsav-full-config-dir-name winsav-current-config-name))))
;; (winsav-save-configuration conf-dir))))
(when (and winsav-save-mode
(let ((exists (file-exists-p (winsav-full-file-name))))
(or (eq winsav-save t)
(and exists (memq winsav-save '(ask-if-new if-exists)))
(and
(or (memq winsav-save '(ask ask-if-new))
(and exists (eq winsav-save 'ask-if-exists)))
(y-or-n-p "Save winsav? ")))))
(unless winsav-dirname
;; Fix-me: Since this can be a new user of winsav I think the
;; best thing to do here is to encourage the user to save in the
;; default directory since otherwise the winsav file will not be
;; loaded at startup. Desktop does not currently do that however
;; (report that!).
(when (y-or-n-p "Winsav was not loaded from file. Save it to file? ")
(let* ((full-file (winsav-full-file-name))
(default-directory (directory-file-name
(file-name-directory full-file))))
(setq winsav-dirname
(file-name-as-directory
(expand-file-name
(read-directory-name "Directory for winsav file: " nil nil t)))))))
(when winsav-dirname
(condition-case err
;;(winsav-save winsav-dirname t)
(winsav-save-configuration winsav-dirname)
(file-error
(unless (yes-or-no-p
(format "Error while saving winsav config: %s Save anyway? "
(error-message-string err)))
(signal (car err) (cdr err)))))))
;; If we own it, we don't anymore.
;;(when (eq (emacs-pid) (winsav-owner)) (winsav-release-lock))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Switching configurations
(defun winsav-restore-full-config (dirname)
"Restore the winsav configuration in directory DIRNAME.
If NAME is nil then restore the startup configuration."
;;(desktop-change-dir dirname)
(when (and winsav-handle-also-desktop desktop-save-mode)
(when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))
(desktop-clear)
(desktop-read dirname))
(winsav-restore-configuration dirname)
;;(setq winsav-current-config-name name)
(winsav-tell-configuration-request))
(defun winsav-full-config-dir-name (name)
"Return full directory path where configuration NAME is stored."
(let* ((base-dir (concat (winsav-full-file-name) ".d"))
(conf-dir (expand-file-name name base-dir)))
(setq conf-dir (file-name-as-directory conf-dir))
;;(message "conf-dir=%s" conf-dir)
conf-dir))
;;;###autoload
(defun winsav-save-full-config (dirname)
"Saved current winsav configuration in directory DIRNAME.
Then change to this configuration.
See also `winsav-switch-config'."
(unless (file-name-absolute-p dirname)
(error "Directory ame must be absolute: %s" dirname))
(let* ((conf-dir (or dirname "~"))
(old-conf-dir winsav-dirname))
(make-directory conf-dir t)
(winsav-save-configuration conf-dir)
(when (and winsav-handle-also-desktop desktop-save-mode)
(desktop-release-lock)
(desktop-save conf-dir))
;;(unless (string= winsav-current-config-name name)
(unless (string= old-conf-dir conf-dir)
;;(setq winsav-current-config-name name)
(winsav-tell-configuration-request))))
;; Fix-me: remove named configurations, use just dir as desktop
(defun winsav-switch-to-default-config ()
"Change to default winsav configuration.
See also `winsav-switch-config'."
(interactive)
(winsav-switch-config "~"))
;;;###autoload
(defun winsav-switch-config (dirname)
"Change to winsav configuration in directory DIRNAME.
If DIRNAME is the current winsav configuration directory then
offer to save it or restore it from saved values.
Otherwise, before switching offer to save the current winsav
configuration. Then finally switch to the new winsav
configuration, creating it if it does not exist.
If option `desktop-save-mode' is on then buffers and files are also
restored and saved the same way.
See also option `winsav-save-mode' and command
`winsav-tell-configuration'."
(interactive
(list
(let ((default-directory (or winsav-dirname default-directory))
(base-dir (concat (winsav-full-file-name) ".d"))
new-dir)
(make-directory base-dir t)
(setq new-dir
(read-directory-name "Winsav: Switch config directory: "))
(when (string= "" new-dir) (setq new-dir nil))
(or new-dir
"~"))))
(setq dirname (file-name-as-directory (expand-file-name dirname)))
(catch 'stop
(let ((conf-file (expand-file-name winsav-base-file-name dirname))
config-exists)
(if (file-exists-p conf-file)
(setq config-exists t)
(unless (y-or-n-p (format "%s was not found. Create it? " conf-file))
(throw 'stop nil)))
(if (string= winsav-dirname dirname)
(if (y-or-n-p "You are already using this configuration, restore it from saved values? ")
(winsav-restore-full-config winsav-dirname)
(when (y-or-n-p "You are already using this winsav configuration, save it? ")
(winsav-save-full-config winsav-dirname)))
(when (y-or-n-p
(format "Save current config, %s,\n first before switching to %s? "
(if (and winsav-dirname
(not (string= winsav-dirname
(file-name-directory (winsav-full-file-name "~")))))
winsav-dirname
"the startup config")
dirname))
(winsav-save-full-config winsav-dirname))
(if config-exists
(winsav-restore-full-config dirname)
(winsav-save-full-config dirname))))))
;;; Old things
;; (defun winsav-log-buffer ()
;; (get-buffer-create "winsav log buffer"))
;; (defun winsav-log (mark obj)
;; (with-current-buffer (winsav-log-buffer)
;; (insert "=== " mark "===\n" (pp-to-string obj))))
;; (global-set-key [f2] 'winsav-test-get)
;; (global-set-key [f3] 'winsav-test-put)
;; (defvar winsav-saved-window-tree nil)
;; (defun winsav-test-get()
;; (interactive)
;; (setq winsav-saved-window-tree (winsav-get-window-tree)))
;; (defun winsav-test-put()
;; (interactive)
;; (let ((ret (winsav-put-window-tree winsav-saved-window-tree
;; (selected-window))))
;; ;;(message "ret=%s" ret)
;; ))
;; (defun winsav-serialize-to-file (obj file)
;; (with-current-buffer (find-file-noselect file)
;; ;;(erase-buffer)
;; (save-restriction
;; (widen)
;; (goto-char (point-max))
;; (insert (winsav-serialize obj)
;; "\n"))
;; ;;(basic-save-buffer)
;; ))
;;(global-set-key [f11] 'winsav-rotate)
;; (defun winsav-de-serialize-window-tree-from-file (file)
;; (with-current-buffer (find-file-noselect file)
;; (save-restriction
;; (widen)
;; (let ((start (point))
;; (end nil))
;; (forward-list)
;; (setq end (point))
;; ;;(goto-char (point-min))
;; (winsav-de-serialize-window-tree (buffer-substring-no-properties start end))))))
;; (defun winsav-restore-from-file (file)
;; (winsav-put-window-tree
;; (winsav-de-serialize-window-tree-from-file file)
;; (selected-window)))
;; (defun winsav-de-serialize-window-tree (str)
;; (save-match-data
;; (let ((read-str
;; (replace-regexp-in-string (rx "#<buffer "
;; (1+ (not (any ">")))
;; ">")
;; "buffer"
;; str))
;; obj-last
;; obj
;; last)
;; (setq read-str
;; (replace-regexp-in-string (rx "#<window "
;; (1+ (not (any ">")))
;; ">")
;; "nil"
;; read-str))
;; (setq obj-last (read-from-string read-str))
;; (setq obj (car obj-last))
;; (setq last (cdr obj-last))
;; ;; Fix me, maby check there are only spaces left (or trim them above...)
;; obj)))
(provide 'winsav)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; winsav.el ends here