nxhtml/util/winsav.el

   1 ;;; winsav.el --- Save and restore window structure
   2 ;;
   3 ;; Author: Lennart Borgman
   4 ;; Created: Sun Jan 14 2007
   5 (defconst winsav:version "0.77") ;;Version: 0.77
   6 ;; Last-Updated: 2009-08-04 Tue
   7 ;; Keywords:
   8 ;; Compatibility:
   9 ;;
  10 ;; Features that might be required by this library:
  11 ;;
  12 ;;   None
  13 ;;
  14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15 ;;
  16 ;;; Commentary:
  17 ;;
  18 ;; This library contains both user level commands and options and
  19 ;; functions for use in other elisp libraries.
  20 ;;
  21 ;;;; User level commands and options
  22 ;;
  23 ;; The user level commands and options are for saving frame, windows
  24 ;; and buffers between Emacs sessions.  To do that you can customize
  25 ;; the options `desktop-save-mode' and `winsav-save-mode' or put this
  26 ;; at the end of your .emacs:
  27 ;;
  28 ;;   (desktop-save-mode 1)
  29 ;;   (winsav-save-mode 1)
  30 ;;
  31 ;; You can also save configurations that you later switch between.
  32 ;; For more information see the command `winsav-save-mode'.
  33 ;;
  34 ;; (There is also a command in this library for rotating window
  35 ;; borders in a frame, `winsav-rotate'.  It is here just because the
  36 ;; needed support functions lives here.)
  37 ;;
  38 ;;
  39 ;;
  40 ;;;; Commands for other elisp libraries
  41 ;;
  42 ;; This library was orignally written to solve the problem of adding a
  43 ;; window to the left of some windows in a frame like the one below
  44 ;;
  45 ;; ___________
  46 ;; |    |    |
  47 ;; | 1  | 2  |
  48 ;; |____|____|
  49 ;; |         |
  50 ;; |    3    |
  51 ;; |_________|
  52 ;;
  53 ;; so that the window structure on the frame becomes
  54 ;;
  55 ;; ___________
  56 ;; |  |  |   |
  57 ;; |  | 1| 2 |
  58 ;; | B|__|___|
  59 ;; | A|      |
  60 ;; | R|  3   |
  61 ;; |__|______|
  62 ;;
  63 ;;
  64 ;; This problem can be solved by this library.  However the solution in
  65 ;; this library is a bit more general: You first copy the window
  66 ;; structure and then restore that into another window.  To do the
  67 ;; above you first copy the window structure in the first frame above
  68 ;; with `winsav-get-window-tree'.  Then you create windows like this:
  69 ;;
  70 ;; ___________
  71 ;; |  |      |
  72 ;; |  |      |
  73 ;; | B|      |
  74 ;; | A|      |
  75 ;; | R|      |
  76 ;; |__|______|
  77 ;;
  78 ;;
  79 ;; Finally you use `winsav-put-window-tree' to put the window
  80 ;; structure into the right window.  (Of course you could have put BAR
  81 ;; above, under etc.)
  82 ;;
  83 ;;
  84 ;;
  85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86 ;;
  87 ;; Bugs and limitations:
  88 ;;
  89 ;; Juanma Barranquero has pointed out there is a serious limitation in
  90 ;; this way of doing it when overlays with 'window properties are
  91 ;; used.  The problem is that any pointers to windows are made invalid
  92 ;; since they are deleted.  So in fact any code that relies on saved
  93 ;; pointers to windows will have problem if the window is one of those
  94 ;; that are involved here.
  95 ;;
  96 ;; To overcome this problem when doing something like inserting a BAR
  97 ;; window (see above) a new window has to be inserted in the existing
  98 ;; window tree on a frame in a way that is currently not supported in
  99 ;; Emacs.
 100 ;;
 101 ;; It would be nice to be have primitives to manipulate the window
 102 ;; tree more generally from elisp.  That requires implementation of
 103 ;; them at the C level of course.
 104 ;;
 105 ;; However it is probably much easier to implement it quite a bit less
 106 ;; general.  The concept of splitting is maybe then the right level to
 107 ;; search for primitives at.
 108 ;;
 109 ;; My conclusion is that it will take some time to find suitable
 110 ;; primitives for this.
 111 ;;
 112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 113 ;;
 114 ;;; Change log:
 115 ;;
 116 ;; Version 0.72:
 117 ;;
 118 ;; - Format of window structure changed in Emacs 23. Adopted to that.
 119 ;; - Added save and restore of frame/window configurations between
 120 ;;   Emacs sessions.
 121 ;; - Added named winsav configurations for save and restore of frames,
 122 ;;   windows, buffers and files.
 123 ;;
 124 ;; Version 0.71:
 125 ;;
 126 ;; - Added rotation of window structure.
 127 ;;
 128 ;; Version 0.70:
 129 ;;
 130 ;; - Support for save and restore from file.
 131 ;;
 132 ;;
 133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 134 ;;
 135 ;; This program is free software; you can redistribute it and/or modify
 136 ;; it under the terms of the GNU General Public License as published by
 137 ;; the Free Software Foundation; either version 2, or (at your option)
 138 ;; any later version.
 139 ;;
 140 ;; This program is distributed in the hope that it will be useful,
 141 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 142 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 143 ;; GNU General Public License for more details.
 144 ;;
 145 ;; You should have received a copy of the GNU General Public License
 146 ;; along with this program; see the file COPYING.  If not, write to the
 147 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 148 ;; Boston, MA 02111-1307, USA.
 149 ;;
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151 ;;
 152 ;;; Code:
 153
 154
 155 (eval-when-compile (require 'cl))
 156 (eval-and-compile (require 'desktop))
 157
 158 ;; (defun winsav-upper-left-window(&optional frame w)
 159 ;;   (let* ((tree (if w w (car (window-tree frame))))
 160 ;;          (is-split (not (windowp tree))))
 161 ;;     (if (not is-split)
 162 ;;         tree
 163 ;;       (winsav-upper-left-window frame (nth 2 tree)))))
 164
 165
 166 (defcustom winsav-after-get-hook nil
 167   "Hook to run after at the end of `winsav-get-window-tree'.
 168 The functions in this hook are called with one parameter which is
 169 the same as the return value from the function above."
 170   :type 'hook
 171   :group 'winsav)
 172
 173 (defcustom winsav-after-put-hook nil
 174   "Hook to run after at the end of `winsav-put-window-tree'.
 175 The functions in this hook are called with one parameter which is
 176 a list where each element is a list \(old-win new-win) where
 177 OLD-WIN are the window from `winsav-get-window-tree' and NEW-WIN
 178 is the newly created corresponding window.  This list is the same
 179 as the return value from the function above."
 180   :type 'hook
 181   :group 'winsav)
 182
 183 (defun winsav-get-window-tree(&optional frame)
 184   "Get window structure.
 185 This returns an object with current windows with values, buffers,
 186 points and the selected window.
 187
 188 FRAME is the frame to save structure from. If nil use selected.
 189
 190 At the very end of this function the hook `winsav-after-get' is
 191 run."
 192   ;;(let* ((upper-left (winsav-upper-left-window frame))
 193   (let* ((upper-left (frame-first-window frame))
 194          (num -1)
 195          sel-num)
 196     (dolist (w (window-list frame nil upper-left))
 197       (setq num (1+ num))
 198       (when (eq w (selected-window))
 199         (setq sel-num num)))
 200     (let ((ret (list sel-num
 201                      (winsav-get-window-tree-1 frame nil))))
 202       (run-hook-with-args 'winsav-after-get-hook ret)
 203       ret)))
 204
 205 ;; Fix-me: add window-hscroll
 206 (defun winsav-get-window-tree-1(frame w)
 207   (let ((tree (if w w (car (window-tree frame)))))
 208     (if (windowp tree)
 209         ;; Note: Desktop is used for saving buffers.
 210         (with-current-buffer (window-buffer tree)
 211           (list (window-buffer tree)
 212                 ;; buffer
 213                 (buffer-name)
 214                 (buffer-file-name)
 215                 ;;buffer-read-only
 216                 ;;(if mumamo-multi-major-mode mumamo-multi-major-mode major-mode)
 217                 ;;minor-modes
 218                 ;;buffer locals
 219                 ;;(cons (+ 0 (mark-marker)) (mark-active))
 220                 ;; window
 221                 (window-point tree)
 222                 (window-edges tree)
 223                 (window-scroll-bars tree)
 224                 (window-fringes tree)
 225                 (window-margins tree)
 226                 (window-hscroll tree)
 227                 ;; misc
 228                 (window-dedicated-p tree)
 229                 (when (fboundp 'window-redisplay-end-trigger)
 230                   (window-redisplay-end-trigger tree))
 231                 (window-start tree)
 232                 tree))
 233       (let* ((dir (nth 0 tree))
 234              (split (nth 1 tree))
 235              (wt (cddr tree))
 236              (wsubs (mapcar (lambda(wc)
 237                               (winsav-get-window-tree-1 nil wc))
 238                             wt)))
 239         (append (list dir split) wsubs)))))
 240
 241 ;;;###autoload
 242 (defun winsav-put-window-tree (saved-tree window &optional copy-win-ovl win-ovl-all-bufs)
 243   "Put window structure SAVED-TREE into WINDOW.
 244 Restore a structure SAVED-TREE returned from
 245 `winsav-get-window-tree' into window WINDOW.
 246
 247 If COPY-WIN-OVL is non-nil then overlays having a 'window
 248 property pointing to one of the windows in SAVED-TREE where this
 249 window still is shown will be copied to a new overlay with
 250 'window property pointing to the corresponding new window.
 251
 252 If WIN-OVL-ALL-BUFS is non-nil then all buffers will be searched
 253 for overlays with a 'window property of the kind above.
 254
 255 At the very end of this function the hook `winsav-after-put' is
 256 run."
 257   (let* ((sel-num (nth 0 saved-tree))
 258          (tree    (nth 1 saved-tree))
 259          nsiz
 260          nh
 261          nw
 262          osiz
 263          oh
 264          ow
 265          scale-w
 266          scale-h
 267          first-win
 268          winsav-put-return)
 269     (unless (or (bufferp (car tree))
 270                 (eq 'buffer (car tree)))
 271       (setq nsiz (window-edges window))
 272       (setq nh (- (nth 3 nsiz) (nth 1 nsiz)))
 273       (setq nw (- (nth 2 nsiz) (nth 0 nsiz)))
 274       (setq osiz (cadr tree))
 275       (setq oh (- (nth 3 osiz) (nth 1 osiz)))
 276       (setq ow (- (nth 2 osiz) (nth 0 osiz)))
 277       (setq scale-w (unless (= ow nw) (/ nw (float ow))))
 278       (setq scale-h (unless (= oh nh) (/ nh (float oh)))))
 279     (setq first-win (winsav-put-window-tree-1 tree window scale-w scale-h t 1))
 280     (select-window first-win)
 281     (when sel-num (other-window sel-num))
 282     (winsav-fix-win-ovl winsav-put-return copy-win-ovl win-ovl-all-bufs)
 283     (run-hook-with-args 'winsav-after-put-hook winsav-put-return)
 284     winsav-put-return))
 285
 286 (defun winsav-put-window-tree-1 (saved-tree window scale-w scale-h first-call level)
 287   "Helper for `winsav-put-window-tree'.
 288 For the arguments SAVED-TREE and WINDOW see that function.
 289
 290 The arguments SCALE-W and SCALE-H are used to make the saved
 291 window config fit into its new place.  FIRST-CALL is a state
 292 variable telling if this is the first round.  LEVEL helps
 293 debugging by tells how far down we are in the call chain."
 294   (if (or (bufferp (car saved-tree))
 295           ;;(not (car saved-tree))
 296           (eq 'buffer (car saved-tree))
 297           )
 298       (let ((buffer  (nth 0 saved-tree))
 299             ;; buffer
 300             (bufnam  (nth 1 saved-tree))
 301             (filnam  (nth 2 saved-tree))
 302             ;;(mark    (nth 3 saved-tree))
 303             ;; window
 304             (point   (nth 3 saved-tree))
 305             (edges   (nth 4 saved-tree))
 306             (scroll  (nth 5 saved-tree))
 307             (fringe  (nth 6 saved-tree))
 308             (margs   (nth 7 saved-tree))
 309             (hscroll (nth 8 saved-tree))
 310             (dedic   (nth 9 saved-tree))
 311             (trigger (nth 10 saved-tree))
 312             (start   (nth 11 saved-tree))
 313             (ovlwin  (nth 12 saved-tree))
 314             scr2
 315             (misbuf  " *Winsav information: Buffer is gone*"))
 316         (or (windowp ovlwin)
 317             (not ovlwin)
 318           (error "Parameter mismatch, ovlwin not window: %s" ovlwin))
 319         (when first-call
 320           (add-to-list 'winsav-put-return (list ovlwin window))
 321           (when (eq 'buffer buffer)
 322             (when filnam
 323               (setq buffer (winsav-find-file-noselect filnam)))
 324             (if (buffer-live-p buffer)
 325                 (or (string= bufnam (buffer-name buffer))
 326                     (eq (string-to-char bufnam) 32) ;; Avoid system buffer names
 327                     (rename-buffer bufnam))
 328               (when (eq (string-to-char bufnam) 32)
 329                 (setq bufnam " *Winsav dummy buffer*"))
 330               ;; Fix-me, this might need some tweaking: Don't restore
 331               ;; buffers without a file name and without
 332               ;; content. (desktop-mode will make that when
 333               ;; necessary.)  Just show the scratch buffer instead.
 334               (setq buffer (get-buffer bufnam))
 335               (unless (and buffer
 336                            (< 0 (buffer-size buffer)))
 337                 (setq buffer (get-buffer-create "*scratch*")))))
 338           (set-window-buffer window buffer)
 339           (set-window-dedicated-p window dedic)
 340           ;; Strange incompatibility in scroll args:
 341           (setq scr2 (list (nth 0 scroll) (nth 2 scroll) (nth 3 scroll)))
 342           (apply 'set-window-scroll-bars (append (list window) scr2))
 343           (apply 'set-window-fringes (append (list window) fringe))
 344           (set-window-margins window (car margs) (cdr margs))
 345           (set-window-hscroll window hscroll)
 346           (unless (>= emacs-major-version 23)
 347             (with-no-warnings
 348               (set-window-redisplay-end-trigger window trigger))))
 349         (let* ((nsiz (window-edges window))
 350                (nh (- (nth 3 nsiz) (nth 1 nsiz)))
 351                (nw (- (nth 2 nsiz) (nth 0 nsiz)))
 352                (osiz edges) ;(nth 2 saved-tree))
 353                (oh (- (nth 3 osiz) (nth 1 osiz)))
 354                (ow (- (nth 2 osiz) (nth 0 osiz)))
 355                (diff-w (- (if scale-w
 356                               (round (* scale-w ow))
 357                             ow)
 358                           nw))
 359                (diff-h (- (if scale-h
 360                               (round (* scale-h oh))
 361                             oh)
 362                           nh)))
 363           ;; Avoid rounding naggings:
 364           (when (> (abs diff-h) 1)
 365             (bw-adjust-window window diff-h nil))
 366           (when (> (abs diff-w) 1)
 367             (bw-adjust-window window diff-w t)))
 368         ;; Fix-me: there were some problems getting point correctly. Don't know why...
 369         (with-selected-window window
 370           (with-current-buffer (window-buffer window)
 371             (goto-char point))
 372           (set-window-point window point)
 373           ;;(unless (buffer-live-p buffer) (setq point 1) (setq start 1))
 374           (set-window-start window start)
 375           ;; Maybe point got off screen?
 376           (when (/= point (window-point window))
 377             (set-window-point window point)))
 378         window)
 379     (let* ((ver (car saved-tree))
 380            (wtree (list (cons window (caddr saved-tree))))
 381            (nwin window)
 382            pwin
 383            pdelta
 384            (first-win nwin))
 385       ;; First split to get it in correct order
 386       (when first-call
 387         (dolist (subtree (cdddr saved-tree))
 388           (setq pwin nwin)
 389           ;;(message "nwin edges=%s, ver=%s" (window-edges nwin) ver)
 390           (let ((split-err nil)
 391                 (window-min-height 1)
 392                 (window-min-width 1))
 393             (setq nwin (split-window nwin nil (not ver))))
 394           ;; Make the previous window as small as permitted to allow
 395           ;; splitting as many times as possible
 396           (setq pdelta (-
 397                         (if ver
 398                             window-min-height
 399                           window-min-width)
 400                         (if ver
 401                             (window-width pwin)
 402                           (window-height pwin))))
 403           ;;(message "pwin=%s, edges=%s, pdelta=%s, ver=%s" pwin (window-edges pwin) pdelta ver)
 404           ;; No reason to fail here:
 405           (condition-case err
 406               (adjust-window-trailing-edge pwin pdelta (not ver))
 407             (error
 408              ;;(message "awt=>%s" (error-message-string err))
 409              nil
 410              ))
 411           ;; Add to traverse
 412           (add-to-list 'wtree
 413                        (cons nwin subtree)
 414                        t)))
 415       ;; Now traverse. Sizing is a bit tricky, multiple runs have to
 416       ;; be done (as in balance-windows).
 417       (let (tried-sizes
 418             last-sizes
 419             (windows (window-list (selected-frame))))
 420         (while (not (member last-sizes tried-sizes))
 421           (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
 422           (setq last-sizes (mapcar (lambda (w)
 423                                      (window-edges w))
 424                                    windows))
 425           (dolist (wsub (reverse wtree))
 426             (select-window (car wsub))
 427             (winsav-put-window-tree-1 (cdr wsub) (selected-window)
 428                                       scale-w scale-h
 429                                       first-call
 430                                       (1+ level)
 431                                       ))
 432           (setq first-call nil)
 433           ))
 434       first-win)))
 435
 436 (defun winsav-fix-win-ovl(win-list copy-win-ovl win-ovl-all-bufs)
 437   (let ((oldwins (mapcar (lambda(elt)
 438                            (car elt))
 439                          win-list))
 440         ovlwin
 441         window)
 442     (let (buffers)
 443       (if win-ovl-all-bufs
 444           (setq buffers (buffer-list))
 445         (mapc (lambda(w)
 446                 (when (window-live-p w)
 447                   (add-to-list 'buffers (window-buffer w))))
 448               oldwins))
 449       (dolist (buf buffers)
 450         (with-current-buffer buf
 451           (save-restriction
 452             (widen)
 453             (dolist (overlay (overlays-in (point-min) (point-max)))
 454               (when (setq ovlwin (car (memq (overlay-get overlay 'window) oldwins)))
 455                 (setq window (cadr (assoc ovlwin win-list)))
 456                 ;; If the old window is still alive then maybe copy
 457                 ;; overlay, otherwise change the 'window prop. However
 458                 ;; copy only if COPY-WIN-OVL is non-nil.
 459                 (if (not (and (window-live-p ovlwin)
 460                               (window-frame ovlwin)))
 461                     (overlay-put overlay 'window window)
 462                   (when copy-win-ovl
 463                     (let* ((props (overlay-properties overlay))
 464                            (start (overlay-start overlay))
 465                            (end   (overlay-end   overlay))
 466                            ;; Fix-me: start and end marker props
 467                            (newovl (make-overlay start end)))
 468                       (while props
 469                         (let ((key (car props))
 470                               (val (cadr props)))
 471                           (setq props (cddr props))
 472                           (when (eq key 'window)
 473                             (setq val window))
 474                           (overlay-put newovl key val))))))))))))))
 475
 476
 477
 478 (defun winsav-transform-edges (edges)
 479   "Just rotate the arguments in EDGES to make them fit next function."
 480   (let ((le (nth 0 edges))
 481         (te (nth 1 edges))
 482         (re (nth 2 edges))
 483         (be (nth 3 edges)))
 484     (list te le be re)))
 485
 486 (defun winsav-transform-1 (tree mirror transpose)
 487   "Mirroring of the window tree TREE.
 488 MIRROR could be 'mirror-top-bottom or 'mirror-left-right which I
 489 think explain what it does here.  TRANSPOSE shifts the tree
 490 between a horisontal and vertical tree."
 491   (let* ((vertical (nth 0 tree))
 492          (edges    (nth 1 tree))
 493          (subtrees (nthcdr 2 tree))
 494          )
 495     ;;(winsav-log "tree 1" tree)
 496     (when transpose
 497       (cond
 498        ((eq vertical nil)
 499         (setcar tree t))
 500        ((eq vertical t)
 501         (setcar tree nil))
 502        (t
 503         (error "Uh? vertical=%S" vertical))))
 504     (setcar (nthcdr 1 tree) (winsav-transform-edges edges))
 505     (dolist (subtree subtrees)
 506       (if (bufferp (car subtree))
 507           (when transpose
 508             (let ((edges    (nth 4 subtree)))
 509               ;;(winsav-log "subtree 1" subtree)
 510               (setcar (nthcdr 4 subtree) (winsav-transform-edges edges))
 511               ;;(winsav-log "subtree 2" subtree)
 512               ))
 513         (winsav-transform-1 subtree mirror transpose)))
 514     (when (case mirror
 515             ('mirror-top-bottom vertical)
 516             ('mirror-left-right (not vertical))
 517             (nil) ;; Don't mirror
 518             (t
 519              (error "Uh? mirror=%s" mirror)))
 520       (setcdr (nthcdr 1 tree) (reverse subtrees))
 521       )
 522     ))
 523
 524 (defun winsav-find-file-noselect (filename)
 525   "Read file FILENAME into a buffer and return the buffer.
 526 Like `find-file-noselect', but if file is not find then creates a
 527 buffer with a message about that."
 528   (let ((buf (find-file-noselect filename)))
 529     (unless buf
 530       (setq buf (generate-new-buffer filename))
 531       (with-current-buffer buf
 532         (insert "Winsav could not find the file " filename)
 533         (set-buffer-modified-p nil)))
 534     buf))
 535
 536
 537
 538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 539 ;;; Session saving and restore etc
 540
 541 ;;;###autoload
 542 (defgroup winsav nil
 543   "Save frames and windows when you exit Emacs."
 544   :group 'frames)
 545
 546 ;;;###autoload
 547 (define-minor-mode winsav-save-mode
 548   "Toggle winsav configuration saving mode.
 549 With numeric ARG, turn winsav saving on if ARG is positive, off
 550 otherwise.
 551
 552 When this mode is turned on, winsav configurations are saved from
 553 one session to another.  A winsav configuration consists of
 554 frames, windows and visible buffers configurations plus
 555 optionally buffers and files managed by the functions used by
 556 option `desktop-save-mode'
 557
 558 By default this is integrated with `desktop-save-mode'.  If
 559 `desktop-save-mode' is on and `winsav-handle-also-desktop' is
 560 non-nil then save and restore also desktop.
 561
 562 See the command `winsav-switch-config' for more information and
 563 other possibilities.
 564
 565 Note: If you want to avoid saving when you exit just turn off
 566 this minor mode.
 567
 568 For information about what is saved and restored and how to save
 569 and restore additional information see the function
 570 `winsav-save-configuration'."
 571   :global t
 572   :group 'winsav)
 573
 574 (defun winsav-save-mode-on ()
 575   "Ensable option `winsav-save-mode'.  Provided for use in hooks."
 576   (winsav-save-mode 1))
 577
 578 (defun winsav-save-mode-off ()
 579   "Disable option `winsav-save-mode'.  Provided for use in hooks."
 580   (winsav-save-mode -1))
 581
 582 (defcustom winsav-save 'ask-if-new
 583   "Specifies whether the winsav config should be saved when it is killed.
 584 A winsav config \(winsav frame configuration) is killed when the
 585 user changes winsav directory or quits Emacs.
 586
 587 Possible values are:
 588    t             -- always save.
 589    ask           -- always ask.
 590    ask-if-new    -- ask if no winsav file exists, otherwise just save.
 591    ask-if-exists -- ask if winsav file exists, otherwise don't save.
 592    if-exists     -- save if winsav file exists, otherwise don't save.
 593    nil           -- never save.
 594 The winsav config is never saved when the option `winsav-save-mode' is nil.
 595 The variables `winsav-dirname' and `winsav-base-file-name'
 596 determine where the winsav config is saved."
 597   :type
 598   '(choice
 599     (const :tag "Always save" t)
 600     (const :tag "Always ask" ask)
 601     (const :tag "Ask if winsav file is new, else do save" ask-if-new)
 602     (const :tag "Ask if winsav file exists, else don't save" ask-if-exists)
 603     (const :tag "Save if winsav file exists, else don't" if-exists)
 604     (const :tag "Never save" nil))
 605   :group 'winsav)
 606
 607 (defcustom winsav-handle-also-desktop t
 608   "If this is non-nil then desktop is also saved and restored.
 609 See option `winsav-save-mode' for more information."
 610   :type 'boolean
 611   :group 'winsav)
 612
 613 (defcustom winsav-base-file-name
 614   (convert-standard-filename ".emacs.winsav")
 615   "Base name of file for Emacs winsav, excluding directory part.
 616 The actual file name will have a system identifier added too."
 617   :type 'file
 618   :group 'winsav)
 619
 620 (defvar winsav-dirname nil
 621   "The directory in which the winsav file should be saved.")
 622
 623 (defun winsav-current-default-dir ()
 624   "Current winsav configuration directory."
 625   (or winsav-dirname "~/"))
 626
 627 ;;(find-file (winsav-full-file-name))
 628 (defun winsav-default-file-name ()
 629   "Default winsav save file name.
 630 The file name consist of `winsav-base-file-name' with a system
 631 identifier added.  This will be '-nw' for a terminal and '-' +
 632 the value of `window-system' otherwise."
 633   (let ((sys-id (if (not window-system)
 634                      "nw"
 635                    (format "%s" window-system))))
 636     (concat winsav-base-file-name "-" sys-id)))
 637
 638 (defun winsav-full-file-name (&optional dirname)
 639   "Return the full name of the winsav session file in DIRNAME.
 640 DIRNAME omitted or nil means use `~'.
 641
 642 The file name part is given by `winsav-default-file-name'."
 643   ;; Fix-me: Different frames in different files? Can multi-tty be handled??
 644     (expand-file-name (winsav-default-file-name) (or dirname
 645                                     (winsav-current-default-dir))))
 646
 647
 648
 649 (defun winsav-serialize (obj)
 650   "Return a string with the printed representation of OBJ.
 651 This should be possible to eval and get a similar object like OBJ
 652 again."
 653   ;;(message "winsav-serialize a")
 654   (prin1-to-string obj)
 655   ;;(message "winsav-serialize b")
 656   )
 657
 658 (defcustom winsav-before-save-configuration-hook nil
 659   "Hook called before saving frames.
 660 Hook for writing elisp code at the beginning of a winsav
 661 configuration file.  When this hook is called the current buffer
 662 and point is where the code should be written.
 663
 664 This is a normal hook.  For more information see
 665 `winsav-save-configuration'."
 666   :type 'hook
 667   :group 'winsav)
 668
 669 (defcustom winsav-after-save-configuration-hook nil
 670   "Hook called after saving frames.
 671 Hook for writing elisp code at the end of a winsav configuration
 672 file.  When this hook is called the current buffer and point is
 673 where the code should be written.
 674
 675 This is a normal hook.  For more information see
 676 `winsav-save-configuration'."
 677   :type 'hook
 678   :group 'winsav)
 679
 680 (defcustom winsav-after-save-frame-hook nil
 681   "Hook called when saving a frame after saving frame data.
 682 Hook for writing elisp code in a winsav configuration file after
 683 each frame creation.  When this hook is called code for restoring
 684 a frame has been written and code that sets
 685 `winsav-last-loaded-frame' to point to it.  Point is in the
 686 configuration file buffer right after this.
 687
 688 This is a normal hook.  For more information see
 689 `winsav-save-configuration'."
 690   :type 'hook
 691   :group 'winsav)
 692
 693 (defvar winsav-loaded-frames nil)
 694 (defvar winsav-last-loaded-frame nil)
 695
 696 (defun winsav-restore-frame (frame-params
 697                              window-tree-params
 698                              use-minibuffer-frame
 699                              window-state
 700                              window-visible)
 701   "Restore a frame with specified values.
 702 If this is a minibuffer only frame then just apply the frame
 703 parameters FRAME-PARAMS.  Otherwise create a new frame using
 704 FRAME-PARAMS and set up windows and buffers according to
 705 WINDOW-TREE-PARAMS.  Also, if USE-MINIBUFFER-FRAME let the new
 706 frame have this minibuffer frame.
 707
 708 WINDOW-STATE is 1 for minimized, 2 for normal and 3 for
 709 maximized."
 710   (let* ((default-minibuffer-frame use-minibuffer-frame)
 711          (frame-name (cdr (assoc 'name frame-params)))
 712          (minibuffer-val (cdr (assoc 'minibuffer frame-params)))
 713          (minibuffer-only (eq 'only minibuffer-val))
 714          (mini-frames
 715           (delq nil (mapcar (lambda (frm)
 716                               (when (eq 'only (frame-parameter frm 'minibuffer))
 717                                 frm))
 718                             (frame-list))))
 719          (frame-with-that-name
 720           (when (and frame-name minibuffer-only)
 721             (catch 'frame
 722               (dolist (frame (frame-list))
 723                 (when (string= frame-name (frame-parameter frame 'name))
 724                   (throw 'frame frame))))))
 725          ;; If this is a minibuffer only frame then if it is already
 726          ;; there under a correct name then do not create it because
 727          ;; there might be variables pointing to it; just set the
 728          ;; parameters. Perhaps even better: if it is not already
 729          ;; there give an error - because it might be impossible to
 730          ;; set things up correctly then.
 731          (frame-with-that-name-has-mini
 732           (when frame-with-that-name
 733             (eq 'only
 734                 (frame-parameter frame-with-that-name 'minibuffer))))
 735          (this-mini-frame (when minibuffer-only
 736                             (or frame-with-that-name
 737                                 (and (= 1 (length mini-frames))
 738                                      (car mini-frames)))))
 739          (create-new
 740           (if minibuffer-only
 741               (if this-mini-frame ;frame-with-that-name-has-mini
 742                   nil
 743                 (error "Winsav: Can't find minibuffer only frame with name %s"
 744                        frame-name))
 745             t))
 746          (this-frame (if create-new
 747                          (make-frame frame-params)
 748                        this-mini-frame))
 749          (win (frame-first-window this-frame)))
 750     ;;(message "create-new=%s, frame-with-that-name=%s" create-new frame-with-that-name)
 751     ;; (when was-max
 752     ;;   (winsav-set-maximized-size this-frame)
 753     ;;   ;; Wait for maximize to occur so horizontal scrolling gets ok.
 754     ;;   (sit-for 1.5)
 755     ;;   )
 756     (case window-state
 757       (1 (winsav-set-minimized-state this-frame))
 758       (3 (winsav-set-maximized-state this-frame)))
 759     (unless window-visible
 760       (make-frame-invisible this-frame))
 761     (if create-new
 762         (winsav-put-window-tree window-tree-params win)
 763       (modify-frame-parameters this-frame frame-params))
 764     (setq winsav-last-loaded-frame this-frame)
 765     (setq winsav-loaded-frames (cons this-frame winsav-loaded-frames))
 766     ))
 767
 768 (defcustom winsav-frame-parameters-to-save
 769   '(
 770     ;;explicit-name
 771     ;;name
 772     ;;parent-id
 773     ;;title
 774     alpha
 775     auto-lower
 776     auto-raise
 777     background-color
 778     background-mode
 779     border-color
 780     border-width
 781     buffer-predicate
 782     cursor-color
 783     cursor-type
 784     font
 785     font-backend
 786     foreground-color
 787     fullscreen
 788     icon-name
 789     icon-type
 790     icon-left
 791     icon-top
 792     internal-border-width
 793     left-fringe
 794     line-spacing
 795     menu-bar-lines
 796     modeline
 797     mouse-color
 798     right-fringe
 799     screen-gamma
 800     scroll-bar-width
 801     tool-bar-lines
 802     top left width height
 803     tty-color-mode ;; ??
 804     unsplittable
 805     user-position
 806     user-size
 807     vertical-scroll-bars
 808     visibility
 809     )
 810   "Parameters saved for frames by `winsav-save-configuration'.
 811 Parameters are those returned by `frame-parameters'."
 812   :type '(repeat (symbol :tag "Frame parameter"))
 813   :group 'winsav)
 814
 815 (defun frame-visible-really-p (frame)
 816   "Return t if FRAME is visible.
 817 This tries to be more corrent on w32 than `frame-visible-p'."
 818   (cond ((fboundp 'w32-frame-placement)
 819          (< 0 (nth 4 (w32-frame-placement frame))))
 820         (t
 821          (frame-visible-p frame))))
 822
 823 (defun frame-maximized-p (frame)
 824   "Return t if it is known that frame is maximized."
 825   (cond ((fboundp 'w32-frame-placement)
 826          (= 3 (abs (nth 4 (w32-frame-placement frame)))))
 827         (t nil)))
 828
 829 (defun frame-minimized-p (frame)
 830   "Return t if it is known that frame is minimized."
 831   (cond ((fboundp 'w32-frame-placement)
 832          (= 3 (abs (nth 4 (w32-frame-placement frame)))))
 833         (t nil)))
 834
 835 ;;(winsav-set-restore-size nil)
 836 ;; (defun winsav-set-restore-size (frame)
 837 ;;   (when (fboundp 'w32-send-sys-command)
 838 ;;     (let ((cur-frm (selected-frame)))
 839 ;;       (select-frame-set-input-focus frame)
 840 ;;       (w32-send-sys-command #xf120)
 841 ;;       ;; Note: sit-for must be used, not sleep-for. Using the latter
 842 ;;       ;; prevents the fetching of the new size (for some reason I do not
 843 ;;       ;; understand).
 844 ;;       (sit-for 1.5)
 845 ;;       (select-frame-set-input-focus cur-frm))
 846 ;;     t))
 847
 848 (defun winsav-set-maximized-state (frame)
 849   (when (fboundp 'w32-send-sys-command)
 850     (select-frame-set-input-focus frame)
 851     (w32-send-sys-command #xf030)
 852     (sit-for 1.0)
 853     t))
 854
 855 (defun winsav-set-minimized-state (frame)
 856   (when (fboundp 'w32-send-sys-command)
 857     (select-frame-set-input-focus frame)
 858     (w32-send-sys-command #xf020)
 859     (sit-for 1.0)
 860     t))
 861
 862 (defun winsav-save-frame (frame mb-frm-nr buffer)
 863   "Write into buffer BUFFER elisp code to recreate frame FRAME.
 864 If MB-FRM-NR is a number then it is the order number of the frame
 865 whose minibuffer should be used."
 866   (message "winsav-save-frame buffer=%s" buffer)
 867   (message "winsav-save-frame buffer 2=%s" (current-buffer))
 868   (let* ((start nil)
 869          (end nil)
 870          (obj (winsav-get-window-tree frame))
 871          (dummy (message "winsav-save-frame buffer 3=%s" (current-buffer)))
 872          (frm-size-now (cons (frame-pixel-height frame)
 873                              (frame-pixel-width frame)))
 874          (dummy (message "winsav-save-frame buffer 4=%s" (current-buffer)))
 875          (placement (when (fboundp 'w32-frame-placement) (w32-frame-placement frame)))
 876          ;; (was-max (and frm-size-rst
 877          ;;               (not (equal frm-size-now frm-size-rst))))
 878          (window-state (abs (nth 4 placement)))
 879          ;; (frm-size-rst (when (winsav-set-restore-size frame)
 880          ;;                   (cons (frame-pixel-height frame)
 881          ;;                         (frame-pixel-width frame))))
 882          ;;(frm-size-rst (when was-max))
 883          ;;(frm-size-rst (when (= 3 (abs (nth 4 placement)))))
 884          (dummy (message "winsav-save-frame buffer 5=%s" (current-buffer)))
 885          (frm-par (frame-parameters frame))
 886          (dummy (message "winsav-save-frame buffer 6=%s" (current-buffer)))
 887          )
 888     (message "winsav-save-frame a1 cb=%s" (current-buffer))
 889     (with-current-buffer buffer
 890       ;;(y-or-n-p (format "was-max=%s" was-max))
 891       (message "winsav-save-frame a2 cb=%s" (current-buffer))
 892       (setq frm-par
 893             (delq nil
 894                   (mapcar (lambda (elt)
 895                             (cond
 896                              ((memq (car elt) winsav-frame-parameters-to-save)
 897                               elt)
 898                              ((eq (car elt) 'minibuffer)
 899                               (let ((val (cdr elt)))
 900                                 (if (not (windowp val))
 901                                     elt
 902                                   (if (eq (window-frame val) frame)
 903                                       nil
 904                                     (cons 'minibuffer nil)))))))
 905                           frm-par)))
 906       (message "winsav-save-frame b cb=%s" (current-buffer))
 907       (insert "(winsav-restore-frame\n'"
 908               ;;make-frame-params
 909               (winsav-serialize frm-par))
 910       (message "winsav-save-frame b.0.1")
 911       ;;window-tree-params
 912       (setq start (point))
 913       (insert "'" (winsav-serialize obj) "\n")
 914       (message "winsav-save-frame b.0.2")
 915       (setq end (copy-marker (point) t))
 916       (message "winsav-save-frame b.0.3")
 917       (message "winsav-save-frame b.1")
 918       ;; (replace-regexp (rx "#<buffer "
 919       ;;                     (1+ (not (any ">")))
 920       ;;                     (1+ ">")) ;; 1+ for indirect buffers ...
 921       ;;                 "buffer"
 922       ;;                 nil start end)
 923       (goto-char start)
 924       (while (re-search-forward (rx "#<buffer "
 925                                     (1+ (not (any ">")))
 926                                     (1+ ">")) ;; 1+ for indirect buffers ...
 927                                 end t)
 928         (replace-match "buffer" nil t))
 929       (message "winsav-save-frame b.2")
 930       ;; (replace-regexp (rx "#<window "
 931       ;;                     (1+ (not (any ">")))
 932       ;;                     (1+ ">"))
 933       ;;                 "nil"
 934       ;;                 nil start end)
 935       (goto-char start)
 936       (while (re-search-forward (rx "#<window "
 937                                     (1+ (not (any ">")))
 938                                     (1+ ">")) ;; 1+ for indirect buffers ...
 939                                 end t)
 940         (replace-match "nil" nil t))
 941       (message "winsav-save-frame c")
 942       (goto-char end)
 943       ;;use-minibuffer-frame
 944       (insert (if mb-frm-nr
 945                   (format "(nth %s (reverse winsav-loaded-frames))" mb-frm-nr)
 946                 "nil")
 947               (format " %s" window-state)
 948               (if (frame-visible-really-p frame) " t " " nil ")
 949               ")\n\n")
 950
 951       (insert "    ;; ---- before after-save-frame-hook ----\n")
 952       ;; (dolist (fun winsav-after-save-frame-hook)
 953       ;;   (funcall fun frame (current-buffer)))
 954       (run-hooks winsav-after-save-frame-hook)
 955       (message "winsav-save-frame d")
 956       (insert "    ;; ---- after after-save-frame-hook  ----\n")
 957
 958       ;;(insert "  )\n\n\n")
 959       )))
 960
 961 (defvar winsav-file-version "1"
 962   "Version number of winsav file format.
 963 Written into the winsav file and used at winsav read to provide
 964 backward compatibility.")
 965
 966
 967 ;; fix-me: This should be in desktop.el
 968 ;; Fix-me: incomplete, not ready.
 969 (defun winsav-restore-indirect-file-buffer (file name)
 970   "Make indirect buffer from file buffer visiting file FILE.
 971 Give it the name NAME."
 972   (let* ((fbuf (find-file-noselect file)))
 973     (when fbuf
 974       (make-indirect-buffer fbuf name))))
 975
 976 (defun winsav-save-indirect-buffers (to-buffer)
 977   "Save information about indirect buffers.
 978 Only file visiting buffers currently.  Clone the base buffers."
 979   (with-current-buffer to-buffer
 980     (dolist (buf (buffer-list))
 981       (when (buffer-base-buffer buf)
 982         (let* ((base-buf (buffer-base-buffer buf))
 983                (file (buffer-file-name base-buf)))
 984           (when file
 985             (insert "(winsav-restore-indirect-file-buffer \""
 986                     file "\" \"" (buffer-name buf) "\")\n")))))))
 987
 988 ;; Fix-me: test
 989 ;; (defun winsav-restore-minibuffer (frame-num frm-num win-num)
 990 ;;   (let* ((frame (nth (1- frame-num) winsav-loaded-frames))
 991 ;;          (mini-frm (nth (1- frm-num) winsav-loaded-frames))
 992 ;;          (mini-win (nth (1- win-num) (reverse (window-list mini-frm))))
 993 ;;          )
 994 ;;     (with-selected-frame frame
 995 ;;       (set-minibuffer-window mini-win))))
 996
 997 (defvar winsav-minibuffer-alist nil)
 998 (defun winsav-save-minibuffers (sorted-frames to-buffer)
 999   "Save information about minibuffer frames.
1000 SORTED-FRAMES should be a list of all frames sorted using
1001 `winsav-frame-sort-predicate'."
1002   (with-current-buffer to-buffer
1003     (setq winsav-minibuffer-alist nil)
1004     (dolist (frame sorted-frames)
1005       (let* ((num-frames (length sorted-frames))
1006              (mini-win (minibuffer-window frame))
1007              (mini-frm (window-frame mini-win))
1008              (win-num (length
1009                        (memq mini-win
1010                              (window-list mini-frm t (frame-first-window mini-frm)))))
1011              (frm-num (- num-frames (length (memq mini-frm sorted-frames))))
1012              (frame-num (- num-frames (length (memq frame sorted-frames)))))
1013         (unless (and (eq mini-frm frame)
1014                      (= win-num 1))
1015           ;; Not the normal minibuffer window
1016           ;;(insert (format ";;(winsav-restore-minibuffer %s %s %s)\n"
1017           ;;(insert (format "'(%s %s)\n" frame-num frm-num)
1018           (setq winsav-minibuffer-alist (cons (list frame-num frm-num) winsav-minibuffer-alist))
1019           )))
1020     (insert "(setq winsav-minibuffer-alist '"
1021             (winsav-serialize winsav-minibuffer-alist)
1022             ")\n")))
1023
1024 (defun winsav-restore-dedicated-window (frame-num win-num dedicate-flag)
1025   "Set dedicated window flag.
1026 On frame number FRAME-NUM in `winsav-loaded-frames' set the
1027 dedicated flag on window number WIN-NUM to DEDICATE-FLAG."
1028   (let* ((frame (nth (1- frame-num) winsav-loaded-frames))
1029          (win (nth (1- win-num) (reverse (window-list frame t
1030                                                       (frame-first-window frame))))))
1031     (set-window-dedicated-p win dedicate-flag)))
1032
1033 (defun winsav-save-dedicated-windows (sorted-frames)
1034   "Save information about dedicated windows on frames in SORTED-FRAMES.
1035 Write this to current buffer."
1036   (dolist (frame sorted-frames)
1037     (dolist (win (window-list frame))
1038       (when (window-dedicated-p win)
1039         (let ((frame-num (length (memq frame sorted-frames)))
1040               (win-num (length
1041                         (memq win
1042                               (window-list frame t (frame-first-window frame)))))
1043               (flag (window-dedicated-p win)))
1044           (insert (format "(winsav-restore-dedicated-window %s %s %S)\n" frame-num win-num flag))
1045           )))))
1046
1047 (defun winsav-restore-ecb (frame-num layout-ecb)
1048   "Restore ECB.
1049 On frame number FRAME-NUM-ECB in `winsav-loaded-frames' restore
1050 ECB layout LAYOUT-ECB."
1051   (when (boundp 'ecb-minor-mode)
1052     (let* ((frame (nth (1- frame-num) winsav-loaded-frames)))
1053       (select-frame frame)
1054       (unless (string= layout-ecb ecb-layout-name)
1055         (setq ecb-layout-name layout-ecb))
1056       (ecb-minor-mode 1))))
1057
1058 (defun winsav-save-ecb (frame-ecb layout-ecb sorted-frames)
1059   "Save information about ECB layout on frames in SORTED-FRAMES.
1060 Write this in current buffer."
1061   (dolist (frame sorted-frames)
1062     (when (eq frame frame-ecb)
1063       (let ((frame-num (length (memq frame sorted-frames))))
1064         (insert (format "(winsav-restore-ecb %s %S)\n" frame-num layout-ecb))))))
1065
1066 ;; (make-frame '((minibuffer)))
1067 ;; (sort (frame-list) 'winsav-frame-sort-predicate)
1068 (defun winsav-frame-sort-predicate (a b)
1069   "Compare frame A and B for sorting.
1070 Sort in the order frames can be created.
1071
1072 - Frames without minibuffers will come later since the need to
1073   refer to the minibuffer frame when they are created.
1074
1075 - Invisible frames comes last since there must be at least one
1076   visible frame from the beginning."
1077   (let* ((a-mbw (minibuffer-window a))
1078          (a-mbw-frm (window-frame a-mbw))
1079          (b-mbw (minibuffer-window b))
1080          (b-mbw-frm (window-frame b-mbw))
1081          (a-visible (frame-visible-really-p a))
1082          (b-visible (frame-visible-really-p b))
1083          )
1084     ;;(message "a-mbw-frm=%s, b=%s" a-mbw-frm b)
1085     ;;(message "b-mbw-frm=%s, a=%s" a-mbw-frm b)
1086     (when (or (not b-visible)
1087               (eq a-mbw-frm b)
1088               (not (eq b-mbw-frm b)))
1089       ;;(message "a > b")
1090       t
1091       )))
1092
1093 (defun winsav-can-read-config (config-version)
1094   "Return t we can read config file version CONFIG-VERSION."
1095   (when (<= config-version 1)
1096     t))
1097
1098 (defvar winsav-file-modtime nil)
1099
1100 ;; Like desktop-save, fix-me
1101 (defun winsav-save-configuration (&optional dirname release)
1102   "Write elisp code to recreate all frames.
1103 Write into the file name computed by `winsav-full-file-name'
1104 given the argument DIRNAME.
1105
1106 The information that is saved for each frame is its size and
1107 position, the window configuration including buffers and the
1108 parameters in `winsav-frame-parameters-to-save'.  If you want save
1109 more information for frames you can do that in the hook
1110 `winsav-after-save-frame-hook'.
1111
1112 See also the hook variables
1113 `winsav-before-save-configuration-hook' and
1114 `winsav-after-save-configuration-hook'.
1115
1116 Fix-me: RELEASE is not implemented."
1117   (winsav-save-config-to-file (winsav-full-file-name dirname)))
1118
1119 (defun winsav-save-config-to-file (conf-file)
1120   "Write elisp code to recreate all frames to CONF-FILE."
1121   (let (start
1122         end
1123         (sorted-frames (sort (frame-list) 'winsav-frame-sort-predicate))
1124         (frm-nr 0)
1125         frame-ecb
1126         layout-ecb)
1127     ;; Recreating invisible frames hits Emacs bug 3859
1128     (setq sorted-frames
1129           (delq nil
1130                 (mapcar (lambda (f)
1131                           (when (frame-parameter f 'visibility) f))
1132                         sorted-frames)))
1133     (when (and (boundp 'ecb-minor-mode) ecb-minor-mode)
1134       (when (frame-live-p ecb-frame)
1135         (setq layout-ecb ecb-layout-name)
1136         (setq frame-ecb ecb-frame))
1137       (ecb-minor-mode -1)
1138       (sit-for 0) ;; Fix-me: is this needed?
1139       )
1140     (message "winsav-save-config:here a")
1141     (with-temp-buffer
1142       (let ((this-buffer (current-buffer)))
1143         (message "winsav-save-config:here b")
1144         ;;(erase-buffer)
1145         (insert
1146          ";; -*- mode: emacs-lisp; coding: utf-8; -*-\n"
1147          ";; --------------------------------------------------------------------------\n"
1148          ";; Winsav File for Emacs\n"
1149          ";; --------------------------------------------------------------------------\n"
1150          ";; Created " (current-time-string) "\n"
1151          ";; Winsav file format version " winsav-file-version "\n"
1152          ";; Emacs version " emacs-version "\n\n"
1153          "(if (not (winsav-can-read-config " winsav-file-version "))\n\n"
1154          "    (message \"Winsav: Can't read config file with version " winsav-file-version "\")\n")
1155         (message "winsav-save-config:here c")
1156         (insert ";; ---- indirect buffers ------------------------\n")
1157         (winsav-save-indirect-buffers this-buffer)
1158         (message "winsav-save-config:here c.1")
1159         ;;(insert ";; ---- special minibuffers ------------------------\n")
1160         (winsav-save-minibuffers sorted-frames this-buffer)
1161         (message "winsav-save-config:here c.2")
1162         (insert "(setq winsav-loaded-frames nil)\n")
1163         (insert ";; ---- before winsav-before-save-configuration-hook ------------------------\n")
1164         (run-hooks 'winsav-before-save-configuration-hook)
1165         (message "winsav-save-config:here c.2a cb=%s" (current-buffer))
1166         (insert ";; ---- after winsav-before-save-configuration-hook  ------------------------\n\n")
1167         (dolist (frm sorted-frames)
1168           (let ((mb-frm-nr (cadr (assoc frm-nr winsav-minibuffer-alist)))
1169                 ;;(mb-frm (when mb-frm-nr (nth mb-frm-nr sorted-frames)))
1170                 )
1171             (message "winsav-save-config:here c.2b.1 tb=%s cb=%s frm=%s" this-buffer (current-buffer) frm)
1172             (winsav-save-frame frm mb-frm-nr this-buffer)
1173             (message "winsav-save-config:here c.2b.2")
1174             (setq frm-nr (1+ frm-nr))))
1175         (message "winsav-save-config:here c.2c cb=%s" (current-buffer))
1176         (insert ";; ---- dedicated windows ------------------------\n")
1177         (winsav-save-dedicated-windows sorted-frames)
1178         (message "winsav-save-config:here c.3")
1179         (insert ";; ---- ECB --------------------------------------\n")
1180         (winsav-save-ecb frame-ecb layout-ecb sorted-frames)
1181         (message "winsav-save-config:here c.4")
1182         (insert "\n\n;; ---- before winsav-after-save-configuration-hook  ------------------------\n")
1183         (run-hooks 'winsav-after-save-configuration-hook)
1184         (message "winsav-save-config:here c.5")
1185         (insert "\n\n;; ---- before winsav-after-save-configuration-hook  ------------------------\n")
1186         (run-hooks 'winsav-after-save-configuration-hook)
1187         (message "winsav-save-config:here c.6")
1188         (insert ";; ---- after winsav-after-save-configuration-hook   ------------------------\n")
1189         (insert "\n)\n")
1190         (message "winsav-save-config:here d")
1191         ;; For pp-buffer:
1192         (let (emacs-lisp-mode-hook
1193               after-change-major-mode-hook
1194               change-major-mode-hook)
1195           (font-lock-mode -1)
1196           (emacs-lisp-mode))
1197         (message "winsav-save-config:here e")
1198         (pp-buffer)
1199         (message "winsav-save-config:here f")
1200         (indent-region (point-min) (point-max))
1201         (message "winsav-save-config:here g")
1202         ;;(save-buffer 0) ;; No backups
1203         ;;(kill-buffer)
1204
1205         ;;(with-current-buffer (find-file-noselect file)
1206         (let ((coding-system-for-write 'utf-8))
1207           (write-region (point-min) (point-max) conf-file nil 'nomessage))
1208         (setq winsav-file-modtime (nth 5 (file-attributes conf-file)))
1209         (setq winsav-dirname (file-name-as-directory (file-name-directory conf-file)))
1210         (message "winsav-save-config:here h")
1211         ))))
1212
1213 (defvar winsav-current-config-name nil)
1214
1215 ;;(winsav-restore-configuration)
1216 ;;(winsav-full-file-name "~")
1217 ;; (defun winsav-restore-winsav-configuration ()
1218 ;;   )
1219
1220 (defcustom winsav-after-restore-hook nil
1221   "Normal hook run after a successful `winsav-restore-configuration'."
1222   :type 'hook
1223   :group 'winsav)
1224
1225 ;; Like desktop-read, fix-me
1226 (defun winsav-restore-configuration (&optional dirname)
1227   "Restore frames from default file in directory DIRNAME.
1228 The default file is given by `winsav-default-file-name'.
1229
1230 The file was probably written by `winsav-save-configuration'.
1231 Delete the frames that were used before."
1232   ;;(message "winsav-restore-configuration %s" dirname)
1233   (winsav-restore-config-from-file (winsav-full-file-name dirname)))
1234
1235 (defun winsav-restore-config-from-file (conf-file)
1236   "Restore frames from configuration file CONF-FILE.
1237 The file was probably written by `winsav-save-configuration'.
1238 Delete the frames that were used before."
1239   (let ((old-frames (sort (frame-list) 'winsav-frame-sort-predicate))
1240         (num-old-deleted 0)
1241         ;; Avoid winsav saving during restore.
1242         (winsav-save nil))
1243     ;;(message "winsav:conf-file=%s" conf-file)
1244     (if (or (not conf-file)
1245             (not (file-exists-p conf-file)))
1246         (progn
1247           (message (propertize "Winsav: No default configuration file found"
1248                                'face 'secondary-selection))
1249           t) ;; Ok
1250       (setq debug-on-error t) ;; fix-me
1251       (if (file-exists-p conf-file)
1252           (progn
1253             (load conf-file nil nil t)
1254             (setq winsav-file-modtime (nth 5 (file-attributes conf-file)))
1255             (setq winsav-dirname (file-name-as-directory (file-name-directory conf-file)))
1256             (when (< 0 (length winsav-loaded-frames))
1257               (dolist (old (reverse old-frames))
1258                 (unless (eq 'only (frame-parameter old 'minibuffer))
1259                   (setq num-old-deleted (1+ num-old-deleted))
1260                   (delete-frame old)))
1261               )
1262             (message "winsav-after-restore-hook =%S" winsav-after-restore-hook)
1263             (run-hooks 'winsav-after-restore-hook)
1264             (message "Winsav: %s frame(s) restored" (length winsav-loaded-frames))
1265             t)
1266         ;; No winsav file found
1267         ;;(winsav-clear)
1268         (message "No winsav file: %s" conf-file)
1269         nil))))
1270
1271 ;; (defcustom winsav-add-to-desktop nil
1272 ;;   "Set this to let desktop save and restore also winsav configurations."
1273 ;;   :type 'boolean
1274 ;;   :set (lambda (sym val)
1275 ;;          (set-default sym val)
1276 ;;          (if value
1277 ;;              (progn
1278 ;;                (add-hook 'desktop-after-read-hook 'winsav-restore-configuration)
1279 ;;                (add-hook 'desktop-save-hook 'winsav-save-configuration))
1280 ;;            (remove-hook 'desktop-after-read-hook 'winsav-restore-configuration)
1281 ;;            (remove-hook 'desktop-save-hook 'winsav-save-configuration)) )
1282 ;;   :group 'winsav)
1283
1284 (defun winsav-restore-configuration-protected (&optional dirname)
1285   "Like `winsav-restore-configuration' but protect for errors.
1286 DIRNAME has the same meaning."
1287   (condition-case err
1288       (winsav-restore-configuration dirname)
1289     (error
1290      (message "winsav-restore-configuration: %s" err))))
1291
1292 (defun winsav-relative-~-or-full (dirname)
1293   (let* ((rel-dir (file-relative-name dirname
1294                                       (file-name-directory
1295                                        (winsav-full-file-name "~"))))
1296          (confname (if (string= ".." (substring rel-dir 0 2))
1297                        winsav-dirname
1298                      (if (string= rel-dir "./")
1299                          "(default)"
1300                        (concat "~/" rel-dir)))))
1301     confname))
1302
1303 (defun winsav-tell-configuration ()
1304   "Tell which winsav configuration that is used."
1305   (interactive)
1306   (save-match-data ;; runs in timer
1307     (let ((confname (if (not winsav-dirname)
1308                         "(none)"
1309                       (winsav-relative-~-or-full winsav-dirname))))
1310       (if t ;;(called-interactively-p)
1311           (message (propertize (format "Current winsav config is '%s'" confname)
1312                                'face 'secondary-selection))
1313         (save-window-excursion
1314           (delete-other-windows)
1315           (set-window-buffer (selected-window)
1316                              (get-buffer-create " *winsav*"))
1317           (with-current-buffer (window-buffer)
1318             (momentary-string-display
1319              (propertize
1320               (format "\n\n\n  Current winsav config is '%s'\n\n\n\n" confname)
1321               'face 'secondary-selection)
1322              (window-start)
1323              (kill-buffer))))))))
1324
1325 (defun winsav-tell-configuration-request ()
1326   "Start an idle timer to call `winsav-tell-configuration'."
1327   (run-with-idle-timer 1 nil 'winsav-tell-configuration))
1328
1329
1330
1331 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1332 ;;; Startup and shut down
1333
1334 ;; Run after desktop at startup so that desktop has loaded files and
1335 ;; buffers.
1336 (defun winsav-after-init ()
1337   "Restore frames and windows.
1338 Run this once after Emacs startup, after desktop in the
1339 `after-init-hook'."
1340   ;; Turn off with --no-deskttop:
1341   (unless desktop-save-mode (winsav-save-mode -1))
1342   (when winsav-save-mode
1343     ;;(run-with-idle-timer 0.1 nil 'winsav-restore-configuration-protected)
1344     ;;(message "winsav-after-init")
1345     ;;(winsav-restore-configuration-protected)
1346     ;; In case of error make sure winsav-save-mode is turned off
1347     (setq inhibit-startup-screen t)
1348     (winsav-save-mode -1)
1349     (winsav-restore-configuration)
1350     (winsav-save-mode 1)
1351     ))
1352
1353 (add-hook 'after-init-hook 'winsav-after-init t)
1354
1355 (add-hook 'kill-emacs-hook 'winsav-kill)
1356 ;;(remove-hook 'kill-emacs-hook 'winsav-kill)
1357
1358 (defun winsav-kill ()
1359   "Save winsav frame configuration.
1360 Run this before Emacs exits."
1361   ;; (when winsav-save-mode
1362   ;;   (let ((conf-dir (when winsav-current-config-name
1363   ;;                     (winsav-full-config-dir-name winsav-current-config-name))))
1364   ;;     (winsav-save-configuration conf-dir))))
1365   (when (and winsav-save-mode
1366              (let ((exists (file-exists-p (winsav-full-file-name))))
1367                (or (eq winsav-save t)
1368                    (and exists (memq winsav-save '(ask-if-new if-exists)))
1369                    (and
1370                     (or (memq winsav-save '(ask ask-if-new))
1371                         (and exists (eq winsav-save 'ask-if-exists)))
1372                     (y-or-n-p "Save winsav? ")))))
1373     (unless winsav-dirname
1374       ;; Fix-me: Since this can be a new user of winsav I think the
1375       ;; best thing to do here is to encourage the user to save in the
1376       ;; default directory since otherwise the winsav file will not be
1377       ;; loaded at startup. Desktop does not currently do that however
1378       ;; (report that!).
1379       (when (y-or-n-p "Winsav was not loaded from file. Save it to file? ")
1380         (let* ((full-file (winsav-full-file-name))
1381                (default-directory (directory-file-name
1382                                    (file-name-directory full-file))))
1383           (setq winsav-dirname
1384                 (file-name-as-directory
1385                  (expand-file-name
1386                   (read-directory-name "Directory for winsav file: " nil nil t)))))))
1387     (when winsav-dirname
1388       (condition-case err
1389           ;;(winsav-save winsav-dirname t)
1390           (winsav-save-configuration winsav-dirname)
1391         (file-error
1392          (unless (yes-or-no-p
1393                   (format "Error while saving winsav config: %s  Save anyway? "
1394                           (error-message-string err)))
1395            (signal (car err) (cdr err)))))))
1396   ;; If we own it, we don't anymore.
1397   ;;(when (eq (emacs-pid) (winsav-owner)) (winsav-release-lock))
1398   )
1399
1400
1401 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1402 ;;; Switching configurations
1403
1404 (defun winsav-restore-full-config (dirname)
1405   "Restore the winsav configuration in directory DIRNAME.
1406 If NAME is nil then restore the startup configuration."
1407   ;;(desktop-change-dir dirname)
1408   (when (and winsav-handle-also-desktop desktop-save-mode)
1409     (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))
1410     (desktop-clear)
1411     (desktop-read dirname))
1412   (winsav-restore-configuration dirname)
1413   ;;(setq winsav-current-config-name name)
1414   (winsav-tell-configuration-request))
1415
1416 (defun winsav-full-config-dir-name (name)
1417   "Return full directory path where configuration NAME is stored."
1418   (let* ((base-dir (concat (winsav-full-file-name) ".d"))
1419          (conf-dir (expand-file-name name base-dir)))
1420     (setq conf-dir (file-name-as-directory conf-dir))
1421     ;;(message "conf-dir=%s" conf-dir)
1422     conf-dir))
1423
1424 ;;;###autoload
1425 (defun winsav-save-full-config (dirname)
1426   "Saved current winsav configuration in directory DIRNAME.
1427 Then change to this configuration.
1428
1429 See also `winsav-switch-config'."
1430   (unless (file-name-absolute-p dirname)
1431     (error "Directory ame must be absolute: %s" dirname))
1432   (let* ((conf-dir (or dirname "~"))
1433          (old-conf-dir winsav-dirname))
1434     (make-directory conf-dir t)
1435     (winsav-save-configuration conf-dir)
1436     (when (and winsav-handle-also-desktop desktop-save-mode)
1437       (desktop-release-lock)
1438       (desktop-save conf-dir))
1439     ;;(unless (string= winsav-current-config-name name)
1440     (unless (string= old-conf-dir conf-dir)
1441       ;;(setq winsav-current-config-name name)
1442       (winsav-tell-configuration-request))))
1443
1444 ;; Fix-me: remove named configurations, use just dir as desktop
1445 (defun winsav-switch-to-default-config ()
1446   "Change to default winsav configuration.
1447 See also `winsav-switch-config'."
1448   (interactive)
1449   (winsav-switch-config "~"))
1450
1451 ;;;###autoload
1452 (defun winsav-switch-config (dirname)
1453   "Change to winsav configuration in directory DIRNAME.
1454 If DIRNAME is the current winsav configuration directory then
1455 offer to save it or restore it from saved values.
1456
1457 Otherwise, before switching offer to save the current winsav
1458 configuration.  Then finally switch to the new winsav
1459 configuration, creating it if it does not exist.
1460
1461 If option `desktop-save-mode' is on then buffers and files are also
1462 restored and saved the same way.
1463
1464 See also option `winsav-save-mode' and command
1465 `winsav-tell-configuration'."
1466   (interactive
1467    (list
1468     (let ((default-directory (or winsav-dirname default-directory))
1469           (base-dir (concat (winsav-full-file-name) ".d"))
1470           new-dir)
1471       (make-directory base-dir t)
1472       (setq new-dir
1473             (read-directory-name "Winsav: Switch config directory: "))
1474       (when (string= "" new-dir) (setq new-dir nil))
1475       (or new-dir
1476           "~"))))
1477   (setq dirname (file-name-as-directory (expand-file-name dirname)))
1478   (catch 'stop
1479     (let ((conf-file (expand-file-name winsav-base-file-name dirname))
1480           config-exists)
1481       (if (file-exists-p conf-file)
1482           (setq config-exists t)
1483         (unless (y-or-n-p (format "%s was not found.  Create it? " conf-file))
1484           (throw 'stop nil)))
1485       (if (string= winsav-dirname dirname)
1486           (if (y-or-n-p "You are already using this configuration, restore it from saved values? ")
1487               (winsav-restore-full-config winsav-dirname)
1488             (when (y-or-n-p "You are already using this winsav configuration, save it? ")
1489               (winsav-save-full-config winsav-dirname)))
1490         (when (y-or-n-p
1491                (format "Save current config, %s,\n first before switching to %s? "
1492                        (if (and winsav-dirname
1493                                 (not (string= winsav-dirname
1494                                               (file-name-directory (winsav-full-file-name "~")))))
1495                            winsav-dirname
1496                          "the startup config")
1497                        dirname))
1498           (winsav-save-full-config winsav-dirname))
1499         (if config-exists
1500             (winsav-restore-full-config dirname)
1501           (winsav-save-full-config dirname))))))
1502
1503
1504
1505
1506 ;;; Old things
1507
1508 ;; (defun winsav-log-buffer ()
1509 ;;   (get-buffer-create "winsav log buffer"))
1510
1511 ;; (defun winsav-log (mark obj)
1512 ;;   (with-current-buffer (winsav-log-buffer)
1513 ;;     (insert "=== " mark "===\n" (pp-to-string obj))))
1514
1515 ;; (global-set-key [f2] 'winsav-test-get)
1516 ;; (global-set-key [f3] 'winsav-test-put)
1517 ;; (defvar winsav-saved-window-tree nil)
1518
1519 ;; (defun winsav-test-get()
1520 ;;   (interactive)
1521 ;;   (setq winsav-saved-window-tree (winsav-get-window-tree)))
1522
1523 ;; (defun winsav-test-put()
1524 ;;   (interactive)
1525 ;;   (let ((ret (winsav-put-window-tree winsav-saved-window-tree
1526 ;;                                      (selected-window))))
1527 ;;     ;;(message "ret=%s" ret)
1528 ;;     ))
1529
1530 ;; (defun winsav-serialize-to-file (obj file)
1531 ;;   (with-current-buffer (find-file-noselect file)
1532 ;;     ;;(erase-buffer)
1533 ;;     (save-restriction
1534 ;;       (widen)
1535 ;;       (goto-char (point-max))
1536 ;;       (insert (winsav-serialize obj)
1537 ;;               "\n"))
1538 ;;     ;;(basic-save-buffer)
1539 ;;     ))
1540
1541 ;;(global-set-key [f11] 'winsav-rotate)
1542
1543 ;; (defun winsav-de-serialize-window-tree-from-file (file)
1544 ;;   (with-current-buffer (find-file-noselect file)
1545 ;;     (save-restriction
1546 ;;       (widen)
1547 ;;       (let ((start (point))
1548 ;;             (end nil))
1549 ;;         (forward-list)
1550 ;;         (setq end (point))
1551 ;;         ;;(goto-char (point-min))
1552 ;;         (winsav-de-serialize-window-tree (buffer-substring-no-properties start end))))))
1553
1554 ;; (defun winsav-restore-from-file (file)
1555 ;;   (winsav-put-window-tree
1556 ;;    (winsav-de-serialize-window-tree-from-file file)
1557 ;;    (selected-window)))
1558
1559 ;; (defun winsav-de-serialize-window-tree (str)
1560 ;;   (save-match-data
1561 ;;     (let ((read-str
1562 ;;            (replace-regexp-in-string (rx "#<buffer "
1563 ;;                                          (1+ (not (any ">")))
1564 ;;                                          ">")
1565 ;;                                      "buffer"
1566 ;;                                      str))
1567 ;;           obj-last
1568 ;;           obj
1569 ;;           last)
1570 ;;       (setq read-str
1571 ;;             (replace-regexp-in-string (rx "#<window "
1572 ;;                                           (1+ (not (any ">")))
1573 ;;                                           ">")
1574 ;;                                       "nil"
1575 ;;                                       read-str))
1576 ;;       (setq obj-last (read-from-string read-str))
1577 ;;       (setq obj (car obj-last))
1578 ;;       (setq last (cdr obj-last))
1579 ;;       ;; Fix me, maby check there are only spaces left (or trim them above...)
1580 ;;       obj)))
1581
1582 (provide 'winsav)
1583
1584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1585 ;;; winsav.el ends here