procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make `make-auto-save-file-name' a magic operation.

Browse source
This commit is contained in:
Michael Albinus 2005-08-30 22:41:02 +00:00
parent 1faabaaa91
commit c1105d052e
7 changed files with 124 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2005-08-31 Michael Albinus <michael.albinus@gmx.de>
* NEWS: Add entry for `make-auto-save-file-name'.
2005-08-19 Emilio C. Lopes <eclig@gmx.net>
* emacsclient.1 (DESCRIPTION): Reflect inclusion in the

4
etc/NEWS
View file

@ -3908,6 +3908,10 @@ operations.
This is useful for autoloaded handlers, to prevent them from being
autoloaded when not really necessary.
+++
*** The function `make-auto-save-file-name' is now handled by file
name handlers. This will be exploited for remote files mainly.
** Input changes:
+++

13
lisp/ChangeLog
View file

@ -1,3 +1,16 @@
2005-08-31 Michael Albinus <michael.albinus@gmx.de>
* files.el (make-auto-save-file-name): Add file name handler call
if applicable.
* net/tramp.el (tramp-file-name-handler-alist)
(tramp-file-name-for-operation): Add `make-auto-save-file-name'.
(tramp-handle-make-auto-save-file-name): Renamed from
`tramp-make-auto-save-file-name'.
(tramp-exists-file-name-handler): New defun.
(tramp-advice-make-auto-save-file-name): Make defadvice only when
`make-auto-save-file-name' is not a magic file name operation.
2005-08-30 Carsten Dominik <dominik@science.uva.nl>
* textmodes/org.el (org-special-keyword): New face.

98
lisp/files.el
View file

@ -4062,53 +4062,57 @@ Does not consider `auto-save-visited-file-name' as that variable is checked
before calling this function. You can redefine this for customization.
See also `auto-save-file-name-p'."
(if buffer-file-name
(let ((list auto-save-file-name-transforms)
(filename buffer-file-name)
result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
filename)
uniq (car (cddr (car list)))))
(setq list (cdr list)))
(if result
(if uniq
(setq filename (concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(replace-regexp-in-string "!" "!!"
filename))))
(setq filename result)))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits
;; before doing anything else, because the regexp
;; passed to string-match below cannot handle
;; extensions longer than 3 characters, multiple
;; dots, and other atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
"#" (match-string 1 fn)
"." (match-string 3 fn) "#"))
(concat (file-name-directory filename)
"#"
(file-name-nondirectory filename)
"#")))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(if (and (memq system-type '(ms-dos windows-nt))
;; Don't modify remote (ange-ftp) filenames
(not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
(convert-standard-filename result)
result))
(let ((handler (find-file-name-handler buffer-file-name
'make-auto-save-file-name)))
(if handler
(funcall handler 'make-auto-save-file-name)
(let ((list auto-save-file-name-transforms)
(filename buffer-file-name)
result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
filename)
uniq (car (cddr (car list)))))
(setq list (cdr list)))
(if result
(if uniq
(setq filename (concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(replace-regexp-in-string "!" "!!"
filename))))
(setq filename result)))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits
;; before doing anything else, because the regexp
;; passed to string-match below cannot handle
;; extensions longer than 3 characters, multiple
;; dots, and other atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
"#" (match-string 1 fn)
"." (match-string 3 fn) "#"))
(concat (file-name-directory filename)
"#"
(file-name-nondirectory filename)
"#")))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(if (and (memq system-type '(ms-dos windows-nt))
;; Don't modify remote (ange-ftp) filenames
(not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
(convert-standard-filename result)
result))))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)

72
lisp/net/tramp.el
View file

@ -1856,6 +1856,7 @@ on the FILENAME argument, even if VISIT was a string.")
(insert-file-contents . tramp-handle-insert-file-contents)
(write-region . tramp-handle-write-region)
(find-backup-file-name . tramp-handle-find-backup-file-name)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(dired-compress-file . tramp-handle-dired-compress-file)
(dired-call-process . tramp-handle-dired-call-process)
@ -1863,7 +1864,7 @@ on the FILENAME argument, even if VISIT was a string.")
. tramp-handle-dired-recursive-delete-directory)
(set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime))
"Alist of handler functions.
"Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.")
;; Handlers for partial tramp file names. For GNU Emacs just
@ -3807,6 +3808,34 @@ This will break if COMMAND prints a newline, followed by the value of
(tramp-run-real-handler 'find-backup-file-name (list filename)))))
(defun tramp-handle-make-auto-save-file-name ()
"Like `make-auto-save-file-name' for tramp files.
Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(when tramp-auto-save-directory
(unless (file-exists-p tramp-auto-save-directory)
(make-directory tramp-auto-save-directory t)))
;; jka-compr doesn't like auto-saving, so by appending "~" to the
;; file name we make sure that jka-compr isn't used for the
;; auto-save file.
(let ((buffer-file-name
(if tramp-auto-save-directory
(expand-file-name
(tramp-subst-strs-in-string
'(("_" . "|")
("/" . "_a")
(":" . "_b")
("|" . "__")
("[" . "_l")
("]" . "_r"))
(buffer-file-name))
tramp-auto-save-directory)
(buffer-file-name)))
;; We set it to nil because `make-auto-save-file-name' shouldn't
;; recurse infinitely.
tramp-auto-save-directory)
(tramp-run-real-handler
'make-auto-save-file-name)))
;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region
@ -4086,8 +4115,9 @@ ARGS are the arguments OPERATION has been called with."
(nth 2 args))
; BUF
((member operation
(list 'set-visited-file-modtime 'verify-visited-file-modtime
; XEmacs only
(list 'make-auto-save-file-name
'set-visited-file-modtime 'verify-visited-file-modtime
; XEmacs only
'backup-buffer))
(buffer-file-name
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
@ -6905,33 +6935,17 @@ as default."
;; Auto saving to a special directory.
(defun tramp-make-auto-save-file-name (fn)
"Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(when tramp-auto-save-directory
(unless (file-exists-p tramp-auto-save-directory)
(make-directory tramp-auto-save-directory t)))
;; jka-compr doesn't like auto-saving, so by appending "~" to the
;; file name we make sure that jka-compr isn't used for the
;; auto-save file.
(let ((buffer-file-name (expand-file-name
(tramp-subst-strs-in-string '(("_" . "|")
("/" . "_a")
(":" . "_b")
("|" . "__")
("[" . "_l")
("]" . "_r"))
fn)
tramp-auto-save-directory)))
(make-auto-save-file-name)))
(defun tramp-exists-file-name-handler (operation)
(let ((file-name-handler-alist (list (cons "/" 'identity))))
(eq (find-file-name-handler "/" operation) 'identity)))
(defadvice make-auto-save-file-name
(around tramp-advice-make-auto-save-file-name () activate)
"Invoke `tramp-make-auto-save-file-name' for tramp files."
(if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))
tramp-auto-save-directory)
(setq ad-return-value
(tramp-make-auto-save-file-name (buffer-file-name)))
ad-do-it))
(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
(defadvice make-auto-save-file-name
(around tramp-advice-make-auto-save-file-name () activate)
"Invoke `tramp-handle-make-auto-save-file-name' for tramp files."
(if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))
(setq ad-return-value (tramp-make-auto-save-file-name))
ad-do-it)))
;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have
;; permission 0666 minus umask. This is a security threat.

8
lispref/ChangeLog
View file

@ -1,3 +1,7 @@
2005-08-31 Michael Albinus <michael.albinus@gmx.de>
* files.texi (Magic File Names): Add `make-auto-save-file-name'.
2005-08-29 Richard M. Stallman <rms@gnu.org>
* elisp.texi (Top): Update subnode menu.
@ -20,7 +24,7 @@
* display.texi (Finding Overlays): Fix `find-overlay-prop' in
`next-overlay-change' example.
2005-08-22 Juri Linkov <juri@jurta.org>
* display.texi (Attribute Functions): Add set-face-inverse-video-p.
@ -65,7 +69,7 @@
(Frame Parameters): Refer to Geometry.
* buffers.texi (The Buffer List): Fix xrefs.
* windows.texi (Splitting Windows): Fix xref.
* frames.texi (Layout Parameters): Add xref.

4
lispref/files.texi
View file

@ -2580,7 +2580,9 @@ Here are the operations that a magic file name handler gets to handle:
@code{get-file-buffer},
@code{insert-directory},
@code{insert-file-contents},@*
@code{load}, @code{make-directory},
@code{load},
@code{make-auto-save-file-name},
@code{make-directory},
@code{make-directory-internal},
@code{make-symbolic-link},@*
@code{rename-file}, @code{set-file-modes}, @code{set-file-times},