Mercurial > hg > xemacs-beta

changeset 4720:3c92890f3750

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add `file-system-ignore-case-p', use it. 2009-10-24 Aidan Kehoe <kehoea@parhasard.net> * files.el (default-file-system-ignore-case): New variable. (file-system-case-alist): New variable. (file-system-ignore-case-p): New function; return t if file names under PATH should be treated case-insensitively. * minibuf.el (read-file-name-1, read-file-name-internal-1) (read-file-name-internal-1): * package-admin.el (package-admin-check-manifest): Use file-system-ignore-case-p instead of checking system-type directly in these functions. (Even though minibuf.el is dumped before files.el, the function is only called in interactive usage, there's no dump time order dependency here.)
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 24 Oct 2009 15:33:23 +0100
parents bd51ab22afa8
children 19d70297d866
files lisp/ChangeLog lisp/files.el lisp/minibuf.el lisp/package-admin.el
diffstat 4 files changed, 140 insertions(+), 96 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Oct 19 12:47:21 2009 +0100
+++ b/lisp/ChangeLog	Sat Oct 24 15:33:23 2009 +0100
@@ -1,3 +1,18 @@
+2009-10-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* files.el (default-file-system-ignore-case): New variable.
+	(file-system-case-alist): New variable.
+	(file-system-ignore-case-p):
+	New function; return t if file names under PATH should be treated
+	case-insensitively.
+	* minibuf.el (read-file-name-1, read-file-name-internal-1)
+	(read-file-name-internal-1): 
+	* package-admin.el (package-admin-check-manifest): 
+	Use file-system-ignore-case-p instead of checking system-type
+	directly in these functions. (Even though minibuf.el is dumped
+	before files.el, the function is only called in interactive usage,
+	there's no dump time order dependency here.) 
+
 2009-10-19  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* bytecomp.el (byte-compile-default-warnings): 
--- a/lisp/files.el	Mon Oct 19 12:47:21 2009 +0100
+++ b/lisp/files.el	Sat Oct 24 15:33:23 2009 +0100
@@ -4514,4 +4514,39 @@
 
 ;; END SYNC WITH FSF 21.2.
 
+;; XEmacs:
+(defvar default-file-system-ignore-case (and
+                                         (memq system-type '(windows-nt
+                                                             cygwin32
+							     darwin))
+                                         t)
+  "What `file-system-ignore-case-p' returns by default.
+This is in the case that nothing in `file-system-case-alist' matches.")
+
+;; Question; do any of the Linuxes mount Windows partitions in a fixed
+;; place?
+(defvar file-system-case-alist nil
+  "Alist to decide where file name case is significant. 
+
+The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression
+matching a file name, and VAL is t if corresponding file names are
+case-insensitive, nil if corresponding file names are case sensitive. Only
+the first match will be used.
+
+This list is used by `file-system-ignore-case-p', itself used in tab
+completion; see also `default-file-system-ignore-case'.")
+
+(defun file-system-ignore-case-p (path)
+  "Return t if PATH resides on a file system with case-insensitive names.
+Otherwise, return nil.  See `file-system-case-alist' and
+`default-file-system-ignore-case'."
+  (check-argument-type #'stringp path)
+  (if file-system-case-alist
+      (loop
+        for (pattern . val)
+        in file-system-case-alist
+        do (and (string-match pattern path) (return val))
+        finally (return default-file-system-ignore-case))
+    default-file-system-ignore-case))
+
 ;;; files.el ends here
--- a/lisp/minibuf.el	Mon Oct 19 12:47:21 2009 +0100
+++ b/lisp/minibuf.el	Sat Oct 24 15:33:23 2009 +0100
@@ -1698,9 +1698,7 @@
     (add-one-shot-hook
      'minibuffer-setup-hook
      (lambda ()
-       ;; #### SCREAM!  Create a `file-system-ignore-case'
-       ;; function, so this kind of stuff is generalized!
-       (and (eq system-type 'windows-nt)
+       (and (file-system-ignore-case-p (or dir default-directory))
 	    (set (make-local-variable 'completion-ignore-case) t))
        (set
 	(make-local-variable
@@ -1777,6 +1775,8 @@
 	    string))
       ;; Not doing environment-variable completion hack
       (let* ((orig (if (equal string "") nil string))
+	     (completion-ignore-case (file-system-ignore-case-p
+				      (or dir default-directory)))
              (sstring (if orig (substitute-in-file-name string) string))
              (specdir (if orig (file-name-directory sstring) nil))
              (name    (if orig (file-name-nondirectory sstring) string))
@@ -1814,6 +1814,8 @@
                    name)))
       ;; An odd number of trailing $'s
       (let* ((start (match-beginning 3))
+	     (completion-ignore-case (file-system-ignore-case-p
+				      (or dir default-directory)))
              (env (substring string
                              (cond ((= start (length string))
                                     ;; "...$"
--- a/lisp/package-admin.el	Mon Oct 19 12:47:21 2009 +0100
+++ b/lisp/package-admin.el	Sat Oct 24 15:33:23 2009 +0100
@@ -279,106 +279,98 @@
 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
 is the top-level directory under which the package was installed."
   (let ((manifest-buf " *pkg-manifest*")
-	(old-case-fold-search case-fold-search)
+	(case-fold-search (file-system-ignore-case-p pkg-topdir))
 	regexp package-name pathname regexps)
-    (unwind-protect
-	(save-excursion				;; Probably redundant.
-	  (set-buffer (get-buffer pkg-outbuf))	;; Probably already the current buffer.
-	  (goto-char (point-min))
+    (save-excursion				;; Probably redundant.
+      (set-buffer (get-buffer pkg-outbuf))	;; Probably already the current buffer.
+      (goto-char (point-min))
+      (setq regexp (concat "\\bpkginfo" 
+			   (char-to-string directory-sep-char)
+			   "MANIFEST\\...*"))
 
-	  ;; Make filenames case-insensitive, if necessary
-	  (if (eq system-type 'windows-nt)
-	      (setq case-fold-search t))
-
-	  (setq regexp (concat "\\bpkginfo" 
-			       (char-to-string directory-sep-char)
-			       "MANIFEST\\...*"))
-
-	  ;; Look for the manifest.
-	  (if (not (re-search-forward regexp nil t))
-	      (progn
-		;; We didn't find a manifest.  Make one.
+      ;; Look for the manifest.
+      (if (not (re-search-forward regexp nil t))
+	  (progn
+	    ;; We didn't find a manifest.  Make one.
 
-		;; Yuk.  We weren't passed the package name, and so we have
-		;; to dig for it.  Look for it as the subdirectory name below
-		;; "lisp", or "man".
-		;; Here, we don't use a single regexp because we want to search
-		;; the directories for a package name in a particular order.
-		(if (catch 'done
-		      (let ((dirs '("lisp" "man")) 
-			    rexp)
-			(while dirs
-			  (setq rexp (concat "\\b" (car dirs)
-					     "[\\/]\\([^\\/]+\\)[\//]"))
-			  (if (re-search-forward rexp nil t)
-			      (throw 'done t))
-			  (setq dirs (cdr dirs)))))
-		    (progn
-		      (setq package-name (buffer-substring (match-beginning 1)
-							   (match-end 1)))
+	    ;; Yuk.  We weren't passed the package name, and so we have
+	    ;; to dig for it.  Look for it as the subdirectory name below
+	    ;; "lisp", or "man".
+	    ;; Here, we don't use a single regexp because we want to search
+	    ;; the directories for a package name in a particular order.
+	    (if (catch 'done
+		  (let ((dirs '("lisp" "man")) 
+			rexp)
+		    (while dirs
+		      (setq rexp (concat "\\b" (car dirs)
+					 "[\\/]\\([^\\/]+\\)[\//]"))
+		      (if (re-search-forward rexp nil t)
+			  (throw 'done t))
+		      (setq dirs (cdr dirs)))))
+		(progn
+		  (setq package-name (buffer-substring (match-beginning 1)
+						       (match-end 1)))
 
-		      ;; Get and erase the manifest buffer
-		      (setq manifest-buf (get-buffer-create manifest-buf))
-		      (buffer-disable-undo manifest-buf)
-		      (erase-buffer manifest-buf)
+		  ;; Get and erase the manifest buffer
+		  (setq manifest-buf (get-buffer-create manifest-buf))
+		  (buffer-disable-undo manifest-buf)
+		  (erase-buffer manifest-buf)
+
+		  ;; Now, scan through the output buffer, looking for
+		  ;; file and directory names.
+		  (goto-char (point-min))
+		  ;; for each line ...
+		  (while (< (point) (point-max))
+		    (beginning-of-line)
+		    (setq pathname nil)
 
-		      ;; Now, scan through the output buffer, looking for
-		      ;; file and directory names.
-		      (goto-char (point-min))
-		      ;; for each line ...
-		      (while (< (point) (point-max))
-			(beginning-of-line)
-			(setq pathname nil)
+		    ;; scan through the regexps, looking for a pathname
+		    (if (catch 'found-path
+			  (setq regexps package-admin-tar-filename-regexps)
+			  (while regexps
+			    (if (looking-at (car regexps))
+				(progn
+				  (setq pathname
+					(buffer-substring
+					 (match-beginning 1)
+					 (match-end 1)))
+				  (throw 'found-path t)))
+			    (setq regexps (cdr regexps))))
+			(progn
+			  ;; found a pathname -- add it to the manifest
+			  ;; buffer
+			  (save-excursion
+			    (set-buffer manifest-buf)
+			    (goto-char (point-max))
+			    (insert pathname "\n"))))
+		    (forward-line 1))
 
-			;; scan through the regexps, looking for a pathname
-			(if (catch 'found-path
-			      (setq regexps package-admin-tar-filename-regexps)
-			      (while regexps
-				(if (looking-at (car regexps))
-				    (progn
-				      (setq pathname
-					    (buffer-substring
-					     (match-beginning 1)
-					     (match-end 1)))
-				      (throw 'found-path t)))
-				(setq regexps (cdr regexps))))
-			    (progn
-			      ;; found a pathname -- add it to the manifest
-			      ;; buffer
-			      (save-excursion
-				(set-buffer manifest-buf)
-				(goto-char (point-max))
-				(insert pathname "\n"))))
-			(forward-line 1))
+		  ;; Processed all lines.
+		  ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
 
-		      ;; Processed all lines.
-		      ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
-
-		      ;; We use `expand-file-name' instead of `concat',
-		      ;; for portability.
-		      (setq pathname (expand-file-name "pkginfo"
-						       pkg-topdir))
-		      ;; Create pkginfo, if necessary
-		      (if (not (file-directory-p pathname))
-			  (make-directory pathname))
-		      (setq pathname (expand-file-name
-				      (concat "MANIFEST." package-name)
-				      pathname))
-		      (save-excursion
-			(set-buffer manifest-buf)
-			;; Put the files in sorted order
-			(if-fboundp 'sort-lines
-			    (sort-lines nil (point-min) (point-max))
-			  (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
-				package-name))
-			;; Write the file.
-			;; Note that using `write-region' *BYPASSES* any check
-			;; to see if XEmacs is currently editing/visiting the
-			;; file.
-			(write-region (point-min) (point-max) pathname))
-		      (kill-buffer manifest-buf))))))
-      ;; Restore old case-fold-search status
-      (setq case-fold-search old-case-fold-search))))
+		  ;; We use `expand-file-name' instead of `concat',
+		  ;; for portability.
+		  (setq pathname (expand-file-name "pkginfo"
+						   pkg-topdir))
+		  ;; Create pkginfo, if necessary
+		  (if (not (file-directory-p pathname))
+		      (make-directory pathname))
+		  (setq pathname (expand-file-name
+				  (concat "MANIFEST." package-name)
+				  pathname))
+		  (save-excursion
+		    (set-buffer manifest-buf)
+		    ;; Put the files in sorted order
+		    (if-fboundp 'sort-lines
+			(sort-lines nil (point-min) (point-max))
+		      (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
+			    package-name))
+		    ;; Write the file.
+		    ;; Note that using `write-region' *BYPASSES* any check
+		    ;; to see if XEmacs is currently editing/visiting the
+		    ;; file.
+		    (write-region (point-min) (point-max) pathname))
+		  (kill-buffer manifest-buf))))))))
 
 ;;;###autoload
 (defun package-admin-add-binary-package (file &optional pkg-dir)