[Emacs-diffs] /srv/bzr/emacs/trunk r102605: * lisp/files.el (dir-locals-collect-variables): Don't let errors stop us.

[Stefan Monnier]

------------------------------------------------------------
revno: 102605
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2010-12-07 21:18:02 -0500
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/files.el
  lisp/jka-cmpr-hook.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-12-07 19:38:38 +0000
+++ b/lisp/ChangeLog    2010-12-08 02:18:02 +0000
@@ -1,3 +1,14 @@
+2010-12-08  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * simple.el (just-one-space): Make argument n default to 1 if

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2010-11-22 19:22:03 +0000
+++ b/lisp/files.el     2010-12-08 02:18:02 +0000
@@ -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:]:address@hidden)"
+  "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:]:address@hidden'" 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."

=== modified file 'lisp/jka-cmpr-hook.el'
--- a/lisp/jka-cmpr-hook.el     2010-08-30 13:03:05 +0000
+++ b/lisp/jka-cmpr-hook.el     2010-12-08 02:18:02 +0000
@@ -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"]