Mercurial > hg > xemacs-beta
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)