]> code.delx.au - gnu-emacs/blobdiff - lisp/dired.el
(ps-print-preprint): Special handling if
[gnu-emacs] / lisp / dired.el
index 1385c7985352fe8b5f7e629293efecdbc4b5e88a..76ce9e8d45d48da54fe4896fdb1389b8db642929 100644 (file)
@@ -1,6 +1,6 @@
 ;;; dired.el --- directory-browsing commands
 
-;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
 ;; Maintainer: FSF
@@ -18,8 +18,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
@@ -47,7 +48,7 @@ may contain even `F', `b', `i' and `s'.  See also the variable
 
 ;;;###autoload
 (defvar dired-chown-program
-  (if (memq system-type '(hpux dgux usg-unix-v irix linux))
+  (if (memq system-type '(hpux dgux usg-unix-v irix linux lignux))
       "chown" "/etc/chown")
   "Name of chown command (usually `chown' or `/etc/chown').")
 
@@ -59,7 +60,8 @@ may contain even `F', `b', `i' and `s'.  See also the variable
 ;;;###autoload
 (defvar dired-ls-F-marks-symlinks nil
   "*Informs dired about how `ls -lF' marks symbolic links.
-Set this to t if `insert-directory-program' with `-lF' marks the symbolic link
+Set this to t if `ls' (or whatever program is specified by
+`insert-directory-program') with `-lF' marks the symbolic link
 itself with a trailing @ (usually the case under Ultrix).
 
 Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
@@ -345,7 +347,7 @@ Optional second argument SWITCHES specifies the `ls' options used.
 \(Interactively, use a prefix argument to be able to specify SWITCHES.)
 Dired displays a list of files in DIRNAME (which may also have
 shell wildcards appended to select certain files).  If DIRNAME is a cons,
-its first element is taken as the directory name and the resr as an explicit
+its first element is taken as the directory name and the rest as an explicit
 list of files to make directory entries for.
 \\<dired-mode-map>\
 You can move around in it with the usual commands.
@@ -384,6 +386,8 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
       (setq dirname dir-or-list))
     (setq dirname (abbreviate-file-name
                   (expand-file-name (directory-file-name dirname))))
+    (if find-file-visit-truename
+       (setq dirname (file-truename dirname)))
     (if (file-directory-p dirname)
        (setq dirname (file-name-as-directory dirname)))
     (if (consp dir-or-list)
@@ -392,7 +396,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
     (dired-internal-noselect dir-or-list switches)))
 
 ;; Separate function from dired-noselect for the sake of dired-vms.el.
-(defun dired-internal-noselect (dir-or-list &optional switches)
+(defun dired-internal-noselect (dir-or-list &optional switches mode)
   ;; If there is an existing dired buffer for DIRNAME, just leave
   ;; buffer as it is (don't even call dired-revert).
   ;; This saves time especially for deep trees or with ange-ftp.
@@ -402,8 +406,13 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
   ;; revert the buffer.
   ;; A pity we can't possibly do "Directory has changed - refresh? "
   ;; like find-file does.
+  ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
+  ;; see there.
   (let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
-        (buffer (dired-find-buffer-nocreate dir-or-list))
+        ;; The following line used to use dir-or-list.
+        ;; That never found an existing buffer, in the case
+        ;; where it is a list.
+        (buffer (dired-find-buffer-nocreate dirname mode))
         ;; note that buffer already is in dired-mode, if found
         (new-buffer-p (not buffer))
         (old-buf (current-buffer)))
@@ -414,20 +423,24 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
          ;; kill-all-local-variables any longer.
          (setq buffer (create-file-buffer (directory-file-name dirname)))))
     (set-buffer buffer)
-    (if (not new-buffer-p)             ; existing buffer ...
-       (if switches                    ; ... but new switches
-           (dired-sort-other switches) ; this calls dired-revert
-         ;; If directory has changed on disk, offer to revert.
-         (if (let ((attributes (file-attributes dirname))
-                   (modtime (visited-file-modtime)))
-               (or (eq modtime 0)
-                   (not (eq (car attributes) t))
-                   (and (= (car (nth 5 attributes)) (car modtime))
-                        (= (nth 1 (nth 5 attributes)) (cdr modtime)))))
-             nil
-           (message
-            (substitute-command-keys
-             "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))
+    (if (not new-buffer-p)     ; existing buffer ...
+       (cond (switches        ; ... but new switches     
+              ;; file list may have changed
+              (if (consp dir-or-list) 
+                  (setq dired-directory dir-or-list))
+              ;; this calls dired-revert
+              (dired-sort-other switches))  
+             ;; If directory has changed on disk, offer to revert.
+             ((if (let ((attributes (file-attributes dirname))
+                        (modtime (visited-file-modtime)))
+                    (or (eq modtime 0)
+                        (not (eq (car attributes) t))
+                        (and (= (car (nth 5 attributes)) (car modtime))
+                             (= (nth 1 (nth 5 attributes)) (cdr modtime)))))
+                  nil
+                (message "%s"
+                         (substitute-command-keys
+                          "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
       ;; Else a new buffer
       (setq default-directory
            (if (file-directory-p dirname)
@@ -435,6 +448,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
              (file-name-directory dirname)))
       (or switches (setq switches dired-listing-switches))
       (dired-mode dirname switches)
+      (if mode (funcall mode))
       ;; default-directory and dired-actual-switches are set now
       ;; (buffer-local), so we can call dired-readin:
       (let ((failed t))
@@ -454,17 +468,21 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
     (set-buffer old-buf)
     buffer))
 
-;; This differs from dired-buffers-for-dir in that it does not consider
-;; subdirs of default-directory and searches for the first match only
-(defun dired-find-buffer-nocreate (dirname)
+(defun dired-find-buffer-nocreate (dirname &optional mode)
+  ;; This differs from dired-buffers-for-dir in that it does not consider
+  ;; subdirs of default-directory and searches for the first match only.
+  ;; Also, the major mode must be MODE.
   (let (found (blist dired-buffers))    ; was (buffer-list)
+    (or mode (setq mode 'dired-mode))
     (while blist
       (if (null (buffer-name (cdr (car blist))))
          (setq blist (cdr blist))
        (save-excursion
          (set-buffer (cdr (car blist)))
-         (if (and (eq major-mode 'dired-mode)
-                  (equal dired-directory dirname))
+         (if (and (eq major-mode mode)
+                  (if (consp dired-directory)
+                      (equal (car dired-directory) dirname)
+                    (equal dired-directory dirname)))
              (setq found (cdr (car blist))
                    blist nil)
            (setq blist (cdr blist))))))
@@ -548,7 +566,19 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
   ;; inset all files listed in the cdr (the car is the passed-in directory
   ;; list).
   (let ((opoint (point))
+       (process-environment (copy-sequence process-environment))
        end)
+    ;; This makes sure that month names come out in English
+    ;; so we can find the start of the file name.
+    ;; But if the user has customized the way of finding the file name,
+    ;; this is not necessary.
+    (if (and (equal dired-move-to-filename-regexp
+                   dired-standard-move-to-filename-regexp)
+            ;; It also isn't necessary if we'd use the C locale anyway.
+            (not (equal (or (getenv "LC_ALL") (getenv "LC_TIME")
+                            (getenv "LANGUAGE") "C")
+                        "C")))
+       (setq process-environment (cons "LC_ALL=C" process-environment)))
     (if (consp dir-or-list)
        ;; In this case, use the file names in the cdr
        ;; exactly as originally given to dired-noselect.
@@ -1085,11 +1115,11 @@ Optional prefix ARG says how many lines to move; default is one line."
   (interactive "p")
   (dired-next-dirline (- arg)))
 
-(defun dired-up-directory ()
+(defun dired-up-directory (&optional other-window)
   "Run dired on parent directory of current directory.
 Find the parent directory either in this buffer or another buffer.
 Creates a buffer if necessary."
-  (interactive)
+  (interactive "P")
   (let* ((dir (dired-current-directory))
         (up (file-name-directory (directory-file-name dir))))
     (or (dired-goto-file (directory-file-name dir))
@@ -1097,8 +1127,9 @@ Creates a buffer if necessary."
        (and (cdr dired-subdir-alist)
             (dired-goto-subdir up))
        (progn
-         (dired 
-up)
+         (if other-window
+             (dired-other-window up)
+           (dired up))
          (dired-goto-file dir)))))
 
 ;; Force `f' rather than `e' in the mode doc:
@@ -1170,15 +1201,13 @@ Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
                         ;; some ls -b don't escape quotes, argh!
                         ;; This is not needed for GNU ls, though.
                         (or (dired-string-replace-match
-                             "\\([^\\]\\)\"" file "\\1\\\\\"")
+                             "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
                             file)
                         "\"")))))
     (if (eq localp 'no-dir)
        file
       (and file (concat (dired-current-directory localp) file)))))
 
-;; Cloning replace-match to work on strings instead of in buffer:
-;; The FIXEDCASE parameter of replace-match is not implemented.
 (defun dired-string-replace-match (regexp string newtext
                                          &optional literal global)
   "Replace first match of REGEXP in STRING with NEWTEXT.
@@ -1186,25 +1215,15 @@ If it does not match, nil is returned instead of the new string.
 Optional arg LITERAL means to take NEWTEXT literally.
 Optional arg GLOBAL means to replace all matches."
   (if global
-        (let ((result "") (start 0) mb me)
-         (while (string-match regexp string start)
-           (setq mb (match-beginning 0)
-                 me (match-end 0)
-                 result (concat result
-                                (substring string start mb)
-                                (if literal
-                                    newtext
-                                  (dired-expand-newtext string newtext)))
-                 start me))
-         (if mb                        ; matched at least once
-             (concat result (substring string start))
-           nil))
-    ;; not GLOBAL
+      (let ((start 0))
+       (while (string-match regexp string start)
+         (let ((from-end (- (length string) (match-end 0))))
+           (setq string (replace-match newtext t literal string))
+           (setq start (- (length string) from-end))))
+         string)
     (if (not (string-match regexp string 0))
        nil
-      (concat (substring string 0 (match-beginning 0))
-             (if literal newtext (dired-expand-newtext string newtext))
-             (substring string (match-end 0))))))
+      (replace-match newtext t literal string))))
 
 (defun dired-make-absolute (file &optional dir)
   ;;"Convert FILE (a pathname relative to DIR) to an absolute pathname."
@@ -1239,6 +1258,10 @@ Optional arg GLOBAL means to replace all matches."
   "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] "
   "Regular expression to match a month abbreviation followed by a number.")
 
+(defconst dired-standard-move-to-filename-regexp
+  "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] "
+  "Regular expression to match a month abbreviation followed by a number.")
+
 ;; Move to first char of filename on this line.
 ;; Returns position (point) or nil if no filename on this line."
 (defun dired-move-to-filename (&optional raise-error eol)
@@ -2009,21 +2032,19 @@ A prefix argument says to unflag those files instead."
   "Flag all backup files (names ending with `~') for deletion.
 With prefix argument, unflag these files."
   (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
+  (let ((dired-marker-char (if unflag-p ?\  dired-del-marker)))
     (dired-mark-if
-     ;; It is less than general to check for ~ here,
+     ;; Don't call backup-file-name-p unless the last character looks like
+     ;; it might be the end of a backup file name.  This isn't very general,
      ;; but it's the only way this runs fast enough.
      (and (save-excursion (end-of-line)
-                         (or
-                          (eq (preceding-char) ?~)
-                          ;; Handle executables in case of -F option.
-                          ;; We need not worry about the other kinds
-                          ;; of markings that -F makes, since they won't
-                          ;; appear on real backup files.
-                          (if (eq (preceding-char) ?*)
-                              (progn
-                                (forward-char -1)
-                                (eq (preceding-char) ?~)))))
+                         ;; Handle executables in case of -F option.
+                         ;; We need not worry about the other kinds
+                         ;; of markings that -F makes, since they won't
+                         ;; appear on real backup files.
+                         (if (eq (preceding-char) ?*)
+                             (forward-char -1))
+                         (eq (preceding-char) ?~))
          (not (looking-at dired-re-dir))
          (let ((fn (dired-get-filename t t)))
            (if fn (backup-file-name-p fn))))
@@ -2211,7 +2232,7 @@ With a prefix argument you can edit the current listing switches instead."
   ;; minor mode accordingly, others appear literally in the mode line.
   ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
   (setq dired-actual-switches switches)
-  (dired-sort-set-modeline)
+  (if (eq major-mode 'dired-mode) (dired-sort-set-modeline))
   (or no-revert (revert-buffer)))
 \f
 ;; To make this file smaller, the less common commands