Download
(defgroup winpoint nil
"Remember buffer positions per-window, not per buffer."
:group 'window)
(defcustom winpoint-non-restore-buffer-list
'()
"The buffer list that don't restore point."
:type 'list
:group 'winpoint)
(defvar winpoint-frame-windows nil
"The current frame's windows and their buffers.
This is an alist mapping windows to their current buffers.")
(when (> emacs-major-version 22)
(eval-when-compile
(with-no-warnings
(make-variable-frame-local 'winpoint-frame-windows))))
(defvar winpoint-frame-positions nil
"The current frame's windows and their associated buffer positions.
This is an alist mapping windows to an alist mapping buffers to
their stored point marker.")
(when (> emacs-major-version 22)
(eval-when-compile
(with-no-warnings
(make-variable-frame-local 'winpoint-frame-positions))))
(defalias 'window-point-remember-mode 'winpoint-mode)
(define-minor-mode winpoint-mode
"Remember positions in a buffer per-window, not per-buffer.
That is, when you have the same buffer open in two different
windows, and you switch the buffer in one window and back again,
the position is the same as it was when you switched away, not
the same as in the other window."
:global t
(cond
(winpoint-mode
(add-hook 'post-command-hook 'winpoint-remember)
(add-hook 'window-configuration-change-hook
'winpoint-remember-configuration))
(t
(remove-hook 'post-command-hook 'winpoint-remember)
(remove-hook 'window-configuration-change-hook
'winpoint-remember-configuration))))
(defun winpoint-remember ()
"Remember the currently visible buffer's positions.
This should be put on `post-command-hook'."
(walk-windows (lambda (win)
(let ((buf (window-buffer win)))
(winpoint-put win
buf
(window-point win))))))
(defun winpoint-remember-configuration ()
"This remembers the currently shown windows.
If any buffer wasn't shown before, point in that window is
restored.
If any window isn't shown anymore, forget about it."
(winpoint-clean)
(setq winpoint-frame-windows
(mapcar (lambda (win)
(let ((old (assq win winpoint-frame-windows))
(newbuf (window-buffer win)))
(when (and old
(not (eq (cdr old)
newbuf)))
(winpoint-restore win))
(cons win newbuf)))
(window-list))))
(eval-when-compile
(when (not (fboundp 'with-selected-window))
(defmacro with-selected-window (window &rest body)
"Execute the forms in BODY with WINDOW as the selected window."
`(save-selected-window
(select-window ,window)
,@body))))
(defun winpoint-restore (win)
"Restore point in the window WIN."
(with-selected-window win
(let ((point (winpoint-get win (current-buffer))))
(when (and point
(not (winpoint-match-non-restore-buffer (buffer-name))))
(goto-char point)))))
(defun winpoint-match-non-restore-buffer (bufname)
"Function document"
(let (buffer-match-p)
(catch 'match
(dolist (element winpoint-non-restore-buffer-list)
(when (string-equal element bufname)
(setq buffer-match-p t)
(throw 'match "Match non restored buffer."))))
buffer-match-p))
(defun winpoint-get (win buf)
"Return a cons cell of the stored point of BUF in WIN."
(let ((window-entry (assq win winpoint-frame-positions)))
(when window-entry
(let ((buffer (assq buf (cdr window-entry))))
(when buffer
(cdr buffer))))))
(defun winpoint-put (win buf point)
"Store POINT as the current point for BUF in WIN."
(let ((window-entry (assq win winpoint-frame-positions)))
(if window-entry
(let ((buffer (assq buf (cdr window-entry))))
(if buffer
(set-marker (cdr buffer) point buf)
(setcdr window-entry
(cons `(,buf . ,(set-marker (make-marker)
point
buf))
(cdr window-entry)))))
(setq winpoint-frame-positions
(cons `(,win . ((,buf . ,(set-marker (make-marker)
point
buf))))
winpoint-frame-positions)))))
(defun winpoint-clean ()
"Remove unknown windows."
(let ((windows (window-list)))
(setq winpoint-frame-positions
(filter-map! (lambda (entry)
(let ((bufs (filter! (lambda (buf+pos)
(buffer-live-p (car buf+pos)))
(cdr entry))))
(when (not (null bufs))
(cons (car entry)
bufs))))
winpoint-frame-positions))))
(defun filter-map! (fun list)
"Map FUN over LIST, retaining all non-nil elements."
(while (and list
(not (setcar list (funcall fun (car list)))))
(setq list (cdr list)))
(when list
(let ((list list))
(while (cdr list)
(if (not (setcar (cdr list)
(funcall fun (cadr list))))
(setcdr list (cddr list))
(setq list (cdr list))))))
list)
(defun filter! (pred list)
"Return all elements of LIST for which PRED returns non-nil.
This modifies LIST whenever possible."
(while (and list
(not (funcall pred (car list))))
(setq list (cdr list)))
(when list
(let ((list list))
(while (cdr list)
(if (not (funcall pred (cadr list)))
(setcdr list (cddr list))
(setq list (cdr list))))))
list)
(provide 'winpoint)