dired.el

早期freebsd实现

;;; Missing: P command, sorting, setting file modes.
;;; Dired buffer containing multiple directories gets totally confused
;;; Implement insertion of subdirectories in situ --- tree dired

;; DIRED commands for Emacs
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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.


;In loaddefs.el
;(defvar dired-listing-switches "-al"
;  "Switches passed to ls for dired. MUST contain the 'l' option.
;CANNOT contain the 'F' option.")

(defun dired-readin (dirname buffer)
  (save-excursion
    (message "Reading directory %s..." dirname)
    (set-buffer buffer)
    (let ((buffer-read-only nil))
      (widen)
      (erase-buffer)
      (setq dirname (expand-file-name dirname))
      (if (file-directory-p dirname)
	  (call-process "ls" nil buffer nil
			dired-listing-switches dirname)
	(let ((default-directory (file-name-directory dirname)))
	  (call-process shell-file-name nil buffer nil
			"-c" (concat "ls " dired-listing-switches " "
				     (file-name-nondirectory dirname)))))
      (goto-char (point-min))
      (while (not (eobp))
	(insert "  ")
	(forward-line 1))
      (goto-char (point-min)))
    (message "Reading directory %s...done" dirname)))

(defun dired-find-buffer (dirname)
  (let ((blist (buffer-list))
	found)
    (while blist
      (save-excursion
        (set-buffer (car blist))
	(if (and (eq major-mode 'dired-mode)
		 (equal dired-directory dirname))
	    (setq found (car blist)
		  blist nil)
	  (setq blist (cdr blist)))))
    (or found
	(create-file-buffer (directory-file-name dirname)))))

(defun dired (dirname)
  "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
Dired displays a list of files in DIRNAME.
You can move around in it with the usual commands.
You can flag files for deletion with C-d
and then delete them by typing `x'.
Type `h' after entering dired for more info."
  (interactive (list (read-file-name "Dired (directory): "
				     nil default-directory nil)))
  (switch-to-buffer (dired-noselect dirname)))

(defun dired-other-window (dirname)
  "\"Edit\" directory DIRNAME.  Like M-x dired but selects in another window."
  (interactive (list (read-file-name "Dired in other window (directory): "
				     nil default-directory nil)))
  (switch-to-buffer-other-window (dired-noselect dirname)))

(defun dired-noselect (dirname)
  "Like M-x dired but returns the dired buffer as value, does not select it."
  (or dirname (setq dirname default-directory))
  (setq dirname (expand-file-name (directory-file-name dirname)))
  (if (file-directory-p dirname)
      (setq dirname (file-name-as-directory dirname)))
  (let ((buffer (dired-find-buffer dirname)))
    (save-excursion
      (set-buffer buffer)
      (dired-readin dirname buffer)
      (dired-move-to-filename)
      (dired-mode dirname))
    buffer))

(defun dired-revert (&optional arg noconfirm)
  (let ((opoint (point))
	(ofile (dired-get-filename t t))
	(buffer-read-only nil))
    (erase-buffer)
    (dired-readin dired-directory (current-buffer))
    (or (and ofile (re-search-forward (concat " " (regexp-quote ofile) "$")
				      nil t))
	(goto-char opoint))
    (beginning-of-line)))

(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
(if dired-mode-map
    nil
  (setq dired-mode-map (make-keymap))
  (suppress-keymap dired-mode-map)
  (define-key dired-mode-map "r" 'dired-rename-file)
  (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted)
  (define-key dired-mode-map "d" 'dired-flag-file-deleted)
  (define-key dired-mode-map "v" 'dired-view-file)
  (define-key dired-mode-map "e" 'dired-find-file)
  (define-key dired-mode-map "f" 'dired-find-file)
  (define-key dired-mode-map "o" 'dired-find-file-other-window)
  (define-key dired-mode-map "u" 'dired-unflag)
  (define-key dired-mode-map "x" 'dired-do-deletions)
  (define-key dired-mode-map "\177" 'dired-backup-unflag)
  (define-key dired-mode-map "?" 'dired-summary)
  (define-key dired-mode-map "c" 'dired-copy-file)
  (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
  (define-key dired-mode-map "~" 'dired-flag-backup-files)
  (define-key dired-mode-map "." 'dired-clean-directory)
  (define-key dired-mode-map "h" 'describe-mode)
  (define-key dired-mode-map " "  'dired-next-line)
  (define-key dired-mode-map "\C-n" 'dired-next-line)
  (define-key dired-mode-map "\C-p" 'dired-previous-line)
  (define-key dired-mode-map "n" 'dired-next-line)
  (define-key dired-mode-map "p" 'dired-previous-line)
  (define-key dired-mode-map "g" 'revert-buffer)
  (define-key dired-mode-map "C" 'dired-compress)
  (define-key dired-mode-map "U" 'dired-uncompress)
  (define-key dired-mode-map "B" 'dired-byte-recompile)
  (define-key dired-mode-map "M" 'dired-chmod)
  (define-key dired-mode-map "G" 'dired-chgrp)
  (define-key dired-mode-map "O" 'dired-chown))


;; Dired mode is suitable only for specially formatted data.
(put 'dired-mode 'mode-class 'special)

(defun dired-mode (&optional dirname)
  "Mode for \"editing\" directory listings.
In dired, you are \"editing\" a list of the files in a directory.
You can move using the usual cursor motion commands.
Letters no longer insert themselves.
Instead, type d to flag a file for Deletion.
Type u to Unflag a file (remove its D flag).
  Type Rubout to back up one line and unflag.
Type x to eXecute the deletions requested.
Type f to Find the current line's file
  (or Dired it, if it is a directory).
Type o to find file or dired directory in Other window.
Type # to flag temporary files (names beginning with #) for Deletion.
Type ~ to flag backup files (names ending with ~) for Deletion.
Type . to flag numerical backups for Deletion.
  (Spares dired-kept-versions or its numeric argument.)
Type r to rename a file.
Type c to copy a file.
Type v to view a file in View mode, returning to Dired when done.
Type g to read the directory again.  This discards all deletion-flags.
Space and Rubout can be used to move down and up by lines.
Also: C -- compress this file.  U -- uncompress this file.
      B -- byte compile this file.
 M, G, O -- change file's mode, group or owner.
\\{dired-mode-map}"
  (interactive)
  (kill-all-local-variables)    
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'dired-revert)
  (setq major-mode 'dired-mode)
  (setq mode-name "Dired")
  (make-local-variable 'dired-directory)
  (setq dired-directory (or dirname default-directory))
  (if dirname
      (setq default-directory 
	    (if (file-directory-p dirname)
		dirname (file-name-directory dirname))))
  (setq mode-line-buffer-identification '("Dired: %17b"))
  (setq case-fold-search nil)
  (setq buffer-read-only t)
  (use-local-map dired-mode-map)
  (run-hooks 'dired-mode-hook))

(defun dired-repeat-over-lines (arg function)
  (beginning-of-line)
  (while (and (> arg 0) (not (eobp)))
    (setq arg (1- arg))
    (save-excursion
      (beginning-of-line)
      (and (bobp) (looking-at "  total")
	   (error "No file on this line"))
      (funcall function))
    (forward-line 1)
    (dired-move-to-filename))
  (while (and (< arg 0) (not (bobp)))
    (setq arg (1+ arg))
    (forward-line -1)
    (dired-move-to-filename)
    (save-excursion
      (beginning-of-line)
      (funcall function))))

(defun dired-flag-file-deleted (arg)
  "In dired, flag the current line's file for deletion.
With arg, repeat over several lines."
  (interactive "p")
  (dired-repeat-over-lines arg
    '(lambda ()
       (let ((buffer-read-only nil))
	 (delete-char 1)
	 (insert "D")))))

(defun dired-summary ()
  (interactive)
  ;>> this should check the key-bindings and use substitute-command-keys if non-standard
  (message
   "d-elete, u-ndelete, x-ecute, f-ind, o-ther window, r-ename, c-opy, v-iew"))

(defun dired-unflag (arg)
  "In dired, remove the current line's delete flag then move to next line."
  (interactive "p")
  (dired-repeat-over-lines arg
    '(lambda ()
       (let ((buffer-read-only nil))
	 (delete-char 1)
	 (insert " ")
	 (forward-char -1)))))

(defun dired-backup-unflag (arg)
  "In dired, move up a line and remove deletion flag there."
  (interactive "p")
  (dired-unflag (- arg)))

(defun dired-next-line (arg)
  "Move down ARG lines then position at filename."
  (interactive "p")
  (next-line arg)
  (dired-move-to-filename))

(defun dired-previous-line (arg)
  "Move up ARG lines then position at filename."
  (interactive "p")
  (previous-line arg)
  (dired-move-to-filename))

(defun dired-find-file ()
  "In dired, visit the file or directory named on this line."
  (interactive)
  (find-file (dired-get-filename)))

(defun dired-view-file ()
  "In dired, examine a file in view mode, returning to dired when done."
  (interactive)
  (if (file-directory-p (dired-get-filename))
      (dired (dired-get-filename))
    (view-file (dired-get-filename))))
	    
(defun dired-find-file-other-window ()
  "In dired, visit this file or directory in another window."
  (interactive)
  (find-file-other-window (dired-get-filename)))

(defun dired-get-filename (&optional localp no-error-if-not-filep)
  "In dired, return name of file mentioned on this line.
Value returned normally includes the directory name.
A non-nil 1st argument means do not include it.  A non-nil 2nd argument
says return nil if no filename on this line, otherwise an error occurs."
  (let (eol)
    (save-excursion
      (end-of-line)
      (setq eol (point))
      (beginning-of-line)
      (if (re-search-forward
	   "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
	   eol t)
	  (progn (skip-chars-forward " ")
		 (skip-chars-forward "^ " eol)
		 (skip-chars-forward " " eol)
		 (let ((beg (point)))
		   (skip-chars-forward "^ \n")
		   (if localp
		       (buffer-substring beg (point))
		     ;; >> uses default-directory, could lose on cd, multiple.
		     (concat default-directory (buffer-substring beg (point))))))
	(if no-error-if-not-filep nil
	  (error "No file on this line"))))))

(defun dired-move-to-filename ()
  "In dired, move to first char of filename on this line.
Returns position (point) or nil if no filename on this line."
  (let ((eol (progn (end-of-line) (point))))
    (beginning-of-line)
    (if (re-search-forward
	 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
	 eol t)
	(progn
	  (skip-chars-forward " ")
	  (skip-chars-forward "^ " eol)
	  (skip-chars-forward " " eol)
	  (point)))))

(defun dired-map-dired-file-lines (fn)
  "perform fn with point at the end of each non-directory line:
arguments are the short and long filename"
  (save-excursion
    (let (filename longfilename (buffer-read-only nil))
      (goto-char (point-min))
      (while (not (eobp))
	(save-excursion
	  (and (not (looking-at "  d"))