Mercurial > emacs
changeset 111847:dc23e3f2eabb
* lisp/files.el (dir-locals-collect-variables): Don't let errors stop us.
Use string-prefix-p.
(file-name-version-regexp): New var.
(file-name-sans-versions):
* lisp/jka-cmpr-hook.el (jka-compr-build-file-regexp): Use it,
(jka-compr-get-compression-info): Use dolist.
(jka-compr-compression-info-list): Don't bother specifying
version/backup regexps.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 07 Dec 2010 21:18:02 -0500 |
parents | 076a5b56d8c9 |
children | 20e12bebbbb5 |
files | lisp/ChangeLog lisp/files.el lisp/jka-cmpr-hook.el |
diffstat | 3 files changed, 66 insertions(+), 36 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Dec 07 22:12:50 2010 +0000 +++ b/lisp/ChangeLog Tue Dec 07 21:18:02 2010 -0500 @@ -1,3 +1,14 @@ +2010-12-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (dir-locals-collect-variables): Don't let errors stop us. + Use string-prefix-p. + (file-name-version-regexp): New var. + (file-name-sans-versions): + * jka-cmpr-hook.el (jka-compr-build-file-regexp): Use it, + (jka-compr-get-compression-info): Use dolist. + (jka-compr-compression-info-list): Don't bother specifying + version/backup regexps. + 2010-12-07 Tassilo Horn <tassilo@member.fsf.org> * simple.el (just-one-space): Make argument n default to 1 if
--- a/lisp/files.el Tue Dec 07 22:12:50 2010 +0000 +++ b/lisp/files.el Tue Dec 07 21:18:02 2010 -0500 @@ -3370,22 +3370,29 @@ Return the new variables list." (let* ((file-name (buffer-file-name)) (sub-file-name (if file-name + ;; FIXME: Why not use file-relative-name? (substring file-name (length root))))) - (dolist (entry class-variables variables) - (let ((key (car entry))) - (cond - ((stringp key) - ;; Don't include this in the previous condition, because we - ;; want to filter all strings before the next condition. - (when (and sub-file-name - (>= (length sub-file-name) (length key)) - (string= key (substring sub-file-name 0 (length key)))) - (setq variables (dir-locals-collect-variables - (cdr entry) root variables)))) - ((or (not key) - (derived-mode-p key)) - (setq variables (dir-locals-collect-mode-variables - (cdr entry) variables)))))))) + (condition-case err + (dolist (entry class-variables variables) + (let ((key (car entry))) + (cond + ((stringp key) + ;; Don't include this in the previous condition, because we + ;; want to filter all strings before the next condition. + (when (and sub-file-name + (>= (length sub-file-name) (length key)) + (string-prefix-p key sub-file-name)) + (setq variables (dir-locals-collect-variables + (cdr entry) root variables)))) + ((or (not key) + (derived-mode-p key)) + (setq variables (dir-locals-collect-mode-variables + (cdr entry) variables)))))) + (error + ;; The file's content might be invalid (e.g. have a merge conflict), but + ;; that shouldn't prevent the user from opening the file. + (message ".dir-locals error: %s" (error-message-string err)) + nil)))) (defun dir-locals-set-directory-class (directory class &optional mtime) "Declare that the DIRECTORY root is an instance of CLASS. @@ -3516,7 +3523,9 @@ (dir-name nil)) (cond ((stringp variables-file) - (setq dir-name (if (buffer-file-name) (file-name-directory (buffer-file-name)) default-directory)) + (setq dir-name (if (buffer-file-name) + (file-name-directory (buffer-file-name)) + default-directory)) (setq class (dir-locals-read-from-file variables-file))) ((consp variables-file) (setq dir-name (nth 0 variables-file)) @@ -3826,21 +3835,25 @@ (and context (set-file-selinux-context to-name context))) +(defvar file-name-version-regexp + "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+~\\)" + "Regular expression matching the backup/version part of a file name. +Used by `file-name-sans-versions'.") + (defun file-name-sans-versions (name &optional keep-backup-version) "Return file NAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, -we do not remove backup version numbers, only true file version numbers." +we do not remove backup version numbers, only true file version numbers. +See also `file-name-version-regexp'." (let ((handler (find-file-name-handler name 'file-name-sans-versions))) (if handler (funcall handler 'file-name-sans-versions name keep-backup-version) (substring name 0 - (if keep-backup-version - (length name) - (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name) - (string-match "~\\'" name) - (length name))))))) + (unless keep-backup-version + (string-match (concat file-name-version-regexp "\\'") + name)))))) (defun file-ownership-preserved-p (file) "Return t if deleting FILE and rewriting it would preserve the owner."
--- a/lisp/jka-cmpr-hook.el Tue Dec 07 22:12:50 2010 +0000 +++ b/lisp/jka-cmpr-hook.el Tue Dec 07 21:18:02 2010 -0500 @@ -73,10 +73,18 @@ (defun jka-compr-build-file-regexp () (purecopy - (mapconcat - 'jka-compr-info-regexp - jka-compr-compression-info-list - "\\|"))) + (let ((re-anchored '()) + (re-free '())) + (dolist (e jka-compr-compression-info-list) + (let ((re (jka-compr-info-regexp e))) + (if (string-match "\\\\'\\'" re) + (push (substring re 0 (match-beginning 0)) re-anchored) + (push re re-free)))) + (concat + (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|")) + "\\(?:" + (mapconcat 'identity re-anchored "\\|") + "\\)" file-name-version-regexp "?\\'")))) ;; Functions for accessing the return value of jka-compr-get-compression-info (defun jka-compr-info-regexp (info) (aref info 0)) @@ -97,11 +105,9 @@ based on the filename itself and `jka-compr-compression-info-list'." (catch 'compression-info (let ((case-fold-search nil)) - (mapc - (function (lambda (x) - (and (string-match (jka-compr-info-regexp x) filename) - (throw 'compression-info x)))) - jka-compr-compression-info-list) + (dolist (x jka-compr-compression-info-list) + (and (string-match (jka-compr-info-regexp x) filename) + (throw 'compression-info x))) nil))) (defun jka-compr-install () @@ -198,7 +204,7 @@ ;; uncomp-message uncomp-prog uncomp-args ;; can-append strip-extension-flag file-magic-bytes] (mapcar 'purecopy - '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" + '(["\\.Z\\'" "compressing" "compress" ("-c") ;; gzip is more common than uncompress. It can only read, not write. "uncompressing" "gzip" ("-c" "-q" "-d") @@ -206,7 +212,7 @@ ;; Formerly, these had an additional arg "-c", but that fails with ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and ;; "Version 0.9.0b, 9-Sept-98". - ["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.bz2\\'" "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil t "BZh"] @@ -214,15 +220,15 @@ "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil nil "BZh"] - ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") t nil "\037\213"] - ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.g?z\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") t t "\037\213"] - ["\\.xz\\(~\\|\\.~[0-9]+~\\)?\\'" + ["\\.xz\\'" "XZ compressing" "xz" ("-c" "-q") "XZ uncompressing" "xz" ("-c" "-q" "-d") t t "\3757zXZ\0"]