--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/dired/dired-nstd.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,438 @@
+;;; -*- Mode:Emacs-Lisp -*-
+;;; Jamie Zawinski <jwz@lucid.com> 7-may-91
+;;;
+;;; This makes dired buffers which display multiple directories display
+;;; them in a tree rather than in an "ls -R"-like format.  Which, as every
+;;; Lisp Machine hacker knows, is the Right Thing!
+;;;
+;;;   -rw-r--r--  1 jwz         31543 Mar 26 03:20 reportmail.el
+;;;   -rw-r--r--  1 jwz         14919 Mar 26 03:20 reportmail.elc
+;;;   drwxr-xr-x  2 jwz          1024 Apr  5 13:08 sk-dired/
+;;;     -rw-r--r--  1 jwz          3258 Mar  6 06:33 ange-ftp-dired.el
+;;;     -rw-r--r--  1 jwz          1750 Mar 12 15:04 ange-ftp-dired.elc
+;;;   -rw-r--r--  1 jwz          3151 Mar 29 00:01 symbol-syntax.el
+;;;   -rw-r--r--  1 jwz          1504 Mar 29 01:01 symbol-syntax.elc
+
+;;; This program 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 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program 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.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to the above address) or from
+;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(defconst dired-subdir-alist nil
+  "Association list of subdirectories and their buffer positions:
+
+  ((LASTDIR STARTMARKER ENDMARKER NESTING-DEPTH)
+   ...
+   (DEFAULT-DIRECTORY POINTMIN POINTMAX 0)).
+"
+;;The markers point right at the end of the line, so that the cursor
+;;looks at either \\n or \\r, the latter for a hidden subdir.
+;; The directories must be file-name-as-directory, of course.
+)
+
+(defun dired-simple-subdir-alist ()
+  ;; Build and return `dired-subdir-alist' assuming just the top level
+  ;; directory to be inserted.  Don't parse the buffer.
+  (set (make-local-variable 'dired-subdir-alist)
+       (list (list default-directory
+		   (point-min-marker) (point-max-marker) 0))))
+
+(define-key dired-mode-map "i" 'dired-insert-subdir-inline)
+(define-key dired-mode-map "j" 'dired-maybe-insert-subdir)
+
+;;; ## these should be macros when this is integrated with the distribution.
+(defun dired-get-subdir-min (elt) (nth 1 elt))
+(defun dired-get-subdir-max (elt) (nth 2 elt))
+
+(defun dired-subdir-min ()
+  (let ((d (dired-current-directory))
+	c)
+    (if (setq c (assoc d dired-subdir-alist))
+	(marker-position (dired-get-subdir-min c))
+      (error "not in a subdir!"))))
+
+(defun dired-subdir-max ()
+  (let ((d (dired-current-directory))
+	c)
+    (if (setq c (assoc d dired-subdir-alist))
+	(marker-position (dired-get-subdir-max c))
+	(point-max))))
+
+(defun dired-clear-alist ()
+  (while dired-subdir-alist
+    (let ((elt (car dired-subdir-alist)))
+      (set-marker (nth 1 elt) nil)
+      (set-marker (nth 2 elt) nil))
+    (setq dired-subdir-alist (cdr dired-subdir-alist))))
+
+(defun dired-unsubdir (dir)
+  ;; Remove DIR from the alist.
+  ;; also remove any directories which are inside of it.
+  (let* ((elt (assoc dir dired-subdir-alist))
+	 (min (nth 1 elt))
+	 (max (nth 2 elt))
+	 other-elt
+	 (rest dired-subdir-alist))
+    (while rest
+      (setq other-elt (car rest))
+      (if (and (<= min (nth 1 other-elt))
+	       (>= max (nth 2 other-elt)))
+	  (setq dired-subdir-alist (delq other-elt dired-subdir-alist)))
+      (setq rest (cdr rest)))))
+
+;;; this needs to be changed to grok indentation.  Or not. -jwz
+;;; Probably not, as dired-revert either starts with one dir and inserting
+;;; then enlarges the alist automatically, or it inserts all dirs with
+;;; one "ls -lR". -sk
+(defun dired-build-subdir-alist ()
+  "Build dired-subdir-alist by parsing the buffer and return it's new value."
+  (interactive)
+  (dired-clear-alist)
+  (save-excursion
+    (let ((count 0))
+      (goto-char (point-min))
+      (setq dired-subdir-alist nil)
+      (while (re-search-forward dired-subdir-regexp nil t)
+	(setq count (1+ count))
+	(dired-alist-add (buffer-substring (match-beginning 1)
+					   (match-end 1))
+			 ;; Put subdir boundary between lines:
+			 (save-excursion
+			   (goto-char (match-beginning 0))
+			   (beginning-of-line)
+			   (point-marker))
+			 ;; isn't this wrong when already more than one
+			 ;; subdir is present with -lR?
+			 ;; maybe.  I don't know.   But we can't call
+			 ;; dired-subdir-max here, it loops.  -jwz.
+			 (point-max-marker)
+			 0)
+	(message "%d" count))
+      (message "%d director%s." count (if (= 1 count) "y" "ies"))
+      ;; return new alist:
+      dired-subdir-alist)))
+
+(defun dired-alist-add (dir start-marker end-marker indentation-depth)
+  ;; indentation-depth may be 0 for more than one directory -- this happens
+  ;; when "ls -R" format is used.
+  ;; ## debugging code
+  (or start-marker (error "start marker nil"))
+  (or end-marker (error "end marker nil"))
+  ;;(or (/= start-marker end-marker) (error "markers are the same"))
+  (let ((old (assoc dir dired-subdir-alist)))
+    (setq dired-subdir-alist
+	  (cons (list (dired-normalize-subdir dir)
+		      start-marker end-marker
+		      (or indentation-depth 0))
+		(delq old dired-subdir-alist)))
+    (dired-alist-sort)))
+
+;; can't see at the moment how this could work with a mixed format
+;; alist -sk
+(defun dired-current-directory (&optional relative)
+  "Get the subdirectory to which this line belongs.
+This returns a string with trailing slash, like default-directory.
+Optional argument means return a name relative to default-directory."
+  (let (elt
+	(here (point))
+	(alist (or dired-subdir-alist (dired-build-subdir-alist)))
+	best-so-far)
+    (while alist
+      (setq elt (car alist))
+      (if (or (< here (nth 1 elt))
+	      (> here (nth 2 elt)))
+	  nil ;; the subdir is disjoint
+	;; otherwise it's on the path between the current file and the root.
+	;; decide if it's deeper than what we've already got.
+	(if (or (null best-so-far)
+		(< (- (nth 2 elt) (nth 1 elt))
+		   (- (nth 2 best-so-far) (nth 1 best-so-far))))
+	    (setq best-so-far elt)))
+      (setq alist (cdr alist)))
+    (if best-so-far
+	(if relative
+	    (dired-make-relative (car best-so-far) default-directory)
+	  (car best-so-far))
+      (progn
+	(dired-build-subdir-alist)
+	(dired-current-directory relative)))))
+
+(defun dired-insert-subdir-del (element)
+  ;; Erase an already present subdir (given by ELEMENT) from buffer.
+  ;; Move to that buffer position.  Return a mark-alist.
+  (let ((begin-marker (dired-get-subdir-min element))
+	(end-marker (dired-get-subdir-max element)))
+    (goto-char end-marker)
+    (or (eobp)
+	(not (= 0 (nth 3 element)))
+	;; for -R style, want a separating newline _between_ subdirs.
+	(forward-char -1))
+    (if (= 0 (nth 3 element))
+	(insert "\n\n"))
+    (prog1
+	(dired-remember-marks begin-marker (point))
+      (delete-region begin-marker (point)))))
+
+
+(defun dired-insert-subdir-doupdate (dirname elt beg-end)
+  (let ((beg (nth 0 beg-end))
+	(end (nth 1 beg-end))
+	(indent (or (nth 2 beg-end) 0)))
+    (if (and elt
+	     (not (eq indent (nth 2 elt))))
+	(setq elt nil
+	      dired-subdir-alist (delq elt dired-subdir-alist)))
+    (if elt
+	(let ((old-start (nth 1 elt))
+	      (old-end   (nth 2 elt)))
+	  (set-marker old-start beg)
+	  (set-marker old-end end)
+	  (setcar (nthcdr 3 elt) indent))
+      (dired-alist-add dirname
+		       (set-marker (make-marker) beg)
+		       (set-marker (make-marker) end)
+		       indent))))
+
+(defun dired-insert-subdir-inline (dirname &optional switches no-error-if-not-dir-p)
+  "Insert this subdirectory into the same dired buffer.
+If it is already present, overwrites previous entry,
+  else inserts it, indented, within its parent's listing.
+With a prefix arg, you may edit the ls switches used for this listing.
+  This command ignores the `R' switch."
+  ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
+  ;; Prospero where dired-ls does the right thing, but
+  ;; file-directory-p has not been redefined.
+  (interactive
+   (list (dired-get-filename)
+	 (if current-prefix-arg
+	     (read-string "Switches for listing: " dired-actual-switches))))
+  (setq dirname (file-name-as-directory (expand-file-name dirname)))
+  (if (let ((case-fold-search nil))
+	(string-match "R" (or switches "")))
+      (setq switches (concat (substring switches 0 (match-beginning 0))
+			     (substring switches (match-end 0)))))
+  (dired-make-relative dirname default-directory) ; error on failure
+  (or no-error-if-not-dir-p
+      (file-directory-p dirname)
+      (error  "Attempt to insert a non-directory: %s" dirname))
+  (let ((elt (assoc dirname dired-subdir-alist))
+	(parentdir (file-name-directory (directory-file-name dirname)))
+	beg end old-start old-end new-start new-end
+	mark-alist
+	tail-adjascents
+	buffer-read-only case-fold-search)
+    (if elt
+	;; subdir is already present - must first erase it from buffer.
+	;; if it's already in -R format, pretend it wasn't there, but
+	;; remember its file marks.
+	(progn
+	  (setq mark-alist
+		(append (dired-insert-subdir-del elt) mark-alist))
+	  (setq dired-subdir-alist
+		(delq elt dired-subdir-alist))))
+    ;;(dired-insert-subdir-newpos) ;##
+    (dired-goto-file dirname)
+    (forward-line 1)
+    (dired-insert-subdir-doupdate
+     dirname elt (dired-insert-subdir-inline-doinsert dirname switches parentdir))
+    (dired-initial-position dirname)
+    (save-excursion (dired-mark-remembered mark-alist)))
+  (dired-nuke-extra-newlines)
+  )
+
+
+(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
+  "Insert this subdirectory into the same dired buffer.
+If it is already present, overwrites previous entry,
+  else appends at end of buffer.
+With a prefix arg, you may edit the ls switches used for this listing.
+  You can add `R' to the switches to expand the whole tree starting at
+  this subdirectory.
+This function takes some pains to conform to ls -lR output."
+  ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
+  ;; Prospero where dired-ls does the right thing, but
+  ;; file-directory-p has not been redefined.
+  (interactive
+   (list (dired-get-filename)
+	 (if current-prefix-arg
+	     (read-string "Switches for listing: " dired-actual-switches))))
+  (setq dirname (file-name-as-directory (expand-file-name dirname)))
+  (dired-make-relative dirname default-directory) ; error on failure
+  (or no-error-if-not-dir-p
+      (file-directory-p dirname)
+      (error  "Attempt to insert a non-directory: %s" dirname))
+  (let ((elt (assoc dirname dired-subdir-alist))
+	(switches-have-R (and switches (string-match "R" switches)))
+	mark-alist
+	buffer-read-only case-fold-search)
+    (if switches-have-R			; avoid double subdirs
+	(setq mark-alist (dired-kill-tree dirname t)))
+    (let ((was-nested (and (nth 3 elt) (not (eq 0 (nth 3 elt))))))
+      (if elt				; subdir is already present
+	  (setq mark-alist		; remove it, remembering marks
+		(append (dired-insert-subdir-del elt) mark-alist)))
+      (if (or was-nested (null elt))
+	  (dired-insert-subdir-newpos dirname))
+      (if was-nested (setcar (nthcdr 3 elt) 0)))
+    (dired-insert-subdir-doupdate
+     dirname elt (dired-insert-subdir-doinsert dirname switches))
+    (if switches-have-R (dired-build-subdir-alist))
+    (dired-initial-position dirname)
+    (save-excursion (dired-mark-remembered mark-alist)))
+  (dired-nuke-extra-newlines))
+
+(defun dired-nuke-extra-newlines ()
+  (let ((buffer-read-only nil))
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward "\n\n\n+" nil t)
+	(goto-char (+ 2 (match-beginning 0)))
+	(delete-region (point) (match-end 0))))))
+
+
+(defun dired-insert-subdir-newpos (new-dir)
+  ;; Find pos for new subdir, according to tree order.
+  ;;(goto-char (point-max))
+  (let ((alist dired-subdir-alist) elt dir pos new-pos)
+    (while alist
+      (setq elt (car alist)
+	    alist (cdr alist)
+	    dir (car elt)
+	    pos (dired-get-subdir-min elt))
+      (if (and (= 0 (nth 3 elt)) ; nested ones don't count.
+	       (dired-tree-lessp dir new-dir))
+	  ;; Insert NEW-DIR after DIR
+	  (setq new-pos (dired-get-subdir-max elt)
+		alist nil)))
+    (goto-char new-pos))
+  ;; want a separating newline between subdirs
+  (insert "\n\n")
+  (point))
+
+
+(defvar dired-no-inline-headerlines t
+  "*set this to t to suppress the directory header and `total' line.")
+
+
+(defun dired-insert-subdir-inline-doinsert (dirname switches parentdir)
+  ;; Insert ls output after point and put point on the correct
+  ;; position for the subdir alist.
+  ;; returns the dired-subdir-alist entry.
+  (let ((begin (point)) end
+	indent
+	tail-adjascents)
+    (message "Reading directory %s..." dirname)
+    (dired-ls dirname
+	      (or switches
+		  (dired-replace-in-string "R" "" dired-actual-switches))
+	      nil t)
+    (message "Reading directory %s...done" dirname)
+    (setq end (point))
+    (setq indent (1+ (nth 3 (assoc parentdir dired-subdir-alist))))
+
+    (save-excursion
+      (goto-char begin)
+      (or dired-no-inline-headerlines
+	  (progn
+	    (dired-insert-headerline dirname)
+	    (save-excursion (delete-horizontal-space)))
+	  (goto-char begin)
+	  (delete-horizontal-space))
+      (if (and dired-no-inline-headerlines
+	       (looking-at "^ *total [0-9]"))
+	  (progn
+	    (delete-region (point) (progn (forward-line 1) (point)))
+	    (setq begin (point)))))
+    ;;
+    ;; If there are other directories whose end-point is right here,
+    ;; then they are the directories such that X is the last directory
+    ;; in the listing of Y.  We need to grab them and update their
+    ;; last-point to be the same as ours will be (goofy margin-case).
+    ;;
+    (let ((rest dired-subdir-alist))
+      (while rest
+	(if (= (point) (nth 2 (car rest)))
+	    (setq tail-adjascents (cons (car rest) tail-adjascents)))
+	(setq rest (cdr rest))))
+    (let ((indent-tabs-mode nil))
+      (indent-rigidly begin (point) (* 2 (1+ indent))))
+    (setq end (point-marker))
+    (goto-char begin)
+    (while tail-adjascents
+      (set-marker (nth 2 (car tail-adjascents)) end)
+      (setq tail-adjascents (cdr tail-adjascents)))
+    (if dired-after-readin-hook
+	(save-restriction
+	  (narrow-to-region begin end)
+	  (run-hooks 'dired-after-readin-hook)))
+    ;;  call dired-insert-headerline afterwards, as under VMS dired-ls
+    ;;  does insert the headerline itself and the insert function just
+    ;;  moves point.
+    (setq end (prog1 (marker-position end) (set-marker end nil)))
+    (goto-char begin)
+    (list begin end indent)))
+
+
+(defun dired-insert-subdir-doinsert (dirname switches)
+  ;; Insert ls output after point and put point on the correct
+  ;; position for the subdir alist.
+  ;; Return the boundary of the inserted text (as list of BEG and END).
+  (let ((begin (point)) end)
+    (message "Reading directory %s..." dirname)
+    (dired-ls dirname
+	      (or switches
+		  (dired-replace-in-string "R" "" dired-actual-switches))
+	      nil t)
+    (message "Reading directory %s...done" dirname)
+    (insert "\n\n")
+    (setq end (point-marker))
+    (indent-rigidly begin (point) 2)
+    (if dired-after-readin-hook
+	(save-restriction
+	  (narrow-to-region begin (point))
+	  (run-hooks 'dired-after-readin-hook)))
+    ;;  call dired-insert-headerline afterwards, as under VMS dired-ls
+    ;;  does insert the headerline itself and the insert function just
+    ;;  moves point.
+    (goto-char begin)
+    (dired-insert-headerline dirname)
+    ;; point is now like in dired-build-subdir-alist
+    (setq end (prog1 (marker-position end) (set-marker end nil)))
+    (list begin end)))
+
+
+(defun dired-insert-old-subdirs (old-subdir-alist)
+  ;; Try to insert all subdirs that were displayed before
+  (or (string-match "R" dired-actual-switches)
+      (let (elt dir)
+	(setq old-subdir-alist (sort old-subdir-alist
+				     (function (lambda (x y)
+				       (< (nth 3 x) (nth 3 y))))))
+	(while old-subdir-alist
+	  (setq elt (car old-subdir-alist)
+		old-subdir-alist (cdr old-subdir-alist)
+		dir (car elt))
+	  (condition-case ()
+	      (if (= 0 (nth 3 elt))
+		  (dired-insert-subdir dir)
+		  (dired-insert-subdir-inline dir))
+	    (error nil))))))
+
+(defun dired-add-entry-do-indentation (marker-char)
+  ;; two spaces or a marker plus a space, plus nesting indentation.
+  ;; Uses fluid vars `directory', `marker-char' from dired-add-entry
+  (insert (if marker-char
+	      (if (integerp marker-char) marker-char dired-marker-char)
+	    ?\040)
+	  ?\040)
+  (let ((indent (nth 3 (assoc directory dired-subdir-alist))))
+    (insert (make-string (* 2 indent) ?\040))))