895 |
;; Moves point if the next ARG files are redisplayed. |
;; Moves point if the next ARG files are redisplayed. |
896 |
(interactive "P\np") |
(interactive "P\np") |
897 |
(if (and test-for-subdir (dired-get-subdir)) |
(if (and test-for-subdir (dired-get-subdir)) |
898 |
(dired-insert-subdir |
(let* ((dir (dired-get-subdir)) |
899 |
(dired-get-subdir) |
(switches (cdr (assoc-string dir dired-switches-alist)))) |
900 |
(if arg (read-string "Switches for listing: " dired-actual-switches))) |
(dired-insert-subdir |
901 |
|
dir |
902 |
|
(when arg |
903 |
|
(read-string "Switches for listing: " |
904 |
|
(or switches |
905 |
|
dired-subdir-switches |
906 |
|
dired-actual-switches))))) |
907 |
(message "Redisplaying...") |
(message "Redisplaying...") |
908 |
;; message much faster than making dired-map-over-marks show progress |
;; message much faster than making dired-map-over-marks show progress |
909 |
(dired-uncache |
(dired-uncache |
1213 |
(dired-advertise))))) |
(dired-advertise))))) |
1214 |
|
|
1215 |
(defun dired-rename-subdir-2 (elt dir to) |
(defun dired-rename-subdir-2 (elt dir to) |
1216 |
;; Update the headerline and dired-subdir-alist element of directory |
;; Update the headerline and dired-subdir-alist element, as well as |
1217 |
;; described by alist-element ELT to reflect the moving of DIR to TO. |
;; dired-switches-alist element, of directory described by |
1218 |
;; Thus, ELT describes either DIR itself or a subdir of DIR. |
;; alist-element ELT to reflect the moving of DIR to TO. Thus, ELT |
1219 |
|
;; describes either DIR itself or a subdir of DIR. |
1220 |
(save-excursion |
(save-excursion |
1221 |
(let ((regexp (regexp-quote (directory-file-name dir))) |
(let ((regexp (regexp-quote (directory-file-name dir))) |
1222 |
(newtext (directory-file-name to)) |
(newtext (directory-file-name to)) |
1230 |
(if (re-search-forward regexp (match-end 1) t) |
(if (re-search-forward regexp (match-end 1) t) |
1231 |
(replace-match newtext t t) |
(replace-match newtext t t) |
1232 |
(error "Expected to find `%s' in headerline of %s" dir (car elt)))) |
(error "Expected to find `%s' in headerline of %s" dir (car elt)))) |
1233 |
;; Update buffer-local dired-subdir-alist |
;; Update buffer-local dired-subdir-alist and dired-switches-alist |
1234 |
(setcar elt |
(let ((cons (assoc-string (car elt) dired-switches-alist)) |
1235 |
(dired-normalize-subdir |
(cur-dir (dired-normalize-subdir |
1236 |
(dired-replace-in-string regexp newtext (car elt))))))) |
(dired-replace-in-string regexp newtext (car elt))))) |
1237 |
|
(setcar elt cur-dir) |
1238 |
|
(when cons (setcar cons cur-dir)))))) |
1239 |
|
|
1240 |
;; The basic function for half a dozen variations on cp/mv/ln/ln -s. |
;; The basic function for half a dozen variations on cp/mv/ln/ln -s. |
1241 |
(defun dired-create-files (file-creator operation fn-list name-constructor |
(defun dired-create-files (file-creator operation fn-list name-constructor |
1731 |
(interactive |
(interactive |
1732 |
(list (dired-get-filename) |
(list (dired-get-filename) |
1733 |
(if current-prefix-arg |
(if current-prefix-arg |
1734 |
(read-string "Switches for listing: " dired-actual-switches)))) |
(read-string "Switches for listing: " |
1735 |
|
(or dired-subdir-switches dired-actual-switches))))) |
1736 |
(let ((opoint (point))) |
(let ((opoint (point))) |
1737 |
;; We don't need a marker for opoint as the subdir is always |
;; We don't need a marker for opoint as the subdir is always |
1738 |
;; inserted *after* opoint. |
;; inserted *after* opoint. |
1759 |
(interactive |
(interactive |
1760 |
(list (dired-get-filename) |
(list (dired-get-filename) |
1761 |
(if current-prefix-arg |
(if current-prefix-arg |
1762 |
(read-string "Switches for listing: " dired-actual-switches)))) |
(read-string "Switches for listing: " |
1763 |
|
(or dired-subdir-switches dired-actual-switches))))) |
1764 |
(setq dirname (file-name-as-directory (expand-file-name dirname))) |
(setq dirname (file-name-as-directory (expand-file-name dirname))) |
|
(dired-insert-subdir-validate dirname switches) |
|
1765 |
(or no-error-if-not-dir-p |
(or no-error-if-not-dir-p |
1766 |
(file-directory-p dirname) |
(file-directory-p dirname) |
1767 |
(error "Attempt to insert a non-directory: %s" dirname)) |
(error "Attempt to insert a non-directory: %s" dirname)) |
1768 |
(let ((elt (assoc dirname dired-subdir-alist)) |
(let ((elt (assoc dirname dired-subdir-alist)) |
1769 |
switches-have-R mark-alist case-fold-search buffer-read-only) |
(cons (assoc-string dirname dired-switches-alist)) |
1770 |
|
(modflag (buffer-modified-p)) |
1771 |
|
(old-switches switches) |
1772 |
|
switches-have-R mark-alist case-fold-search buffer-read-only) |
1773 |
|
(and (not switches) cons (setq switches (cdr cons))) |
1774 |
|
(dired-insert-subdir-validate dirname switches) |
1775 |
;; case-fold-search is nil now, so we can test for capital `R': |
;; case-fold-search is nil now, so we can test for capital `R': |
1776 |
(if (setq switches-have-R (and switches (string-match "R" switches))) |
(if (setq switches-have-R (and switches (string-match "R" switches))) |
1777 |
;; avoid duplicated subdirs |
;; avoid duplicated subdirs |
1782 |
(dired-insert-subdir-newpos dirname)) ; else compute new position |
(dired-insert-subdir-newpos dirname)) ; else compute new position |
1783 |
(dired-insert-subdir-doupdate |
(dired-insert-subdir-doupdate |
1784 |
dirname elt (dired-insert-subdir-doinsert dirname switches)) |
dirname elt (dired-insert-subdir-doinsert dirname switches)) |
1785 |
(if switches-have-R (dired-build-subdir-alist switches)) |
(when old-switches |
1786 |
|
(if cons |
1787 |
|
(setcdr cons switches) |
1788 |
|
(push (cons dirname switches) dired-switches-alist))) |
1789 |
|
(when switches-have-R |
1790 |
|
(dired-build-subdir-alist switches) |
1791 |
|
(dolist (cur-ass dired-subdir-alist) |
1792 |
|
(let ((cur-dir (car cur-ass))) |
1793 |
|
(and (dired-in-this-tree cur-dir dirname) |
1794 |
|
(not (string= cur-dir dirname)) |
1795 |
|
(let ((cur-cons (assoc-string cur-dir dired-switches-alist))) |
1796 |
|
(if cur-cons |
1797 |
|
(setcdr cur-cons switches) |
1798 |
|
(push (cons cur-dir switches) dired-switches-alist))))))) |
1799 |
(dired-initial-position dirname) |
(dired-initial-position dirname) |
1800 |
(save-excursion (dired-mark-remembered mark-alist)))) |
(save-excursion (dired-mark-remembered mark-alist)) |
1801 |
|
(restore-buffer-modified-p modflag))) |
1802 |
|
|
1803 |
;; This is a separate function for dired-vms. |
;; This is a separate function for dired-vms. |
1804 |
(defun dired-insert-subdir-validate (dirname &optional switches) |
(defun dired-insert-subdir-validate (dirname &optional switches) |
1806 |
;; Signal an error if invalid (e.g. user typed `i' on `..'). |
;; Signal an error if invalid (e.g. user typed `i' on `..'). |
1807 |
(or (dired-in-this-tree dirname (expand-file-name default-directory)) |
(or (dired-in-this-tree dirname (expand-file-name default-directory)) |
1808 |
(error "%s: not in this directory tree" dirname)) |
(error "%s: not in this directory tree" dirname)) |
1809 |
(if switches |
(let ((real-switches (or switches dired-subdir-switches))) |
1810 |
|
(when real-switches |
1811 |
(let (case-fold-search) |
(let (case-fold-search) |
1812 |
(mapcar |
(mapcar |
1813 |
(function |
(function |
1814 |
(lambda (x) |
(lambda (x) |
1815 |
(or (eq (null (string-match x switches)) |
(or (eq (null (string-match x real-switches)) |
1816 |
(null (string-match x dired-actual-switches))) |
(null (string-match x dired-actual-switches))) |
1817 |
(error "Can't have dirs with and without -%s switches together" |
(error |
1818 |
x)))) |
"Can't have dirs with and without -%s switches together" x)))) |
1819 |
;; all switches that make a difference to dired-get-filename: |
;; all switches that make a difference to dired-get-filename: |
1820 |
'("F" "b"))))) |
'("F" "b")))))) |
1821 |
|
|
1822 |
(defun dired-alist-add (dir new-marker) |
(defun dired-alist-add (dir new-marker) |
1823 |
;; Add new DIR at NEW-MARKER. Sort alist. |
;; Add new DIR at NEW-MARKER. Sort alist. |
1885 |
;; Return the boundary of the inserted text (as list of BEG and END). |
;; Return the boundary of the inserted text (as list of BEG and END). |
1886 |
(save-excursion |
(save-excursion |
1887 |
(let ((begin (point))) |
(let ((begin (point))) |
|
(message "Reading directory %s..." dirname) |
|
1888 |
(let ((dired-actual-switches |
(let ((dired-actual-switches |
1889 |
(or switches |
(or switches |
1890 |
|
dired-subdir-switches |
1891 |
(dired-replace-in-string "R" "" dired-actual-switches)))) |
(dired-replace-in-string "R" "" dired-actual-switches)))) |
1892 |
(if (equal dirname (car (car (last dired-subdir-alist)))) |
(if (equal dirname (car (car (last dired-subdir-alist)))) |
1893 |
;; If doing the top level directory of the buffer, |
;; If doing the top level directory of the buffer, |
1894 |
;; redo it as specified in dired-directory. |
;; redo it as specified in dired-directory. |
1895 |
(dired-readin-insert) |
(dired-readin-insert) |
1896 |
(dired-insert-directory dirname dired-actual-switches nil nil t))) |
(dired-insert-directory dirname dired-actual-switches nil nil t))) |
|
(message "Reading directory %s...done" dirname) |
|
1897 |
(list begin (point))))) |
(list begin (point))))) |
1898 |
|
|
1899 |
(defun dired-insert-subdir-doupdate (dirname elt beg-end) |
(defun dired-insert-subdir-doupdate (dirname elt beg-end) |
2036 |
Lower levels are unaffected." |
Lower levels are unaffected." |
2037 |
;; With optional REMEMBER-MARKS, return a mark-alist. |
;; With optional REMEMBER-MARKS, return a mark-alist. |
2038 |
(interactive) |
(interactive) |
2039 |
(let ((beg (dired-subdir-min)) |
(let* ((beg (dired-subdir-min)) |
2040 |
(end (dired-subdir-max)) |
(end (dired-subdir-max)) |
2041 |
buffer-read-only cur-dir) |
(modflag (buffer-modified-p)) |
2042 |
(setq cur-dir (dired-current-directory)) |
(cur-dir (dired-current-directory)) |
2043 |
|
(cons (assoc-string cur-dir dired-switches-alist)) |
2044 |
|
buffer-read-only) |
2045 |
(if (equal cur-dir default-directory) |
(if (equal cur-dir default-directory) |
2046 |
(error "Attempt to kill top level directory")) |
(error "Attempt to kill top level directory")) |
2047 |
(prog1 |
(prog1 |
2049 |
(delete-region beg end) |
(delete-region beg end) |
2050 |
(if (eobp) ; don't leave final blank line |
(if (eobp) ; don't leave final blank line |
2051 |
(delete-char -1)) |
(delete-char -1)) |
2052 |
(dired-unsubdir cur-dir)))) |
(dired-unsubdir cur-dir) |
2053 |
|
(when cons |
2054 |
|
(setq dired-switches-alist (delete cons dired-switches-alist))) |
2055 |
|
(restore-buffer-modified-p modflag)))) |
2056 |
|
|
2057 |
(defun dired-unsubdir (dir) |
(defun dired-unsubdir (dir) |
2058 |
;; Remove DIR from the alist |
;; Remove DIR from the alist |
2111 |
Use \\[dired-hide-all] to (un)hide all directories." |
Use \\[dired-hide-all] to (un)hide all directories." |
2112 |
(interactive "p") |
(interactive "p") |
2113 |
(dired-hide-check) |
(dired-hide-check) |
2114 |
(while (>= (setq arg (1- arg)) 0) |
(let ((modflag (buffer-modified-p))) |
2115 |
(let* ((cur-dir (dired-current-directory)) |
(while (>= (setq arg (1- arg)) 0) |
2116 |
(hidden-p (dired-subdir-hidden-p cur-dir)) |
(let* ((cur-dir (dired-current-directory)) |
2117 |
(elt (assoc cur-dir dired-subdir-alist)) |
(hidden-p (dired-subdir-hidden-p cur-dir)) |
2118 |
(end-pos (1- (dired-get-subdir-max elt))) |
(elt (assoc cur-dir dired-subdir-alist)) |
2119 |
buffer-read-only) |
(end-pos (1- (dired-get-subdir-max elt))) |
2120 |
;; keep header line visible, hide rest |
buffer-read-only) |
2121 |
(goto-char (dired-get-subdir-min elt)) |
;; keep header line visible, hide rest |
2122 |
(skip-chars-forward "^\n\r") |
(goto-char (dired-get-subdir-min elt)) |
2123 |
(if hidden-p |
(skip-chars-forward "^\n\r") |
2124 |
(subst-char-in-region (point) end-pos ?\r ?\n) |
(if hidden-p |
2125 |
(subst-char-in-region (point) end-pos ?\n ?\r))) |
(subst-char-in-region (point) end-pos ?\r ?\n) |
2126 |
(dired-next-subdir 1 t))) |
(subst-char-in-region (point) end-pos ?\n ?\r))) |
2127 |
|
(dired-next-subdir 1 t)) |
2128 |
|
(restore-buffer-modified-p modflag))) |
2129 |
|
|
2130 |
;;;###autoload |
;;;###autoload |
2131 |
(defun dired-hide-all (arg) |
(defun dired-hide-all (arg) |
2134 |
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." |
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." |
2135 |
(interactive "P") |
(interactive "P") |
2136 |
(dired-hide-check) |
(dired-hide-check) |
2137 |
(let (buffer-read-only) |
(let ((modflag (buffer-modified-p)) |
2138 |
|
buffer-read-only) |
2139 |
(if (save-excursion |
(if (save-excursion |
2140 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2141 |
(search-forward "\r" nil t)) |
(search-forward "\r" nil t)) |
2144 |
;; hide |
;; hide |
2145 |
(let ((pos (point-max)) ; pos of end of last directory |
(let ((pos (point-max)) ; pos of end of last directory |
2146 |
(alist dired-subdir-alist)) |
(alist dired-subdir-alist)) |
2147 |
(while alist ; while there are dirs before pos |
(while alist ; while there are dirs before pos |
2148 |
(subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir |
(subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir |
2149 |
(save-excursion |
(save-excursion |
2150 |
(goto-char pos) ; current dir |
(goto-char pos) ; current dir |
2153 |
(point)) |
(point)) |
2154 |
?\n ?\r) |
?\n ?\r) |
2155 |
(setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir |
(setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir |
2156 |
(setq alist (cdr alist))))))) |
(setq alist (cdr alist))))) |
2157 |
|
(restore-buffer-modified-p modflag))) |
2158 |
|
|
2159 |
;;;###end dired-ins.el |
;;;###end dired-ins.el |
2160 |
|
|