🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.bug
Article #98892

dired enhancements

#98892
From: jonathan
Date: Mon, 28 Jan 1991 18:58
174 lines
7157 bytes
Here is a much more thoroughly debugged set of enhancements to dired.
You may add them (or some derivative thereof) to the distribution if
you wish.

To summarize the changes:

1) Fix dired-get-filename to work with ls -F and make that the default.

2) Added dired-toggle-sort which toggles use of the ls -t option.

3) Have all commands leave with the point positioned at the filename.

(load-library "dired")

;;; dired-mkdir

(defun mkdir (directory)
  "Make a directory relative to the current directory."
  (interactive "FDirectory to create: ")
  (shell-command (concat "mkdir " directory)))

(defun dired-mkdir (directory)
  "Make a directory relative to the current directory."
  (interactive "FDirectory to create: ")
  (mkdir directory)
  (revert-buffer))

(define-key dired-mode-map "" 'dired-mkdir)
(define-key dired-mode-map "" 'dired-mkdir)

;;; Fix dired-get-filename to work with ls -F

(defvar dired-listing-switches "-algF" "\
*Switches passed to ls for Dired.  MUST contain the `l' option.
MUST NOT contain the `s' or `i' options.")
(make-variable-buffer-local 'dired-listing-switches)
(setq-default dired-listing-switches "-algF")

(fset 'dired-simple-get-filename (symbol-function 'dired-get-filename))

(defun dired-get-filename (&optional localp no-error-if-not-filep)
  "Call \\[dired-simple-get-filename].
Then, if dired-listing-switches contains the F flag,
fix up the filename by getting rid of the extra character."
  (let ((filename (dired-simple-get-filename localp no-error-if-not-filep))
	eol)
    (if (and (string-match "F" dired-listing-switches)
	     (save-excursion
	       (end-of-line)
	       (setq eol (point))
	       (beginning-of-line)
	       (re-search-forward
		"^. \\([ds]\\|\\-..x\\|\\-.....x\\|\\-........x\\)"
		eol t)))
	(substring filename 0 (1- (length filename)))
      filename)))

;;; Can no longer depend on finding ~ at the end of the line; look for
;;; it at the end of the filename.

(defun dired-flag-backup-files ()
  "Flag all backup files (names ending with ~) for deletion."
  (interactive)
  (save-excursion
   (let ((buffer-read-only nil))
     (goto-char (point-min))
     (while (not (eobp))
       (and (not (looking-at "  d"))
	    (not (eolp))
	    (let ((fn (dired-get-filename t t)))
	      (if fn
		  (if (fboundp 'backup-file-name-p)
		      (backup-file-name-p fn)
		    (string-match "~$" fn))))
	    (progn (delete-char 1)
		   (insert "D")))
       (forward-line 1)))))

;;; dired-toggle-sort

(define-key dired-mode-map "t" 'dired-toggle-sort)

(defun dired-toggle-sort ()
  "Make the dired-listing-switches variable local to the current buffer.
Then, if it contains the t flag, remove it, if not add it."
  (interactive)
  (let ((t-flag (string-match "t" dired-listing-switches)))
    (setq dired-listing-switches
	  (if t-flag (concat (substring dired-listing-switches 0 t-flag)
			     (substring dired-listing-switches (1+ t-flag)))
	    (concat dired-listing-switches "t"))))
  (revert-buffer))

;;; Finish with dired-move-to-filename, instead of beginning-of-line.

(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))
    (dired-move-to-filename)))

;;; The problem with dired-mode is that it called
;;; kill-all-local-variables.  That's makes it difficult to support
;;; per buffer state.  I don't think any major mode should do that.

(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.
Type t to toggle whether the listing is sorted by modification date.
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)
  (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))

;;; Don't try to do file-name-nondirectory on the filename in the
;;; buffer, just call ls without a full pathname, so it doesn't have
;;; to be fixed up.
;;; Leave the point the beginning of the filename; not the
;;; beginning-of-line.

(defun dired-add-entry (directory filename)
  ;; If tree dired is implemented, this function will have to do
  ;; something smarter with the directory.  Currently, just check
  ;; default directory, if same, add the new entry at point.  With tree
  ;; dired, should call 'dired-current-directory' or similar.  Note
  ;; that this adds the entry 'out of order' if files sorted by time,
  ;; etc.
  (if (string-equal directory default-directory)
      (let ((buffer-read-only nil))
	(beginning-of-line)
	(call-process "ls" nil t nil
		      "-d" dired-listing-switches filename)
	(forward-line -1)
	(insert "  ")
	(dired-move-to-filename))))
Technical Details
Message-ID: <9101281858.AA24774@transylvania.ksr.com>
Path: arc1-ca.pugleaf.net!gmdzi!unido!fauern!ira.uka.de!sol.ctr.columbia.edu!zaphod.mps.ohio-state.edu!magnus.ircc.ohio-state.edu!tut.cis.ohio-state.edu!ksr.com!jonathan
References: <9101172231.AA26520@transylvania.ksr.com>

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: fb2f1,422eac631ef8f73e
X-Google-Attributes: gidfb2f1,public
X-Google-ArrivalTime: 1991-01-28 10:58:40 PST
Path: arc1-ca.pugleaf.net!gmdzi!unido!fauern!ira.uka.de!sol.ctr.columbia.edu!zaphod.mps.ohio-state.edu!magnus.ircc.ohio-state.edu!tut.cis.ohio-state.edu!ksr.com!jonathan
From: jonathan@ksr.com
Newsgroups: gnu.emacs.bug
Subject: dired enhancements
Message-ID: <9101281858.AA24774@transylvania.ksr.com>
Date: 28 Jan 91 18:58:40 GMT
References: <9101172231.AA26520@transylvania.ksr.com>
Sender: daemon@tut.cis.ohio-state.edu
Distribution: gnu
Organization: GNUs Not Usenet
Lines: 174
Approved: bug-gnu-emacs@prep.ai.mit.edu