From 33cf0fb2261201d66a7bf122d30718bdfbd7d38e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 7 Dec 2010 21:18:02 -0500 Subject: [PATCH] * 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. --- lisp/ChangeLog | 11 +++++++++ lisp/files.el | 57 ++++++++++++++++++++++++++----------------- lisp/jka-cmpr-hook.el | 34 +++++++++++++++----------- 3 files changed, 66 insertions(+), 36 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6eb650ae7bb..c6e035ebe97 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2010-12-08 Stefan Monnier + + * 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 * simple.el (just-one-space): Make argument n default to 1 if diff --git a/lisp/files.el b/lisp/files.el index 2e2d4eeb1fb..43ba34f8bef 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3370,22 +3370,29 @@ ROOT is the root directory of the project. 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 @@ and `file-local-variables-alist', without applying them." (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 @@ BACKUPNAME is the backup file name, which is the old file renamed." (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." diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 68f564c488f..aba9dac1434 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -73,10 +73,18 @@ Otherwise, it is nil.") (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 @@ The determination as to which compression scheme, if any, to use is 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 @@ options through Custom does this automatically." ;; 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 @@ options through Custom does this automatically." ;; 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 @@ options through Custom does this automatically." "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"] -- 2.39.2