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