LCOV - code coverage report
Current view: top level - lisp - dired.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 399 1462 27.3 %
Date: 2017-08-30 10:12:24 Functions: 31 137 22.6 %

          Line data    Source code
       1             : ;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1985-1986, 1992-1997, 2000-2017 Free Software
       4             : ;; Foundation, Inc.
       5             : 
       6             : ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
       7             : ;; Maintainer: emacs-devel@gnu.org
       8             : ;; Keywords: files
       9             : ;; Package: emacs
      10             : 
      11             : ;; This file is part of GNU Emacs.
      12             : 
      13             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      14             : ;; it under the terms of the GNU General Public License as published by
      15             : ;; the Free Software Foundation, either version 3 of the License, or
      16             : ;; (at your option) any later version.
      17             : 
      18             : ;; GNU Emacs is distributed in the hope that it will be useful,
      19             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      20             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      21             : ;; GNU General Public License for more details.
      22             : 
      23             : ;; You should have received a copy of the GNU General Public License
      24             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      25             : 
      26             : ;;; Commentary:
      27             : 
      28             : ;; This is a major mode for directory browsing and editing.
      29             : ;; It is documented in the Emacs manual.
      30             : 
      31             : ;; Rewritten in 1990/1991 to add tree features, file marking and
      32             : ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
      33             : ;; Finished up by rms in 1992.
      34             : 
      35             : ;;; Code:
      36             : 
      37             : (eval-when-compile (require 'subr-x))
      38             : ;; When bootstrapping dired-loaddefs has not been generated.
      39             : (require 'dired-loaddefs nil t)
      40             : 
      41             : (declare-function dired-buffer-more-recently-used-p
      42             :                   "dired-x" (buffer1 buffer2))
      43             : 
      44             : ;;; Customizable variables
      45             : 
      46             : (defgroup dired nil
      47             :   "Directory editing."
      48             :   :link '(custom-manual "(emacs)Dired")
      49             :   :group 'files)
      50             : 
      51             : (defgroup dired-mark nil
      52             :   "Handling marks in Dired."
      53             :   :prefix "dired-"
      54             :   :group 'dired)
      55             : 
      56             : 
      57             : ;;;###autoload
      58             : (defcustom dired-listing-switches (purecopy "-al")
      59             :   "Switches passed to `ls' for Dired.  MUST contain the `l' option.
      60             : May contain all other options that don't contradict `-l';
      61             : may contain even `F', `b', `i' and `s'.  See also the variable
      62             : `dired-ls-F-marks-symlinks' concerning the `F' switch.
      63             : Options that include embedded whitespace must be quoted
      64             : like this: \\\"--option=value with spaces\\\"; you can use
      65             : `combine-and-quote-strings' to produce the correct quoting of
      66             : each option.
      67             : On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
      68             : some of the `ls' switches are not supported; see the doc string of
      69             : `insert-directory' in `ls-lisp.el' for more details."
      70             :   :type 'string
      71             :   :group 'dired)
      72             : 
      73             : (defcustom dired-subdir-switches nil
      74             :   "If non-nil, switches passed to `ls' for inserting subdirectories.
      75             : If nil, `dired-listing-switches' is used."
      76             :    :group 'dired
      77             :    :type '(choice (const :tag "Use dired-listing-switches" nil)
      78             :                   (string :tag "Switches")))
      79             : 
      80             : (defcustom dired-chown-program
      81             :   (purecopy (cond ((executable-find "chown") "chown")
      82             :                   ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
      83             :                   ((file-executable-p "/etc/chown") "/etc/chown")
      84             :                   (t "chown")))
      85             :   "Name of chown command (usually `chown')."
      86             :   :group 'dired
      87             :   :type 'file)
      88             : 
      89             : (defcustom dired-use-ls-dired 'unspecified
      90             :   "Non-nil means Dired should pass the \"--dired\" option to \"ls\".
      91             : The special value of `unspecified' means to check explicitly, and
      92             : save the result in this variable.  This is performed the first
      93             : time `dired-insert-directory' is called.
      94             : 
      95             : Note that if you set this option to nil, either through choice or
      96             : because your \"ls\" program does not support \"--dired\", Dired
      97             : will fail to parse some \"unusual\" file names, e.g. those with leading
      98             : spaces.  You might want to install ls from GNU Coreutils, which does
      99             : support this option.  Alternatively, you might want to use Emacs's
     100             : own emulation of \"ls\", by using:
     101             :   (setq ls-lisp-use-insert-directory-program nil)
     102             :   (require \\='ls-lisp)
     103             : This is used by default on MS Windows, which does not have an \"ls\" program.
     104             : Note that `ls-lisp' does not support as many options as GNU ls, though.
     105             : For more details, see Info node `(emacs)ls in Lisp'."
     106             :   :group 'dired
     107             :   :type '(choice (const :tag "Check for --dired support" unspecified)
     108             :                  (const :tag "Do not use --dired" nil)
     109             :                  (other :tag "Use --dired" t)))
     110             : 
     111             : (defcustom dired-chmod-program "chmod"
     112             :   "Name of chmod command (usually `chmod')."
     113             :   :group 'dired
     114             :   :type 'file)
     115             : 
     116             : (defcustom dired-touch-program "touch"
     117             :   "Name of touch command (usually `touch')."
     118             :    :group 'dired
     119             :    :type 'file)
     120             : 
     121             : (defcustom dired-ls-F-marks-symlinks nil
     122             :   "Informs Dired about how `ls -lF' marks symbolic links.
     123             : Set this to t if `ls' (or whatever program is specified by
     124             : `insert-directory-program') with `-lF' marks the symbolic link
     125             : itself with a trailing @ (usually the case under Ultrix).
     126             : 
     127             : Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
     128             : nil (the default), if it gives `bar@ -> foo', set it to t.
     129             : 
     130             : Dired checks if there is really a @ appended.  Thus, if you have a
     131             : marking `ls' program on one host and a non-marking on another host, and
     132             : don't care about symbolic links which really end in a @, you can
     133             : always set this variable to t."
     134             :   :type 'boolean
     135             :   :group 'dired-mark)
     136             : 
     137             : (defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
     138             :   "Regexp of files to skip when finding first file of a directory.
     139             : A value of nil means move to the subdir line.
     140             : A value of t means move to first file."
     141             :   :type '(choice (const :tag "Move to subdir" nil)
     142             :                  (const :tag "Move to first" t)
     143             :                  regexp)
     144             :   :group 'dired)
     145             : 
     146             : (defcustom dired-keep-marker-rename t
     147             :   ;; Use t as default so that moved files "take their markers with them".
     148             :   "Controls marking of renamed files.
     149             : If t, files keep their previous marks when they are renamed.
     150             : If a character, renamed files (whether previously marked or not)
     151             : are afterward marked with that character.
     152             : This option affects only files renamed by `dired-do-rename' and
     153             : `dired-do-rename-regexp'.  See `wdired-keep-marker-rename'
     154             : if you want to do the same for files renamed in WDired mode."
     155             :   :type '(choice (const :tag "Keep" t)
     156             :                  (character :tag "Mark" :value ?R))
     157             :   :group 'dired-mark)
     158             : 
     159             : (defcustom dired-keep-marker-copy ?C
     160             :   "Controls marking of copied files.
     161             : If t, copied files are marked if and as the corresponding original files were.
     162             : If a character, copied files are unconditionally marked with that character."
     163             :   :type '(choice (const :tag "Keep" t)
     164             :                  (character :tag "Mark"))
     165             :   :group 'dired-mark)
     166             : 
     167             : (defcustom dired-keep-marker-hardlink ?H
     168             :   "Controls marking of newly made hard links.
     169             : If t, they are marked if and as the files linked to were marked.
     170             : If a character, new links are unconditionally marked with that character."
     171             :   :type '(choice (const :tag "Keep" t)
     172             :                  (character :tag "Mark"))
     173             :   :group 'dired-mark)
     174             : 
     175             : (defcustom dired-keep-marker-symlink ?Y
     176             :   "Controls marking of newly made symbolic links.
     177             : If t, they are marked if and as the files linked to were marked.
     178             : If a character, new links are unconditionally marked with that character."
     179             :   :type '(choice (const :tag "Keep" t)
     180             :                  (character :tag "Mark"))
     181             :   :group 'dired-mark)
     182             : 
     183             : (defcustom dired-dwim-target nil
     184             :   "If non-nil, Dired tries to guess a default target directory.
     185             : This means: if there is a Dired buffer displayed in the next
     186             : window, use its current directory, instead of this Dired buffer's
     187             : current directory.
     188             : 
     189             : The target is used in the prompt for file copy, rename etc."
     190             :   :type 'boolean
     191             :   :group 'dired)
     192             : 
     193             : (defcustom dired-copy-preserve-time t
     194             :   "If non-nil, Dired preserves the last-modified time in a file copy.
     195             : \(This works on only some systems.)"
     196             :   :type 'boolean
     197             :   :group 'dired)
     198             : 
     199             : ; These variables were deleted and the replacements are on files.el.
     200             : ; We leave aliases behind for back-compatibility.
     201             : (defvaralias 'dired-free-space-program 'directory-free-space-program)
     202             : (defvaralias 'dired-free-space-args 'directory-free-space-args)
     203             : 
     204             : ;;; Hook variables
     205             : 
     206             : (defcustom dired-load-hook nil
     207             :   "Run after loading Dired.
     208             : You can customize key bindings or load extensions with this."
     209             :   :group 'dired
     210             :   :type 'hook)
     211             : 
     212             : (defcustom dired-mode-hook nil
     213             :   "Run at the very end of `dired-mode'."
     214             :   :group 'dired
     215             :   :type 'hook)
     216             : 
     217             : (defcustom dired-before-readin-hook nil
     218             :   "This hook is run before a Dired buffer is read in (created or reverted)."
     219             :   :group 'dired
     220             :   :type 'hook)
     221             : 
     222             : (defcustom dired-after-readin-hook nil
     223             :   "Hook run after each time a file or directory is read by Dired.
     224             : After each listing of a file or directory, this hook is run
     225             : with the buffer narrowed to the listing."
     226             :   :group 'dired
     227             :   :type 'hook)
     228             : ;; Note this can't simply be run inside function `dired-ls' as the hook
     229             : ;; functions probably depend on the dired-subdir-alist to be OK.
     230             : 
     231             : (defcustom dired-initial-position-hook nil
     232             :   "This hook is used to position the point.
     233             : It is run by the function `dired-initial-position'."
     234             :   :group 'dired
     235             :   :type 'hook
     236             :   :version "24.4")
     237             : 
     238             : (defcustom dired-dnd-protocol-alist
     239             :   '(("^file:///" . dired-dnd-handle-local-file)
     240             :     ("^file://"  . dired-dnd-handle-file)
     241             :     ("^file:"    . dired-dnd-handle-local-file))
     242             :   "The functions to call when a drop in `dired-mode' is made.
     243             : See `dnd-protocol-alist' for more information.  When nil, behave
     244             : as in other buffers.  Changing this option is effective only for
     245             : new Dired buffers."
     246             :   :type '(choice (repeat (cons (regexp) (function)))
     247             :                  (const :tag "Behave as in other buffers" nil))
     248             :   :version "22.1"
     249             :   :group 'dired)
     250             : 
     251             : (defcustom dired-hide-details-hide-symlink-targets t
     252             :   "Non-nil means `dired-hide-details-mode' hides symbolic link targets."
     253             :   :type 'boolean
     254             :   :version "24.4"
     255             :   :group 'dired)
     256             : 
     257             : (defcustom dired-hide-details-hide-information-lines t
     258             :   "Non-nil means `dired-hide-details-mode' hides all but header and file lines."
     259             :   :type 'boolean
     260             :   :version "24.4"
     261             :   :group 'dired)
     262             : 
     263             : (defcustom dired-always-read-filesystem nil
     264             :   "Non-nil means revert buffers visiting files before searching them.
     265             :  By default,  commands like `dired-mark-files-containing-regexp' will
     266             :  search any buffers visiting the marked files without reverting them,
     267             :  even if they were changed on disk.  When this option is non-nil, such
     268             :  buffers are always reverted in a temporary buffer before searching
     269             :  them: the search is performed on the temporary buffer, the original
     270             :  buffer visiting the file is not modified."
     271             :   :type 'boolean
     272             :   :version "26.1"
     273             :   :group 'dired)
     274             : 
     275             : ;; Internal variables
     276             : 
     277             : (defvar dired-marker-char ?*            ; the answer is 42
     278             :   ;; so that you can write things like
     279             :   ;; (let ((dired-marker-char ?X))
     280             :   ;;    ;; great code using X markers ...
     281             :   ;;    )
     282             :   ;; For example, commands operating on two sets of files, A and B.
     283             :   ;; Or marking files with digits 0-9.  This could implicate
     284             :   ;; concentric sets or an order for the marked files.
     285             :   ;; The code depends on dynamic scoping on the marker char.
     286             :   "In Dired, the current mark character.
     287             : This is what the do-commands look for, and what the mark-commands store.")
     288             : 
     289             : (defvar dired-del-marker ?D
     290             :   "Character used to flag files for deletion.")
     291             : 
     292             : (defvar dired-shrink-to-fit t
     293             : ;; I see no reason ever to make this nil -- rms.
     294             : ;;  (> baud-rate search-slow-speed)
     295             :   "Non-nil means Dired shrinks the display buffer to fit the marked files.")
     296             : (make-obsolete-variable 'dired-shrink-to-fit
     297             :                         "use the Customization interface to add a new rule
     298             : to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
     299             : action argument symbol is `window-height' and its value is nil." "24.3")
     300             : 
     301             : (defvar dired-file-version-alist)
     302             : 
     303             : ;;;###autoload
     304             : (defvar dired-directory nil
     305             :   "The directory name or wildcard spec that this Dired directory lists.
     306             : Local to each Dired buffer.  May be a list, in which case the car is the
     307             : directory name and the cdr is the list of files to mention.
     308             : The directory name must be absolute, but need not be fully expanded.")
     309             : 
     310             : ;; Beware of "-l;reboot" etc.  See bug#3230.
     311             : (defun dired-safe-switches-p (switches)
     312             :   "Return non-nil if string SWITCHES does not look risky for Dired."
     313           0 :   (or (not switches)
     314           0 :       (and (stringp switches)
     315           0 :            (< (length switches) 100)    ; arbitrary
     316           0 :            (string-match-p "\\` *-[- [:alnum:]]+\\'" switches))))
     317             : 
     318             : (defvar dired-actual-switches nil
     319             :   "The value of `dired-listing-switches' used to make this buffer's text.")
     320             : 
     321             : (put 'dired-actual-switches 'safe-local-variable 'dired-safe-switches-p)
     322             : 
     323             : (defvar dired-re-inode-size "[0-9  \t]*[.,0-9]*[BkKMGTPEZY]?[ \t]*"
     324             :   "Regexp for optional initial inode and file size as made by `ls -i -s'.")
     325             : 
     326             : ;; These regexps must be tested at beginning-of-line, but are also
     327             : ;; used to search for next matches, so neither omitting "^" nor
     328             : ;; replacing "^" by "\n" (to make it slightly faster) will work.
     329             : 
     330             : (defvar dired-re-mark "^[^ \n]")
     331             : ;; "Regexp matching a marked line.
     332             : ;; Important: the match ends just after the marker."
     333             : (defvar dired-re-maybe-mark "^. ")
     334             : ;; The [^:] part after "d" and "l" is to avoid confusion with the
     335             : ;; DOS/Windows-style drive letters in directory names, like in "d:/foo".
     336             : (defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
     337             : (defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
     338             : (defvar dired-re-exe;; match ls permission string of an executable file
     339             :   (mapconcat (lambda (x)
     340             :                 (concat dired-re-maybe-mark dired-re-inode-size x))
     341             :              '("-[-r][-w][xs][-r][-w].[-r][-w]."
     342             :                "-[-r][-w].[-r][-w][xs][-r][-w]."
     343             :                "-[-r][-w].[-r][-w].[-r][-w][xst]")
     344             :              "\\|"))
     345             : (defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
     346             : (defvar dired-re-dot "^.* \\.\\.?/?$")
     347             : 
     348             : ;; The subdirectory names in the next two lists are expanded.
     349             : (defvar dired-subdir-alist nil
     350             :   "Association list of subdirectories and their buffer positions.
     351             : Each subdirectory has an element: (DIRNAME . STARTMARKER).
     352             : The order of elements is the reverse of the order in the buffer.
     353             : In simple cases, this list contains one element.")
     354             : 
     355             : (defvar-local dired-switches-alist nil
     356             :   "Keeps track of which switches to use for inserted subdirectories.
     357             : This is an alist of the form (SUBDIR . SWITCHES).")
     358             : 
     359             : (defvaralias 'dired-move-to-filename-regexp
     360             :   'directory-listing-before-filename-regexp)
     361             : 
     362             : (defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
     363             :   "Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
     364             : Subexpression 1 is the subdirectory proper, no trailing colon.
     365             : The match starts at the beginning of the line and ends after the end
     366             : of the line (\\n or \\r).
     367             : Subexpression 2 must end right before the \\n or \\r.")
     368             : 
     369             : (defgroup dired-faces nil
     370             :   "Faces used by Dired."
     371             :   :group 'dired
     372             :   :group 'faces)
     373             : 
     374             : (defface dired-header
     375             :   '((t (:inherit font-lock-type-face)))
     376             :   "Face used for directory headers."
     377             :   :group 'dired-faces
     378             :   :version "22.1")
     379             : (defvar dired-header-face 'dired-header
     380             :   "Face name used for directory headers.")
     381             : 
     382             : (defface dired-mark
     383             :   '((t (:inherit font-lock-constant-face)))
     384             :   "Face used for Dired marks."
     385             :   :group 'dired-faces
     386             :   :version "22.1")
     387             : (defvar dired-mark-face 'dired-mark
     388             :   "Face name used for Dired marks.")
     389             : 
     390             : (defface dired-marked
     391             :   '((t (:inherit warning)))
     392             :   "Face used for marked files."
     393             :   :group 'dired-faces
     394             :   :version "22.1")
     395             : (defvar dired-marked-face 'dired-marked
     396             :   "Face name used for marked files.")
     397             : 
     398             : (defface dired-flagged
     399             :   '((t (:inherit error)))
     400             :   "Face used for files flagged for deletion."
     401             :   :group 'dired-faces
     402             :   :version "22.1")
     403             : (defvar dired-flagged-face 'dired-flagged
     404             :   "Face name used for files flagged for deletion.")
     405             : 
     406             : (defface dired-warning
     407             :   ;; Inherit from font-lock-warning-face since with min-colors 8
     408             :   ;; font-lock-comment-face is not colored any more.
     409             :   '((t (:inherit font-lock-warning-face)))
     410             :   "Face used to highlight a part of a buffer that needs user attention."
     411             :   :group 'dired-faces
     412             :   :version "22.1")
     413             : (defvar dired-warning-face 'dired-warning
     414             :   "Face name used for a part of a buffer that needs user attention.")
     415             : 
     416             : (defface dired-perm-write
     417             :   '((((type w32 pc)) :inherit default)  ;; These default to rw-rw-rw.
     418             :     ;; Inherit from font-lock-comment-delimiter-face since with min-colors 8
     419             :     ;; font-lock-comment-face is not colored any more.
     420             :     (t (:inherit font-lock-comment-delimiter-face)))
     421             :   "Face used to highlight permissions of group- and world-writable files."
     422             :   :group 'dired-faces
     423             :   :version "22.2")
     424             : (defvar dired-perm-write-face 'dired-perm-write
     425             :   "Face name used for permissions of group- and world-writable files.")
     426             : 
     427             : (defface dired-directory
     428             :   '((t (:inherit font-lock-function-name-face)))
     429             :   "Face used for subdirectories."
     430             :   :group 'dired-faces
     431             :   :version "22.1")
     432             : (defvar dired-directory-face 'dired-directory
     433             :   "Face name used for subdirectories.")
     434             : 
     435             : (defface dired-symlink
     436             :   '((t (:inherit font-lock-keyword-face)))
     437             :   "Face used for symbolic links."
     438             :   :group 'dired-faces
     439             :   :version "22.1")
     440             : (defvar dired-symlink-face 'dired-symlink
     441             :   "Face name used for symbolic links.")
     442             : 
     443             : (defface dired-ignored
     444             :   '((t (:inherit shadow)))
     445             :   "Face used for files suffixed with `completion-ignored-extensions'."
     446             :   :group 'dired-faces
     447             :   :version "22.1")
     448             : (defvar dired-ignored-face 'dired-ignored
     449             :   "Face name used for files suffixed with `completion-ignored-extensions'.")
     450             : 
     451             : (defvar dired-font-lock-keywords
     452             :   (list
     453             :    ;;
     454             :    ;; Dired marks.
     455             :    (list dired-re-mark '(0 dired-mark-face))
     456             :    ;;
     457             :    ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
     458             :    ;; file name itself.  We search for Dired defined regexps, and then use the
     459             :    ;; Dired defined function `dired-move-to-filename' before searching for the
     460             :    ;; simple regexp ".+".  It is that regexp which matches the file name.
     461             :    ;;
     462             :    ;; Marked files.
     463             :    (list (concat "^[" (char-to-string dired-marker-char) "]")
     464             :          '(".+" (dired-move-to-filename) nil (0 dired-marked-face)))
     465             :    ;;
     466             :    ;; Flagged files.
     467             :    (list (concat "^[" (char-to-string dired-del-marker) "]")
     468             :          '(".+" (dired-move-to-filename) nil (0 dired-flagged-face)))
     469             :    ;; People who are paranoid about security would consider this more
     470             :    ;; important than other things such as whether it is a directory.
     471             :    ;; But we don't want to encourage paranoia, so our default
     472             :    ;; should be what's most useful for non-paranoids. -- rms.
     473             : ;;;   ;;
     474             : ;;;   ;; Files that are group or world writable.
     475             : ;;;   (list (concat dired-re-maybe-mark dired-re-inode-size
     476             : ;;;              "\\([-d]\\(....w....\\|.......w.\\)\\)")
     477             : ;;;      '(1 dired-warning-face)
     478             : ;;;      '(".+" (dired-move-to-filename) nil (0 dired-warning-face)))
     479             :    ;; However, we don't need to highlight the file name, only the
     480             :    ;; permissions, to win generally.  -- fx.
     481             :    ;; Fixme: we could also put text properties on the permission
     482             :    ;; fields with keymaps to frob the permissions, somewhat a la XEmacs.
     483             :    (list (concat dired-re-maybe-mark dired-re-inode-size
     484             :                  "[-d]....\\(w\\)....")       ; group writable
     485             :          '(1 dired-perm-write-face))
     486             :    (list (concat dired-re-maybe-mark dired-re-inode-size
     487             :                  "[-d].......\\(w\\).")       ; world writable
     488             :          '(1 dired-perm-write-face))
     489             :    ;;
     490             :    ;; Subdirectories.
     491             :    (list dired-re-dir
     492             :          '(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
     493             :    ;;
     494             :    ;; Symbolic links.
     495             :    (list dired-re-sym
     496             :          '(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
     497             :    ;;
     498             :    ;; Files suffixed with `completion-ignored-extensions'.
     499             :    '(eval .
     500             :      ;; It is quicker to first find just an extension, then go back to the
     501             :      ;; start of that file name.  So we do this complex MATCH-ANCHORED form.
     502             :      (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
     503             :            '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
     504             :    ;;
     505             :    ;; Files suffixed with `completion-ignored-extensions'
     506             :    ;; plus a character put in by -F.
     507             :    '(eval .
     508             :      (list (concat "\\(" (regexp-opt completion-ignored-extensions)
     509             :                    "\\|#\\)[*=|]$")
     510             :            '(".+" (progn
     511             :                     (end-of-line)
     512             :                     ;; If the last character is not part of the filename,
     513             :                     ;; move back to the start of the filename
     514             :                     ;; so it can be fontified.
     515             :                     ;; Otherwise, leave point at the end of the line;
     516             :                     ;; that way, nothing is fontified.
     517             :                     (unless (get-text-property (1- (point)) 'mouse-face)
     518             :                       (dired-move-to-filename)))
     519             :              nil (0 dired-ignored-face))))
     520             :    ;;
     521             :    ;; Explicitly put the default face on file names ending in a colon to
     522             :    ;; avoid fontifying them as directory header.
     523             :    (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
     524             :          '(".+" (dired-move-to-filename) nil (0 'default)))
     525             :    ;;
     526             :    ;; Directory headers.
     527             :    (list dired-subdir-regexp '(1 dired-header-face))
     528             : )
     529             :   "Additional expressions to highlight in Dired mode.")
     530             : 
     531             : (defvar dnd-protocol-alist)
     532             : 
     533             : ;;; Macros must be defined before they are used, for the byte compiler.
     534             : 
     535             : (defmacro dired-mark-if (predicate msg)
     536             :   "Mark all files for which PREDICATE evals to non-nil.
     537             : PREDICATE is evaluated on each line, with point at beginning of line.
     538             : MSG is a noun phrase for the type of files being marked.
     539             : It should end with a noun that can be pluralized by adding `s'.
     540             : Return value is the number of files marked, or nil if none were marked."
     541           7 :   `(let ((inhibit-read-only t) count)
     542             :     (save-excursion
     543             :       (setq count 0)
     544           7 :       (when ,msg
     545             :         (message "%s %ss%s..."
     546             :                  (cond ((eq dired-marker-char ?\040) "Unmarking")
     547             :                        ((eq dired-del-marker dired-marker-char)
     548             :                         "Flagging")
     549             :                        (t "Marking"))
     550           7 :                  ,msg
     551             :                  (if (eq dired-del-marker dired-marker-char)
     552             :                      " for deletion"
     553             :                    "")))
     554             :       (goto-char (point-min))
     555             :       (while (not (eobp))
     556           7 :         (if ,predicate
     557             :             (progn
     558             :               (delete-char 1)
     559             :               (insert dired-marker-char)
     560             :               (setq count (1+ count))))
     561             :         (forward-line 1))
     562           7 :       (if ,msg (message "%s %s%s %s%s."
     563             :                         count
     564           7 :                         ,msg
     565             :                         (dired-plural-s count)
     566             :                         (if (eq dired-marker-char ?\040) "un" "")
     567             :                         (if (eq dired-marker-char dired-del-marker)
     568             :                             "flagged" "marked"))))
     569           7 :     (and (> count 0) count)))
     570             : 
     571             : (defmacro dired-map-over-marks (body arg &optional show-progress
     572             :                                      distinguish-one-marked)
     573             :   "Eval BODY with point on each marked line.  Return a list of BODY's results.
     574             : If no marked file could be found, execute BODY on the current
     575             : line.  ARG, if non-nil, specifies the files to use instead of the
     576             : marked files.
     577             : 
     578             : If ARG is an integer, use the next ARG (or previous -ARG, if
     579             : ARG<0) files.  In that case, point is dragged along.  This is so
     580             : that commands on the next ARG (instead of the marked) files can
     581             : be chained easily.
     582             : For any other non-nil value of ARG, use the current file.
     583             : 
     584             : If optional third arg SHOW-PROGRESS evaluates to non-nil,
     585             : redisplay the dired buffer after each file is processed.
     586             : 
     587             : No guarantee is made about the position on the marked line.
     588             : BODY must ensure this itself if it depends on this.
     589             : 
     590             : Search starts at the beginning of the buffer, thus the car of the
     591             : list corresponds to the line nearest to the buffer's bottom.
     592             : This is also true for (positive and negative) integer values of
     593             : ARG.
     594             : 
     595             : BODY should not be too long as it is expanded four times.
     596             : 
     597             : If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one
     598             : marked file, return (t FILENAME) instead of (FILENAME)."
     599             :   ;;
     600             :   ;;Warning: BODY must not add new lines before point - this may cause an
     601             :   ;;endless loop.
     602             :   ;;This warning should not apply any longer, sk  2-Sep-1991 14:10.
     603           3 :   `(prog1
     604             :        (let ((inhibit-read-only t) case-fold-search found results)
     605           3 :          (if ,arg
     606           3 :              (if (integerp ,arg)
     607             :                  (progn ;; no save-excursion, want to move point.
     608             :                    (dired-repeat-over-lines
     609           3 :                     ,arg
     610             :                     (lambda ()
     611           3 :                       (if ,show-progress (sit-for 0))
     612           3 :                       (setq results (cons ,body results))))
     613           3 :                    (if (< ,arg 0)
     614             :                        (nreverse results)
     615             :                      results))
     616             :                ;; non-nil, non-integer ARG means use current file:
     617           3 :                (list ,body))
     618             :            (let ((regexp (dired-marker-regexp)) next-position)
     619             :              (save-excursion
     620             :                (goto-char (point-min))
     621             :                ;; remember position of next marked file before BODY
     622             :                ;; can insert lines before the just found file,
     623             :                ;; confusing us by finding the same marked file again
     624             :                ;; and again and...
     625             :                (setq next-position (and (re-search-forward regexp nil t)
     626             :                                         (point-marker))
     627             :                      found (not (null next-position)))
     628             :                (while next-position
     629             :                  (goto-char next-position)
     630           3 :                  (if ,show-progress (sit-for 0))
     631           3 :                  (setq results (cons ,body results))
     632             :                  ;; move after last match
     633             :                  (goto-char next-position)
     634             :                  (forward-line 1)
     635             :                  (set-marker next-position nil)
     636             :                  (setq next-position (and (re-search-forward regexp nil t)
     637             :                                           (point-marker)))))
     638           3 :              (if (and ,distinguish-one-marked (= (length results) 1))
     639             :                  (setq results (cons t results)))
     640             :              (if found
     641             :                  results
     642           3 :                (list ,body)))))
     643             :      ;; save-excursion loses, again
     644           3 :      (dired-move-to-filename)))
     645             : 
     646             : (defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked)
     647             :   "Return the marked files' names as list of strings.
     648             : The list is in the same order as the buffer, that is, the car is the
     649             :   first marked file.
     650             : Values returned are normally absolute file names.
     651             : Optional arg LOCALP as in `dired-get-filename'.
     652             : Optional second argument ARG, if non-nil, specifies files near
     653             :  point instead of marked files.  It usually comes from the prefix
     654             :  argument.
     655             :   If ARG is an integer, use the next ARG files.
     656             :   If ARG is any other non-nil value, return the current file name.
     657             :   If no files are marked, and ARG is nil, also return the current file name.
     658             : Optional third argument FILTER, if non-nil, is a function to select
     659             :   some of the files--those for which (funcall FILTER FILENAME) is non-nil.
     660             : 
     661             : If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
     662             : return (t FILENAME) instead of (FILENAME).
     663             : Don't use that together with FILTER."
     664           0 :   (let ((all-of-them
     665           0 :          (save-excursion
     666           0 :            (delq nil (dired-map-over-marks
     667             :                       (dired-get-filename localp 'no-error-if-not-filep)
     668           0 :                       arg nil distinguish-one-marked))))
     669             :         result)
     670           0 :     (when (equal all-of-them '(t))
     671           0 :       (setq all-of-them nil))
     672           0 :     (if (not filter)
     673           0 :         (if (and distinguish-one-marked (eq (car all-of-them) t))
     674           0 :             all-of-them
     675           0 :           (nreverse all-of-them))
     676           0 :       (dolist (file all-of-them)
     677           0 :         (if (funcall filter file)
     678           0 :             (push file result)))
     679           0 :       result)))
     680             : 
     681             : ;; The dired command
     682             : 
     683             : (defun dired-read-dir-and-switches (str)
     684             :   ;; For use in interactive.
     685           0 :   (reverse (list
     686           0 :             (if current-prefix-arg
     687           0 :                 (read-string "Dired listing switches: "
     688           0 :                              dired-listing-switches))
     689             :             ;; If a dialog is used, call `read-directory-name' so the
     690             :             ;; dialog code knows we want directories.  Some dialogs
     691             :             ;; can only select directories or files when popped up,
     692             :             ;; not both.  If no dialog is used, call `read-file-name'
     693             :             ;; because the user may want completion of file names for
     694             :             ;; use in a wildcard pattern.
     695           0 :             (if (next-read-file-uses-dialog-p)
     696           0 :                 (read-directory-name (format "Dired %s(directory): " str)
     697           0 :                                      nil default-directory nil)
     698           0 :               (read-file-name (format "Dired %s(directory): " str)
     699           0 :                               nil default-directory nil)))))
     700             : 
     701             : ;; We want to switch to a more sophisticated version of
     702             : ;; dired-read-dir-and-switches like the following, if there is a way
     703             : ;; to make it more intuitive.  See bug#1285.
     704             : 
     705             : ;; (defun dired-read-dir-and-switches (str)
     706             : ;;   ;; For use in interactive.
     707             : ;;   (reverse
     708             : ;;    (list
     709             : ;;     (if current-prefix-arg
     710             : ;;         (read-string "Dired listing switches: "
     711             : ;;                      dired-listing-switches))
     712             : ;;     ;; If a dialog is about to be used, call read-directory-name so
     713             : ;;     ;; the dialog code knows we want directories.  Some dialogs can
     714             : ;;     ;; only select directories or files when popped up, not both.
     715             : ;;     (if (next-read-file-uses-dialog-p)
     716             : ;;         (read-directory-name (format "Dired %s(directory): " str)
     717             : ;;                              nil default-directory nil)
     718             : ;;       (let ((cie ()))
     719             : ;;         (dolist (ext completion-ignored-extensions)
     720             : ;;           (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
     721             : ;;         (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
     722             : ;;         (let* ((default (and buffer-file-name
     723             : ;;                              (abbreviate-file-name buffer-file-name)))
     724             : ;;                (cie cie)
     725             : ;;                (completion-table
     726             : ;;                 ;; We need a mix of read-file-name and
     727             : ;;                 ;; read-directory-name so that completion to directories
     728             : ;;                 ;; is preferred, but if the user wants to enter a global
     729             : ;;                 ;; pattern, he can still use completion on filenames to
     730             : ;;                 ;; help him write the pattern.
     731             : ;;                 ;; Essentially, we want to use
     732             : ;;                 ;; (completion-table-with-predicate
     733             : ;;                 ;;  'read-file-name-internal 'file-directory-p nil)
     734             : ;;                 ;; but that doesn't work because read-file-name-internal
     735             : ;;                 ;; does not obey its `predicate' argument.
     736             : ;;                 (completion-table-in-turn
     737             : ;;                  (lambda (str pred action)
     738             : ;;                    (let ((read-file-name-predicate
     739             : ;;                           (lambda (f)
     740             : ;;                             (and (not (member f '("./" "../")))
     741             : ;;                                  ;; Hack! Faster than file-directory-p!
     742             : ;;                                  (eq (aref f (1- (length f))) ?/)
     743             : ;;                                  (not (string-match cie f))))))
     744             : ;;                      (complete-with-action
     745             : ;;                       action 'read-file-name-internal str nil)))
     746             : ;;                  'read-file-name-internal)))
     747             : ;;           (minibuffer-with-setup-hook
     748             : ;;               (lambda ()
     749             : ;;                 (setq minibuffer-default default)
     750             : ;;                 (setq minibuffer-completion-table completion-table))
     751             : ;;             (read-file-name (format "Dired %s(directory): " str)
     752             : ;;                             nil default-directory nil))))))))
     753             : 
     754             : (defun dired-file-name-at-point ()
     755             :   "Try to get a file name at point in the current dired buffer.
     756             : This hook is intended to be put in `file-name-at-point-functions'.
     757             : Note that it returns an abbreviated name that can't be used
     758             : as an argument to `dired-goto-file'."
     759           0 :   (let ((filename (dired-get-filename nil t)))
     760           0 :     (when filename
     761           0 :       (if (file-directory-p filename)
     762           0 :           (file-name-as-directory (abbreviate-file-name filename))
     763           0 :         (abbreviate-file-name filename)))))
     764             : 
     765             : ;;;###autoload (define-key ctl-x-map "d" 'dired)
     766             : ;;;###autoload
     767             : (defun dired (dirname &optional switches)
     768             :   "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
     769             : Optional second argument SWITCHES specifies the `ls' options used.
     770             : \(Interactively, use a prefix argument to be able to specify SWITCHES.)
     771             : 
     772             : If DIRNAME is a string, Dired displays a list of files in DIRNAME (which
     773             : may also have shell wildcards appended to select certain files).
     774             : 
     775             : If DIRNAME is a cons, its first element is taken as the directory name
     776             : and the rest as an explicit list of files to make directory entries for.
     777             : In this case, SWITCHES are applied to each of the files separately, and
     778             : therefore switches that control the order of the files in the produced
     779             : listing have no effect.
     780             : 
     781             : \\<dired-mode-map>\
     782             : You can flag files for deletion with \\[dired-flag-file-deletion] and then
     783             : delete them by typing \\[dired-do-flagged-delete].
     784             : Type \\[describe-mode] after entering Dired for more info.
     785             : 
     786             : If DIRNAME is already in a Dired buffer, that buffer is used without refresh."
     787             :   ;; Cannot use (interactive "D") because of wildcards.
     788           0 :   (interactive (dired-read-dir-and-switches ""))
     789           0 :   (pop-to-buffer-same-window (dired-noselect dirname switches)))
     790             : 
     791             : ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
     792             : ;;;###autoload
     793             : (defun dired-other-window (dirname &optional switches)
     794             :   "\"Edit\" directory DIRNAME.  Like `dired' but selects in another window."
     795           0 :   (interactive (dired-read-dir-and-switches "in other window "))
     796           0 :   (switch-to-buffer-other-window (dired-noselect dirname switches)))
     797             : 
     798             : ;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
     799             : ;;;###autoload
     800             : (defun dired-other-frame (dirname &optional switches)
     801             :   "\"Edit\" directory DIRNAME.  Like `dired' but makes a new frame."
     802           0 :   (interactive (dired-read-dir-and-switches "in other frame "))
     803           0 :   (switch-to-buffer-other-frame (dired-noselect dirname switches)))
     804             : 
     805             : ;;;###autoload
     806             : (defun dired-noselect (dir-or-list &optional switches)
     807             :   "Like `dired' but returns the Dired buffer as value, does not select it."
     808           6 :   (or dir-or-list (setq dir-or-list default-directory))
     809             :   ;; This loses the distinction between "/foo/*/" and "/foo/*" that
     810             :   ;; some shells make:
     811           6 :   (let (dirname initially-was-dirname)
     812           6 :     (if (consp dir-or-list)
     813           0 :         (setq dirname (car dir-or-list))
     814           6 :       (setq dirname dir-or-list))
     815           6 :     (setq initially-was-dirname
     816           6 :           (string= (file-name-as-directory dirname) dirname))
     817           6 :     (setq dirname (abbreviate-file-name
     818           6 :                    (expand-file-name (directory-file-name dirname))))
     819           6 :     (if find-file-visit-truename
     820           6 :         (setq dirname (file-truename dirname)))
     821             :     ;; If the argument was syntactically  a directory name not a file name,
     822             :     ;; or if it happens to name a file that is a directory,
     823             :     ;; convert it syntactically to a directory name.
     824             :     ;; The reason for checking initially-was-dirname
     825             :     ;; and not just file-directory-p
     826             :     ;; is that file-directory-p is slow over ftp.
     827           6 :     (if (or initially-was-dirname (file-directory-p dirname))
     828           6 :         (setq dirname  (file-name-as-directory dirname)))
     829           6 :     (if (consp dir-or-list)
     830           0 :         (setq dir-or-list (cons dirname (cdr dir-or-list)))
     831           6 :       (setq dir-or-list dirname))
     832           6 :     (dired-internal-noselect dir-or-list switches)))
     833             : 
     834             : ;; The following is an internal dired function.  It returns non-nil if
     835             : ;; the directory visited by the current dired buffer has changed on
     836             : ;; disk.  DIRNAME should be the directory name of that directory.
     837             : (defun dired-directory-changed-p (dirname)
     838           0 :   (not (let ((attributes (file-attributes dirname))
     839           0 :              (modtime (visited-file-modtime)))
     840           0 :          (or (eq modtime 0)
     841           0 :              (not (eq (car attributes) t))
     842           0 :              (equal (nth 5 attributes) modtime)))))
     843             : 
     844             : (defun dired-buffer-stale-p (&optional noconfirm)
     845             :   "Return non-nil if current Dired buffer needs updating.
     846             : If NOCONFIRM is non-nil, then this function always returns nil
     847             : for a remote directory.  This feature is used by Auto Revert mode."
     848           0 :   (let ((dirname
     849           0 :          (if (consp dired-directory) (car dired-directory) dired-directory)))
     850           0 :     (and (stringp dirname)
     851           0 :          (not (when noconfirm (file-remote-p dirname)))
     852           0 :          (file-readable-p dirname)
     853             :          ;; Do not auto-revert when the dired buffer can be currently
     854             :          ;; written by the user as in `wdired-mode'.
     855           0 :          buffer-read-only
     856           0 :          (dired-directory-changed-p dirname))))
     857             : 
     858             : (defcustom dired-auto-revert-buffer nil
     859             :   "Automatically revert Dired buffer on revisiting.
     860             : If t, revisiting an existing Dired buffer automatically reverts it.
     861             : If its value is a function, call this function with the directory
     862             : name as single argument and revert the buffer if it returns non-nil.
     863             : Otherwise, a message offering to revert the changed dired buffer
     864             : is displayed.
     865             : Note that this is not the same as `auto-revert-mode' that
     866             : periodically reverts at specified time intervals."
     867             :   :type '(choice
     868             :           (const :tag "Don't revert" nil)
     869             :           (const :tag "Always revert visited Dired buffer" t)
     870             :           (const :tag "Revert changed Dired buffer" dired-directory-changed-p)
     871             :           (function :tag "Predicate function"))
     872             :   :group 'dired
     873             :   :version "23.2")
     874             : 
     875             : (defun dired--need-align-p ()
     876             :   "Return non-nil if some file names are misaligned.
     877             : The return value is the target column for the file names."
     878           0 :   (save-excursion
     879           0 :     (goto-char (point-min))
     880           0 :     (dired-goto-next-file)
     881             :     ;; Use point difference instead of `current-column', because
     882             :     ;; the former works when `dired-hide-details-mode' is enabled.
     883           0 :     (let* ((first (- (point) (point-at-bol)))
     884           0 :            (target first))
     885           0 :       (while (and (not (eobp))
     886           0 :                   (progn
     887           0 :                     (forward-line)
     888           0 :                     (dired-move-to-filename)))
     889           0 :         (when-let* ((distance (- (point) (point-at-bol)))
     890           0 :                     (higher (> distance target)))
     891           0 :           (setq target distance)))
     892           0 :       (and (/= first target) target))))
     893             : 
     894             : (defun dired--align-all-files ()
     895             :   "Align all files adding spaces in front of the size column."
     896           0 :   (let ((target (dired--need-align-p))
     897           0 :         (regexp directory-listing-before-filename-regexp))
     898           0 :     (when target
     899           0 :       (save-excursion
     900           0 :         (goto-char (point-min))
     901           0 :         (dired-goto-next-file)
     902           0 :         (while (dired-move-to-filename)
     903             :           ;; Use point difference instead of `current-column', because
     904             :           ;; the former works when `dired-hide-details-mode' is enabled.
     905           0 :           (let ((distance (- target (- (point) (point-at-bol))))
     906             :                 (inhibit-read-only t))
     907           0 :             (unless (zerop distance)
     908           0 :               (re-search-backward regexp nil t)
     909           0 :               (goto-char (match-beginning 0))
     910           0 :               (search-backward-regexp "[[:space:]]" nil t)
     911           0 :               (skip-chars-forward "[:space:]")
     912           0 :               (insert-char ?\s distance 'inherit))
     913           0 :             (forward-line)))))))
     914             : 
     915             : (defun dired-internal-noselect (dir-or-list &optional switches mode)
     916             :   ;; If DIR-OR-LIST is a string and there is an existing dired buffer
     917             :   ;; for it, just leave buffer as it is (don't even call dired-revert).
     918             :   ;; This saves time especially for deep trees or with ange-ftp.
     919             :   ;; The user can type `g' easily, and it is more consistent with find-file.
     920             :   ;; But if SWITCHES are given they are probably different from the
     921             :   ;; buffer's old value, so call dired-sort-other, which does
     922             :   ;; revert the buffer.
     923             :   ;; Revert the buffer if DIR-OR-LIST is a cons or `dired-directory'
     924             :   ;; is a cons and DIR-OR-LIST is a string.
     925             :   ;; A pity we can't possibly do "Directory has changed - refresh? "
     926             :   ;; like find-file does.
     927             :   ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
     928             :   ;; see there.
     929           6 :   (let* ((old-buf (current-buffer))
     930           6 :          (dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
     931             :          ;; Look for an existing buffer.
     932           6 :          (buffer (dired-find-buffer-nocreate dirname mode))
     933             :          ;; Note that buffer already is in dired-mode, if found.
     934           6 :          (new-buffer-p (null buffer)))
     935           6 :     (or buffer
     936           6 :         (setq buffer (create-file-buffer (directory-file-name dirname))))
     937           6 :     (set-buffer buffer)
     938           6 :     (if (not new-buffer-p)              ; existing buffer ...
     939           0 :         (cond (switches                 ; ... but new switches
     940             :                ;; file list may have changed
     941           0 :                (setq dired-directory dir-or-list)
     942             :                ;; this calls dired-revert
     943           0 :                (dired-sort-other switches))
     944             :               ;; Always revert when `dir-or-list' is a cons.  Also revert
     945             :               ;; if `dired-directory' is a cons but `dir-or-list' is not.
     946           0 :               ((or (consp dir-or-list) (consp dired-directory))
     947           0 :                (setq dired-directory dir-or-list)
     948           0 :                (revert-buffer))
     949             :               ;; Always revert regardless of whether it has changed or not.
     950           0 :               ((eq dired-auto-revert-buffer t)
     951           0 :                (revert-buffer))
     952             :               ;; Revert when predicate function returns non-nil.
     953           0 :               ((functionp dired-auto-revert-buffer)
     954           0 :                (when (funcall dired-auto-revert-buffer dirname)
     955           0 :                  (revert-buffer)
     956           0 :                  (message "Changed directory automatically updated")))
     957             :               ;; If directory has changed on disk, offer to revert.
     958           0 :               ((when (dired-directory-changed-p dirname)
     959           0 :                  (message "%s"
     960           0 :                           (substitute-command-keys
     961           0 :                            "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
     962             :       ;; Else a new buffer
     963           6 :       (setq default-directory
     964           6 :             (or (car-safe (insert-directory-wildcard-in-dir-p dirname))
     965             :                 ;; We can do this unconditionally
     966             :                 ;; because dired-noselect ensures that the name
     967             :                 ;; is passed in directory name syntax
     968             :                 ;; if it was the name of a directory at all.
     969           6 :                 (file-name-directory dirname)))
     970           6 :       (or switches (setq switches dired-listing-switches))
     971           6 :       (if mode (funcall mode)
     972           6 :         (dired-mode dir-or-list switches))
     973             :       ;; default-directory and dired-actual-switches are set now
     974             :       ;; (buffer-local), so we can call dired-readin:
     975           6 :       (let ((failed t))
     976           6 :         (unwind-protect
     977           6 :             (progn (dired-readin)
     978           6 :                    (setq failed nil))
     979             :           ;; dired-readin can fail if parent directories are inaccessible.
     980             :           ;; Don't leave an empty buffer around in that case.
     981           6 :           (if failed (kill-buffer buffer))))
     982           6 :       (goto-char (point-min))
     983           6 :       (dired-initial-position dirname))
     984           6 :     (when (consp dired-directory)
     985           6 :       (dired--align-all-files))
     986           6 :     (set-buffer old-buf)
     987           6 :     buffer))
     988             : 
     989             : (defvar dired-buffers nil
     990             :   ;; Enlarged by dired-advertise
     991             :   ;; Queried by function dired-buffers-for-dir. When this detects a
     992             :   ;; killed buffer, it is removed from this list.
     993             :   "Alist of expanded directories and their associated Dired buffers.")
     994             : 
     995             : (defvar dired-find-subdir)
     996             : 
     997             : ;; FIXME add a doc-string, and document dired-x extensions.
     998             : (defun dired-find-buffer-nocreate (dirname &optional mode)
     999             :   ;; This differs from dired-buffers-for-dir in that it does not consider
    1000             :   ;; subdirs of default-directory and searches for the first match only.
    1001             :   ;; Also, the major mode must be MODE.
    1002           6 :   (if (and (featurep 'dired-x)
    1003           0 :            dired-find-subdir
    1004             :            ;; Don't try to find a wildcard as a subdirectory.
    1005           6 :            (string-equal dirname (file-name-directory dirname)))
    1006           0 :       (let* ((cur-buf (current-buffer))
    1007           0 :              (buffers (nreverse
    1008           0 :                        (dired-buffers-for-dir (expand-file-name dirname))))
    1009           0 :              (cur-buf-matches (and (memq cur-buf buffers)
    1010             :                                    ;; Wildcards must match, too:
    1011           0 :                                    (equal dired-directory dirname))))
    1012             :         ;; We don't want to switch to the same buffer---
    1013           0 :         (setq buffers (delq cur-buf buffers))
    1014           0 :         (or (car (sort buffers #'dired-buffer-more-recently-used-p))
    1015             :             ;; ---unless it's the only possibility:
    1016           0 :             (and cur-buf-matches cur-buf)))
    1017             :     ;; No dired-x, or dired-find-subdir nil.
    1018           6 :     (setq dirname (expand-file-name dirname))
    1019           6 :     (let (found (blist dired-buffers))    ; was (buffer-list)
    1020           6 :       (or mode (setq mode 'dired-mode))
    1021          11 :       (while blist
    1022           5 :         (if (null (buffer-name (cdr (car blist))))
    1023           5 :             (setq blist (cdr blist))
    1024           0 :           (with-current-buffer (cdr (car blist))
    1025           0 :             (if (and (eq major-mode mode)
    1026           0 :                      dired-directory  ;; nil during find-alternate-file
    1027           0 :                      (equal dirname
    1028           0 :                             (expand-file-name
    1029           0 :                              (if (consp dired-directory)
    1030           0 :                                  (car dired-directory)
    1031           0 :                                dired-directory))))
    1032           0 :                 (setq found (cdr (car blist))
    1033           0 :                       blist nil)
    1034           6 :               (setq blist (cdr blist))))))
    1035           6 :       found)))
    1036             : 
    1037             : 
    1038             : ;; Read in a new dired buffer
    1039             : 
    1040             : (defun dired-readin ()
    1041             :   "Read in a new Dired buffer.
    1042             : Differs from `dired-insert-subdir' in that it accepts
    1043             : wildcards, erases the buffer, and builds the subdir-alist anew
    1044             : \(including making it buffer-local and clearing it first)."
    1045             : 
    1046             :   ;; default-directory and dired-actual-switches must be buffer-local
    1047             :   ;; and initialized by now.
    1048           6 :   (let (dirname
    1049             :         ;; This makes readin much much faster.
    1050             :         ;; In particular, it prevents the font lock hook from running
    1051             :         ;; until the directory is all read in.
    1052             :         (inhibit-modification-hooks t))
    1053           6 :     (if (consp dired-directory)
    1054           0 :         (setq dirname (car dired-directory))
    1055           6 :       (setq dirname dired-directory))
    1056           6 :     (setq dirname (expand-file-name dirname))
    1057           6 :     (save-excursion
    1058             :       ;; This hook which may want to modify dired-actual-switches
    1059             :       ;; based on dired-directory, e.g. with ange-ftp to a SysV host
    1060             :       ;; where ls won't understand -Al switches.
    1061           6 :       (run-hooks 'dired-before-readin-hook)
    1062           6 :       (if (consp buffer-undo-list)
    1063           6 :           (setq buffer-undo-list nil))
    1064           6 :       (setq-local file-name-coding-system
    1065           6 :                   (or coding-system-for-read file-name-coding-system))
    1066           6 :       (let ((inhibit-read-only t)
    1067             :             ;; Don't make undo entries for readin.
    1068             :             (buffer-undo-list t))
    1069           6 :         (widen)
    1070           6 :         (erase-buffer)
    1071           6 :         (dired-readin-insert))
    1072           6 :       (goto-char (point-min))
    1073             :       ;; Must first make alist buffer local and set it to nil because
    1074             :       ;; dired-build-subdir-alist will call dired-clear-alist first
    1075           6 :       (setq-local dired-subdir-alist nil)
    1076           6 :       (dired-build-subdir-alist)
    1077           6 :       (let ((attributes (file-attributes dirname)))
    1078           6 :         (if (eq (car attributes) t)
    1079           6 :             (set-visited-file-modtime (nth 5 attributes))))
    1080           6 :       (set-buffer-modified-p nil)
    1081             :       ;; No need to narrow since the whole buffer contains just
    1082             :       ;; dired-readin's output, nothing else.  The hook can
    1083             :       ;; successfully use dired functions (e.g. dired-get-filename)
    1084             :       ;; as the subdir-alist has been built in dired-readin.
    1085           6 :       (run-hooks 'dired-after-readin-hook))))
    1086             : 
    1087             : ;; Subroutines of dired-readin
    1088             : 
    1089             : (defun dired-readin-insert ()
    1090             :   ;; Insert listing for the specified dir (and maybe file list)
    1091             :   ;; already in dired-directory, assuming a clean buffer.
    1092           6 :   (let (dir file-list)
    1093           6 :     (if (consp dired-directory)
    1094           0 :         (setq dir (car dired-directory)
    1095           0 :               file-list (cdr dired-directory))
    1096           6 :       (setq dir dired-directory
    1097           6 :             file-list nil))
    1098           6 :     (setq dir (expand-file-name dir))
    1099           6 :     (if (and (equal "" (file-name-nondirectory dir))
    1100           6 :              (not file-list))
    1101             :         ;; If we are reading a whole single directory...
    1102           0 :         (dired-insert-directory dir dired-actual-switches nil nil t)
    1103           6 :       (if (and (not (insert-directory-wildcard-in-dir-p dir))
    1104           2 :                (not (file-readable-p
    1105           6 :                      (directory-file-name (file-name-directory dir)))))
    1106           6 :           (error "Directory %s inaccessible or nonexistent" dir))
    1107             :       ;; Else treat it as a wildcard spec
    1108             :       ;; unless we have an explicit list of files.
    1109           6 :       (dired-insert-directory dir dired-actual-switches
    1110           6 :                               file-list (not file-list) t))))
    1111             : 
    1112             : (defun dired-align-file (beg end)
    1113             :   "Align the fields of a file to the ones of surrounding lines.
    1114             : BEG..END is the line where the file info is located."
    1115             :   ;; Some versions of ls try to adjust the size of each field so as to just
    1116             :   ;; hold the largest element ("largest" in the current invocation, of
    1117             :   ;; course).  So when a single line is output, the size of each field is
    1118             :   ;; just big enough for that one output.  Thus when dired refreshes one
    1119             :   ;; line, the alignment if this line w.r.t the rest is messed up because
    1120             :   ;; the fields of that one line will generally be smaller.
    1121             :   ;;
    1122             :   ;; To work around this problem, we here add spaces to try and
    1123             :   ;; re-align the fields as needed.  Since this is purely aesthetic,
    1124             :   ;; it is of utmost importance that it doesn't mess up anything like
    1125             :   ;; `dired-move-to-filename'.  To this end, we limit ourselves to
    1126             :   ;; adding spaces only, and to only add them at places where there
    1127             :   ;; was already at least one space.  This way, as long as
    1128             :   ;; `directory-listing-before-filename-regexp' always matches spaces
    1129             :   ;; with "*" or "+", we know we haven't made anything worse.  There
    1130             :   ;; is one spot where the exact number of spaces is important, which
    1131             :   ;; is just before the actual filename, so we refrain from adding
    1132             :   ;; spaces there (and within the filename as well, of course).
    1133           0 :   (save-excursion
    1134           0 :     (let (file file-col other other-col)
    1135             :       ;; Check that there is indeed a file, and that there is another adjacent
    1136             :       ;; file with which to align, and that additional spaces are needed to
    1137             :       ;; align the filenames.
    1138           0 :       (when (and (setq file (progn (goto-char beg)
    1139           0 :                                    (dired-move-to-filename nil end)))
    1140           0 :                  (setq file-col (current-column))
    1141           0 :                  (setq other
    1142           0 :                        (or (and (goto-char beg)
    1143           0 :                                 (zerop (forward-line -1))
    1144           0 :                                 (dired-move-to-filename))
    1145           0 :                            (and (goto-char beg)
    1146           0 :                                 (zerop (forward-line 1))
    1147           0 :                                 (dired-move-to-filename))))
    1148           0 :                  (setq other-col (current-column))
    1149           0 :                  (/= file other)
    1150             :                  ;; Make sure there is some work left to do.
    1151           0 :                  (> other-col file-col))
    1152             :         ;; If we've only looked at the line above, check to see if the line
    1153             :         ;; below exists as well and if so, align with the shorter one.
    1154           0 :         (when (and (< other file)
    1155           0 :                    (goto-char beg)
    1156           0 :                    (zerop (forward-line 1))
    1157           0 :                    (dired-move-to-filename))
    1158           0 :           (let ((alt-col (current-column)))
    1159           0 :             (when (< alt-col other-col)
    1160           0 :               (setq other-col alt-col)
    1161           0 :               (setq other (point)))))
    1162             :         ;; Keep positions uptodate when we insert stuff.
    1163           0 :         (if (> other file) (setq other (copy-marker other)))
    1164           0 :         (setq file (copy-marker file))
    1165             :         ;; Main loop.
    1166           0 :         (goto-char beg)
    1167           0 :         (skip-chars-forward " ")      ;Skip to the first field.
    1168           0 :         (while (and (> other-col file-col)
    1169             :                     ;; Don't touch anything just before (and after) the
    1170             :                     ;; beginning of the filename.
    1171           0 :                     (> file (point)))
    1172             :           ;; We're now just in front of a field, with a space behind us.
    1173           0 :           (let* ((curcol (current-column))
    1174             :                  ;; Nums are right-aligned.
    1175           0 :                  (num-align (looking-at-p "[0-9]"))
    1176             :                  ;; Let's look at the other line, in the same column: we
    1177             :                  ;; should be either near the end of the previous field, or
    1178             :                  ;; in the space between that field and the next.
    1179             :                  ;; [ Of course, it's also possible that we're already within
    1180             :                  ;; the next field or even past it, but that's unlikely since
    1181             :                  ;; other-col > file-col. ]
    1182             :                  ;; Let's find the distance to the alignment-point (either
    1183             :                  ;; the beginning or the end of the next field, depending on
    1184             :                  ;; whether this field is left or right aligned).
    1185             :                  (align-pt-offset
    1186           0 :                   (save-excursion
    1187           0 :                     (goto-char other)
    1188           0 :                     (move-to-column curcol)
    1189           0 :                     (when (looking-at
    1190           0 :                            (concat
    1191           0 :                             (if (eq (char-before) ?\s) " *" "[^ ]* *")
    1192           0 :                             (if num-align "[0-9][^ ]*")))
    1193           0 :                       (- (match-end 0) (match-beginning 0)))))
    1194             :                  ;; Now, the number of spaces to insert is align-pt-offset
    1195             :                  ;; minus the distance to the equivalent point on the
    1196             :                  ;; current line.
    1197             :                  (spaces
    1198           0 :                   (if (not num-align)
    1199           0 :                       align-pt-offset
    1200           0 :                     (and align-pt-offset
    1201           0 :                          (save-excursion
    1202           0 :                            (skip-chars-forward "^ ")
    1203           0 :                            (- align-pt-offset (- (current-column) curcol)))))))
    1204           0 :             (when (and spaces (> spaces 0))
    1205           0 :               (setq file-col (+ spaces file-col))
    1206           0 :               (if (> file-col other-col)
    1207           0 :                   (setq spaces (- spaces (- file-col other-col))))
    1208           0 :               (insert-char ?\s spaces 'inherit)
    1209             :               ;; Let's just make really sure we did not mess up.
    1210           0 :               (unless (save-excursion
    1211           0 :                         (eq (dired-move-to-filename) (marker-position file)))
    1212             :                 ;; Damn!  We messed up: let's revert the change.
    1213           0 :                 (delete-char (- spaces)))))
    1214             :           ;; Now skip to next field.
    1215           0 :           (skip-chars-forward "^ ") (skip-chars-forward " "))
    1216           0 :         (set-marker file nil)))))
    1217             : 
    1218             : 
    1219             : (defvar ls-lisp-use-insert-directory-program)
    1220             : 
    1221             : (defun dired-check-switches (switches short &optional long)
    1222             :   "Return non-nil if the string SWITCHES matches LONG or SHORT format."
    1223         230 :   (let (case-fold-search)
    1224         230 :     (and (stringp switches)
    1225         230 :          (string-match-p (concat "\\(\\`\\| \\)-[[:alnum:]]*" short
    1226         230 :                                  (if long (concat "\\|--" long "\\>") ""))
    1227         230 :                          switches))))
    1228             : 
    1229             : (defun dired-switches-escape-p (switches)
    1230             :   "Return non-nil if the string SWITCHES contains -b or --escape."
    1231             :   ;; Do not match things like "--block-size" that happen to contain "b".
    1232          18 :   (dired-check-switches switches "b" "escape"))
    1233             : 
    1234             : (defun dired-switches-recursive-p (switches)
    1235             :   "Return non-nil if the string SWITCHES contains -R or --recursive."
    1236          18 :   (dired-check-switches switches "R" "recursive"))
    1237             : 
    1238             : (defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
    1239             :   "Insert a directory listing of DIR, Dired style.
    1240             : Use SWITCHES to make the listings.
    1241             : If FILE-LIST is non-nil, list only those files.
    1242             : Otherwise, if WILDCARD is non-nil, expand wildcards;
    1243             :  in that case, DIR should be a file name that uses wildcards.
    1244             : In other cases, DIR should be a directory name or a directory filename.
    1245             : If HDR is non-nil, insert a header line with the directory name."
    1246           6 :   (let ((opoint (point))
    1247           6 :         (process-environment (copy-sequence process-environment))
    1248             :         end)
    1249           6 :     (if (and
    1250             :          ;; Don't try to invoke `ls' if we are on DOS/Windows where
    1251             :          ;; ls-lisp emulation is used, except if they want to use `ls'
    1252             :          ;; as indicated by `ls-lisp-use-insert-directory-program'.
    1253           6 :          (not (and (featurep 'ls-lisp)
    1254           6 :                    (null ls-lisp-use-insert-directory-program)))
    1255           6 :          (not (and (featurep 'eshell)
    1256           6 :                    (bound-and-true-p eshell-ls-use-in-dired)))
    1257           6 :          (or (file-remote-p dir)
    1258           0 :              (if (eq dired-use-ls-dired 'unspecified)
    1259             :                  ;; Check whether "ls --dired" gives exit code 0, and
    1260             :                  ;; save the answer in `dired-use-ls-dired'.
    1261           0 :                  (or (setq dired-use-ls-dired
    1262           0 :                            (eq 0 (call-process insert-directory-program
    1263           0 :                                                nil nil nil "--dired")))
    1264           0 :                      (progn
    1265           0 :                        (message "ls does not support --dired; \
    1266           0 : see `dired-use-ls-dired' for more details.")
    1267           0 :                        nil))
    1268           6 :                dired-use-ls-dired)))
    1269           6 :         (setq switches (concat "--dired " switches)))
    1270             :     ;; Expand directory wildcards and fill file-list.
    1271           6 :     (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir)))
    1272           6 :       (cond (dir-wildcard
    1273           4 :              (setq switches (concat "-d " switches))
    1274             :              ;; We don't know whether the remote ls supports
    1275             :              ;; "--dired", so we cannot add it to the `process-file'
    1276             :              ;; call for wildcards.
    1277           4 :              (when (file-remote-p dir)
    1278           4 :                (setq switches (dired-replace-in-string "--dired" "" switches)))
    1279           4 :              (let* ((default-directory (car dir-wildcard))
    1280           4 :                     (script (format "ls %s %s" switches (cdr dir-wildcard)))
    1281           4 :                     (remotep (file-remote-p dir))
    1282           4 :                     (sh (or (and remotep "/bin/sh")
    1283           0 :                             (and (bound-and-true-p explicit-shell-file-name)
    1284           0 :                                  (executable-find explicit-shell-file-name))
    1285           4 :                             (executable-find "sh")))
    1286           4 :                     (switch (if remotep "-c" shell-command-switch)))
    1287           4 :                (unless
    1288           4 :                    (zerop
    1289           4 :                     (process-file sh nil (current-buffer) nil switch script))
    1290           0 :                  (user-error
    1291           4 :                   "%s: No files matching wildcard" (cdr dir-wildcard)))
    1292           4 :                (insert-directory-clean (point) switches)))
    1293             :             (t
    1294             :              ;; We used to specify the C locale here, to force English
    1295             :              ;; month names; but this should not be necessary any
    1296             :              ;; more, with the new value of
    1297             :              ;; `directory-listing-before-filename-regexp'.
    1298           2 :              (if file-list
    1299           0 :                  (dolist (f file-list)
    1300           0 :                    (let ((beg (point)))
    1301           0 :                      (insert-directory f switches nil nil)
    1302             :                      ;; Re-align fields, if necessary.
    1303           0 :                      (dired-align-file beg (point))))
    1304           6 :                (insert-directory dir switches wildcard (not wildcard))))))
    1305             :     ;; Quote certain characters, unless ls quoted them for us.
    1306           6 :     (if (not (dired-switches-escape-p dired-actual-switches))
    1307           6 :         (save-excursion
    1308           6 :           (setq end (point-marker))
    1309           6 :           (goto-char opoint)
    1310          38 :           (while (search-forward "\\" end t)
    1311          32 :             (replace-match (apply #'propertize
    1312             :                                   "\\\\"
    1313          32 :                                   (text-properties-at (match-beginning 0)))
    1314          32 :                            nil t))
    1315           6 :           (goto-char opoint)
    1316           6 :           (while (search-forward "\^m" end t)
    1317           0 :             (replace-match (apply #'propertize
    1318             :                                   "\\015"
    1319           0 :                                   (text-properties-at (match-beginning 0)))
    1320           6 :                            nil t))
    1321           6 :           (set-marker end nil))
    1322             :       ;; Replace any newlines in DIR with literal "\n"s, for the sake
    1323             :       ;; of the header line.  To disambiguate a literal "\n" in the
    1324             :       ;; actual dirname, we also replace "\" with "\\".
    1325             :       ;; Personally, I think this should always be done, irrespective
    1326             :       ;; of the value of dired-actual-switches, because:
    1327             :       ;;  i) Dired simply does not work with an unescaped newline in
    1328             :       ;;  the directory name used in the header (bug=10469#28), and
    1329             :       ;;  ii) "\" is always replaced with "\\" in the listing, so doing
    1330             :       ;;  it in the header as well makes things consistent.
    1331             :       ;; But at present it is only done if "-b" is in ls-switches,
    1332             :       ;; because newlines in dirnames are uncommon, and people may
    1333             :       ;; have gotten used to seeing unescaped "\" in the headers.
    1334             :       ;; Note: adjust dired-build-subdir-alist if you change this.
    1335           0 :       (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t)
    1336           6 :             dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
    1337             :     ;; If we used --dired and it worked, the lines are already indented.
    1338             :     ;; Otherwise, indent them.
    1339           6 :     (unless (save-excursion
    1340           6 :               (goto-char opoint)
    1341           6 :               (looking-at-p "  "))
    1342           4 :       (let ((indent-tabs-mode nil))
    1343           6 :         (indent-rigidly opoint (point) 2)))
    1344             :     ;; Insert text at the beginning to standardize things.
    1345           6 :     (let ((content-point opoint))
    1346           6 :       (save-excursion
    1347           6 :         (goto-char opoint)
    1348           6 :         (when (and (or hdr wildcard)
    1349           6 :                    (not (and (looking-at "^  \\(.*\\):$")
    1350           6 :                              (file-name-absolute-p (match-string 1)))))
    1351             :           ;; Note that dired-build-subdir-alist will replace the name
    1352             :           ;; by its expansion, so it does not matter whether what we insert
    1353             :           ;; here is fully expanded, but it should be absolute.
    1354           6 :           (insert "  " (or (car-safe (insert-directory-wildcard-in-dir-p dir))
    1355           6 :                            (directory-file-name (file-name-directory dir))) ":\n")
    1356           6 :           (setq content-point (point)))
    1357           6 :         (when wildcard
    1358             :           ;; Insert "wildcard" line where "total" line would be for a full dir.
    1359           6 :           (insert "  wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir))
    1360           6 :                                     (file-name-nondirectory dir))
    1361           6 :                   "\n")))
    1362           6 :       (dired-insert-set-properties content-point (point)))))
    1363             : 
    1364             : (defun dired-insert-set-properties (beg end)
    1365             :   "Add various text properties to the lines in the region."
    1366           6 :   (save-excursion
    1367           6 :     (goto-char beg)
    1368         206 :     (while (< (point) end)
    1369         200 :       (ignore-errors
    1370         200 :         (if (not (dired-move-to-filename))
    1371           6 :             (unless (or (looking-at-p "^$")
    1372           6 :                         (looking-at-p dired-subdir-regexp))
    1373           6 :               (put-text-property (line-beginning-position)
    1374           6 :                                  (1+ (line-end-position))
    1375           6 :                                  'invisible 'dired-hide-details-information))
    1376         194 :           (put-text-property (+ (line-beginning-position) 1) (1- (point))
    1377         194 :                              'invisible 'dired-hide-details-detail)
    1378         194 :           (add-text-properties
    1379         194 :            (point)
    1380         194 :            (progn
    1381         194 :              (dired-move-to-end-of-filename)
    1382         194 :              (point))
    1383             :            '(mouse-face
    1384             :              highlight
    1385             :              dired-filename t
    1386         194 :              help-echo "mouse-2: visit this file in other window"))
    1387         194 :           (when (< (+ (point) 4) (line-end-position))
    1388           0 :             (put-text-property (+ (point) 4) (line-end-position)
    1389         200 :                                'invisible 'dired-hide-details-link))))
    1390         200 :       (forward-line 1))))
    1391             : 
    1392             : ;; Reverting a dired buffer
    1393             : 
    1394             : (defun dired-revert (&optional _arg _noconfirm)
    1395             :   "Reread the Dired buffer.
    1396             : Must also be called after `dired-actual-switches' have changed.
    1397             : Should not fail even on completely garbaged buffers.
    1398             : Preserves old cursor, marks/flags, hidden-p.
    1399             : 
    1400             : Dired sets `revert-buffer-function' to this function.  The args
    1401             : ARG and NOCONFIRM, passed from `revert-buffer', are ignored."
    1402           0 :   (widen)                               ; just in case user narrowed
    1403           0 :   (let ((modflag (buffer-modified-p))
    1404           0 :         (positions (dired-save-positions))
    1405             :         (mark-alist nil)                ; save marked files
    1406           0 :         (hidden-subdirs (dired-remember-hidden))
    1407           0 :         (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
    1408             :         (case-fold-search nil)          ; we check for upper case ls flags
    1409             :         (inhibit-read-only t))
    1410           0 :     (goto-char (point-min))
    1411           0 :     (setq mark-alist;; only after dired-remember-hidden since this unhides:
    1412           0 :           (dired-remember-marks (point-min) (point-max)))
    1413             :     ;; treat top level dir extra (it may contain wildcards)
    1414           0 :     (if (not (consp dired-directory))
    1415           0 :         (dired-uncache dired-directory)
    1416           0 :       (dired-uncache (car dired-directory))
    1417           0 :       (dolist (dir (cdr dired-directory))
    1418           0 :         (if (file-name-absolute-p dir)
    1419           0 :             (dired-uncache dir))))
    1420             :     ;; Run dired-after-readin-hook just once, below.
    1421           0 :     (let ((dired-after-readin-hook nil))
    1422           0 :       (dired-readin)
    1423           0 :       (dired-insert-old-subdirs old-subdir-alist))
    1424           0 :     (dired-mark-remembered mark-alist)  ; mark files that were marked
    1425             :     ;; ... run the hook for the whole buffer, and only after markers
    1426             :     ;; have been reinserted (else omitting in dired-x would omit marked files)
    1427           0 :     (run-hooks 'dired-after-readin-hook)        ; no need to narrow
    1428           0 :     (dired-restore-positions positions)
    1429           0 :     (save-excursion                     ; hide subdirs that were hidden
    1430           0 :       (dolist (dir hidden-subdirs)
    1431           0 :         (if (dired-goto-subdir dir)
    1432           0 :             (dired-hide-subdir 1))))
    1433           0 :     (unless modflag (restore-buffer-modified-p nil)))
    1434             :   ;; outside of the let scope
    1435             : ;;;  Might as well not override the user if the user changed this.
    1436             : ;;;  (setq buffer-read-only t)
    1437             :   )
    1438             : 
    1439             : ;; Subroutines of dired-revert
    1440             : ;; Some of these are also used when inserting subdirs.
    1441             : 
    1442             : (defun dired-save-positions ()
    1443             :   "Return current positions in the buffer and all windows with this directory.
    1444             : The positions have the form (BUFFER-POSITION WINDOW-POSITIONS).
    1445             : 
    1446             : BUFFER-POSITION is the point position in the current Dired buffer.
    1447             : It has the form (BUFFER DIRED-FILENAME BUFFER-LINE-NUMBER).
    1448             : 
    1449             : WINDOW-POSITIONS are current positions in all windows displaying
    1450             : this dired buffer.  The window positions have the form (WINDOW
    1451             : DIRED-FILENAME WINDOW-LINE-NUMBER).
    1452             : 
    1453             : We store line numbers instead of point positions because the header
    1454             : lines might change as well: when this happen the line number doesn't
    1455             : change; the point does."
    1456           0 :   (list
    1457           0 :    (list (current-buffer) (dired-get-filename nil t) (line-number-at-pos))
    1458           0 :    (mapcar (lambda (w)
    1459           0 :              (with-selected-window w
    1460           0 :                (list w
    1461           0 :                      (dired-get-filename nil t)
    1462           0 :                      (line-number-at-pos (window-point w)))))
    1463           0 :            (get-buffer-window-list nil 0 t))))
    1464             : 
    1465             : (defun dired-restore-positions (positions)
    1466             :   "Restore POSITIONS saved with `dired-save-positions'."
    1467           0 :   (let* ((buf-file-pos (nth 0 positions))
    1468           0 :          (buffer (nth 0 buf-file-pos)))
    1469           0 :     (unless (and (nth 1 buf-file-pos)
    1470           0 :                  (dired-goto-file (nth 1 buf-file-pos)))
    1471           0 :       (goto-char (point-min))
    1472           0 :       (forward-line (1- (nth 2 buf-file-pos)))
    1473           0 :       (dired-move-to-filename))
    1474           0 :     (dolist (win-file-pos (nth 1 positions))
    1475             :       ;; Ensure that window still displays the original buffer.
    1476           0 :       (when (eq (window-buffer (nth 0 win-file-pos)) buffer)
    1477           0 :         (with-selected-window (nth 0 win-file-pos)
    1478           0 :           (unless (and (nth 1 win-file-pos)
    1479           0 :                        (dired-goto-file (nth 1 win-file-pos)))
    1480           0 :             (goto-char (point-min))
    1481           0 :             (forward-line (1- (nth 2 win-file-pos)))
    1482           0 :             (dired-move-to-filename)))))))
    1483             : 
    1484             : (defun dired-remember-marks (beg end)
    1485             :   "Return alist of files and their marks, from BEG to END."
    1486           0 :   (if selective-display                 ; must unhide to make this work.
    1487           0 :       (let ((inhibit-read-only t))
    1488           0 :         (subst-char-in-region beg end ?\r ?\n)))
    1489           0 :   (let (fil chr alist)
    1490           0 :     (save-excursion
    1491           0 :       (goto-char beg)
    1492           0 :       (while (re-search-forward dired-re-mark end t)
    1493           0 :         (if (setq fil (dired-get-filename nil t))
    1494           0 :             (setq chr (preceding-char)
    1495           0 :                   alist (cons (cons fil chr) alist)))))
    1496           0 :     alist))
    1497             : 
    1498             : (defun dired-mark-remembered (alist)
    1499             :   "Mark all files remembered in ALIST.
    1500             : Each element of ALIST looks like (FILE . MARKERCHAR)."
    1501           0 :   (let (elt fil chr)
    1502           0 :     (save-excursion
    1503           0 :       (while alist
    1504           0 :         (setq elt (car alist)
    1505           0 :               alist (cdr alist)
    1506           0 :               fil (car elt)
    1507           0 :               chr (cdr elt))
    1508           0 :         (when (dired-goto-file fil)
    1509           0 :           (beginning-of-line)
    1510           0 :           (delete-char 1)
    1511           0 :           (insert chr))))))
    1512             : 
    1513             : (defun dired-remember-hidden ()
    1514             :   "Return a list of names of subdirs currently hidden."
    1515           0 :   (let ((l dired-subdir-alist) dir pos result)
    1516           0 :     (while l
    1517           0 :       (setq dir (car (car l))
    1518           0 :             pos (cdr (car l))
    1519           0 :             l (cdr l))
    1520           0 :       (goto-char pos)
    1521           0 :       (skip-chars-forward "^\r\n")
    1522           0 :       (if (eq (following-char) ?\r)
    1523           0 :           (setq result (cons dir result))))
    1524           0 :     result))
    1525             : 
    1526             : (defun dired-insert-old-subdirs (old-subdir-alist)
    1527             :   "Try to insert all subdirs that were displayed before.
    1528             : Do so according to the former subdir alist OLD-SUBDIR-ALIST."
    1529           0 :   (or (dired-switches-recursive-p dired-actual-switches)
    1530           0 :       (let (elt dir)
    1531           0 :         (while old-subdir-alist
    1532           0 :           (setq elt (car old-subdir-alist)
    1533           0 :                 old-subdir-alist (cdr old-subdir-alist)
    1534           0 :                 dir (car elt))
    1535           0 :           (ignore-errors
    1536           0 :             (dired-uncache dir)
    1537           0 :             (dired-insert-subdir dir))))))
    1538             : 
    1539             : (defun dired-uncache (dir)
    1540             :   "Remove directory DIR from any directory cache."
    1541           0 :   (let ((handler (find-file-name-handler dir 'dired-uncache)))
    1542           0 :     (if handler
    1543           0 :         (funcall handler 'dired-uncache dir))))
    1544             : 
    1545             : ;; dired mode key bindings and initialization
    1546             : 
    1547             : (defvar dired-mode-map
    1548             :   ;; This looks ugly when substitute-command-keys uses C-d instead d:
    1549             :   ;;  (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
    1550             :   (let ((map (make-keymap)))
    1551             :     (set-keymap-parent map special-mode-map)
    1552             :     (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
    1553             :     (define-key map [follow-link] 'mouse-face)
    1554             :     ;; Commands to mark or flag certain categories of files
    1555             :     (define-key map "#" 'dired-flag-auto-save-files)
    1556             :     (define-key map "." 'dired-clean-directory)
    1557             :     (define-key map "~" 'dired-flag-backup-files)
    1558             :     ;; Upper case keys (except !) for operating on the marked files
    1559             :     (define-key map "A" 'dired-do-find-regexp)
    1560             :     (define-key map "C" 'dired-do-copy)
    1561             :     (define-key map "B" 'dired-do-byte-compile)
    1562             :     (define-key map "D" 'dired-do-delete)
    1563             :     (define-key map "G" 'dired-do-chgrp)
    1564             :     (define-key map "H" 'dired-do-hardlink)
    1565             :     (define-key map "L" 'dired-do-load)
    1566             :     (define-key map "M" 'dired-do-chmod)
    1567             :     (define-key map "O" 'dired-do-chown)
    1568             :     (define-key map "P" 'dired-do-print)
    1569             :     (define-key map "Q" 'dired-do-find-regexp-and-replace)
    1570             :     (define-key map "R" 'dired-do-rename)
    1571             :     (define-key map "S" 'dired-do-symlink)
    1572             :     (define-key map "T" 'dired-do-touch)
    1573             :     (define-key map "X" 'dired-do-shell-command)
    1574             :     (define-key map "Z" 'dired-do-compress)
    1575             :     (define-key map "c" 'dired-do-compress-to)
    1576             :     (define-key map "!" 'dired-do-shell-command)
    1577             :     (define-key map "&" 'dired-do-async-shell-command)
    1578             :     ;; Comparison commands
    1579             :     (define-key map "=" 'dired-diff)
    1580             :     ;; Tree Dired commands
    1581             :     (define-key map "\M-\C-?" 'dired-unmark-all-files)
    1582             :     (define-key map "\M-\C-d" 'dired-tree-down)
    1583             :     (define-key map "\M-\C-u" 'dired-tree-up)
    1584             :     (define-key map "\M-\C-n" 'dired-next-subdir)
    1585             :     (define-key map "\M-\C-p" 'dired-prev-subdir)
    1586             :     ;; move to marked files
    1587             :     (define-key map "\M-{" 'dired-prev-marked-file)
    1588             :     (define-key map "\M-}" 'dired-next-marked-file)
    1589             :     ;; Make all regexp commands share a `%' prefix:
    1590             :     ;; We used to get to the submap via a symbol dired-regexp-prefix,
    1591             :     ;; but that seems to serve little purpose, and copy-keymap
    1592             :     ;; does a better job without it.
    1593             :     (define-key map "%" nil)
    1594             :     (define-key map "%u" 'dired-upcase)
    1595             :     (define-key map "%l" 'dired-downcase)
    1596             :     (define-key map "%d" 'dired-flag-files-regexp)
    1597             :     (define-key map "%g" 'dired-mark-files-containing-regexp)
    1598             :     (define-key map "%m" 'dired-mark-files-regexp)
    1599             :     (define-key map "%r" 'dired-do-rename-regexp)
    1600             :     (define-key map "%C" 'dired-do-copy-regexp)
    1601             :     (define-key map "%H" 'dired-do-hardlink-regexp)
    1602             :     (define-key map "%R" 'dired-do-rename-regexp)
    1603             :     (define-key map "%S" 'dired-do-symlink-regexp)
    1604             :     (define-key map "%&" 'dired-flag-garbage-files)
    1605             :     ;; Commands for marking and unmarking.
    1606             :     (define-key map "*" nil)
    1607             :     (define-key map "**" 'dired-mark-executables)
    1608             :     (define-key map "*/" 'dired-mark-directories)
    1609             :     (define-key map "*@" 'dired-mark-symlinks)
    1610             :     (define-key map "*%" 'dired-mark-files-regexp)
    1611             :     (define-key map "*c" 'dired-change-marks)
    1612             :     (define-key map "*s" 'dired-mark-subdir-files)
    1613             :     (define-key map "*m" 'dired-mark)
    1614             :     (define-key map "*u" 'dired-unmark)
    1615             :     (define-key map "*?" 'dired-unmark-all-files)
    1616             :     (define-key map "*!" 'dired-unmark-all-marks)
    1617             :     (define-key map "U" 'dired-unmark-all-marks)
    1618             :     (define-key map "*\177" 'dired-unmark-backward)
    1619             :     (define-key map "*\C-n" 'dired-next-marked-file)
    1620             :     (define-key map "*\C-p" 'dired-prev-marked-file)
    1621             :     (define-key map "*t" 'dired-toggle-marks)
    1622             :     ;; Lower keys for commands not operating on all the marked files
    1623             :     (define-key map "a" 'dired-find-alternate-file)
    1624             :     (define-key map "d" 'dired-flag-file-deletion)
    1625             :     (define-key map "e" 'dired-find-file)
    1626             :     (define-key map "f" 'dired-find-file)
    1627             :     (define-key map "\C-m" 'dired-find-file)
    1628             :     (put 'dired-find-file :advertised-binding "\C-m")
    1629             :     (define-key map "g" 'revert-buffer)
    1630             :     (define-key map "i" 'dired-maybe-insert-subdir)
    1631             :     (define-key map "j" 'dired-goto-file)
    1632             :     (define-key map "k" 'dired-do-kill-lines)
    1633             :     (define-key map "l" 'dired-do-redisplay)
    1634             :     (define-key map "m" 'dired-mark)
    1635             :     (define-key map "n" 'dired-next-line)
    1636             :     (define-key map "o" 'dired-find-file-other-window)
    1637             :     (define-key map "\C-o" 'dired-display-file)
    1638             :     (define-key map "p" 'dired-previous-line)
    1639             :     (define-key map "s" 'dired-sort-toggle-or-edit)
    1640             :     (define-key map "t" 'dired-toggle-marks)
    1641             :     (define-key map "u" 'dired-unmark)
    1642             :     (define-key map "v" 'dired-view-file)
    1643             :     (define-key map "w" 'dired-copy-filename-as-kill)
    1644             :     (define-key map "W" 'browse-url-of-dired-file)
    1645             :     (define-key map "x" 'dired-do-flagged-delete)
    1646             :     (define-key map "y" 'dired-show-file-type)
    1647             :     (define-key map "+" 'dired-create-directory)
    1648             :     ;; moving
    1649             :     (define-key map "<" 'dired-prev-dirline)
    1650             :     (define-key map ">" 'dired-next-dirline)
    1651             :     (define-key map "^" 'dired-up-directory)
    1652             :     (define-key map " " 'dired-next-line)
    1653             :     (define-key map [?\S-\ ] 'dired-previous-line)
    1654             :     (define-key map [remap next-line] 'dired-next-line)
    1655             :     (define-key map [remap previous-line] 'dired-previous-line)
    1656             :     ;; hiding
    1657             :     (define-key map "$" 'dired-hide-subdir)
    1658             :     (define-key map "\M-$" 'dired-hide-all)
    1659             :     (define-key map "(" 'dired-hide-details-mode)
    1660             :     ;; isearch
    1661             :     (define-key map (kbd "M-s a C-s")   'dired-do-isearch)
    1662             :     (define-key map (kbd "M-s a M-C-s") 'dired-do-isearch-regexp)
    1663             :     (define-key map (kbd "M-s f C-s")   'dired-isearch-filenames)
    1664             :     (define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp)
    1665             :     ;; misc
    1666             :     (define-key map [remap read-only-mode] 'dired-toggle-read-only)
    1667             :     ;; `toggle-read-only' is an obsolete alias for `read-only-mode'
    1668             :     (define-key map [remap toggle-read-only] 'dired-toggle-read-only)
    1669             :     (define-key map "?" 'dired-summary)
    1670             :     (define-key map "\177" 'dired-unmark-backward)
    1671             :     (define-key map [remap undo] 'dired-undo)
    1672             :     (define-key map [remap advertised-undo] 'dired-undo)
    1673             :     ;; thumbnail manipulation (image-dired)
    1674             :     (define-key map "\C-td" 'image-dired-display-thumbs)
    1675             :     (define-key map "\C-tt" 'image-dired-tag-files)
    1676             :     (define-key map "\C-tr" 'image-dired-delete-tag)
    1677             :     (define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer)
    1678             :     (define-key map "\C-ti" 'image-dired-dired-display-image)
    1679             :     (define-key map "\C-tx" 'image-dired-dired-display-external)
    1680             :     (define-key map "\C-ta" 'image-dired-display-thumbs-append)
    1681             :     (define-key map "\C-t." 'image-dired-display-thumb)
    1682             :     (define-key map "\C-tc" 'image-dired-dired-comment-files)
    1683             :     (define-key map "\C-tf" 'image-dired-mark-tagged-files)
    1684             :     (define-key map "\C-t\C-t" 'image-dired-dired-toggle-marked-thumbs)
    1685             :     (define-key map "\C-te" 'image-dired-dired-edit-comment-and-tags)
    1686             :     ;; encryption and decryption (epa-dired)
    1687             :     (define-key map ":d" 'epa-dired-do-decrypt)
    1688             :     (define-key map ":v" 'epa-dired-do-verify)
    1689             :     (define-key map ":s" 'epa-dired-do-sign)
    1690             :     (define-key map ":e" 'epa-dired-do-encrypt)
    1691             : 
    1692             :     ;; Make menu bar items.
    1693             : 
    1694             :     ;; No need to fo this, now that top-level items are fewer.
    1695             :     ;;;;
    1696             :     ;; Get rid of the Edit menu bar item to save space.
    1697             :     ;(define-key map [menu-bar edit] 'undefined)
    1698             : 
    1699             :     (define-key map [menu-bar subdir]
    1700             :       (cons "Subdir" (make-sparse-keymap "Subdir")))
    1701             : 
    1702             :     (define-key map [menu-bar subdir hide-all]
    1703             :       '(menu-item "Hide All" dired-hide-all
    1704             :                   :help "Hide all subdirectories, leave only header lines"))
    1705             :     (define-key map [menu-bar subdir hide-subdir]
    1706             :       '(menu-item "Hide/UnHide Subdir" dired-hide-subdir
    1707             :                   :help "Hide or unhide current directory listing"))
    1708             :     (define-key map [menu-bar subdir tree-down]
    1709             :       '(menu-item "Tree Down" dired-tree-down
    1710             :                   :help "Go to first subdirectory header down the tree"))
    1711             :     (define-key map [menu-bar subdir tree-up]
    1712             :       '(menu-item "Tree Up" dired-tree-up
    1713             :                   :help "Go to first subdirectory header up the tree"))
    1714             :     (define-key map [menu-bar subdir up]
    1715             :       '(menu-item "Up Directory" dired-up-directory
    1716             :                   :help "Edit the parent directory"))
    1717             :     (define-key map [menu-bar subdir prev-subdir]
    1718             :       '(menu-item "Prev Subdir" dired-prev-subdir
    1719             :                   :help "Go to previous subdirectory header line"))
    1720             :     (define-key map [menu-bar subdir next-subdir]
    1721             :       '(menu-item "Next Subdir" dired-next-subdir
    1722             :                   :help "Go to next subdirectory header line"))
    1723             :     (define-key map [menu-bar subdir prev-dirline]
    1724             :       '(menu-item "Prev Dirline" dired-prev-dirline
    1725             :                   :help "Move to next directory-file line"))
    1726             :     (define-key map [menu-bar subdir next-dirline]
    1727             :       '(menu-item "Next Dirline" dired-next-dirline
    1728             :                   :help "Move to previous directory-file line"))
    1729             :     (define-key map [menu-bar subdir insert]
    1730             :       '(menu-item "Insert This Subdir" dired-maybe-insert-subdir
    1731             :                   :help "Insert contents of subdirectory"
    1732             :                   :enable (let ((f (dired-get-filename nil t)))
    1733             :                             (and f (file-directory-p f)))))
    1734             :     (define-key map [menu-bar immediate]
    1735             :       (cons "Immediate" (make-sparse-keymap "Immediate")))
    1736             : 
    1737             :     (define-key map
    1738             :       [menu-bar immediate image-dired-dired-display-external]
    1739             :       '(menu-item "Display Image Externally" image-dired-dired-display-external
    1740             :                   :help "Display image in external viewer"))
    1741             :     (define-key map
    1742             :       [menu-bar immediate image-dired-dired-display-image]
    1743             :       '(menu-item "Display Image" image-dired-dired-display-image
    1744             :                   :help "Display sized image in a separate window"))
    1745             :     (define-key map
    1746             :       [menu-bar immediate image-dired-dired-toggle-marked-thumbs]
    1747             :       '(menu-item "Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs
    1748             :                   :help "Add or remove image thumbnails in front of marked file names"))
    1749             : 
    1750             :     (define-key map [menu-bar immediate hide-details]
    1751             :       '(menu-item "Hide Details" dired-hide-details-mode
    1752             :                   :help "Hide details in buffer"
    1753             :                   :button (:toggle . dired-hide-details-mode)))
    1754             :     (define-key map [menu-bar immediate revert-buffer]
    1755             :       '(menu-item "Refresh" revert-buffer
    1756             :                   :help "Update contents of shown directories"))
    1757             : 
    1758             :     (define-key map [menu-bar immediate dashes]
    1759             :       '("--"))
    1760             : 
    1761             :     (define-key map [menu-bar immediate isearch-filenames-regexp]
    1762             :       '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp
    1763             :                   :help "Incrementally search for regexp in file names only"))
    1764             :     (define-key map [menu-bar immediate isearch-filenames]
    1765             :       '(menu-item "Isearch in File Names..." dired-isearch-filenames
    1766             :                   :help "Incrementally search for string in file names only."))
    1767             :     (define-key map [menu-bar immediate compare-directories]
    1768             :       '(menu-item "Compare Directories..." dired-compare-directories
    1769             :                   :help "Mark files with different attributes in two Dired buffers"))
    1770             :     (define-key map [menu-bar immediate backup-diff]
    1771             :       '(menu-item "Compare with Backup" dired-backup-diff
    1772             :                   :help "Diff file at cursor with its latest backup"))
    1773             :     (define-key map [menu-bar immediate diff]
    1774             :       '(menu-item "Diff..." dired-diff
    1775             :                   :help "Compare file at cursor with another file"))
    1776             :     (define-key map [menu-bar immediate view]
    1777             :       '(menu-item "View This File" dired-view-file
    1778             :                   :help "Examine file at cursor in read-only mode"))
    1779             :     (define-key map [menu-bar immediate display]
    1780             :       '(menu-item "Display in Other Window" dired-display-file
    1781             :                   :help "Display file at cursor in other window"))
    1782             :     (define-key map [menu-bar immediate find-file-other-window]
    1783             :       '(menu-item "Find in Other Window" dired-find-file-other-window
    1784             :                   :help "Edit file at cursor in other window"))
    1785             :     (define-key map [menu-bar immediate find-file]
    1786             :       '(menu-item "Find This File" dired-find-file
    1787             :                   :help "Edit file at cursor"))
    1788             :     (define-key map [menu-bar immediate create-directory]
    1789             :       '(menu-item "Create Directory..." dired-create-directory
    1790             :                   :help "Create a directory"))
    1791             :     (define-key map [menu-bar immediate wdired-mode]
    1792             :       '(menu-item "Edit File Names" wdired-change-to-wdired-mode
    1793             :                   :help "Put a Dired buffer in a mode in which filenames are editable"
    1794             :                   :keys "C-x C-q"
    1795             :                   :filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
    1796             : 
    1797             :     (define-key map [menu-bar regexp]
    1798             :       (cons "Regexp" (make-sparse-keymap "Regexp")))
    1799             : 
    1800             :     (define-key map
    1801             :       [menu-bar regexp image-dired-mark-tagged-files]
    1802             :       '(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files
    1803             :                   :help "Mark files whose image tags matches regexp"))
    1804             : 
    1805             :     (define-key map [menu-bar regexp dashes-1]
    1806             :       '("--"))
    1807             : 
    1808             :     (define-key map [menu-bar regexp downcase]
    1809             :       '(menu-item "Downcase" dired-downcase
    1810             :                   ;; When running on plain MS-DOS, there's only one
    1811             :                   ;; letter-case for file names.
    1812             :                   :enable (or (not (fboundp 'msdos-long-file-names))
    1813             :                               (msdos-long-file-names))
    1814             :                   :help "Rename marked files to lower-case name"))
    1815             :     (define-key map [menu-bar regexp upcase]
    1816             :       '(menu-item "Upcase" dired-upcase
    1817             :                   :enable (or (not (fboundp 'msdos-long-file-names))
    1818             :                               (msdos-long-file-names))
    1819             :                   :help "Rename marked files to upper-case name"))
    1820             :     (define-key map [menu-bar regexp hardlink]
    1821             :       '(menu-item "Hardlink..." dired-do-hardlink-regexp
    1822             :                   :help "Make hard links for files matching regexp"))
    1823             :     (define-key map [menu-bar regexp symlink]
    1824             :       '(menu-item "Symlink..." dired-do-symlink-regexp
    1825             :                   :visible (fboundp 'make-symbolic-link)
    1826             :                   :help "Make symbolic links for files matching regexp"))
    1827             :     (define-key map [menu-bar regexp rename]
    1828             :       '(menu-item "Rename..." dired-do-rename-regexp
    1829             :                   :help "Rename marked files matching regexp"))
    1830             :     (define-key map [menu-bar regexp copy]
    1831             :       '(menu-item "Copy..." dired-do-copy-regexp
    1832             :                   :help "Copy marked files matching regexp"))
    1833             :     (define-key map [menu-bar regexp flag]
    1834             :       '(menu-item "Flag..." dired-flag-files-regexp
    1835             :                   :help "Flag files matching regexp for deletion"))
    1836             :     (define-key map [menu-bar regexp mark]
    1837             :       '(menu-item "Mark..." dired-mark-files-regexp
    1838             :                   :help "Mark files matching regexp for future operations"))
    1839             :     (define-key map [menu-bar regexp mark-cont]
    1840             :       '(menu-item "Mark Containing..." dired-mark-files-containing-regexp
    1841             :                   :help "Mark files whose contents matches regexp"))
    1842             : 
    1843             :     (define-key map [menu-bar mark]
    1844             :       (cons "Mark" (make-sparse-keymap "Mark")))
    1845             : 
    1846             :     (define-key map [menu-bar mark prev]
    1847             :       '(menu-item "Previous Marked" dired-prev-marked-file
    1848             :                   :help "Move to previous marked file"))
    1849             :     (define-key map [menu-bar mark next]
    1850             :       '(menu-item "Next Marked" dired-next-marked-file
    1851             :                   :help "Move to next marked file"))
    1852             :     (define-key map [menu-bar mark marks]
    1853             :       '(menu-item "Change Marks..." dired-change-marks
    1854             :                   :help "Replace marker with another character"))
    1855             :     (define-key map [menu-bar mark unmark-all]
    1856             :       '(menu-item "Unmark All" dired-unmark-all-marks))
    1857             :     (define-key map [menu-bar mark symlinks]
    1858             :       '(menu-item "Mark Symlinks" dired-mark-symlinks
    1859             :                   :visible (fboundp 'make-symbolic-link)
    1860             :                   :help "Mark all symbolic links"))
    1861             :     (define-key map [menu-bar mark directories]
    1862             :       '(menu-item "Mark Directories" dired-mark-directories
    1863             :                   :help "Mark all directories except `.' and `..'"))
    1864             :     (define-key map [menu-bar mark directory]
    1865             :       '(menu-item "Mark Old Backups" dired-clean-directory
    1866             :                   :help "Flag old numbered backups for deletion"))
    1867             :     (define-key map [menu-bar mark executables]
    1868             :       '(menu-item "Mark Executables" dired-mark-executables
    1869             :                   :help "Mark all executable files"))
    1870             :     (define-key map [menu-bar mark garbage-files]
    1871             :       '(menu-item "Flag Garbage Files" dired-flag-garbage-files
    1872             :                   :help "Flag unneeded files for deletion"))
    1873             :     (define-key map [menu-bar mark backup-files]
    1874             :       '(menu-item "Flag Backup Files" dired-flag-backup-files
    1875             :                   :help "Flag all backup files for deletion"))
    1876             :     (define-key map [menu-bar mark auto-save-files]
    1877             :       '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
    1878             :                   :help "Flag auto-save files for deletion"))
    1879             :     (define-key map [menu-bar mark deletion]
    1880             :       '(menu-item "Flag" dired-flag-file-deletion
    1881             :                   :help "Flag current line's file for deletion"))
    1882             :     (define-key map [menu-bar mark unmark]
    1883             :       '(menu-item "Unmark" dired-unmark
    1884             :                   :help "Unmark or unflag current line's file"))
    1885             :     (define-key map [menu-bar mark mark]
    1886             :       '(menu-item "Mark" dired-mark
    1887             :                   :help "Mark current line's file for future operations"))
    1888             :     (define-key map [menu-bar mark toggle-marks]
    1889             :       '(menu-item "Toggle Marks" dired-toggle-marks
    1890             :                   :help "Mark unmarked files, unmark marked ones"))
    1891             : 
    1892             :     (define-key map [menu-bar operate]
    1893             :       (cons "Operate" (make-sparse-keymap "Operate")))
    1894             : 
    1895             :     (define-key map
    1896             :       [menu-bar operate image-dired-delete-tag]
    1897             :       '(menu-item "Delete Image Tag..." image-dired-delete-tag
    1898             :                   :help "Delete image tag from current or marked files"))
    1899             :     (define-key map
    1900             :       [menu-bar operate image-dired-tag-files]
    1901             :       '(menu-item "Add Image Tags..." image-dired-tag-files
    1902             :                   :help "Add image tags to current or marked files"))
    1903             :     (define-key map
    1904             :       [menu-bar operate image-dired-dired-comment-files]
    1905             :       '(menu-item "Add Image Comment..." image-dired-dired-comment-files
    1906             :                   :help "Add image comment to current or marked files"))
    1907             :     (define-key map
    1908             :       [menu-bar operate image-dired-display-thumbs]
    1909             :       '(menu-item "Display Image Thumbnails" image-dired-display-thumbs
    1910             :                   :help "Display image thumbnails for current or marked image files"))
    1911             : 
    1912             :     (define-key map [menu-bar operate dashes-4]
    1913             :       '("--"))
    1914             : 
    1915             :     (define-key map
    1916             :       [menu-bar operate epa-dired-do-decrypt]
    1917             :       '(menu-item "Decrypt..." epa-dired-do-decrypt
    1918             :                   :help "Decrypt current or marked files"))
    1919             : 
    1920             :     (define-key map
    1921             :       [menu-bar operate epa-dired-do-verify]
    1922             :       '(menu-item "Verify" epa-dired-do-verify
    1923             :                   :help "Verify digital signature of current or marked files"))
    1924             : 
    1925             :     (define-key map
    1926             :       [menu-bar operate epa-dired-do-sign]
    1927             :       '(menu-item "Sign..." epa-dired-do-sign
    1928             :                   :help "Create digital signature of current or marked files"))
    1929             : 
    1930             :     (define-key map
    1931             :       [menu-bar operate epa-dired-do-encrypt]
    1932             :       '(menu-item "Encrypt..." epa-dired-do-encrypt
    1933             :                   :help "Encrypt current or marked files"))
    1934             : 
    1935             :     (define-key map [menu-bar operate dashes-3]
    1936             :       '("--"))
    1937             : 
    1938             :     (define-key map [menu-bar operate query-replace]
    1939             :       '(menu-item "Query Replace in Files..." dired-do-find-regexp-and-replace
    1940             :                   :help "Replace regexp matches in marked files"))
    1941             :     (define-key map [menu-bar operate search]
    1942             :       '(menu-item "Search Files..." dired-do-find-regexp
    1943             :                   :help "Search marked files for matches of regexp"))
    1944             :     (define-key map [menu-bar operate isearch-regexp]
    1945             :       '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp
    1946             :                   :help "Incrementally search marked files for regexp"))
    1947             :     (define-key map [menu-bar operate isearch]
    1948             :       '(menu-item "Isearch Files..." dired-do-isearch
    1949             :                   :help "Incrementally search marked files for string"))
    1950             :     (define-key map [menu-bar operate chown]
    1951             :       '(menu-item "Change Owner..." dired-do-chown
    1952             :                   :visible (not (memq system-type '(ms-dos windows-nt)))
    1953             :                   :help "Change the owner of marked files"))
    1954             :     (define-key map [menu-bar operate chgrp]
    1955             :       '(menu-item "Change Group..." dired-do-chgrp
    1956             :                   :visible (not (memq system-type '(ms-dos windows-nt)))
    1957             :                   :help "Change the group of marked files"))
    1958             :     (define-key map [menu-bar operate chmod]
    1959             :       '(menu-item "Change Mode..." dired-do-chmod
    1960             :                   :help "Change mode (attributes) of marked files"))
    1961             :     (define-key map [menu-bar operate touch]
    1962             :       '(menu-item "Change Timestamp..." dired-do-touch
    1963             :                   :help "Change timestamp of marked files"))
    1964             :     (define-key map [menu-bar operate load]
    1965             :       '(menu-item "Load" dired-do-load
    1966             :                   :help "Load marked Emacs Lisp files"))
    1967             :     (define-key map [menu-bar operate compile]
    1968             :       '(menu-item "Byte-compile" dired-do-byte-compile
    1969             :                   :help "Byte-compile marked Emacs Lisp files"))
    1970             :     (define-key map [menu-bar operate compress]
    1971             :       '(menu-item "Compress" dired-do-compress
    1972             :                   :help "Compress/uncompress marked files"))
    1973             :     (define-key map [menu-bar operate print]
    1974             :       '(menu-item "Print..." dired-do-print
    1975             :                   :help "Ask for print command and print marked files"))
    1976             :     (define-key map [menu-bar operate hardlink]
    1977             :       '(menu-item "Hardlink to..." dired-do-hardlink
    1978             :                   :help "Make hard links for current or marked files"))
    1979             :     (define-key map [menu-bar operate symlink]
    1980             :       '(menu-item "Symlink to..." dired-do-symlink
    1981             :                   :visible (fboundp 'make-symbolic-link)
    1982             :                   :help "Make symbolic links for current or marked files"))
    1983             :     (define-key map [menu-bar operate async-command]
    1984             :       '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command
    1985             :                   :help "Run a shell command asynchronously on current or marked files"))
    1986             :     (define-key map [menu-bar operate command]
    1987             :       '(menu-item "Shell Command..." dired-do-shell-command
    1988             :                   :help "Run a shell command on current or marked files"))
    1989             :     (define-key map [menu-bar operate delete]
    1990             :       '(menu-item "Delete" dired-do-delete
    1991             :                   :help "Delete current file or all marked files"))
    1992             :     (define-key map [menu-bar operate rename]
    1993             :       '(menu-item "Rename to..." dired-do-rename
    1994             :                   :help "Rename current file or move marked files"))
    1995             :     (define-key map [menu-bar operate copy]
    1996             :       '(menu-item "Copy to..." dired-do-copy
    1997             :                   :help "Copy current file or all marked files"))
    1998             : 
    1999             :     map)
    2000             :   "Local keymap for Dired mode buffers.")
    2001             : 
    2002             : ;; Dired mode is suitable only for specially formatted data.
    2003             : (put 'dired-mode 'mode-class 'special)
    2004             : 
    2005             : ;; Autoload cookie needed by desktop.el
    2006             : ;;;###autoload
    2007             : (defun dired-mode (&optional dirname switches)
    2008             :   "\
    2009             : Mode for \"editing\" directory listings.
    2010             : In Dired, you are \"editing\" a list of the files in a directory and
    2011             :   (optionally) its subdirectories, in the format of `ls -lR'.
    2012             :   Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
    2013             : \"Editing\" means that you can run shell commands on files, visit,
    2014             :   compress, load or byte-compile them, change their file attributes
    2015             :   and insert subdirectories into the same buffer.  You can \"mark\"
    2016             :   files for later commands or \"flag\" them for deletion, either file
    2017             :   by file or all files matching certain criteria.
    2018             : You can move using the usual cursor motion commands.\\<dired-mode-map>
    2019             : The buffer is read-only.  Digits are prefix arguments.
    2020             : Type \\[dired-flag-file-deletion] to flag a file `D' for deletion.
    2021             : Type \\[dired-mark] to Mark a file or subdirectory for later commands.
    2022             :   Most commands operate on the marked files and use the current file
    2023             :   if no files are marked.  Use a numeric prefix argument to operate on
    2024             :   the next ARG (or previous -ARG if ARG<0) files, or just `1'
    2025             :   to operate on the current file only.  Prefix arguments override marks.
    2026             :   Mark-using commands display a list of failures afterwards.  Type \\[dired-summary]
    2027             :   to see why something went wrong.
    2028             : Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory.
    2029             : Type \\[dired-unmark-backward] to back up one line and unmark or unflag.
    2030             : Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'.
    2031             : Type \\[dired-find-file] to Find the current line's file
    2032             :   (or dired it in another buffer, if it is a directory).
    2033             : Type \\[dired-find-file-other-window] to find file or Dired directory in Other window.
    2034             : Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
    2035             : Type \\[dired-do-rename] to Rename a file or move the marked files to another directory.
    2036             : Type \\[dired-do-copy] to Copy files.
    2037             : Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
    2038             : Type \\[revert-buffer] to read all currently expanded directories aGain.
    2039             :   This retains all marks and hides subdirs again that were hidden before.
    2040             : Use `SPC' and `DEL' to move down and up by lines.
    2041             : 
    2042             : If Dired ever gets confused, you can either type \\[revert-buffer] \
    2043             : to read the
    2044             : directories again, type \\[dired-do-redisplay] \
    2045             : to relist the file at point or the marked files or a
    2046             : subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
    2047             : again for the directory tree.
    2048             : 
    2049             : Customization variables (rename this buffer and type \\[describe-variable] on each line
    2050             : for more info):
    2051             : 
    2052             :   `dired-listing-switches'
    2053             :   `dired-trivial-filenames'
    2054             :   `dired-marker-char'
    2055             :   `dired-del-marker'
    2056             :   `dired-keep-marker-rename'
    2057             :   `dired-keep-marker-copy'
    2058             :   `dired-keep-marker-hardlink'
    2059             :   `dired-keep-marker-symlink'
    2060             : 
    2061             : Hooks (use \\[describe-variable] to see their documentation):
    2062             : 
    2063             :   `dired-before-readin-hook'
    2064             :   `dired-after-readin-hook'
    2065             :   `dired-mode-hook'
    2066             :   `dired-load-hook'
    2067             : 
    2068             : Keybindings:
    2069             : \\{dired-mode-map}"
    2070             :   ;; Not to be called interactively (e.g. dired-directory will be set
    2071             :   ;; to default-directory, which is wrong with wildcards).
    2072           6 :   (kill-all-local-variables)
    2073           6 :   (use-local-map dired-mode-map)
    2074           6 :   (dired-advertise)                     ; default-directory is already set
    2075           6 :   (setq major-mode 'dired-mode
    2076             :         mode-name "Dired"
    2077             :         ;; case-fold-search nil
    2078             :         buffer-read-only t
    2079             :         selective-display t             ; for subdirectory hiding
    2080             :         mode-line-buffer-identification
    2081           6 :         (propertized-buffer-identification "%17b"))
    2082             :   ;; Ignore dired-hide-details-* value of invisible text property by default.
    2083           6 :   (when (eq buffer-invisibility-spec t)
    2084           6 :     (setq buffer-invisibility-spec (list t)))
    2085           6 :   (setq-local revert-buffer-function #'dired-revert)
    2086           6 :   (setq-local buffer-stale-function #'dired-buffer-stale-p)
    2087           6 :   (setq-local page-delimiter "\n\n")
    2088           6 :   (setq-local dired-directory (or dirname default-directory))
    2089             :   ;; list-buffers uses this to display the dir being edited in this buffer.
    2090           6 :   (setq list-buffers-directory
    2091           6 :         (expand-file-name (if (listp dired-directory)
    2092           0 :                               (car dired-directory)
    2093           6 :                             dired-directory)))
    2094           6 :   (setq-local dired-actual-switches (or switches dired-listing-switches))
    2095           6 :   (setq-local font-lock-defaults
    2096           6 :               '(dired-font-lock-keywords t nil nil beginning-of-line))
    2097           6 :   (setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data)
    2098           6 :   (setq dired-switches-alist nil)
    2099           6 :   (hack-dir-local-variables-non-file-buffer) ; before sorting
    2100           6 :   (dired-sort-other dired-actual-switches t)
    2101           6 :   (when (featurep 'dnd)
    2102           6 :     (setq-local dnd-protocol-alist
    2103           6 :                 (append dired-dnd-protocol-alist dnd-protocol-alist)))
    2104           6 :   (add-hook 'file-name-at-point-functions 'dired-file-name-at-point nil t)
    2105           6 :   (add-hook 'isearch-mode-hook 'dired-isearch-filenames-setup nil t)
    2106           6 :   (run-mode-hooks 'dired-mode-hook))
    2107             : 
    2108             : ;; Idiosyncratic dired commands that don't deal with marks.
    2109             : 
    2110             : (defun dired-summary ()
    2111             :   "Summarize basic Dired commands and show recent Dired errors."
    2112             :   (interactive)
    2113           0 :   (dired-why)
    2114             :   ;>> this should check the key-bindings and use substitute-command-keys if non-standard
    2115           0 :   (message
    2116           0 :    "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
    2117             : 
    2118             : (defun dired-undo ()
    2119             :   "Undo in a Dired buffer.
    2120             : This doesn't recover lost files, it just undoes changes in the buffer itself.
    2121             : You can use it to recover marks, killed lines or subdirs."
    2122             :   (interactive)
    2123           0 :   (let ((inhibit-read-only t))
    2124           0 :     (undo))
    2125           0 :   (dired-build-subdir-alist)
    2126           0 :   (message "Change in Dired buffer undone.
    2127           0 : Actual changes in files cannot be undone by Emacs."))
    2128             : 
    2129             : (defun dired-toggle-read-only ()
    2130             :   "Edit Dired buffer with Wdired, or make it read-only.
    2131             : If the current buffer can be edited with Wdired, (i.e. the major
    2132             : mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
    2133             : Otherwise, toggle `read-only-mode'."
    2134             :   (interactive)
    2135           0 :   (if (derived-mode-p 'dired-mode)
    2136           0 :       (wdired-change-to-wdired-mode)
    2137           0 :     (read-only-mode 'toggle)))
    2138             : 
    2139             : (defun dired-next-line (arg)
    2140             :   "Move down lines then position at filename.
    2141             : Optional prefix ARG says how many lines to move; default is one line."
    2142             :   (interactive "^p")
    2143           0 :   (let ((line-move-visual)
    2144             :         (goal-column))
    2145           0 :     (line-move arg t))
    2146             :   ;; We never want to move point into an invisible line.
    2147           0 :   (while (and (invisible-p (point))
    2148           0 :               (not (if (and arg (< arg 0)) (bobp) (eobp))))
    2149           0 :     (forward-char (if (and arg (< arg 0)) -1 1)))
    2150           0 :   (dired-move-to-filename))
    2151             : 
    2152             : (defun dired-previous-line (arg)
    2153             :   "Move up lines then position at filename.
    2154             : Optional prefix ARG says how many lines to move; default is one line."
    2155             :   (interactive "^p")
    2156           0 :   (dired-next-line (- (or arg 1))))
    2157             : 
    2158             : (defun dired-next-dirline (arg &optional opoint)
    2159             :   "Goto ARGth next directory file line."
    2160             :   (interactive "p")
    2161           0 :   (or opoint (setq opoint (point)))
    2162           0 :   (if (if (> arg 0)
    2163           0 :           (re-search-forward dired-re-dir nil t arg)
    2164           0 :         (beginning-of-line)
    2165           0 :         (re-search-backward dired-re-dir nil t (- arg)))
    2166           0 :       (dired-move-to-filename)          ; user may type `i' or `f'
    2167           0 :     (goto-char opoint)
    2168           0 :     (error "No more subdirectories")))
    2169             : 
    2170             : (defun dired-prev-dirline (arg)
    2171             :   "Goto ARGth previous directory file line."
    2172             :   (interactive "p")
    2173           0 :   (dired-next-dirline (- arg)))
    2174             : 
    2175             : (defun dired-up-directory (&optional other-window)
    2176             :   "Run Dired on parent directory of current directory.
    2177             : Find the parent directory either in this buffer or another buffer.
    2178             : Creates a buffer if necessary.
    2179             : If OTHER-WINDOW (the optional prefix arg), display the parent
    2180             : directory in another window."
    2181             :   (interactive "P")
    2182           0 :   (let* ((dir (dired-current-directory))
    2183           0 :          (up (file-name-directory (directory-file-name dir))))
    2184           0 :     (or (dired-goto-file (directory-file-name dir))
    2185             :         ;; Only try dired-goto-subdir if buffer has more than one dir.
    2186           0 :         (and (cdr dired-subdir-alist)
    2187           0 :              (dired-goto-subdir up))
    2188           0 :         (progn
    2189           0 :           (if other-window
    2190           0 :               (dired-other-window up)
    2191           0 :             (dired up))
    2192           0 :           (dired-goto-file dir)))))
    2193             : 
    2194             : (defun dired-get-file-for-visit ()
    2195             :   "Get the current line's file name, with an error if file does not exist."
    2196             :   (interactive)
    2197             :   ;; We pass t for second arg so that we don't get error for `.' and `..'.
    2198           0 :   (let ((raw (dired-get-filename nil t))
    2199             :         file-name)
    2200           0 :     (if (null raw)
    2201           0 :         (error "No file on this line"))
    2202           0 :     (setq file-name (file-name-sans-versions raw t))
    2203           0 :     (if (file-exists-p file-name)
    2204           0 :         file-name
    2205           0 :       (if (file-symlink-p file-name)
    2206           0 :           (error "File is a symlink to a nonexistent target")
    2207           0 :         (error "File no longer exists; type `g' to update Dired buffer")))))
    2208             : 
    2209             : ;; Force C-m keybinding rather than `f' or `e' in the mode doc:
    2210             : (define-obsolete-function-alias 'dired-advertised-find-file 'dired-find-file "23.2")
    2211             : (defun dired-find-file ()
    2212             :   "In Dired, visit the file or directory named on this line."
    2213             :   (interactive)
    2214             :   ;; Bind `find-file-run-dired' so that the command works on directories
    2215             :   ;; too, independent of the user's setting.
    2216           0 :   (let ((find-file-run-dired t)
    2217             :         ;; This binding prevents problems with preserving point in
    2218             :         ;; windows displaying Dired buffers, because reverting a Dired
    2219             :         ;; buffer empties it, which changes the places where the
    2220             :         ;; markers used by switch-to-buffer-preserve-window-point
    2221             :         ;; point.
    2222             :         (switch-to-buffer-preserve-window-point
    2223           0 :          (if dired-auto-revert-buffer
    2224             :              nil
    2225           0 :            switch-to-buffer-preserve-window-point)))
    2226           0 :     (find-file (dired-get-file-for-visit))))
    2227             : 
    2228             : (defun dired-find-alternate-file ()
    2229             :   "In Dired, visit this file or directory instead of the Dired buffer."
    2230             :   (interactive)
    2231           0 :   (set-buffer-modified-p nil)
    2232           0 :   (find-alternate-file (dired-get-file-for-visit)))
    2233             : ;; Don't override the setting from .emacs.
    2234             : ;;;###autoload (put 'dired-find-alternate-file 'disabled t)
    2235             : 
    2236             : (defun dired-mouse-find-file-other-window (event)
    2237             :   "In Dired, visit the file or directory name you click on."
    2238             :   (interactive "e")
    2239           0 :   (let (window pos file)
    2240           0 :     (save-excursion
    2241           0 :       (setq window (posn-window (event-end event))
    2242           0 :             pos (posn-point (event-end event)))
    2243           0 :       (if (not (windowp window))
    2244           0 :           (error "No file chosen"))
    2245           0 :       (set-buffer (window-buffer window))
    2246           0 :       (goto-char pos)
    2247           0 :       (setq file (dired-get-file-for-visit)))
    2248           0 :     (if (file-directory-p file)
    2249           0 :         (or (and (cdr dired-subdir-alist)
    2250           0 :                  (dired-goto-subdir file))
    2251           0 :             (progn
    2252           0 :               (select-window window)
    2253           0 :               (dired-other-window file)))
    2254           0 :       (select-window window)
    2255           0 :       (find-file-other-window (file-name-sans-versions file t)))))
    2256             : 
    2257             : (defun dired-view-file ()
    2258             :   "In Dired, examine a file in view mode, returning to Dired when done.
    2259             : When file is a directory, show it in this buffer if it is inserted.
    2260             : Otherwise, display it in another buffer."
    2261             :   (interactive)
    2262           0 :   (let ((file (dired-get-file-for-visit)))
    2263           0 :     (if (file-directory-p file)
    2264           0 :         (or (and (cdr dired-subdir-alist)
    2265           0 :                  (dired-goto-subdir file))
    2266           0 :             (dired file))
    2267           0 :       (view-file file))))
    2268             : 
    2269             : (defun dired-find-file-other-window ()
    2270             :   "In Dired, visit this file or directory in another window."
    2271             :   (interactive)
    2272           0 :   (find-file-other-window (dired-get-file-for-visit)))
    2273             : 
    2274             : (defun dired-display-file ()
    2275             :   "In Dired, display this file or directory in another window."
    2276             :   (interactive)
    2277           0 :   (display-buffer (find-file-noselect (dired-get-file-for-visit))
    2278           0 :                   t))
    2279             : 
    2280             : ;;; Functions for extracting and manipulating file names in Dired buffers.
    2281             : 
    2282             : (defun dired-get-filename (&optional localp no-error-if-not-filep)
    2283             :   "In Dired, return name of file mentioned on this line.
    2284             : Value returned normally includes the directory name.
    2285             : Optional arg LOCALP with value `no-dir' means don't include directory
    2286             : name in result.  A value of `verbatim' means to return the name exactly as
    2287             : it occurs in the buffer, and a value of t means construct name relative to
    2288             : `default-directory', which still may contain slashes if in a subdirectory.
    2289             : Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
    2290             : regular filenames and return nil if no filename on this line.
    2291             : Otherwise, an error occurs in these cases."
    2292           6 :   (let (case-fold-search file p1 p2 already-absolute)
    2293           6 :     (save-excursion
    2294           6 :       (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
    2295           6 :           (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
    2296             :     ;; nil if no file on this line, but no-error-if-not-filep is t:
    2297           6 :     (if (setq file (and p1 p2 (buffer-substring p1 p2)))
    2298           6 :         (progn
    2299             :           ;; Get rid of the mouse-face property that file names have.
    2300           6 :           (set-text-properties 0 (length file) nil file)
    2301             :           ;; Unquote names quoted by ls or by dired-insert-directory.
    2302             :           ;; This code was written using `read' to unquote, because
    2303             :           ;; it's faster than substituting \007 (4 chars) -> ^G (1
    2304             :           ;; char) etc. in a lisp loop.  Unfortunately, this decision
    2305             :           ;; has necessitated hacks such as dealing with filenames
    2306             :           ;; with quotation marks in their names.
    2307           6 :           (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file)
    2308           6 :             (setq file (replace-match "\\\"" nil t file 1)))
    2309             :           ;; Unescape any spaces escaped by ls -b (bug#10469).
    2310             :           ;; Other -b quotes, eg \t, \n, work transparently.
    2311           6 :           (if (dired-switches-escape-p dired-actual-switches)
    2312           0 :               (let ((start 0)
    2313             :                     (rep "")
    2314             :                     (shift -1))
    2315           0 :                 (if (eq localp 'verbatim)
    2316           0 :                     (setq rep "\\\\"
    2317           0 :                           shift +1))
    2318           0 :                 (while (string-match "\\(\\\\\\) " file start)
    2319           0 :                   (setq file (replace-match rep nil t file 1)
    2320           6 :                         start (+ shift (match-end 0))))))
    2321           6 :           (when (eq system-type 'windows-nt)
    2322           0 :             (save-match-data
    2323           0 :               (let ((start 0))
    2324           0 :                 (while (string-match "\\\\" file start)
    2325           0 :                   (aset file (match-beginning 0) ?/)
    2326           6 :                   (setq start (match-end 0))))))
    2327             : 
    2328             :           ;; Hence we don't need to worry about converting `\\' back to `\'.
    2329           6 :           (setq file (read (concat "\"" file "\"")))
    2330             :           ;; The above `read' will return a unibyte string if FILE
    2331             :           ;; contains eight-bit-control/graphic characters.
    2332           6 :           (if (and enable-multibyte-characters
    2333           6 :                    (not (multibyte-string-p file)))
    2334           6 :               (setq file (string-to-multibyte file)))))
    2335           6 :     (and file (file-name-absolute-p file)
    2336             :          ;; A relative file name can start with ~.
    2337             :          ;; Don't treat it as absolute in this context.
    2338           0 :          (not (eq (aref file 0) ?~))
    2339           6 :          (setq already-absolute t))
    2340           6 :     (cond
    2341           6 :      ((null file)
    2342             :       nil)
    2343           6 :      ((eq localp 'verbatim)
    2344           0 :       file)
    2345           6 :      ((and (not no-error-if-not-filep)
    2346           6 :            (member file '("." "..")))
    2347           0 :       (error "Cannot operate on `.' or `..'"))
    2348           6 :      ((and (eq localp 'no-dir) already-absolute)
    2349           0 :       (file-name-nondirectory file))
    2350           6 :      (already-absolute
    2351           0 :       (let ((handler (find-file-name-handler file nil)))
    2352             :         ;; check for safe-magic property so that we won't
    2353             :         ;; put /: for names that don't really need them.
    2354             :         ;; For instance, .gz files when auto-compression-mode is on.
    2355           0 :         (if (and handler (not (get handler 'safe-magic)))
    2356           0 :             (concat "/:" file)
    2357           0 :           file)))
    2358           6 :      ((eq localp 'no-dir)
    2359           0 :       file)
    2360           6 :      ((equal (dired-current-directory) "/")
    2361           0 :       (setq file (concat (dired-current-directory localp) file))
    2362           0 :       (let ((handler (find-file-name-handler file nil)))
    2363             :         ;; check for safe-magic property so that we won't
    2364             :         ;; put /: for names that don't really need them.
    2365             :         ;; For instance, .gz files when auto-compression-mode is on.
    2366           0 :         (if (and handler (not (get handler 'safe-magic)))
    2367           0 :             (concat "/:" file)
    2368           0 :           file)))
    2369             :      (t
    2370           6 :       (concat (dired-current-directory localp) file)))))
    2371             : 
    2372             : (defun dired-string-replace-match (regexp string newtext
    2373             :                                    &optional literal global)
    2374             :   "Replace first match of REGEXP in STRING with NEWTEXT.
    2375             : If it does not match, nil is returned instead of the new string.
    2376             : Optional arg LITERAL means to take NEWTEXT literally.
    2377             : Optional arg GLOBAL means to replace all matches."
    2378           0 :   (if global
    2379           0 :       (let ((start 0) ret)
    2380           0 :         (while (string-match regexp string start)
    2381           0 :           (let ((from-end (- (length string) (match-end 0))))
    2382           0 :             (setq ret (setq string (replace-match newtext t literal string)))
    2383           0 :             (setq start (- (length string) from-end))))
    2384           0 :           ret)
    2385           0 :     (if (not (string-match regexp string 0))
    2386             :         nil
    2387           0 :       (replace-match newtext t literal string))))
    2388             : 
    2389             : (defun dired-make-absolute (file &optional dir)
    2390             :   ;;"Convert FILE (a file name relative to DIR) to an absolute file name."
    2391             :   ;; We can't always use expand-file-name as this would get rid of `.'
    2392             :   ;; or expand in / instead default-directory if DIR=="".
    2393             :   ;; This should be good enough for ange-ftp.
    2394             :   ;; It should be reasonably fast, though, as it is called in
    2395             :   ;; dired-get-filename.
    2396           0 :   (concat (or dir default-directory) file))
    2397             : 
    2398             : (defun dired-make-relative (file &optional dir)
    2399             :   "Convert FILE (an absolute file name) to a name relative to DIR.
    2400             : If DIR is omitted or nil, it defaults to `default-directory'.
    2401             : If FILE is not in the directory tree of DIR, return FILE
    2402             : unchanged."
    2403           0 :   (or dir (setq dir default-directory))
    2404             :   ;; This case comes into play if default-directory is set to
    2405             :   ;; use ~.
    2406           0 :   (if (and (> (length dir) 0) (= (aref dir 0) ?~))
    2407           0 :       (setq dir (expand-file-name dir)))
    2408           0 :   (if (string-match (concat "^" (regexp-quote dir)) file)
    2409           0 :       (substring file (match-end 0))
    2410           0 :     file))
    2411             : 
    2412             : (define-minor-mode dired-hide-details-mode
    2413             :   "Toggle visibility of detailed information in current Dired buffer.
    2414             : When this minor mode is enabled, details such as file ownership and
    2415             : permissions are hidden from view.
    2416             : 
    2417             : See options: `dired-hide-details-hide-symlink-targets' and
    2418             : `dired-hide-details-hide-information-lines'."
    2419             :   :group 'dired
    2420           0 :   (unless (derived-mode-p 'dired-mode)
    2421           0 :     (error "Not a Dired buffer"))
    2422           0 :   (dired-hide-details-update-invisibility-spec)
    2423           0 :   (if dired-hide-details-mode
    2424           0 :       (add-hook 'wdired-mode-hook
    2425             :                 'dired-hide-details-update-invisibility-spec
    2426             :                 nil
    2427           0 :                 t)
    2428           0 :     (remove-hook 'wdired-mode-hook
    2429             :                  'dired-hide-details-update-invisibility-spec
    2430           0 :                  t)))
    2431             : 
    2432             : (defun dired-hide-details-update-invisibility-spec ()
    2433           0 :   (funcall (if dired-hide-details-mode
    2434             :                'add-to-invisibility-spec
    2435           0 :              'remove-from-invisibility-spec)
    2436           0 :            'dired-hide-details-detail)
    2437           0 :   (funcall (if (and dired-hide-details-mode
    2438           0 :                     dired-hide-details-hide-information-lines)
    2439             :                'add-to-invisibility-spec
    2440           0 :              'remove-from-invisibility-spec)
    2441           0 :            'dired-hide-details-information)
    2442           0 :   (funcall (if (and dired-hide-details-mode
    2443           0 :                     dired-hide-details-hide-symlink-targets
    2444           0 :                     (not (derived-mode-p 'wdired-mode)))
    2445             :                'add-to-invisibility-spec
    2446           0 :              'remove-from-invisibility-spec)
    2447           0 :            'dired-hide-details-link))
    2448             : 
    2449             : ;;; Functions for finding the file name in a dired buffer line.
    2450             : 
    2451             : (defvar dired-permission-flags-regexp
    2452             :   "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
    2453             :   "Regular expression to match the permission flags in `ls -l'.")
    2454             : 
    2455             : ;; Move to first char of filename on this line.
    2456             : ;; Returns position (point) or nil if no filename on this line."
    2457             : (defun dired-move-to-filename (&optional raise-error eol)
    2458             :   "Move to the beginning of the filename on the current line.
    2459             : Return the position of the beginning of the filename, or nil if none found."
    2460             :   ;; This is the UNIX version.
    2461         224 :   (or eol (setq eol (line-end-position)))
    2462         224 :   (beginning-of-line)
    2463             :   ;; First try assuming `ls --dired' was used.
    2464         224 :   (let ((change (next-single-property-change (point) 'dired-filename nil eol)))
    2465         224 :     (cond
    2466         224 :      ((and change (< change eol))
    2467          12 :       (goto-char change))
    2468         212 :      ((re-search-forward directory-listing-before-filename-regexp eol t)
    2469         194 :       (goto-char (match-end 0)))
    2470          18 :      ((re-search-forward dired-permission-flags-regexp eol t)
    2471             :       ;; Ha!  There *is* a file.  Our regexp-from-hell just failed to find it.
    2472           0 :       (if raise-error
    2473           0 :           (error "Unrecognized line!  Check directory-listing-before-filename-regexp"))
    2474           0 :       (beginning-of-line)
    2475             :       nil)
    2476          18 :      (raise-error
    2477         224 :       (error "No file on this line")))))
    2478             : 
    2479             : (defun dired-move-to-end-of-filename (&optional no-error)
    2480             :   ;; Assumes point is at beginning of filename,
    2481             :   ;; thus the rwx bit re-search-backward below will succeed in *this*
    2482             :   ;; line if at all.  So, it should be called only after
    2483             :   ;; (dired-move-to-filename t).
    2484             :   ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
    2485             :   ;; This is the UNIX version.
    2486         200 :   (if (get-text-property (point) 'dired-filename)
    2487           6 :       (goto-char (next-single-property-change (point) 'dired-filename))
    2488         194 :     (let (opoint file-type executable symlink hidden used-F eol)
    2489         194 :       (setq used-F (dired-check-switches dired-actual-switches "F" "classify")
    2490         194 :             opoint (point)
    2491         194 :             eol (line-end-position)
    2492         194 :             hidden (and selective-display
    2493         194 :                         (save-excursion (search-forward "\r" eol t))))
    2494         194 :       (if hidden
    2495             :           nil
    2496         194 :         (save-excursion ;; Find out what kind of file this is:
    2497             :           ;; Restrict perm bits to be non-blank,
    2498             :           ;; otherwise this matches one char to early (looking backward):
    2499             :           ;; "l---------" (some systems make symlinks that way)
    2500             :           ;; "----------" (plain file with zero perms)
    2501         194 :           (if (re-search-backward
    2502         194 :                dired-permission-flags-regexp nil t)
    2503         194 :               (setq file-type (char-after (match-beginning 1))
    2504         194 :                     symlink (eq file-type ?l)
    2505             :                     ;; Only with -F we need to know whether it's an executable
    2506         194 :                     executable (and
    2507         194 :                                 used-F
    2508           0 :                                 (string-match
    2509             :                                  "[xst]" ;; execute bit set anywhere?
    2510           0 :                                  (concat
    2511           0 :                                   (match-string 2)
    2512           0 :                                   (match-string 3)
    2513         194 :                                   (match-string 4)))))
    2514         194 :             (or no-error (error "No file on this line"))))
    2515             :         ;; Move point to end of name:
    2516         194 :         (if symlink
    2517           0 :             (if (search-forward " -> " eol t)
    2518           0 :                 (progn
    2519           0 :                   (forward-char -4)
    2520           0 :                   (and used-F
    2521           0 :                        dired-ls-F-marks-symlinks
    2522           0 :                        (eq (preceding-char) ?@) ;; did ls really mark the link?
    2523           0 :                        (forward-char -1))))
    2524         194 :           (goto-char eol) ;; else not a symbolic link
    2525             :           ;; ls -lF marks dirs, sockets, fifos and executables with exactly
    2526             :           ;; one trailing character. (Executable bits on symlinks ain't mean
    2527             :           ;; a thing, even to ls, but we know it's not a symlink.)
    2528         194 :           (and used-F
    2529           0 :                (or (memq file-type '(?d ?s ?p))
    2530           0 :                    executable)
    2531         194 :                (forward-char -1))))
    2532         194 :       (or no-error
    2533         194 :           (not (eq opoint (point)))
    2534           0 :           (error "%s" (if hidden
    2535           0 :                      (substitute-command-keys
    2536           0 :                       "File line is hidden, type \\[dired-hide-subdir] to unhide")
    2537         194 :                    "No file on this line")))
    2538         194 :       (if (eq opoint (point))
    2539             :           nil
    2540         200 :         (point)))))
    2541             : 
    2542             : 
    2543             : ;;; COPY NAMES OF MARKED FILES INTO KILL-RING.
    2544             : 
    2545             : (defun dired-copy-filename-as-kill (&optional arg)
    2546             :   "Copy names of marked (or next ARG) files into the kill ring.
    2547             : The names are separated by a space.
    2548             : With a zero prefix arg, use the absolute file name of each marked file.
    2549             : With \\[universal-argument], use the file name relative to the Dired buffer's
    2550             : `default-directory'.  (This still may contain slashes if in a subdirectory.)
    2551             : 
    2552             : If on a subdir headerline, use absolute subdirname instead;
    2553             : prefix arg and marked files are ignored in this case.
    2554             : 
    2555             : You can then feed the file name(s) to other commands with \\[yank]."
    2556             :   (interactive "P")
    2557           0 :   (let ((string
    2558           0 :          (or (dired-get-subdir)
    2559           0 :              (mapconcat #'identity
    2560           0 :                         (if arg
    2561           0 :                             (cond ((zerop (prefix-numeric-value arg))
    2562           0 :                                    (dired-get-marked-files))
    2563           0 :                                   ((consp arg)
    2564           0 :                                    (dired-get-marked-files t))
    2565             :                                   (t
    2566           0 :                                    (dired-get-marked-files
    2567           0 :                                     'no-dir (prefix-numeric-value arg))))
    2568           0 :                           (dired-get-marked-files 'no-dir))
    2569           0 :                         " "))))
    2570           0 :     (unless (string= string "")
    2571           0 :       (if (eq last-command 'kill-region)
    2572           0 :           (kill-append string nil)
    2573           0 :         (kill-new string))
    2574           0 :       (message "%s" string))))
    2575             : 
    2576             : 
    2577             : ;; Keeping Dired buffers in sync with the filesystem and with each other
    2578             : 
    2579             : (defun dired-buffers-for-dir (dir &optional file)
    2580             : ;; Return a list of buffers for DIR (top level or in-situ subdir).
    2581             : ;; If FILE is non-nil, include only those whose wildcard pattern (if any)
    2582             : ;; matches FILE.
    2583             : ;; The list is in reverse order of buffer creation, most recent last.
    2584             : ;; As a side effect, killed dired buffers for DIR are removed from
    2585             : ;; dired-buffers.
    2586           6 :   (setq dir (file-name-as-directory dir))
    2587           6 :   (let (result buf)
    2588           6 :     (dolist (elt dired-buffers)
    2589           5 :       (setq buf (cdr elt))
    2590           5 :       (cond
    2591           5 :        ((null (buffer-name buf))
    2592             :         ;; Buffer is killed - clean up:
    2593           5 :         (setq dired-buffers (delq elt dired-buffers)))
    2594           0 :        ((dired-in-this-tree dir (car elt))
    2595           0 :         (with-current-buffer buf
    2596           0 :           (and (assoc dir dired-subdir-alist)
    2597           0 :                (or (null file)
    2598           0 :                    (if (stringp dired-directory)
    2599           0 :                        (let ((wildcards (file-name-nondirectory
    2600           0 :                                          dired-directory)))
    2601           0 :                          (or (zerop (length wildcards))
    2602           0 :                              (string-match-p (dired-glob-regexp wildcards)
    2603           0 :                                              file)))
    2604           0 :                      (member (expand-file-name file dir)
    2605           0 :                              (cdr dired-directory))))
    2606           6 :                (setq result (cons buf result)))))))
    2607           6 :     result))
    2608             : 
    2609             : (defun dired-glob-regexp (pattern)
    2610             :   "Convert glob-pattern PATTERN to a regular expression."
    2611           0 :   (let ((matched-in-pattern 0)  ;; How many chars of PATTERN we've handled.
    2612             :         regexp)
    2613           0 :     (while (string-match "[[?*]" pattern matched-in-pattern)
    2614           0 :       (let ((op-end (match-end 0))
    2615           0 :             (next-op (aref pattern (match-beginning 0))))
    2616           0 :         (setq regexp (concat regexp
    2617           0 :                              (regexp-quote
    2618           0 :                               (substring pattern matched-in-pattern
    2619           0 :                                          (match-beginning 0)))))
    2620           0 :         (cond ((= next-op ??)
    2621           0 :                (setq regexp (concat regexp "."))
    2622           0 :                (setq matched-in-pattern op-end))
    2623           0 :               ((= next-op ?\[)
    2624             :                ;; Fails to handle ^ yet ????
    2625           0 :                (let* ((set-start (match-beginning 0))
    2626             :                       (set-cont
    2627           0 :                        (if (= (aref pattern (1+ set-start)) ?^)
    2628           0 :                            (+ 3 set-start)
    2629           0 :                          (+ 2 set-start)))
    2630           0 :                       (set-end (string-match-p "]" pattern set-cont))
    2631           0 :                       (set (substring pattern set-start (1+ set-end))))
    2632           0 :                  (setq regexp (concat regexp set))
    2633           0 :                  (setq matched-in-pattern (1+ set-end))))
    2634           0 :               ((= next-op ?*)
    2635           0 :                (setq regexp (concat regexp ".*"))
    2636           0 :                (setq matched-in-pattern op-end)))))
    2637           0 :     (concat "\\`"
    2638           0 :             regexp
    2639           0 :             (regexp-quote
    2640           0 :              (substring pattern matched-in-pattern))
    2641           0 :             "\\'")))
    2642             : 
    2643             : 
    2644             : 
    2645             : (defun dired-advertise ()
    2646             :   ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
    2647             :   ;; With wildcards we actually advertise too much.
    2648           6 :   (let ((expanded-default (expand-file-name default-directory)))
    2649           6 :     (if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
    2650             :         t                               ; we have already advertised ourselves
    2651           6 :       (setq dired-buffers
    2652           6 :             (cons (cons expanded-default (current-buffer))
    2653           6 :                   dired-buffers)))))
    2654             : 
    2655             : (defun dired-unadvertise (dir)
    2656             :   ;; Remove DIR from the buffer alist in variable dired-buffers.
    2657             :   ;; This has the effect of removing any buffer whose main directory is DIR.
    2658             :   ;; It does not affect buffers in which DIR is a subdir.
    2659             :   ;; Removing is also done as a side-effect in dired-buffer-for-dir.
    2660           0 :   (setq dired-buffers
    2661           0 :         (delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
    2662             : 
    2663             : ;; Tree Dired
    2664             : 
    2665             : ;;; utility functions
    2666             : 
    2667             : (defun dired-in-this-tree (file dir)
    2668             :   ;;"Is FILE part of the directory tree starting at DIR?"
    2669           0 :   (let (case-fold-search)
    2670           0 :     (string-match-p (concat "^" (regexp-quote dir)) file)))
    2671             : 
    2672             : (defun dired-normalize-subdir (dir)
    2673             :   ;; Prepend default-directory to DIR if relative file name.
    2674             :   ;; dired-get-filename must be able to make a valid file name from a
    2675             :   ;; file and its directory DIR.
    2676           6 :   (file-name-as-directory
    2677           6 :    (if (file-name-absolute-p dir)
    2678           6 :        dir
    2679           6 :      (expand-file-name dir default-directory))))
    2680             : 
    2681             : (defun dired-get-subdir ()
    2682             :   ;;"Return the subdir name on this line, or nil if not on a headerline."
    2683             :   ;; Look up in the alist whether this is a headerline.
    2684           0 :   (save-excursion
    2685           0 :     (let ((cur-dir (dired-current-directory)))
    2686           0 :       (beginning-of-line)               ; alist stores b-o-l positions
    2687           0 :       (and (zerop (- (point)
    2688           0 :                      (dired-get-subdir-min (assoc cur-dir
    2689           0 :                                                   dired-subdir-alist))))
    2690           0 :            cur-dir))))
    2691             : 
    2692             : ;; can't use macro,  must be redefinable for other alist format in dired-nstd.
    2693             : (defalias 'dired-get-subdir-min 'cdr)
    2694             : 
    2695             : (defun dired-get-subdir-max (elt)
    2696           0 :   (save-excursion
    2697           0 :     (goto-char (dired-get-subdir-min elt))
    2698           0 :     (dired-subdir-max)))
    2699             : 
    2700             : (defun dired-clear-alist ()
    2701           6 :   (while dired-subdir-alist
    2702           0 :     (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
    2703           6 :     (setq dired-subdir-alist (cdr dired-subdir-alist))))
    2704             : 
    2705             : (defun dired-subdir-index (dir)
    2706             :   ;; Return an index into alist for use with nth
    2707             :   ;; for the sake of subdir moving commands.
    2708           0 :   (let (found (index 0) (alist dired-subdir-alist))
    2709           0 :     (while alist
    2710           0 :       (if (string= dir (car (car alist)))
    2711           0 :           (setq alist nil found t)
    2712           0 :         (setq alist (cdr alist) index (1+ index))))
    2713           0 :     (if found index nil)))
    2714             : 
    2715             : (defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
    2716             :   "Go to next subdirectory, regardless of level."
    2717             :   ;; Use 0 arg to go to this directory's header line.
    2718             :   ;; NO-SKIP prevents moving to end of header line, returning whatever
    2719             :   ;; position was found in dired-subdir-alist.
    2720             :   (interactive "p")
    2721           0 :   (let ((this-dir (dired-current-directory))
    2722             :         pos index)
    2723             :     ;; nth with negative arg does not return nil but the first element
    2724           0 :     (setq index (- (dired-subdir-index this-dir) arg))
    2725           0 :     (setq pos (if (>= index 0)
    2726           0 :                   (dired-get-subdir-min (nth index dired-subdir-alist))))
    2727           0 :     (if pos
    2728           0 :         (progn
    2729           0 :           (goto-char pos)
    2730           0 :           (or no-skip (skip-chars-forward "^\n\r"))
    2731           0 :           (point))
    2732           0 :       (if no-error-if-not-found
    2733             :           nil                           ; return nil if not found
    2734           0 :         (error "%s directory" (if (> arg 0) "Last" "First"))))))
    2735             : 
    2736             : (defun dired-build-subdir-alist (&optional switches)
    2737             :   "Build `dired-subdir-alist' by parsing the buffer.
    2738             : Returns the new value of the alist.
    2739             : If optional arg SWITCHES is non-nil, use its value
    2740             : instead of `dired-actual-switches'."
    2741             :   (interactive)
    2742           6 :   (dired-clear-alist)
    2743           6 :   (save-excursion
    2744           6 :     (let* ((count 0)
    2745             :            (inhibit-read-only t)
    2746             :            (buffer-undo-list t)
    2747           6 :            (switches (or switches dired-actual-switches))
    2748             :            new-dir-name
    2749             :            (R-ftp-base-dir-regex
    2750             :             ;; Used to expand subdirectory names correctly in recursive
    2751             :             ;; ange-ftp listings.
    2752           6 :             (and (dired-switches-recursive-p switches)
    2753           0 :                  (string-match "\\`/.*:\\(/.*\\)" default-directory)
    2754           6 :                  (concat "\\`" (match-string 1 default-directory)))))
    2755           6 :       (goto-char (point-min))
    2756           6 :       (setq dired-subdir-alist nil)
    2757          12 :       (while (re-search-forward dired-subdir-regexp nil t)
    2758             :         ;; Avoid taking a file name ending in a colon
    2759             :         ;; as a subdir name.
    2760           6 :         (unless (save-excursion
    2761           6 :                   (goto-char (match-beginning 0))
    2762           6 :                   (beginning-of-line)
    2763           6 :                   (forward-char 2)
    2764           6 :                   (looking-at-p dired-re-perms))
    2765           6 :           (save-excursion
    2766           6 :             (goto-char (match-beginning 1))
    2767           6 :             (setq new-dir-name
    2768           6 :                   (buffer-substring-no-properties (point) (match-end 1))
    2769             :                   new-dir-name
    2770           6 :                   (save-match-data
    2771           6 :                     (if (and R-ftp-base-dir-regex
    2772           0 :                              (not (string= new-dir-name default-directory))
    2773           6 :                              (string-match R-ftp-base-dir-regex new-dir-name))
    2774           0 :                         (concat default-directory
    2775           0 :                                 (substring new-dir-name (match-end 0)))
    2776           6 :                       (expand-file-name new-dir-name))))
    2777           6 :             (delete-region (point) (match-end 1))
    2778           6 :             (insert new-dir-name))
    2779           6 :           (setq count (1+ count))
    2780             :           ;; Undo any escaping of newlines and \ by dired-insert-directory.
    2781             :           ;; Convert "n" preceded by odd number of \ to newline, and \\ to \.
    2782           6 :           (when (and (dired-switches-escape-p switches)
    2783           6 :                      (string-match-p "\\\\" new-dir-name))
    2784           0 :             (let (temp res)
    2785           0 :               (mapc (lambda (char)
    2786           0 :                       (cond ((equal char ?\\)
    2787           0 :                              (if temp
    2788           0 :                                  (setq res (concat res "\\")
    2789           0 :                                        temp nil)
    2790           0 :                                (setq temp "\\")))
    2791           0 :                             ((and temp (equal char ?n))
    2792           0 :                              (setq res (concat res "\n")
    2793           0 :                                    temp nil))
    2794             :                             (t
    2795           0 :                              (setq res (concat res temp (char-to-string char))
    2796           0 :                                    temp nil))))
    2797           0 :                     new-dir-name)
    2798           6 :               (setq new-dir-name res)))
    2799           6 :           (dired-alist-add-1 new-dir-name
    2800             :            ;; Place a sub directory boundary between lines.
    2801           6 :            (save-excursion
    2802           6 :              (goto-char (match-beginning 0))
    2803           6 :              (beginning-of-line)
    2804           6 :              (point-marker)))))
    2805           6 :       (if (and (> count 1) (called-interactively-p 'interactive))
    2806           6 :           (message "Buffer includes %d directories" count)))
    2807             :     ;; We don't need to sort it because it is in buffer order per
    2808             :     ;; constructionem.  Return new alist:
    2809           6 :     dired-subdir-alist))
    2810             : 
    2811             : (defun dired-alist-add-1 (dir new-marker)
    2812             :   ;; Add new DIR at NEW-MARKER.  Don't sort.
    2813           6 :   (setq dired-subdir-alist
    2814           6 :         (cons (cons (dired-normalize-subdir dir) new-marker)
    2815           6 :               dired-subdir-alist)))
    2816             : 
    2817             : (defun dired-goto-next-nontrivial-file ()
    2818             :   ;; Position point on first nontrivial file after point.
    2819           6 :   (dired-goto-next-file);; so there is a file to compare with
    2820           6 :   (if (stringp dired-trivial-filenames)
    2821           6 :       (while (and (not (eobp))
    2822           6 :                   (string-match-p dired-trivial-filenames
    2823           6 :                                   (file-name-nondirectory
    2824           6 :                                    (or (dired-get-filename nil t) ""))))
    2825           0 :         (forward-line 1)
    2826           6 :         (dired-move-to-filename))))
    2827             : 
    2828             : (defun dired-goto-next-file ()
    2829           6 :   (let ((max (1- (dired-subdir-max))))
    2830          18 :     (while (and (not (dired-move-to-filename)) (< (point) max))
    2831          12 :       (forward-line 1))))
    2832             : 
    2833             : (defun dired-goto-file (file)
    2834             :   "Go to line describing file FILE in this Dired buffer."
    2835             :   ;; Return value of point on success, else nil.
    2836             :   ;; FILE must be an absolute file name.
    2837             :   ;; Loses if FILE contains control chars like "\007" for which ls
    2838             :   ;; either inserts "?" or "\\007" into the buffer, so we won't find
    2839             :   ;; it in the buffer.
    2840             :   (interactive
    2841           0 :    (prog1                               ; let push-mark display its message
    2842           0 :        (list (expand-file-name
    2843           0 :               (read-file-name "Goto file: "
    2844           0 :                               (dired-current-directory))))
    2845           0 :      (push-mark)))
    2846           0 :   (unless (file-name-absolute-p file)
    2847           0 :     (error "File name `%s' is not absolute" file))
    2848           0 :   (setq file (directory-file-name file)) ; does no harm if not a directory
    2849           0 :   (let* ((case-fold-search nil)
    2850           0 :          (dir (file-name-directory file))
    2851           0 :          (found (or
    2852             :                  ;; First, look for a listing under the absolute name.
    2853           0 :                  (save-excursion
    2854           0 :                    (goto-char (point-min))
    2855           0 :                    (dired-goto-file-1 file file (point-max)))
    2856             :                  ;; Next, look for it as a relative name with leading
    2857             :                  ;; subdirectories.  (This happens in Dired buffers
    2858             :                  ;; created by find-dired, for example.)
    2859           0 :                  (save-excursion
    2860           0 :                    (goto-char (point-min))
    2861           0 :                    (dired-goto-file-1 (file-relative-name file
    2862           0 :                                                           default-directory)
    2863           0 :                                       file (point-max)))
    2864             :                  ;; Otherwise, look for it as a relative name, a base
    2865             :                  ;; name only.  The hair is to get the result of
    2866             :                  ;; `dired-goto-subdir' without calling it if we don't
    2867             :                  ;; have any subdirs.
    2868           0 :                  (save-excursion
    2869           0 :                    (when (if (string= dir (expand-file-name default-directory))
    2870           0 :                              (goto-char (point-min))
    2871           0 :                            (and (cdr dired-subdir-alist)
    2872           0 :                                 (dired-goto-subdir dir)))
    2873           0 :                      (dired-goto-file-1 (file-name-nondirectory file)
    2874           0 :                                         file
    2875           0 :                                         (dired-subdir-max)))))))
    2876             :     ;; Return buffer position, if found.
    2877           0 :     (if found
    2878           0 :         (goto-char found))))
    2879             : 
    2880             : (defun dired-goto-file-1 (file full-name limit)
    2881             :   "Advance to the Dired listing labeled by FILE; return its position.
    2882             : Return nil if the listing is not found.  If FILE contains
    2883             : characters that would not appear in a Dired buffer, search using
    2884             : the quoted forms of those characters.
    2885             : 
    2886             : FULL-NAME specifies the actual file name the listing must have,
    2887             : as returned by `dired-get-filename'.  LIMIT is the search limit."
    2888           0 :   (let (str)
    2889           0 :     (setq str (replace-regexp-in-string "\^m" "\\^m"  file nil t))
    2890           0 :     (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t))
    2891           0 :     (and (dired-switches-escape-p dired-actual-switches)
    2892           0 :          (string-match-p "[ \t\n]" str)
    2893             :          ;; FIXME: to fix this for embedded control characters etc, we
    2894             :          ;; should escape everything that `ls -b' does.
    2895           0 :          (setq str (replace-regexp-in-string " " "\\ "  str nil t)
    2896           0 :                str (replace-regexp-in-string "\t" "\\t" str nil t)
    2897           0 :                str (replace-regexp-in-string "\n" "\\n" str nil t)))
    2898           0 :     (let ((found nil)
    2899             :           ;; filenames are preceded by SPC, this makes the search faster
    2900             :           ;; (e.g. for the filename "-").
    2901           0 :           (search-string (concat " " str)))
    2902           0 :       (while (and (not found)
    2903           0 :                   (search-forward search-string limit 'move))
    2904             :         ;; Check that we are in the right place.  Match could have
    2905             :         ;; BASE just as initial substring or in permission bits etc.
    2906           0 :         (if (equal full-name (dired-get-filename nil t))
    2907           0 :             (setq found (dired-move-to-filename))
    2908           0 :           (forward-line 1)))
    2909           0 :       found)))
    2910             : 
    2911             : (defvar dired-find-subdir)
    2912             : 
    2913             : ;; FIXME document whatever dired-x is doing.
    2914             : (defun dired-initial-position (dirname)
    2915             :   "Where point should go in a new listing of DIRNAME.
    2916             : Point is assumed to be at the beginning of new subdir line.
    2917             : It runs the hook `dired-initial-position-hook'."
    2918           6 :   (end-of-line)
    2919           6 :   (and (featurep 'dired-x) dired-find-subdir
    2920           6 :        (dired-goto-subdir dirname))
    2921           6 :   (if dired-trivial-filenames (dired-goto-next-nontrivial-file))
    2922           6 :   (run-hooks 'dired-initial-position-hook))
    2923             : 
    2924             : ;; These are hooks which make tree dired work.
    2925             : ;; They are in this file because other parts of dired need to call them.
    2926             : ;; But they don't call the rest of tree dired unless there are subdirs loaded.
    2927             : 
    2928             : ;; This function is called for each retrieved filename.
    2929             : ;; It could stand to be faster, though it's mostly function call
    2930             : ;; overhead.  Avoiding the function call seems to save about 10% in
    2931             : ;; dired-get-filename.  Make it a defsubst?
    2932             : (defun dired-current-directory (&optional localp)
    2933             :   "Return the name of the subdirectory to which this line belongs.
    2934             : This returns a string with trailing slash, like `default-directory'.
    2935             : Optional argument means return a file name relative to `default-directory',
    2936             : in which case the value could be an empty string if `default-directory'
    2937             : is the directory where the file on this line resides."
    2938          12 :   (let ((here (point))
    2939          12 :         (alist (or dired-subdir-alist
    2940             :                    ;; probably because called in a non-dired buffer
    2941          12 :                    (error "No subdir-alist in %s" (current-buffer))))
    2942             :         elt dir)
    2943          24 :     (while alist
    2944          12 :       (setq elt (car alist)
    2945          12 :             dir (car elt)
    2946             :             ;; use `<=' (not `<') as subdir line is part of subdir
    2947          12 :             alist (if (<= (dired-get-subdir-min elt) here)
    2948             :                       nil               ; found
    2949          12 :                     (cdr alist))))
    2950          12 :     (if localp
    2951           0 :         (dired-make-relative dir default-directory)
    2952          12 :       dir)))
    2953             : 
    2954             : ;; Subdirs start at the beginning of their header lines and end just
    2955             : ;; before the beginning of the next header line (or end of buffer).
    2956             : 
    2957             : (defun dired-subdir-max ()
    2958           6 :   (save-excursion
    2959           6 :     (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
    2960           6 :         (point-max)
    2961           6 :       (point))))
    2962             : 
    2963             : ;; Deleting files
    2964             : 
    2965             : (defcustom dired-recursive-deletes 'top
    2966             :   "Whether Dired deletes directories recursively.
    2967             : If nil, Dired will not delete non-empty directories.
    2968             : `always' means to delete non-empty directories recursively,
    2969             : without asking.  This is dangerous!
    2970             : `top' means to ask for each top-level directory specified by the
    2971             : Dired deletion command, and delete its subdirectories without
    2972             : asking.
    2973             : Any other value means to ask for each directory."
    2974             :   :type '(choice :tag "Delete non-empty directories"
    2975             :                  (const :tag "Yes" always)
    2976             :                  (const :tag "No--only delete empty directories" nil)
    2977             :                  (const :tag "Confirm for each directory" t)
    2978             :                  (const :tag "Confirm for each top directory only" top))
    2979             :   :group 'dired)
    2980             : 
    2981             : ;; Match anything but `.' and `..'.
    2982             : (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
    2983             : 
    2984             : (defconst dired-delete-help
    2985             :   "Type:
    2986             : `yes' to delete recursively the current directory,
    2987             : `no' to skip to next,
    2988             : `all' to delete all remaining directories with no more questions,
    2989             : `quit' to exit,
    2990             : `help' to show this help message.")
    2991             : 
    2992             : (defun dired--yes-no-all-quit-help (prompt &optional help-msg)
    2993             :   "Ask a question with valid answers: yes, no, all, quit, help.
    2994             : PROMPT must end with '? ', for instance, 'Delete it? '.
    2995             : If optional arg HELP-MSG is non-nil, then is a message to show when
    2996             : the user answers 'help'.  Otherwise, default to `dired-delete-help'."
    2997           0 :   (let ((valid-answers (list "yes" "no" "all" "quit"))
    2998             :         (answer "")
    2999             :         (input-fn (lambda ()
    3000           0 :                     (read-string
    3001           0 :                      (format "%s [yes, no, all, quit, help] " prompt)))))
    3002           0 :     (setq answer (funcall input-fn))
    3003           0 :     (when (string= answer "help")
    3004           0 :       (with-help-window "*Help*"
    3005           0 :         (with-current-buffer "*Help*"
    3006           0 :           (insert (or help-msg dired-delete-help)))))
    3007           0 :     (while (not (member answer valid-answers))
    3008           0 :       (unless (string= answer "help")
    3009           0 :         (beep)
    3010           0 :         (message "Please answer `yes' or `no' or `all' or `quit'")
    3011           0 :         (sleep-for 2))
    3012           0 :       (setq answer (funcall input-fn)))
    3013           0 :     answer))
    3014             : 
    3015             : ;; Delete file, possibly delete a directory and all its files.
    3016             : ;; This function is useful outside of dired.  One could change its name
    3017             : ;; to e.g. recursive-delete-file and put it somewhere else.
    3018             : (defun dired-delete-file (file &optional recursive trash) "\
    3019             : Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
    3020             : RECURSIVE determines what to do with a non-empty directory.  The effect of
    3021             : its possible values is:
    3022             : 
    3023             :   nil           -- do not delete.
    3024             :   `always'      -- delete recursively without asking.
    3025             :   `top'         -- ask for each directory at top level.
    3026             :   Anything else -- ask for each sub-directory.
    3027             : 
    3028             : TRASH non-nil means to trash the file instead of deleting, provided
    3029             : `delete-by-moving-to-trash' (which see) is non-nil."
    3030             :        ;; This test is equivalent to
    3031             :        ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
    3032             :        ;; but more efficient
    3033           0 :        (if (not (eq t (car (file-attributes file))))
    3034           0 :            (delete-file file trash)
    3035           0 :          (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot))))
    3036           0 :            (if (and recursive (not empty-dir-p))
    3037           0 :                (unless (eq recursive 'always)
    3038           0 :                  (let ((prompt
    3039           0 :                         (format "Recursively %s %s? "
    3040           0 :                                 (if (and trash delete-by-moving-to-trash)
    3041             :                                     "trash"
    3042           0 :                                   "delete")
    3043           0 :                                 (dired-make-relative file))))
    3044           0 :                    (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
    3045           0 :                      ('"all" (setq recursive 'always dired-recursive-deletes recursive))
    3046           0 :                      ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
    3047           0 :                      ('"no" (setq recursive nil))
    3048           0 :                      ('"quit" (keyboard-quit)))))
    3049           0 :              (setq recursive nil)) ; Empty dir or recursive is nil.
    3050           0 :            (delete-directory file recursive trash))))
    3051             : 
    3052             : (defun dired-do-flagged-delete (&optional nomessage)
    3053             :   "In Dired, delete the files flagged for deletion.
    3054             : If NOMESSAGE is non-nil, we don't display any message
    3055             : if there are no flagged files.
    3056             : `dired-recursive-deletes' controls whether deletion of
    3057             : non-empty directories is allowed."
    3058             :   (interactive)
    3059           0 :   (let* ((dired-marker-char dired-del-marker)
    3060           0 :          (regexp (dired-marker-regexp))
    3061             :          case-fold-search)
    3062           0 :     (if (save-excursion (goto-char (point-min))
    3063           0 :                         (re-search-forward regexp nil t))
    3064           0 :         (dired-internal-do-deletions
    3065           0 :          (nreverse
    3066             :           ;; this can't move point since ARG is nil
    3067           0 :           (dired-map-over-marks (cons (dired-get-filename) (point))
    3068           0 :                                 nil))
    3069           0 :          nil t)
    3070           0 :       (or nomessage
    3071           0 :           (message "(No deletions requested)")))))
    3072             : 
    3073             : (defun dired-do-delete (&optional arg)
    3074             :   "Delete all marked (or next ARG) files.
    3075             : `dired-recursive-deletes' controls whether deletion of
    3076             : non-empty directories is allowed."
    3077             :   ;; This is more consistent with the file marking feature than
    3078             :   ;; dired-do-flagged-delete.
    3079             :   (interactive "P")
    3080           0 :   (dired-internal-do-deletions
    3081           0 :    (nreverse
    3082             :     ;; this may move point if ARG is an integer
    3083           0 :     (dired-map-over-marks (cons (dired-get-filename) (point))
    3084           0 :                           arg))
    3085           0 :    arg t))
    3086             : 
    3087             : (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
    3088             : 
    3089             : (defun dired-internal-do-deletions (l arg &optional trash)
    3090             :   ;; L is an alist of files to delete, with their buffer positions.
    3091             :   ;; ARG is the prefix arg.
    3092             :   ;; Filenames are absolute.
    3093             :   ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
    3094             :   ;; That way as changes are made in the buffer they do not shift the
    3095             :   ;; lines still to be changed, so the (point) values in L stay valid.
    3096             :   ;; Also, for subdirs in natural order, a subdir's files are deleted
    3097             :   ;; before the subdir itself - the other way around would not work.
    3098           0 :   (let* ((files (mapcar #'car l))
    3099           0 :          (count (length l))
    3100             :          (succ 0)
    3101             :          ;; Bind `dired-recursive-deletes' so that we can change it
    3102             :          ;; locally according with the user answer within `dired-delete-file'.
    3103           0 :          (dired-recursive-deletes dired-recursive-deletes)
    3104           0 :          (trashing (and trash delete-by-moving-to-trash)))
    3105             :     ;; canonicalize file list for pop up
    3106           0 :     (setq files (nreverse (mapcar #'dired-make-relative files)))
    3107           0 :     (if (dired-mark-pop-up
    3108           0 :          " *Deletions*" 'delete files dired-deletion-confirmer
    3109           0 :          (format "%s %s "
    3110           0 :                  (if trashing "Trash" "Delete")
    3111           0 :                  (dired-mark-prompt arg files)))
    3112           0 :         (save-excursion
    3113           0 :           (catch '--delete-cancel
    3114           0 :           (let ((progress-reporter
    3115           0 :                  (make-progress-reporter
    3116           0 :                   (if trashing "Trashing..." "Deleting...")
    3117           0 :                   succ count))
    3118             :                 failures) ;; files better be in reverse order for this loop!
    3119           0 :             (while l
    3120           0 :               (goto-char (cdr (car l)))
    3121           0 :               (let ((inhibit-read-only t))
    3122           0 :                 (condition-case err
    3123           0 :                     (let ((fn (car (car l))))
    3124           0 :                       (dired-delete-file fn dired-recursive-deletes trash)
    3125             :                       ;; if we get here, removing worked
    3126           0 :                       (setq succ (1+ succ))
    3127           0 :                       (progress-reporter-update progress-reporter succ)
    3128           0 :                       (dired-fun-in-all-buffers
    3129           0 :                        (file-name-directory fn) (file-name-nondirectory fn)
    3130           0 :                        #'dired-delete-entry fn))
    3131           0 :                   (quit (throw '--delete-cancel (message "OK, canceled")))
    3132             :                   (error ;; catch errors from failed deletions
    3133           0 :                    (dired-log "%s\n" err)
    3134           0 :                    (setq failures (cons (car (car l)) failures)))))
    3135           0 :               (setq l (cdr l)))
    3136           0 :             (if (not failures)
    3137           0 :                 (progress-reporter-done progress-reporter)
    3138           0 :               (dired-log-summary
    3139           0 :                (format "%d of %d deletion%s failed"
    3140           0 :                        (length failures) count
    3141           0 :                        (dired-plural-s count))
    3142           0 :                failures)))))
    3143           0 :       (message "(No deletions performed)")))
    3144           0 :   (dired-move-to-filename))
    3145             : 
    3146             : (defun dired-fun-in-all-buffers (directory file fun &rest args)
    3147             :   ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
    3148             :   ;; If the buffer has a wildcard pattern, check that it matches FILE.
    3149             :   ;; (FILE does not include a directory component.)
    3150             :   ;; FILE may be nil, in which case ignore it.
    3151             :   ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
    3152           0 :   (let (success-list)
    3153           0 :     (dolist (buf (dired-buffers-for-dir (expand-file-name directory)
    3154           0 :                                         file))
    3155           0 :       (with-current-buffer buf
    3156           0 :         (if (apply fun args)
    3157           0 :             (setq success-list (cons (buffer-name buf) success-list)))))
    3158           0 :     success-list))
    3159             : 
    3160             : ;; Delete the entry for FILE from
    3161             : (defun dired-delete-entry (file)
    3162           0 :   (save-excursion
    3163           0 :     (and (dired-goto-file file)
    3164           0 :          (let ((inhibit-read-only t))
    3165           0 :            (delete-region (progn (beginning-of-line) (point))
    3166           0 :                           (save-excursion (forward-line 1) (point))))))
    3167           0 :   (dired-clean-up-after-deletion file))
    3168             : 
    3169             : (defvar dired-clean-up-buffers-too)
    3170             : 
    3171             : (defun dired-clean-up-after-deletion (fn)
    3172             :   "Clean up after a deleted file or directory FN.
    3173             : Removes any expanded subdirectory of deleted directory.
    3174             : If `dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil,
    3175             : also offers to kill buffers visiting deleted files and directories."
    3176           0 :   (save-excursion (and (cdr dired-subdir-alist)
    3177           0 :                        (dired-goto-subdir fn)
    3178           0 :                        (dired-kill-subdir)))
    3179             :   ;; Offer to kill buffer of deleted file FN.
    3180           0 :   (when (and (featurep 'dired-x) dired-clean-up-buffers-too)
    3181           0 :     (let ((buf (get-file-buffer fn)))
    3182           0 :       (and buf
    3183           0 :            (funcall #'y-or-n-p
    3184           0 :                     (format "Kill buffer of %s, too? "
    3185           0 :                             (file-name-nondirectory fn)))
    3186           0 :            (kill-buffer buf)))
    3187           0 :     (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
    3188           0 :       (and buf-list
    3189           0 :            (y-or-n-p (format "Kill Dired buffer%s of %s, too? "
    3190           0 :                              (dired-plural-s (length buf-list))
    3191           0 :                              (file-name-nondirectory fn)))
    3192           0 :            (dolist (buf buf-list)
    3193           0 :              (kill-buffer buf))))))
    3194             : 
    3195             : 
    3196             : ;; Confirmation
    3197             : 
    3198             : (defun dired-marker-regexp ()
    3199           0 :   (concat "^" (regexp-quote (char-to-string dired-marker-char))))
    3200             : 
    3201             : (defun dired-plural-s (count)
    3202           0 :   (if (= 1 count) "" "s"))
    3203             : 
    3204             : (defun dired-mark-prompt (arg files)
    3205             :   "Return a string suitable for use in a Dired prompt.
    3206             : ARG is normally the prefix argument for the calling command.
    3207             : FILES should be a list of file names.
    3208             : 
    3209             : The return value has a form like \"foo.txt\", \"[next 3 files]\",
    3210             : or \"* [3 files]\"."
    3211             :   ;; distinguish-one-marked can cause the first element to be just t.
    3212           0 :   (if (eq (car files) t) (setq files (cdr files)))
    3213           0 :   (let ((count (length files)))
    3214           0 :     (if (= count 1)
    3215           0 :         (car files)
    3216             :       ;; more than 1 file:
    3217           0 :       (if (integerp arg)
    3218             :           ;; abs(arg) = count
    3219             :           ;; Perhaps this is nicer, but it also takes more screen space:
    3220             :           ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
    3221             :           ;;                        count)
    3222           0 :           (format "[next %d files]" arg)
    3223           0 :         (format "%c [%d files]" dired-marker-char count)))))
    3224             : 
    3225             : (defun dired-pop-to-buffer (buf)
    3226             :   "Pop up buffer BUF in a way suitable for Dired."
    3227             :   (declare (obsolete dired-mark-pop-up "24.3"))
    3228           0 :   (let ((split-window-preferred-function
    3229             :          (lambda (window)
    3230           0 :            (or (and (let ((split-height-threshold 0))
    3231           0 :                       (window-splittable-p (selected-window)))
    3232             :                     ;; Try to split the selected window vertically if
    3233             :                     ;; that's possible.  (Bug#1806)
    3234           0 :                     (split-window-below))
    3235             :                ;; Otherwise, try to split WINDOW sensibly.
    3236           0 :                (split-window-sensibly window))))
    3237             :         pop-up-frames)
    3238           0 :     (pop-to-buffer (get-buffer-create buf)))
    3239             :   ;; See Bug#12281.
    3240           0 :   (set-window-start nil (point-min))
    3241             :   ;; If dired-shrink-to-fit is t, make its window fit its contents.
    3242           0 :   (when dired-shrink-to-fit
    3243             :     ;; Try to not delete window when we want to display less than
    3244             :     ;; `window-min-height' lines.
    3245           0 :     (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t)))
    3246             : 
    3247             : (defcustom dired-no-confirm nil
    3248             :   "A list of symbols for commands Dired should not confirm, or t.
    3249             : Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
    3250             : `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink',
    3251             : `touch' and `uncompress'.
    3252             : If t, confirmation is never needed."
    3253             :   :group 'dired
    3254             :   :type '(choice (const :tag "Confirmation never needed" t)
    3255             :                  (set (const byte-compile) (const chgrp)
    3256             :                       (const chmod) (const chown) (const compress)
    3257             :                       (const copy) (const delete) (const hardlink)
    3258             :                       (const load) (const move) (const print)
    3259             :                       (const shell) (const symlink) (const touch)
    3260             :                       (const uncompress))))
    3261             : 
    3262             : (defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args)
    3263             :   "Return FUNCTION's result on ARGS after showing which files are marked.
    3264             : Displays the file names in a window showing a buffer named
    3265             : BUFFER-OR-NAME; the default name being \" *Marked Files*\".  The
    3266             : window is not shown if there is just one file, `dired-no-confirm'
    3267             : is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'.
    3268             : 
    3269             : By default, Dired shrinks the display buffer to fit the marked files.
    3270             : To disable this, use the Customization interface to add a new rule
    3271             : to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\",
    3272             : action argument symbol is `window-height' and its value is nil.
    3273             : 
    3274             : FILES is the list of marked files.  It can also be (t FILENAME)
    3275             : in the case of one marked file, to distinguish that from using
    3276             : just the current file.
    3277             : 
    3278             : FUNCTION should not manipulate files, just read input (an
    3279             : argument or confirmation)."
    3280           0 :   (if (or (eq dired-no-confirm t)
    3281           0 :           (memq op-symbol dired-no-confirm)
    3282             :           ;; If FILES defaulted to the current line's file.
    3283           0 :           (= (length files) 1))
    3284           0 :       (apply function args)
    3285           0 :     (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*")))
    3286             :           ;; Mark *Marked Files* window as softly-dedicated, to prevent
    3287             :           ;; other buffers e.g. *Completions* from reusing it (bug#17554).
    3288             :           (display-buffer-mark-dedicated 'soft))
    3289           0 :       (with-displayed-buffer-window
    3290           0 :        buffer
    3291           0 :        (cons 'display-buffer-below-selected
    3292             :              '((window-height . fit-window-to-buffer)
    3293           0 :                (preserve-size . (nil . t))))
    3294           0 :        #'(lambda (window _value)
    3295           0 :            (with-selected-window window
    3296           0 :              (unwind-protect
    3297           0 :                  (apply function args)
    3298           0 :                (when (window-live-p window)
    3299           0 :                  (quit-restore-window window 'kill)))))
    3300             :        ;; Handle (t FILE) just like (FILE), here.  That value is
    3301             :        ;; used (only in some cases), to mean just one file that was
    3302             :        ;; marked, rather than the current line file.
    3303           0 :        (with-current-buffer buffer
    3304           0 :          (dired-format-columns-of-files
    3305           0 :           (if (eq (car files) t) (cdr files) files))
    3306           0 :          (remove-text-properties (point-min) (point-max)
    3307           0 :                                  '(mouse-face nil help-echo nil)))))))
    3308             : 
    3309             : (defun dired-format-columns-of-files (files)
    3310           0 :   (let ((beg (point)))
    3311           0 :     (completion--insert-strings files)
    3312           0 :     (put-text-property beg (point) 'mouse-face nil)))
    3313             : 
    3314             : ;; Commands to mark or flag file(s) at or near current line.
    3315             : 
    3316             : (defun dired-repeat-over-lines (arg function)
    3317             :   ;; This version skips non-file lines.
    3318           0 :   (let ((pos (make-marker)))
    3319           0 :     (beginning-of-line)
    3320           0 :     (while (and (> arg 0) (not (eobp)))
    3321           0 :       (setq arg (1- arg))
    3322           0 :       (beginning-of-line)
    3323           0 :       (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
    3324           0 :       (save-excursion
    3325           0 :         (forward-line 1)
    3326           0 :         (move-marker pos (1+ (point))))
    3327           0 :       (save-excursion (funcall function))
    3328             :       ;; Advance to the next line--actually, to the line that *was* next.
    3329             :       ;; (If FUNCTION inserted some new lines in between, skip them.)
    3330           0 :       (goto-char pos))
    3331           0 :     (while (and (< arg 0) (not (bobp)))
    3332           0 :       (setq arg (1+ arg))
    3333           0 :       (forward-line -1)
    3334           0 :       (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
    3335           0 :       (beginning-of-line)
    3336           0 :       (save-excursion (funcall function)))
    3337           0 :     (move-marker pos nil)
    3338           0 :     (dired-move-to-filename)))
    3339             : 
    3340             : (defun dired-between-files ()
    3341             :   ;; This used to be a regexp match of the `total ...' line output by
    3342             :   ;; ls, which is slightly faster, but that is not very robust; notably,
    3343             :   ;; it fails for non-english locales.
    3344           0 :   (save-excursion (not (dired-move-to-filename))))
    3345             : 
    3346             : (defun dired-next-marked-file (arg &optional wrap opoint)
    3347             :   "Move to the next marked file.
    3348             : If WRAP is non-nil, wrap around to the beginning of the buffer if
    3349             : we reach the end."
    3350             :   (interactive "p\np")
    3351           0 :   (or opoint (setq opoint (point)));; return to where interactively started
    3352           0 :   (if (if (> arg 0)
    3353           0 :           (re-search-forward dired-re-mark nil t arg)
    3354           0 :         (beginning-of-line)
    3355           0 :         (re-search-backward dired-re-mark nil t (- arg)))
    3356           0 :       (dired-move-to-filename)
    3357           0 :     (if (null wrap)
    3358           0 :         (progn
    3359           0 :           (goto-char opoint)
    3360           0 :           (error "No next marked file"))
    3361           0 :       (message "(Wraparound for next marked file)")
    3362           0 :       (goto-char (if (> arg 0) (point-min) (point-max)))
    3363           0 :       (dired-next-marked-file arg nil opoint))))
    3364             : 
    3365             : (defun dired-prev-marked-file (arg &optional wrap)
    3366             :   "Move to the previous marked file.
    3367             : If WRAP is non-nil, wrap around to the end of the buffer if we
    3368             : reach the beginning of the buffer."
    3369             :   (interactive "p\np")
    3370           0 :   (dired-next-marked-file (- arg) wrap))
    3371             : 
    3372             : (defun dired-file-marker (file)
    3373             :   ;; Return FILE's marker, or nil if unmarked.
    3374           0 :   (save-excursion
    3375           0 :     (and (dired-goto-file file)
    3376           0 :          (progn
    3377           0 :            (beginning-of-line)
    3378           0 :            (if (not (equal ?\040 (following-char)))
    3379           0 :                (following-char))))))
    3380             : 
    3381             : (defun dired-mark-files-in-region (start end)
    3382           0 :   (let ((inhibit-read-only t))
    3383           0 :     (if (> start end)
    3384           0 :         (error "start > end"))
    3385           0 :     (goto-char start)                   ; assumed at beginning of line
    3386           0 :     (while (< (point) end)
    3387             :       ;; Skip subdir line and following garbage like the `total' line:
    3388           0 :       (while (and (< (point) end) (dired-between-files))
    3389           0 :         (forward-line 1))
    3390           0 :       (if (and (not (looking-at-p dired-re-dot))
    3391           0 :                (dired-get-filename nil t))
    3392           0 :           (progn
    3393           0 :             (delete-char 1)
    3394           0 :             (insert dired-marker-char)))
    3395           0 :       (forward-line 1))))
    3396             : 
    3397             : (defun dired-mark (arg &optional interactive)
    3398             :   "Mark the file at point in the Dired buffer.
    3399             : If the region is active, mark all files in the region.
    3400             : Otherwise, with a prefix arg, mark files on the next ARG lines.
    3401             : 
    3402             : If on a subdir headerline, mark all its files except `.' and `..'.
    3403             : 
    3404             : Use \\[dired-unmark-all-files] to remove all marks
    3405             : and \\[dired-unmark] on a subdir to remove the marks in
    3406             : this subdir."
    3407           0 :   (interactive (list current-prefix-arg t))
    3408           0 :   (cond
    3409             :    ;; Mark files in the active region.
    3410           0 :    ((and interactive (use-region-p))
    3411           0 :     (save-excursion
    3412           0 :       (let ((beg (region-beginning))
    3413           0 :             (end (region-end)))
    3414           0 :         (dired-mark-files-in-region
    3415           0 :          (progn (goto-char beg) (line-beginning-position))
    3416           0 :          (progn (goto-char end) (line-beginning-position))))))
    3417             :    ;; Mark subdir files from the subdir headerline.
    3418           0 :    ((dired-get-subdir)
    3419           0 :     (save-excursion (dired-mark-subdir-files)))
    3420             :    ;; Mark the current (or next ARG) files.
    3421             :    (t
    3422           0 :     (let ((inhibit-read-only t))
    3423           0 :       (dired-repeat-over-lines
    3424           0 :        (prefix-numeric-value arg)
    3425           0 :        (lambda () (delete-char 1) (insert dired-marker-char)))))))
    3426             : 
    3427             : (defun dired-unmark (arg &optional interactive)
    3428             :   "Unmark the file at point in the Dired buffer.
    3429             : If the region is active, unmark all files in the region.
    3430             : Otherwise, with a prefix arg, unmark files on the next ARG lines.
    3431             : 
    3432             : If looking at a subdir, unmark all its files except `.' and `..'.
    3433             : If the region is active in Transient Mark mode, unmark all files
    3434             : in the active region."
    3435           0 :   (interactive (list current-prefix-arg t))
    3436           0 :   (let ((dired-marker-char ?\040))
    3437           0 :     (dired-mark arg interactive)))
    3438             : 
    3439             : (defun dired-flag-file-deletion (arg &optional interactive)
    3440             :   "In Dired, flag the current line's file for deletion.
    3441             : If the region is active, flag all files in the region.
    3442             : Otherwise, with a prefix arg, flag files on the next ARG lines.
    3443             : 
    3444             : If on a subdir headerline, flag all its files except `.' and `..'.
    3445             : If the region is active in Transient Mark mode, flag all files
    3446             : in the active region."
    3447           0 :   (interactive (list current-prefix-arg t))
    3448           0 :   (let ((dired-marker-char dired-del-marker))
    3449           0 :     (dired-mark arg interactive)))
    3450             : 
    3451             : (defun dired-unmark-backward (arg)
    3452             :   "In Dired, move up lines and remove marks or deletion flags there.
    3453             : Optional prefix ARG says how many lines to unmark/unflag; default
    3454             : is one line.
    3455             : If the region is active in Transient Mark mode, unmark all files
    3456             : in the active region."
    3457             :   (interactive "p")
    3458           0 :   (dired-unmark (- arg) t))
    3459             : 
    3460             : (defun dired-toggle-marks ()
    3461             :   "Toggle marks: marked files become unmarked, and vice versa.
    3462             : Files marked with other flags (such as `D') are not affected.
    3463             : `.' and `..' are never toggled.
    3464             : As always, hidden subdirs are not affected."
    3465             :   (interactive)
    3466           0 :   (save-excursion
    3467           0 :     (goto-char (point-min))
    3468           0 :     (let ((inhibit-read-only t))
    3469           0 :       (while (not (eobp))
    3470           0 :         (or (dired-between-files)
    3471           0 :             (looking-at-p dired-re-dot)
    3472             :             ;; use subst instead of insdel because it does not move
    3473             :             ;; the gap and thus should be faster and because
    3474             :             ;; other characters are left alone automatically
    3475           0 :             (apply 'subst-char-in-region
    3476           0 :                    (point) (1+ (point))
    3477           0 :                    (if (eq ?\040 (following-char)) ; SPC
    3478           0 :                        (list ?\040 dired-marker-char)
    3479           0 :                      (list dired-marker-char ?\040))))
    3480           0 :         (forward-line 1)))))
    3481             : 
    3482             : ;;; Commands to mark or flag files based on their characteristics or names.
    3483             : 
    3484             : (defvar dired-regexp-history nil
    3485             :   "History list of regular expressions used in Dired commands.")
    3486             : 
    3487             : (defun dired-read-regexp (prompt &optional default history)
    3488             :   "Read a regexp using `read-regexp'."
    3489             :   (declare (obsolete read-regexp "24.5"))
    3490           0 :   (read-regexp prompt default (or history 'dired-regexp-history)))
    3491             : 
    3492             : (defun dired-mark-files-regexp (regexp &optional marker-char)
    3493             :   "Mark all files matching REGEXP for use in later commands.
    3494             : A prefix argument means to unmark them instead.
    3495             : `.' and `..' are never marked.
    3496             : 
    3497             : REGEXP is an Emacs regexp, not a shell wildcard.  Thus, use `\\.o$' for
    3498             : object files--just `.o' will mark more than you might think."
    3499             :   (interactive
    3500           0 :    (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
    3501           0 :                               " files (regexp): ")
    3502             :                       ;; Add more suggestions into the default list
    3503           0 :                       (cons nil (list (dired-get-filename t t)
    3504           0 :                                       (and (dired-get-filename nil t)
    3505           0 :                                            (concat (regexp-quote
    3506           0 :                                                     (file-name-extension
    3507           0 :                                                      (dired-get-filename nil t) t))
    3508           0 :                                                    "\\'"))))
    3509           0 :                       'dired-regexp-history)
    3510           0 :          (if current-prefix-arg ?\040)))
    3511           0 :   (let ((dired-marker-char (or marker-char dired-marker-char)))
    3512           0 :     (dired-mark-if
    3513             :      (and (not (looking-at-p dired-re-dot))
    3514             :           (not (eolp))                  ; empty line
    3515             :           (let ((fn (dired-get-filename t t)))
    3516             :             (and fn (string-match-p regexp fn))))
    3517           0 :      "matching file")))
    3518             : 
    3519             : (defun dired-mark-files-containing-regexp (regexp &optional marker-char)
    3520             :   "Mark all files with contents containing REGEXP for use in later commands.
    3521             : A prefix argument means to unmark them instead.
    3522             : `.' and `..' are never marked.
    3523             : 
    3524             : Note that if a file is visited in an Emacs buffer, and
    3525             : `dired-always-read-filesystem' is nil, this command will
    3526             : look in the buffer without revisiting the file, so the results might
    3527             : be inconsistent with the file on disk if its contents has changed
    3528             : since it was last visited."
    3529             :   (interactive
    3530           0 :    (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
    3531           0 :                               " files containing (regexp): ")
    3532           0 :                       nil 'dired-regexp-history)
    3533           0 :          (if current-prefix-arg ?\040)))
    3534           0 :   (let ((dired-marker-char (or marker-char dired-marker-char)))
    3535           0 :     (dired-mark-if
    3536             :      (and (not (looking-at-p dired-re-dot))
    3537             :           (not (eolp))                  ; empty line
    3538             :           (let ((fn (dired-get-filename nil t)))
    3539             :             (when (and fn (file-readable-p fn)
    3540             :                        (not (file-directory-p fn)))
    3541             :               (let ((prebuf (get-file-buffer fn)))
    3542             :                 (message "Checking %s" fn)
    3543             :                 ;; For now we do it inside emacs
    3544             :                 ;; Grep might be better if there are a lot of files
    3545             :                 (if (and prebuf (not dired-always-read-filesystem))
    3546             :                     (with-current-buffer prebuf
    3547             :                       (save-excursion
    3548             :                         (goto-char (point-min))
    3549             :                         (re-search-forward regexp nil t)))
    3550             :                   (with-temp-buffer
    3551             :                     (insert-file-contents fn)
    3552             :                     (goto-char (point-min))
    3553             :                     (re-search-forward regexp nil t))))
    3554             :                       )))
    3555           0 :      "matching file")))
    3556             : 
    3557             : (defun dired-flag-files-regexp (regexp)
    3558             :   "In Dired, flag all files containing the specified REGEXP for deletion.
    3559             : The match is against the non-directory part of the filename.  Use `^'
    3560             :   and `$' to anchor matches.  Exclude subdirs by hiding them.
    3561             : `.' and `..' are never flagged."
    3562           0 :   (interactive (list (read-regexp "Flag for deletion (regexp): "
    3563           0 :                                   nil 'dired-regexp-history)))
    3564           0 :   (dired-mark-files-regexp regexp dired-del-marker))
    3565             : 
    3566             : (defun dired-mark-symlinks (unflag-p)
    3567             :   "Mark all symbolic links.
    3568             : With prefix argument, unmark or unflag all those files."
    3569             :   (interactive "P")
    3570           0 :   (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
    3571           0 :     (dired-mark-if (looking-at-p dired-re-sym) "symbolic link")))
    3572             : 
    3573             : (defun dired-mark-directories (unflag-p)
    3574             :   "Mark all directory file lines except `.' and `..'.
    3575             : With prefix argument, unmark or unflag all those files."
    3576             :   (interactive "P")
    3577           0 :   (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
    3578           0 :     (dired-mark-if (and (looking-at-p dired-re-dir)
    3579             :                         (not (looking-at-p dired-re-dot)))
    3580           0 :                    "directory file")))
    3581             : 
    3582             : (defun dired-mark-executables (unflag-p)
    3583             :   "Mark all executable files.
    3584             : With prefix argument, unmark or unflag all those files."
    3585             :   (interactive "P")
    3586           0 :   (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
    3587           0 :     (dired-mark-if (looking-at-p dired-re-exe) "executable file")))
    3588             : 
    3589             : ;; dired-x.el has a dired-mark-sexp interactive command: mark
    3590             : ;; files for which PREDICATE returns non-nil.
    3591             : 
    3592             : (defun dired-flag-auto-save-files (&optional unflag-p)
    3593             :   "Flag for deletion files whose names suggest they are auto save files.
    3594             : A prefix argument says to unmark or unflag those files instead."
    3595             :   (interactive "P")
    3596           0 :   (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
    3597           0 :     (dired-mark-if
    3598             :      ;; It is less than general to check for # here,
    3599             :      ;; but it's the only way this runs fast enough.
    3600             :      (and (save-excursion (end-of-line)
    3601             :                           (or
    3602             :                            (eq (preceding-char) ?#)
    3603             :                            ;; Handle executables in case of -F option.
    3604             :                            ;; We need not worry about the other kinds
    3605             :                            ;; of markings that -F makes, since they won't
    3606             :                            ;; appear on real auto-save files.
    3607             :                            (if (eq (preceding-char) ?*)
    3608             :                                (progn
    3609             :                                  (forward-char -1)
    3610             :                                  (eq (preceding-char) ?#)))))
    3611             :           (not (looking-at-p dired-re-dir))
    3612             :           (let ((fn (dired-get-filename t t)))
    3613             :             (if fn (auto-save-file-name-p
    3614             :                     (file-name-nondirectory fn)))))
    3615           0 :      "auto save file")))
    3616             : 
    3617             : (defcustom dired-garbage-files-regexp
    3618             :   ;; `log' here is dubious, since it's typically used for useful log
    3619             :   ;; files, not just TeX stuff.  -- fx
    3620             :   (concat (regexp-opt
    3621             :            '(".log" ".toc" ".dvi" ".bak" ".orig" ".rej" ".aux"))
    3622             :           "\\'")
    3623             :   "Regular expression to match \"garbage\" files for `dired-flag-garbage-files'."
    3624             :   :type 'regexp
    3625             :   :group 'dired)
    3626             : 
    3627             : (defun dired-flag-garbage-files ()
    3628             :   "Flag for deletion all files that match `dired-garbage-files-regexp'."
    3629             :   (interactive)
    3630           0 :   (dired-flag-files-regexp dired-garbage-files-regexp))
    3631             : 
    3632             : (defun dired-flag-backup-files (&optional unflag-p)
    3633             :   "Flag all backup files (names ending with `~') for deletion.
    3634             : With prefix argument, unmark or unflag these files."
    3635             :   (interactive "P")
    3636           0 :   (let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
    3637           0 :     (dired-mark-if
    3638             :      ;; Don't call backup-file-name-p unless the last character looks like
    3639             :      ;; it might be the end of a backup file name.  This isn't very general,
    3640             :      ;; but it's the only way this runs fast enough.
    3641             :      (and (save-excursion (end-of-line)
    3642             :                           ;; Handle executables in case of -F option.
    3643             :                           ;; We need not worry about the other kinds
    3644             :                           ;; of markings that -F makes, since they won't
    3645             :                           ;; appear on real backup files.
    3646             :                           (if (eq (preceding-char) ?*)
    3647             :                               (forward-char -1))
    3648             :                           (eq (preceding-char) ?~))
    3649             :           (not (looking-at-p dired-re-dir))
    3650             :           (let ((fn (dired-get-filename t t)))
    3651             :             (if fn (backup-file-name-p fn))))
    3652           0 :      "backup file")))
    3653             : 
    3654             : (defun dired-change-marks (&optional old new)
    3655             :   "Change all OLD marks to NEW marks.
    3656             : OLD and NEW are both characters used to mark files."
    3657             :   (interactive
    3658           0 :    (let* ((cursor-in-echo-area t)
    3659           0 :           (old (progn (message "Change (old mark): ") (read-char)))
    3660           0 :           (new (progn (message  "Change %c marks to (new mark): " old)
    3661           0 :                       (read-char))))
    3662           0 :      (list old new)))
    3663           0 :   (if (or (eq old ?\r) (eq new ?\r))
    3664           0 :       (ding)
    3665           0 :     (let ((string (format "\n%c" old))
    3666             :           (inhibit-read-only t))
    3667           0 :       (save-excursion
    3668           0 :         (goto-char (point-min))
    3669           0 :         (while (search-forward string nil t)
    3670           0 :           (if (if (= old ?\s)
    3671           0 :                   (save-match-data
    3672           0 :                     (dired-get-filename 'no-dir t))
    3673           0 :                 t)
    3674           0 :               (subst-char-in-region (match-beginning 0)
    3675           0 :                                     (match-end 0) old new)))))))
    3676             : 
    3677             : (defun dired-unmark-all-marks ()
    3678             :   "Remove all marks from all files in the Dired buffer."
    3679             :   (interactive)
    3680           0 :   (dired-unmark-all-files ?\r))
    3681             : 
    3682             : ;; Bound in dired-unmark-all-files
    3683             : (defvar dired-unmark-all-files-query)
    3684             : 
    3685             : (defun dired-unmark-all-files (mark &optional arg)
    3686             :   "Remove a specific mark (or any mark) from every file.
    3687             : After this command, type the mark character to remove,
    3688             : or type RET to remove all marks.
    3689             : With prefix arg, query for each marked file.
    3690             : Type \\[help-command] at that time for help."
    3691             :   (interactive "cRemove marks (RET means all): \nP")
    3692           0 :   (save-excursion
    3693           0 :     (let* ((count 0)
    3694             :            (inhibit-read-only t) case-fold-search
    3695             :            dired-unmark-all-files-query
    3696           0 :            (string (format "\n%c" mark))
    3697             :            (help-form "\
    3698             : Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
    3699             : `!' to unmark all remaining files with no more questions."))
    3700           0 :       (goto-char (point-min))
    3701           0 :       (while (if (eq mark ?\r)
    3702           0 :                  (re-search-forward dired-re-mark nil t)
    3703           0 :                (search-forward string nil t))
    3704           0 :         (if (or (not arg)
    3705           0 :                 (let ((file (dired-get-filename t t)))
    3706           0 :                   (and file
    3707           0 :                        (dired-query 'dired-unmark-all-files-query
    3708             :                                     "Unmark file `%s'? "
    3709           0 :                                     file))))
    3710           0 :             (progn (subst-char-in-region (1- (point)) (point)
    3711           0 :                                          (preceding-char) ?\s)
    3712           0 :                    (setq count (1+ count)))))
    3713           0 :       (message (if (= count 1) "1 mark removed"
    3714           0 :                  "%d marks removed")
    3715           0 :                count))))
    3716             : 
    3717             : ;; Logging failures operating on files, and showing the results.
    3718             : 
    3719             : (defvar dired-log-buffer "*Dired log*")
    3720             : 
    3721             : (defun dired-why ()
    3722             :   "Pop up a buffer with error log output from Dired.
    3723             : A group of errors from a single command ends with a formfeed.
    3724             : Thus, use \\[backward-page] to find the beginning of a group of errors."
    3725             :   (interactive)
    3726           0 :   (if (get-buffer dired-log-buffer)
    3727           0 :       (let ((owindow (selected-window))
    3728           0 :             (window (display-buffer (get-buffer dired-log-buffer))))
    3729           0 :         (unwind-protect
    3730           0 :             (progn
    3731           0 :               (select-window window)
    3732           0 :               (goto-char (point-max))
    3733           0 :               (forward-line -1)
    3734           0 :               (backward-page 1)
    3735           0 :               (recenter 0))
    3736           0 :           (select-window owindow)))))
    3737             : 
    3738             : (defun dired-log (log &rest args)
    3739             :   ;; Log a message or the contents of a buffer.
    3740             :   ;; If LOG is a string and there are more args, it is formatted with
    3741             :   ;; those ARGS.  Usually the LOG string ends with a \n.
    3742             :   ;; End each bunch of errors with (dired-log t):
    3743             :   ;; this inserts the current time and buffer at the start of the page,
    3744             :   ;; and \f (formfeed) at the end.
    3745           0 :   (let ((obuf (current-buffer)))
    3746           0 :     (with-current-buffer (get-buffer-create dired-log-buffer)
    3747           0 :       (goto-char (point-max))
    3748           0 :       (let ((inhibit-read-only t))
    3749           0 :         (cond ((stringp log)
    3750           0 :                (insert (if args
    3751           0 :                            (apply #'format-message log args)
    3752           0 :                          log)))
    3753           0 :               ((bufferp log)
    3754           0 :                (insert-buffer-substring log))
    3755           0 :               ((eq t log)
    3756           0 :                (backward-page 1)
    3757           0 :                (unless (bolp)
    3758           0 :                  (insert "\n"))
    3759           0 :                (insert (current-time-string)
    3760           0 :                        (format-message "\tBuffer `%s'\n" (buffer-name obuf)))
    3761           0 :                (goto-char (point-max))
    3762           0 :                (insert "\f\n")))))))
    3763             : 
    3764             : (defun dired-log-summary (string failures)
    3765             :   "State a summary of a command's failures, in echo area and log buffer.
    3766             : STRING is an overall summary of the failures.
    3767             : FAILURES is a list of file names that we failed to operate on,
    3768             : or nil if file names are not applicable."
    3769           0 :   (if (= (length failures) 1)
    3770           0 :       (message "%s"
    3771           0 :                (with-current-buffer dired-log-buffer
    3772           0 :                  (goto-char (point-max))
    3773           0 :                  (backward-page 1)
    3774           0 :                  (if (eolp) (forward-line 1))
    3775           0 :                  (buffer-substring (point) (point-max))))
    3776           0 :     (message (if failures "%s--type ? for details (%s)"
    3777           0 :                "%s--type ? for details")
    3778           0 :              string failures))
    3779             :   ;; Log a summary describing a bunch of errors.
    3780           0 :   (dired-log (concat "\n" string "\n"))
    3781           0 :   (dired-log t))
    3782             : 
    3783             : ;;; Sorting
    3784             : 
    3785             : ;; Most ls can only sort by name or by date (with -t), nothing else.
    3786             : ;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
    3787             : ;; So anything that does not contain these is sort "by name".
    3788             : 
    3789             : (defvar dired-ls-sorting-switches "SXU"
    3790             :   "String of `ls' switches (single letters) except \"t\" that influence sorting.
    3791             : 
    3792             : This indicates to Dired which option switches to watch out for because they
    3793             : will change the sorting order behavior of `ls'.
    3794             : 
    3795             : To change the default sorting order (e.g. add a `-v' option), see the
    3796             : variable `dired-listing-switches'.  To temporarily override the listing
    3797             : format, use `\\[universal-argument] \\[dired]'.")
    3798             : 
    3799             : (defvar dired-sort-by-date-regexp
    3800             :   (concat "\\(\\`\\| \\)-[^- ]*t"
    3801             :           ;; `dired-ls-sorting-switches' after -t overrides -t.
    3802             :           "[^ " dired-ls-sorting-switches "]*"
    3803             :           "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t"
    3804             :           dired-ls-sorting-switches "]+\\)\\)* *$")
    3805             :   "Regexp recognized by Dired to set `by date' mode.")
    3806             : 
    3807             : (defvar dired-sort-by-name-regexp
    3808             :   (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|"
    3809             :           "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$")
    3810             :   "Regexp recognized by Dired to set `by name' mode.")
    3811             : 
    3812             : (defvar dired-sort-inhibit nil
    3813             :   "Non-nil means the Dired sort command is disabled.
    3814             : The idea is to set this buffer-locally in special Dired buffers.")
    3815             : 
    3816             : (defun dired-sort-set-mode-line ()
    3817             :   ;; Set mode line display according to dired-actual-switches.
    3818             :   ;; Mode line display of "by name" or "by date" guarantees the user a
    3819             :   ;; match with the corresponding regexps.  Non-matching switches are
    3820             :   ;; shown literally.
    3821           6 :   (when (eq major-mode 'dired-mode)
    3822           6 :     (setq mode-name
    3823           6 :           (let (case-fold-search)
    3824           6 :             (cond ((string-match-p
    3825           6 :                     dired-sort-by-name-regexp dired-actual-switches)
    3826             :                    "Dired by name")
    3827           0 :                   ((string-match-p
    3828           0 :                     dired-sort-by-date-regexp dired-actual-switches)
    3829             :                    "Dired by date")
    3830             :                   (t
    3831           6 :                    (concat "Dired " dired-actual-switches)))))
    3832           6 :     (force-mode-line-update)))
    3833             : 
    3834             : (define-obsolete-function-alias 'dired-sort-set-modeline
    3835             :   'dired-sort-set-mode-line "24.3")
    3836             : 
    3837             : (defun dired-sort-toggle-or-edit (&optional arg)
    3838             :   "Toggle sorting by date, and refresh the Dired buffer.
    3839             : With a prefix argument, edit the current listing switches instead."
    3840             :   (interactive "P")
    3841           0 :   (when dired-sort-inhibit
    3842           0 :     (error "Cannot sort this Dired buffer"))
    3843           0 :   (if arg
    3844           0 :       (dired-sort-other
    3845           0 :        (read-string "ls switches (must contain -l): " dired-actual-switches))
    3846           0 :     (dired-sort-toggle)))
    3847             : 
    3848             : (defun dired-sort-toggle ()
    3849             :   ;; Toggle between sort by date/name.  Reverts the buffer.
    3850           0 :   (let ((sorting-by-date (string-match-p dired-sort-by-date-regexp
    3851           0 :                                          dired-actual-switches))
    3852             :         ;; Regexp for finding (possibly embedded) -t switches.
    3853             :         (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)")
    3854             :         case-fold-search)
    3855             :     ;; Remove the -t switch.
    3856           0 :     (while (string-match switch-regexp dired-actual-switches)
    3857           0 :       (if (and (equal (match-string 2 dired-actual-switches) "")
    3858           0 :                (equal (match-string 4 dired-actual-switches) ""))
    3859             :           ;; Remove a stand-alone -t switch.
    3860           0 :           (setq dired-actual-switches
    3861           0 :                 (replace-match "" t t dired-actual-switches))
    3862             :         ;; Remove a switch of the form -XtY for some X and Y.
    3863           0 :         (setq dired-actual-switches
    3864           0 :               (replace-match "" t t dired-actual-switches 3))))
    3865             : 
    3866             :     ;; Now, if we weren't sorting by date before, add the -t switch.
    3867             :     ;; Some simple-minded ls implementations (eg ftp servers) only
    3868             :     ;; allow a single option string, so try not to add " -t" if possible.
    3869           0 :     (unless sorting-by-date
    3870           0 :       (setq dired-actual-switches
    3871           0 :             (concat dired-actual-switches
    3872           0 :                     (if (string-match-p "\\`-[[:alnum:]]+\\'"
    3873           0 :                                         dired-actual-switches)
    3874             :                         "t"
    3875           0 :                       " -t")))))
    3876           0 :   (dired-sort-set-mode-line)
    3877           0 :   (revert-buffer))
    3878             : 
    3879             : ;; Some user code loads dired especially for this.
    3880             : ;; Don't do that--use replace-regexp-in-string instead.
    3881             : (defun dired-replace-in-string (regexp newtext string)
    3882             :   ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
    3883             :   ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
    3884           4 :   (let ((result "") (start 0) mb me)
    3885           8 :     (while (string-match regexp string start)
    3886           4 :       (setq mb (match-beginning 0)
    3887           4 :             me (match-end 0)
    3888           4 :             result (concat result (substring string start mb) newtext)
    3889           4 :             start me))
    3890           4 :     (concat result (substring string start))))
    3891             : 
    3892             : (defun dired-sort-other (switches &optional no-revert)
    3893             :   "Specify new `ls' SWITCHES for current Dired buffer.
    3894             : Values matching `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp'
    3895             : set the minor mode accordingly, others appear literally in the mode line.
    3896             : With optional second arg NO-REVERT, don't refresh the listing afterwards."
    3897           6 :   (dired-sort-R-check switches)
    3898           6 :   (setq dired-actual-switches switches)
    3899           6 :   (dired-sort-set-mode-line)
    3900           6 :   (or no-revert (revert-buffer)))
    3901             : 
    3902             : (defvar-local dired-subdir-alist-pre-R nil
    3903             :   "Value of `dired-subdir-alist' before -R switch added.")
    3904             : 
    3905             : (defun dired-sort-R-check (switches)
    3906             :   "Additional processing of -R in ls option string SWITCHES.
    3907             : Saves `dired-subdir-alist' when R is set and restores saved value
    3908             : minus any directories explicitly deleted when R is cleared.
    3909             : To be called first in body of `dired-sort-other', etc."
    3910           6 :   (cond
    3911           6 :    ((and (dired-switches-recursive-p switches)
    3912           6 :          (not (dired-switches-recursive-p dired-actual-switches)))
    3913             :     ;; Adding -R to ls switches -- save `dired-subdir-alist':
    3914           0 :     (setq dired-subdir-alist-pre-R dired-subdir-alist))
    3915           6 :    ((and (dired-switches-recursive-p dired-actual-switches)
    3916           6 :          (not (dired-switches-recursive-p switches)))
    3917             :     ;; Deleting -R from ls switches -- revert to pre-R subdirs
    3918             :     ;; that are still present:
    3919           0 :     (setq dired-subdir-alist
    3920           0 :           (if dired-subdir-alist-pre-R
    3921           0 :               (let (subdirs)
    3922           0 :                 (while dired-subdir-alist-pre-R
    3923           0 :                   (if (assoc (caar dired-subdir-alist-pre-R)
    3924           0 :                              dired-subdir-alist)
    3925             :                       ;; subdir still present...
    3926           0 :                       (setq subdirs
    3927           0 :                             (cons (car dired-subdir-alist-pre-R)
    3928           0 :                                   subdirs)))
    3929           0 :                   (setq dired-subdir-alist-pre-R
    3930           0 :                         (cdr dired-subdir-alist-pre-R)))
    3931           0 :                 (reverse subdirs))
    3932             :             ;; No pre-R subdir alist, so revert to main directory
    3933             :             ;; listing:
    3934           6 :             (list (car (reverse dired-subdir-alist))))))))
    3935             : 
    3936             : 
    3937             : ;;;;  Drag and drop support
    3938             : 
    3939             : (defcustom dired-recursive-copies 'top
    3940             :   "Whether Dired copies directories recursively.
    3941             : If nil, never copy recursively.
    3942             : `always' means to copy recursively without asking.
    3943             : `top' means to ask for each directory at top level.
    3944             : Any other value means to ask for each directory."
    3945             :   :type '(choice :tag "Copy directories"
    3946             :                  (const :tag "No recursive copies" nil)
    3947             :                  (const :tag "Ask for each directory" t)
    3948             :                  (const :tag "Ask for each top directory only" top)
    3949             :                  (const :tag "Copy directories without asking" always))
    3950             :   :group 'dired)
    3951             : 
    3952             : (defun dired-dnd-popup-notice ()
    3953           0 :   (message-box
    3954           0 :    "Dired recursive copies are currently disabled.\nSee the variable `dired-recursive-copies'."))
    3955             : 
    3956             : (declare-function x-popup-menu "menu.c" (position menu))
    3957             : 
    3958             : (defun dired-dnd-do-ask-action (uri)
    3959             :   ;; No need to get actions and descriptions from the source,
    3960             :   ;; we only have three actions anyway.
    3961           0 :   (let ((action (x-popup-menu
    3962             :                  t
    3963           0 :                  (list "What action?"
    3964           0 :                        (cons ""
    3965             :                              '(("Copy here" . copy)
    3966             :                                ("Move here" . move)
    3967             :                                ("Link here" . link)
    3968             :                                "--"
    3969           0 :                                ("Cancel" . nil)))))))
    3970           0 :     (if action
    3971           0 :         (dired-dnd-handle-local-file uri action)
    3972           0 :       nil)))
    3973             : 
    3974             : (declare-function dired-relist-entry "dired-aux" (file))
    3975             : (declare-function make-symbolic-link "fileio.c")
    3976             : 
    3977             : ;; Only used when (featurep 'dnd).
    3978             : (declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist))
    3979             : (declare-function dnd-get-local-file-uri "dnd" (uri))
    3980             : 
    3981             : (defvar dired-overwrite-confirmed)      ;Defined in dired-aux.
    3982             : 
    3983             : (defun dired-dnd-handle-local-file (uri action)
    3984             :   "Copy, move or link a file to the Dired directory.
    3985             : URI is the file to handle, ACTION is one of copy, move, link or ask.
    3986             : Ask means pop up a menu for the user to select one of copy, move or link."
    3987           0 :   (require 'dired-aux)
    3988           0 :   (let* ((from (dnd-get-local-file-name uri t))
    3989           0 :          (to (when from
    3990           0 :                (concat (dired-current-directory)
    3991           0 :                        (file-name-nondirectory from)))))
    3992           0 :     (when from
    3993           0 :       (cond ((eq action 'ask)
    3994           0 :              (dired-dnd-do-ask-action uri))
    3995             :             ;; If copying a directory and dired-recursive-copies is
    3996             :             ;; nil, dired-copy-file fails.  Pop up a notice.
    3997           0 :             ((and (memq action '(copy private))
    3998           0 :                   (file-directory-p from)
    3999           0 :                   (not dired-recursive-copies))
    4000           0 :              (dired-dnd-popup-notice))
    4001           0 :             ((memq action '(copy private move link))
    4002           0 :              (let ((overwrite (and (file-exists-p to)
    4003           0 :                                    (y-or-n-p
    4004           0 :                                     (format-message
    4005           0 :                                      "Overwrite existing file `%s'? " to))))
    4006             :                    ;; Binding dired-overwrite-confirmed to nil makes
    4007             :                    ;; dired-handle-overwrite a no-op.  We instead use
    4008             :                    ;; y-or-n-p, which pops a graphical menu.
    4009             :                    dired-overwrite-confirmed backup-file)
    4010           0 :                (when (and overwrite
    4011             :                           ;; d-b-o is defined in dired-aux.
    4012           0 :                           (boundp 'dired-backup-overwrite)
    4013           0 :                           dired-backup-overwrite
    4014           0 :                           (setq backup-file
    4015           0 :                                 (car (find-backup-file-name to)))
    4016           0 :                           (or (eq dired-backup-overwrite 'always)
    4017           0 :                               (y-or-n-p
    4018           0 :                                (format-message
    4019           0 :                                 "Make backup for existing file `%s'? " to))))
    4020           0 :                  (rename-file to backup-file 0)
    4021           0 :                  (dired-relist-entry backup-file))
    4022           0 :                (cond ((memq action '(copy private))
    4023           0 :                       (dired-copy-file from to overwrite))
    4024           0 :                      ((eq action 'move)
    4025           0 :                       (dired-rename-file from to overwrite))
    4026           0 :                      ((eq action 'link)
    4027           0 :                       (make-symbolic-link from to overwrite)))
    4028           0 :                (dired-relist-entry to)
    4029           0 :                action))))))
    4030             : 
    4031             : (defun dired-dnd-handle-file (uri action)
    4032             :   "Copy, move or link a file to the Dired directory if it is a local file.
    4033             : URI is the file to handle.  If the hostname in the URI isn't local, do nothing.
    4034             : ACTION is one of copy, move, link or ask.
    4035             : Ask means pop up a menu for the user to select one of copy, move or link."
    4036           0 :   (let ((local-file (dnd-get-local-file-uri uri)))
    4037           0 :     (if local-file (dired-dnd-handle-local-file local-file action)
    4038           0 :       nil)))
    4039             : 
    4040             : 
    4041             : ;;;;  Desktop support
    4042             : 
    4043             : (eval-when-compile (require 'desktop))
    4044             : (declare-function desktop-file-name "desktop" (filename dirname))
    4045             : 
    4046             : (defun dired-desktop-buffer-misc-data (dirname)
    4047             :   "Auxiliary information to be saved in desktop file."
    4048           0 :   (cons
    4049             :    ;; Value of `dired-directory'.
    4050           0 :    (if (consp dired-directory)
    4051             :        ;; Directory name followed by list of files.
    4052           0 :        (cons (desktop-file-name (car dired-directory) dirname)
    4053           0 :              (cdr dired-directory))
    4054             :      ;; Directory name, optionally with shell wildcard.
    4055           0 :      (desktop-file-name dired-directory dirname))
    4056             :    ;; Subdirectories in `dired-subdir-alist'.
    4057           0 :    (cdr
    4058           0 :      (nreverse
    4059           0 :        (mapcar
    4060           0 :         (lambda (f) (desktop-file-name (car f) dirname))
    4061           0 :          dired-subdir-alist)))))
    4062             : 
    4063             : (defun dired-restore-desktop-buffer (_file-name
    4064             :                                      _buffer-name
    4065             :                                      misc-data)
    4066             :   "Restore a Dired buffer specified in a desktop file."
    4067             :   ;; First element of `misc-data' is the value of `dired-directory'.
    4068             :   ;; This value is a directory name, optionally with shell wildcard or
    4069             :   ;; a directory name followed by list of files.
    4070           0 :   (let* ((dired-dir (car misc-data))
    4071           0 :          (dir (if (consp dired-dir) (car dired-dir) dired-dir)))
    4072           0 :     (if (file-directory-p (file-name-directory dir))
    4073           0 :         (with-demoted-errors "Desktop: Problem restoring directory: %S"
    4074           0 :           (dired dired-dir)
    4075             :           ;; The following elements of `misc-data' are the keys
    4076             :           ;; from `dired-subdir-alist'.
    4077           0 :           (mapc 'dired-maybe-insert-subdir (cdr misc-data))
    4078           0 :           (current-buffer))
    4079           0 :       (message "Desktop: Directory %s no longer exists." dir)
    4080           0 :       (when desktop-missing-file-warning (sit-for 1))
    4081           0 :       nil)))
    4082             : 
    4083             : (add-to-list 'desktop-buffer-mode-handlers
    4084             :              '(dired-mode . dired-restore-desktop-buffer))
    4085             : 
    4086             : (provide 'dired)
    4087             : 
    4088             : (run-hooks 'dired-load-hook)            ; for your customizations
    4089             : 
    4090             : ;;; dired.el ends here

Generated by: LCOV version 1.12