aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/files.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/files.el')
-rw-r--r--lisp/files.el159
1 files changed, 93 insertions, 66 deletions
diff --git a/lisp/files.el b/lisp/files.el
index 2f3efa33c28..96647fb2626 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -978,12 +978,15 @@ or mount points potentially requiring authentication as a different user.")
978;; nil))) 978;; nil)))
979 979
980(defun locate-dominating-file (file name) 980(defun locate-dominating-file (file name)
981 "Look up the directory hierarchy from FILE for a directory containing NAME. 981 "Starting from FILE, look up directory hierarchy for directory containing NAME.
982FILE can be a file or a directory. If it's a file, its directory will
983serve as the starting point for searching the hierarchy of directories.
982Stop at the first parent directory containing a file NAME, 984Stop at the first parent directory containing a file NAME,
983and return the directory. Return nil if not found. 985and return the directory. Return nil if not found.
984Instead of a string, NAME can also be a predicate taking one argument 986Instead of a string, NAME can also be a predicate taking one argument
985\(a directory) and returning a non-nil value if that directory is the one for 987\(a directory) and returning a non-nil value if that directory is the one for
986which we're looking." 988which we're looking. The predicate will be called with every file/directory
989the function needs to examine, starting with FILE."
987 ;; We used to use the above locate-dominating-files code, but the 990 ;; We used to use the above locate-dominating-files code, but the
988 ;; directory-files call is very costly, so we're much better off doing 991 ;; directory-files call is very costly, so we're much better off doing
989 ;; multiple calls using the code in here. 992 ;; multiple calls using the code in here.
@@ -1596,8 +1599,8 @@ automatically choosing a major mode, use \\[find-file-literally]."
1596 (confirm-nonexistent-file-or-buffer))) 1599 (confirm-nonexistent-file-or-buffer)))
1597 (let ((value (find-file-noselect filename nil nil wildcards))) 1600 (let ((value (find-file-noselect filename nil nil wildcards)))
1598 (if (listp value) 1601 (if (listp value)
1599 (mapcar 'switch-to-buffer (nreverse value)) 1602 (mapcar 'pop-to-buffer-same-window (nreverse value))
1600 (switch-to-buffer value)))) 1603 (pop-to-buffer-same-window value))))
1601 1604
1602(defun find-file-other-window (filename &optional wildcards) 1605(defun find-file-other-window (filename &optional wildcards)
1603 "Edit file FILENAME, in another window. 1606 "Edit file FILENAME, in another window.
@@ -2543,7 +2546,7 @@ since only a single case-insensitive search through the alist is made."
2543 ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) 2546 ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
2544 ("\\.bash\\'" . sh-mode) 2547 ("\\.bash\\'" . sh-mode)
2545 ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) 2548 ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
2546 ("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) 2549 ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
2547 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) 2550 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
2548 ("\\.m?spec\\'" . sh-mode) 2551 ("\\.m?spec\\'" . sh-mode)
2549 ("\\.m[mes]\\'" . nroff-mode) 2552 ("\\.m[mes]\\'" . nroff-mode)
@@ -6552,6 +6555,75 @@ regardless of the language.")
6552 6555
6553(defvar insert-directory-ls-version 'unknown) 6556(defvar insert-directory-ls-version 'unknown)
6554 6557
6558(defun insert-directory-wildcard-in-dir-p (dir)
6559 "Return non-nil if DIR contents a shell wildcard in the directory part.
6560The return value is a cons (DIR . WILDCARDS); DIR is the
6561`default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
6562
6563Valid wildcards are '*', '?', '[abc]' and '[a-z]'."
6564 (let ((wildcards "[?*"))
6565 (when (and (or (not (featurep 'ls-lisp))
6566 ls-lisp-support-shell-wildcards)
6567 (string-match (concat "[" wildcards "]") (file-name-directory dir))
6568 (not (file-exists-p dir))) ; Prefer an existing file to wildcards.
6569 (let ((regexp (format "\\`\\([^%s]+/\\)\\([^%s]*[%s].*\\)"
6570 wildcards wildcards wildcards)))
6571 (string-match regexp dir)
6572 (cons (match-string 1 dir) (match-string 2 dir))))))
6573
6574(defun insert-directory-clean (beg switches)
6575 (when (if (stringp switches)
6576 (string-match "--dired\\>" switches)
6577 (member "--dired" switches))
6578 ;; The following overshoots by one line for an empty
6579 ;; directory listed with "--dired", but without "-a"
6580 ;; switch, where the ls output contains a
6581 ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
6582 ;; We take care of that case later.
6583 (forward-line -2)
6584 (when (looking-at "//SUBDIRED//")
6585 (delete-region (point) (progn (forward-line 1) (point)))
6586 (forward-line -1))
6587 (if (looking-at "//DIRED//")
6588 (let ((end (line-end-position))
6589 (linebeg (point))
6590 error-lines)
6591 ;; Find all the lines that are error messages,
6592 ;; and record the bounds of each one.
6593 (goto-char beg)
6594 (while (< (point) linebeg)
6595 (or (eql (following-char) ?\s)
6596 (push (list (point) (line-end-position)) error-lines))
6597 (forward-line 1))
6598 (setq error-lines (nreverse error-lines))
6599 ;; Now read the numeric positions of file names.
6600 (goto-char linebeg)
6601 (forward-word-strictly 1)
6602 (forward-char 3)
6603 (while (< (point) end)
6604 (let ((start (insert-directory-adj-pos
6605 (+ beg (read (current-buffer)))
6606 error-lines))
6607 (end (insert-directory-adj-pos
6608 (+ beg (read (current-buffer)))
6609 error-lines)))
6610 (if (memq (char-after end) '(?\n ?\s))
6611 ;; End is followed by \n or by " -> ".
6612 (put-text-property start end 'dired-filename t)
6613 ;; It seems that we can't trust ls's output as to
6614 ;; byte positions of filenames.
6615 (put-text-property beg (point) 'dired-filename nil)
6616 (end-of-line))))
6617 (goto-char end)
6618 (beginning-of-line)
6619 (delete-region (point) (progn (forward-line 1) (point))))
6620 ;; Take care of the case where the ls output contains a
6621 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
6622 ;; and we went one line too far back (see above).
6623 (forward-line 1))
6624 (if (looking-at "//DIRED-OPTIONS//")
6625 (delete-region (point) (progn (forward-line 1) (point))))))
6626
6555;; insert-directory 6627;; insert-directory
6556;; - must insert _exactly_one_line_ describing FILE if WILDCARD and 6628;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
6557;; FULL-DIRECTORY-P is nil. 6629;; FULL-DIRECTORY-P is nil.
@@ -6611,13 +6683,19 @@ normally equivalent short `-D' option is just passed on to
6611 default-file-name-coding-system)))) 6683 default-file-name-coding-system))))
6612 (setq result 6684 (setq result
6613 (if wildcard 6685 (if wildcard
6614 ;; Run ls in the directory part of the file pattern 6686 ;; If the wildcard is just in the file part, then run ls in
6615 ;; using the last component as argument. 6687 ;; the directory part of the file pattern using the last
6616 (let ((default-directory 6688 ;; component as argument. Otherwise, run ls in the longest
6617 (if (file-name-absolute-p file) 6689 ;; subdirectory of the directory part free of wildcards; use
6618 (file-name-directory file) 6690 ;; the remaining of the file pattern as argument.
6619 (file-name-directory (expand-file-name file)))) 6691 (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file))
6620 (pattern (file-name-nondirectory file))) 6692 (default-directory
6693 (cond (dir-wildcard (car dir-wildcard))
6694 (t
6695 (if (file-name-absolute-p file)
6696 (file-name-directory file)
6697 (file-name-directory (expand-file-name file))))))
6698 (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file))))
6621 ;; NB since switches is passed to the shell, be 6699 ;; NB since switches is passed to the shell, be
6622 ;; careful of malicious values, eg "-l;reboot". 6700 ;; careful of malicious values, eg "-l;reboot".
6623 ;; See eg dired-safe-switches-p. 6701 ;; See eg dired-safe-switches-p.
@@ -6665,7 +6743,8 @@ normally equivalent short `-D' option is just passed on to
6665 (setq file (expand-file-name file))) 6743 (setq file (expand-file-name file)))
6666 (list 6744 (list
6667 (if full-directory-p 6745 (if full-directory-p
6668 (concat (file-name-as-directory file) ".") 6746 ;; (concat (file-name-as-directory file) ".")
6747 file
6669 file)))))))) 6748 file))))))))
6670 6749
6671 ;; If we got "//DIRED//" in the output, it means we got a real 6750 ;; If we got "//DIRED//" in the output, it means we got a real
@@ -6736,59 +6815,7 @@ normally equivalent short `-D' option is just passed on to
6736 ;; Unix. Access the file to get a suitable error. 6815 ;; Unix. Access the file to get a suitable error.
6737 (access-file file "Reading directory") 6816 (access-file file "Reading directory")
6738 (error "Listing directory failed but `access-file' worked"))) 6817 (error "Listing directory failed but `access-file' worked")))
6739 6818 (insert-directory-clean beg switches)
6740 (when (if (stringp switches)
6741 (string-match "--dired\\>" switches)
6742 (member "--dired" switches))
6743 ;; The following overshoots by one line for an empty
6744 ;; directory listed with "--dired", but without "-a"
6745 ;; switch, where the ls output contains a
6746 ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
6747 ;; We take care of that case later.
6748 (forward-line -2)
6749 (when (looking-at "//SUBDIRED//")
6750 (delete-region (point) (progn (forward-line 1) (point)))
6751 (forward-line -1))
6752 (if (looking-at "//DIRED//")
6753 (let ((end (line-end-position))
6754 (linebeg (point))
6755 error-lines)
6756 ;; Find all the lines that are error messages,
6757 ;; and record the bounds of each one.
6758 (goto-char beg)
6759 (while (< (point) linebeg)
6760 (or (eql (following-char) ?\s)
6761 (push (list (point) (line-end-position)) error-lines))
6762 (forward-line 1))
6763 (setq error-lines (nreverse error-lines))
6764 ;; Now read the numeric positions of file names.
6765 (goto-char linebeg)
6766 (forward-word-strictly 1)
6767 (forward-char 3)
6768 (while (< (point) end)
6769 (let ((start (insert-directory-adj-pos
6770 (+ beg (read (current-buffer)))
6771 error-lines))
6772 (end (insert-directory-adj-pos
6773 (+ beg (read (current-buffer)))
6774 error-lines)))
6775 (if (memq (char-after end) '(?\n ?\s))
6776 ;; End is followed by \n or by " -> ".
6777 (put-text-property start end 'dired-filename t)
6778 ;; It seems that we can't trust ls's output as to
6779 ;; byte positions of filenames.
6780 (put-text-property beg (point) 'dired-filename nil)
6781 (end-of-line))))
6782 (goto-char end)
6783 (beginning-of-line)
6784 (delete-region (point) (progn (forward-line 1) (point))))
6785 ;; Take care of the case where the ls output contains a
6786 ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
6787 ;; and we went one line too far back (see above).
6788 (forward-line 1))
6789 (if (looking-at "//DIRED-OPTIONS//")
6790 (delete-region (point) (progn (forward-line 1) (point)))))
6791
6792 ;; Now decode what read if necessary. 6819 ;; Now decode what read if necessary.
6793 (let ((coding (or coding-system-for-read 6820 (let ((coding (or coding-system-for-read
6794 file-name-coding-system 6821 file-name-coding-system