/[emacs]/emacs/lisp/dired-aux.el
ViewVC logotype

Diff of /emacs/lisp/dired-aux.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.118 by jurta, Sat May 1 05:35:34 2004 UTC revision 1.119 by teirllm, Sun Jun 6 02:26:46 2004 UTC
# Line 895  a prefix arg lets you edit the `ls' swit Line 895  a prefix arg lets you edit the `ls' swit
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
# Line 1207  Special value `always' suppresses confir Line 1213  Special value `always' suppresses confir
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))
# Line 1223  Special value `always' suppresses confir Line 1230  Special value `always' suppresses confir
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
# Line 1722  This function takes some pains to confor Line 1731  This function takes some pains to confor
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.
# Line 1749  This function takes some pains to confor Line 1759  This function takes some pains to confor
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
# Line 1767  This function takes some pains to confor Line 1782  This function takes some pains to confor
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)
# Line 1777  This function takes some pains to confor Line 1806  This function takes some pains to confor
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.
# Line 1855  With optional arg REMEMBER-MARKS, return Line 1885  With optional arg REMEMBER-MARKS, return
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)
# Line 2007  marks the files listed in the subdirecto Line 2036  marks the files listed in the subdirecto
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
# Line 2018  Lower levels are unaffected." Line 2049  Lower levels are unaffected."
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
# Line 2077  Optional prefix arg is a repeat factor. Line 2111  Optional prefix arg is a repeat factor.
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)
# Line 2098  If there is already something hidden, ma Line 2134  If there is already something hidden, ma
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))
# Line 2107  Use \\[dired-hide-subdir] to (un)hide a Line 2144  Use \\[dired-hide-subdir] to (un)hide a
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
# Line 2116  Use \\[dired-hide-subdir] to (un)hide a Line 2153  Use \\[dired-hide-subdir] to (un)hide a
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    

Legend:
Removed from v.1.118  
changed lines
  Added in v.1.119

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26