diff lisp/package-admin.el @ 4720:3c92890f3750

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 15139dbf89f4
children 308d34e9f07d
line wrap: on
line diff
--- 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)