saveplace.el 13.7 KB
Newer Older
1
;;; saveplace.el --- automatically save place in files
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3
;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4

Karl Fogel's avatar
Karl Fogel committed
5
;; Author: Karl Fogel <kfogel@red-bean.com>
Richard M. Stallman's avatar
Richard M. Stallman committed
6 7 8 9 10 11
;; Maintainer: FSF
;; Created: July, 1993
;; Keywords: bookmarks, placeholders

;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
16 17 18 19 20 21 22

;; GNU Emacs 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
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Erik Naggum's avatar
Erik Naggum committed
24

Richard M. Stallman's avatar
Richard M. Stallman committed
25 26
;;; Commentary:

Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29 30 31 32
;; Automatically save place in files, so that visiting them later
;; (even during a different Emacs session) automatically moves point
;; to the saved position, when the file is first found.  Uses the
;; value of buffer-local variable save-place to determine whether to
;; save position or not.
;;
33 34
;; Thanks to Stefan Schoef, who sent a patch with the
;; `save-place-version-control' stuff in it.
Richard M. Stallman's avatar
Richard M. Stallman committed
35

Richard M. Stallman's avatar
Richard M. Stallman committed
36 37
;;; Code:

Richard M. Stallman's avatar
Richard M. Stallman committed
38
;; this is what I was using during testing:
39
;; (define-key ctl-x-map "p" 'toggle-save-place-globally)
Richard M. Stallman's avatar
Richard M. Stallman committed
40

41 42 43 44 45
(defgroup save-place nil
  "Automatically save place in files."
  :group 'data)


Richard M. Stallman's avatar
Richard M. Stallman committed
46 47 48 49 50 51 52
(defvar save-place-alist nil
  "Alist of saved places to go back to when revisiting files.
Each element looks like (FILENAME . POSITION);
visiting file FILENAME goes automatically to position POSITION
rather than the beginning of the buffer.
This alist is saved between Emacs sessions.")

53
(defcustom save-place nil
Lute Kamstra's avatar
Lute Kamstra committed
54
  "Non-nil means automatically save place in each file.
Richard M. Stallman's avatar
Richard M. Stallman committed
55 56 57 58
This means when you visit a file, point goes to the last place
where it was when you previously visited the same file.
This variable is automatically buffer-local.

59 60 61
If you wish your place in any file to always be automatically
saved, set this to t using the Customize facility, or put the
following code in your init file:
Richard M. Stallman's avatar
Richard M. Stallman committed
62

Richard M. Stallman's avatar
Richard M. Stallman committed
63
\(setq-default save-place t)
64
\(require 'saveplace)"
65
  :type 'boolean
66
  :require 'saveplace
67
  :group 'save-place)
Richard M. Stallman's avatar
Richard M. Stallman committed
68 69 70

(make-variable-buffer-local 'save-place)

Stefan Monnier's avatar
Stefan Monnier committed
71
(defcustom save-place-file (locate-user-emacs-file "places" ".emacs-places")
Lute Kamstra's avatar
Lute Kamstra committed
72
  "Name of the file that records `save-place-alist' value."
73 74
  :type 'file
  :group 'save-place)
Richard M. Stallman's avatar
Richard M. Stallman committed
75

76
(defcustom save-place-version-control nil
Lute Kamstra's avatar
Lute Kamstra committed
77
  "Controls whether to make numbered backups of master save-place file.
78 79 80
It can have four values: t, nil, `never', and `nospecial'.  The first
three have the same meaning that they do for the variable
`version-control', and the final value `nospecial' means just use the
81 82 83 84
value of `version-control'."
  :type '(radio (const :tag "Unconditionally" t)
		(const :tag "For VC Files" nil)
		(const never)
85
		(const :tag "Use value of `version-control'" nospecial))
86
  :group 'save-place)
87

Richard M. Stallman's avatar
Richard M. Stallman committed
88 89 90
(defvar save-place-loaded nil
  "Non-nil means that the `save-place-file' has been loaded.")

91
(defcustom save-place-limit 400
92
  "Maximum number of entries to retain in the list; nil means no limit."
93
  :version "24.1"                       ; nil -> 400
94 95 96
  :type '(choice (integer :tag "Entries" :value 1)
		 (const :tag "No Limit" nil))
  :group 'save-place)
97

98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
(defcustom save-place-forget-unreadable-files t
  "Non-nil means forget place in unreadable files.

The filenames in `save-place-alist' that do not match
`save-place-skip-check-regexp' are filtered through
`file-readable-p'. if nil, their alist entries are removed.

You may do this anytime by calling the complementary function,
`save-place-forget-unreadable-files'.  When this option is turned on,
this happens automatically before saving `save-place-alist' to
`save-place-file'."
  :type 'boolean :group 'save-place)

(defcustom save-place-save-skipped t
  "If non-nil, remember files matching `save-place-skip-check-regexp'.

When filtering `save-place-alist' for unreadable files, some will not
be checked, based on said regexp, and instead saved or forgotten based
on this flag."
  :type 'boolean :group 'save-place)

(defcustom save-place-skip-check-regexp
  ;; thanks to ange-ftp-name-format
  "\\`/\\(?:cdrom\\|floppy\\|mnt\\|\\(?:[^@/:]*@\\)?[^@/:]*[^@/:.]:\\)"
  "Regexp whose file names shall not be checked for readability.

When forgetting unreadable files, file names matching this regular
expression shall not be checked for readability, but instead be
subject to `save-place-save-skipped'.

Files for which such a check may be inconvenient include those on
removable and network volumes."
  :type 'regexp :group 'save-place)

132 133
(defcustom save-place-ignore-files-regexp
  "\\(?:COMMIT_EDITMSG\\|hg-editor-[[:alnum:]]+\\.txt\\|svn-commit\\.tmp\\|bzr_log\\.[[:alnum:]]+\\)$"
134
  "Regexp matching files for which no position should be recorded.
135
Useful for temporary file such as commit message files that are
136 137
automatically created by the VCS.  If set to nil, this feature is
disabled, i.e., the position is recorded for all files."
138
  :version "24.1"
139 140
  :type 'regexp :group 'save-place)

Richard M. Stallman's avatar
Richard M. Stallman committed
141 142 143 144 145 146 147 148 149
(defun toggle-save-place (&optional parg)
  "Toggle whether to save your place in this file between sessions.
If this mode is enabled, point is recorded when you kill the buffer
or exit Emacs.  Visiting this file again will go to that position,
even in a later Emacs session.

If called with a prefix arg, the mode is enabled if and only if
the argument is positive.

150 151
To save places automatically in all files, put this in your init
file:
Richard M. Stallman's avatar
Richard M. Stallman committed
152 153 154

\(setq-default save-place t\)"
  (interactive "P")
155 156
  (if (not (or buffer-file-name dired-directory))
      (message "Buffer `%s' not visiting a file or directory" (buffer-name))
Richard M. Stallman's avatar
Richard M. Stallman committed
157 158
    (if (and save-place (or (not parg) (<= parg 0)))
	(progn
159
	  (message "No place will be saved in this file")
Richard M. Stallman's avatar
Richard M. Stallman committed
160
	  (setq save-place nil))
161
      (message "Place will be saved")
Richard M. Stallman's avatar
Richard M. Stallman committed
162 163
      (setq save-place t))))

164 165
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))

Richard M. Stallman's avatar
Richard M. Stallman committed
166 167 168 169 170 171 172 173
(defun save-place-to-alist ()
  ;; put filename and point in a cons box and then cons that onto the
  ;; front of the save-place-alist, if save-place is non-nil.
  ;; Otherwise, just delete that file from the alist.
  ;; first check to make sure alist has been loaded in from the master
  ;; file.  If not, do so, then feel free to modify the alist.  It
  ;; will be saved again when Emacs is killed.
  (or save-place-loaded (load-save-place-alist-from-file))
174
  (let ((item (or buffer-file-name
175 176 177 178
                  (and dired-directory
		       (if (consp dired-directory)
			   (expand-file-name (car dired-directory))
			 (expand-file-name dired-directory))))))
179 180 181 182 183
    (when (and item
               (or (not save-place-ignore-files-regexp)
                   (not (string-match save-place-ignore-files-regexp
                                      item))))
      (let ((cell (assoc item save-place-alist))
184 185 186 187 188 189 190 191 192
            (position (cond ((eq major-mode 'hexl-mode)
			     (with-no-warnings
			       (1+ (hexl-current-address))))
			    (dired-directory
			     (let ((filename (dired-get-filename nil t)))
			       (if filename
				   `((dired-filename . ,filename))
				 (point))))
			    (t (point)))))
193 194 195
        (if cell
            (setq save-place-alist (delq cell save-place-alist)))
        (if (and save-place
196 197
                 (not (and (integerp position)
			   (= position 1)))) ;; Optimize out the degenerate case.
198 199 200
            (setq save-place-alist
                  (cons (cons item position)
                        save-place-alist)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
201

202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228
(defun save-place-forget-unreadable-files ()
  "Remove unreadable files from `save-place-alist'.
For each entry in the alist, if `file-readable-p' returns nil for the
filename, remove the entry.  Save the new alist \(as the first pair
may have changed\) back to `save-place-alist'."
  (interactive)
  ;; the following was adapted from an in-place filtering function,
  ;; `filter-mod', used in the original.
  (unless (null save-place-alist)	;says it better than `when'
    ;; first, check all except first
    (let ((fmprev save-place-alist) (fmcur (cdr save-place-alist)))
      (while fmcur			;not null
	;; a value is only saved when it becomes FMPREV.
	(if (if (string-match save-place-skip-check-regexp (caar fmcur))
		save-place-save-skipped
	      (file-readable-p (caar fmcur)))
	    (setq fmprev fmcur)
	  (setcdr fmprev (cdr fmcur)))
	(setq fmcur (cdr fmcur))))
    ;; test first pair, keep it if OK, otherwise 2nd element, which
    ;; may be '()
    (unless (if (string-match save-place-skip-check-regexp
			      (caar save-place-alist))
		save-place-save-skipped
	      (file-readable-p (caar save-place-alist)))
      (setq save-place-alist (cdr save-place-alist)))))

Richard M. Stallman's avatar
Richard M. Stallman committed
229
(defun save-place-alist-to-file ()
230 231
  (let ((file (expand-file-name save-place-file))
        (coding-system-for-write 'utf-8))
232
    (with-current-buffer (get-buffer-create " *Saved Places*")
Richard M. Stallman's avatar
Richard M. Stallman committed
233
      (delete-region (point-min) (point-max))
234 235
      (when save-place-forget-unreadable-files
	(save-place-forget-unreadable-files))
236 237
      (insert (format ";;; -*- coding: %s -*-\n"
                      (symbol-name coding-system-for-write)))
238 239
      (let ((print-length nil)
            (print-level nil))
240
        (pp save-place-alist (current-buffer)))
241 242 243 244 245 246 247
      (let ((version-control
             (cond
              ((null save-place-version-control) nil)
              ((eq 'never save-place-version-control) 'never)
              ((eq 'nospecial save-place-version-control) version-control)
              (t
               t))))
248
	(condition-case nil
249
	    ;; Don't use write-file; we don't want this buffer to visit it.
250
            (write-region (point-min) (point-max) file)
251 252
	  (file-error (message "Saving places: can't write %s" file)))
        (kill-buffer (current-buffer))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
253 254 255 256 257 258 259 260 261

(defun load-save-place-alist-from-file ()
  (if (not save-place-loaded)
      (progn
        (setq save-place-loaded t)
        (let ((file (expand-file-name save-place-file)))
          ;; make sure that the alist does not get overwritten, and then
          ;; load it if it exists:
          (if (file-readable-p file)
262 263 264
              ;; don't want to use find-file because we have been
              ;; adding hooks to it.
              (with-current-buffer (get-buffer-create " *Saved Places*")
Richard M. Stallman's avatar
Richard M. Stallman committed
265 266 267
                (delete-region (point-min) (point-max))
                (insert-file-contents file)
                (goto-char (point-min))
268
                (setq save-place-alist
269
                      (with-demoted-errors "Error reading save-place-file: %S"
270
                        (car (read-from-string
271
                              (buffer-substring (point-min) (point-max))))))
272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288

                ;; If there is a limit, and we're over it, then we'll
                ;; have to truncate the end of the list:
                (if save-place-limit
                    (if (<= save-place-limit 0)
                        ;; Zero gets special cased.  I'm not thrilled
                        ;; with this, but the loop for >= 1 is tight.
                        (setq save-place-alist nil)
                      ;; Else the limit is >= 1, so enforce it by
                      ;; counting and then `setcdr'ing.
                      (let ((s save-place-alist)
                            (count 1))
                        (while s
                          (if (>= count save-place-limit)
                              (setcdr s nil)
                            (setq count (1+ count)))
                          (setq s (cdr s))))))
289

290
                (kill-buffer (current-buffer))))
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292 293 294 295 296 297 298 299 300
          nil))))

(defun save-places-to-alist ()
  ;; go through buffer-list, saving places to alist if save-place is
  ;; non-nil, deleting them from alist if it is nil.
  (let ((buf-list (buffer-list)))
    (while buf-list
      ;; put this into a save-excursion in case someone is counting on
      ;; another function in kill-emacs-hook to act on the last buffer
      ;; they were in:
301
      (with-current-buffer (car buf-list)
Richard M. Stallman's avatar
Richard M. Stallman committed
302 303
	;; save-place checks buffer-file-name too, but we can avoid
	;; overhead of function call by checking here too.
304 305
	(and (or buffer-file-name dired-directory)
	     (save-place-to-alist))
Richard M. Stallman's avatar
Richard M. Stallman committed
306
	(setq buf-list (cdr buf-list))))))
307 308 309 310 311

(defun save-place-find-file-hook ()
  (or save-place-loaded (load-save-place-alist-from-file))
  (let ((cell (assoc buffer-file-name save-place-alist)))
    (if cell
Richard M. Stallman's avatar
Richard M. Stallman committed
312
	(progn
313
	  (or revert-buffer-in-progress-p
314 315
	      (and (integerp (cdr cell))
		   (goto-char (cdr cell))))
316 317 318
          ;; and make sure it will be saved again for later
          (setq save-place t)))))

319 320
(declare-function dired-goto-file "dired" (file))

321 322 323
(defun save-place-dired-hook ()
  "Position the point in a dired buffer."
  (or save-place-loaded (load-save-place-alist-from-file))
324 325 326 327
  (let ((cell (assoc (if (consp dired-directory)
			 (expand-file-name (car dired-directory))
		       (expand-file-name dired-directory))
		     save-place-alist)))
328 329 330
    (if cell
        (progn
          (or revert-buffer-in-progress-p
331 332 333 334
              (if (integerp (cdr cell))
		  (goto-char (cdr cell))
		(and (assq 'dired-filename (cdr cell))
		     (dired-goto-file (cdr (assq 'dired-filename (cdr cell)))))))
335 336 337
          ;; and make sure it will be saved again for later
          (setq save-place t)))))

338
(defun save-place-kill-emacs-hook ()
339 340 341 342
  ;; First update the alist.  This loads the old save-place-file if nec.
  (save-places-to-alist)
  ;; Now save the alist in the file, if we have ever loaded the file
  ;; (including just now).
343
  (if save-place-loaded
344
      (save-place-alist-to-file)))
345

346
(add-hook 'find-file-hook 'save-place-find-file-hook t)
347

348 349
(add-hook 'dired-initial-position-hook 'save-place-dired-hook)

Juanma Barranquero's avatar
Juanma Barranquero committed
350 351
(unless noninteractive
  (add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
Richard M. Stallman's avatar
Richard M. Stallman committed
352 353 354 355 356 357

(add-hook 'kill-buffer-hook 'save-place-to-alist)

(provide 'saveplace) ; why not...

;;; saveplace.el ends here