🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.bug
Article #87469

19.27: dired-find-subdir, expand dir bug.

#87469
From: Lawrence R. Dodd
Date: Fri, 16 Sep 1994 15:21
367 lines
15399 bytes
GNU Emacs 19.27.1 (sparc-sun-sunos4.1.2) of Thu Sep 15 1994 on roebling

Doing this

 emacs -q
 (require 'dired-x)
 (setq dired-find-subdir t)
 (dired "~/")
 (dired "~/")

causes the dired buffer `~/<2>' to be formed where dired buffer `~/'
should be used.  Here are patches, basically from Michael Ernst,
that need to be applied to dired.el, dired-aux.el, and dired-x.el in
order to fix this problem.

Fri Sep 16 08:14:27 1994  Michael Ernst  <mernst@theory.lcs.mit.edu>
			  Lawrence R. Dodd  <dodd@roebling.poly.edu>

	* dired.el, dired-aux.el, dired-x.el: Make directories in
	dired-buffers and dired-subdir-alist be expanded; adjust calls
	accordingly.

	* dired.el (dired-subdir-alist, dired-buffers): Doc mod.
	(dired-buffers-for-dir): Check first if dired buffer exists.
	(dired-advertise): Use expanded default-directory.
	(dired-unadvertise): Expand DIR.
	(dired-in-this-tree): Do not expand DIR.

	* dired-aux.el (dired-fun-in-all-buffers): Expand DIRECTORY.
	(dired-rename-subdir): Use expanded FROM-DIR.
	(dired-rename-subdir-1): Use expanded DIR.
	(dired-kill-tree): Expand DIRNAME.

	* dired-x.el: (dired-find-buffer-nocreate,
	dired-clean-up-after-deletion): Expand arg to
	dired-buffers-for-dir.

*** dired.el-orig	Sat Aug  6 14:36:26 1994
--- dired.el	Fri Sep 16 08:50:39 1994
***************
*** 188,195 ****
  (defvar dired-re-perms "-[-r][-w].[-r][-w].[-r][-w].")
  (defvar dired-re-dot "^.* \\.\\.?$")
  
  (defvar dired-subdir-alist nil
!   "Association list of subdirectories and their buffer positions.
  Each subdirectory has an element: (DIRNAME . STARTMARKER).
  The order of elements is the reverse of the order in the buffer.
  In simple cases, this list contains one element.")
--- 188,196 ----
  (defvar dired-re-perms "-[-r][-w].[-r][-w].[-r][-w].")
  (defvar dired-re-dot "^.* \\.\\.?$")
  
+ ;; The subdirectory names in this list are expanded.
  (defvar dired-subdir-alist nil
!   "Association list of expanded subdirectories and their buffer positions.
  Each subdirectory has an element: (DIRNAME . STARTMARKER).
  The order of elements is the reverse of the order in the buffer.
  In simple cases, this list contains one element.")
***************
*** 1250,1256 ****
    ;; Enlarged by dired-advertise
    ;; Queried by function dired-buffers-for-dir. When this detects a
    ;; killed buffer, it is removed from this list.
!   "Alist of directories and their associated dired buffers.")
  
  (defun dired-buffers-for-dir (dir)
  ;; Return a list of buffers that dired DIR (top level or in-situ subdir).
--- 1251,1257 ----
    ;; Enlarged by dired-advertise
    ;; Queried by function dired-buffers-for-dir. When this detects a
    ;; killed buffer, it is removed from this list.
!   "Alist of expanded directories and their associated dired buffers.")
  
  (defun dired-buffers-for-dir (dir)
  ;; Return a list of buffers that dired DIR (top level or in-situ subdir).
***************
*** 1258,1286 ****
  ;; As a side effect, killed dired buffers for DIR are removed from
  ;; dired-buffers.
    (setq dir (file-name-as-directory dir))
!   (let ((alist dired-buffers) result elt)
      (while alist
!       (setq elt (car alist))
!       (if (dired-in-this-tree dir (car elt))
! 	  (let ((buf (cdr elt)))
! 	    (if (buffer-name buf)
! 		(if (assoc dir (save-excursion
! 				 (set-buffer buf)
! 				 dired-subdir-alist))
! 		    (setq result (cons buf result)))
! 	      ;; else buffer is killed - clean up:
! 	      (setq dired-buffers (delq elt dired-buffers)))))
        (setq alist (cdr alist)))
      result))
  
  (defun dired-advertise ()
!   ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
    ;; With wildcards we actually advertise too much.
!   (if (memq (current-buffer) (dired-buffers-for-dir default-directory))
!       t					; we have already advertised ourselves
!     (setq dired-buffers
! 	  (cons (cons default-directory (current-buffer))
! 		dired-buffers))))
  
  (defun dired-unadvertise (dir)
    ;; Remove DIR from the buffer alist in variable dired-buffers.
--- 1259,1288 ----
  ;; As a side effect, killed dired buffers for DIR are removed from
  ;; dired-buffers.
    (setq dir (file-name-as-directory dir))
!   (let ((alist dired-buffers) result elt buf)
      (while alist
!       (setq elt (car alist)
! 	    buf (cdr elt))
!       (if (buffer-name buf)
! 	  (if (dired-in-this-tree dir (car elt))
! 	      (if (assoc dir (save-excursion
! 			       (set-buffer buf)
! 			       dired-subdir-alist))
! 		  (setq result (cons buf result))))
! 	;; else buffer is killed - clean up:
! 	(setq dired-buffers (delq elt dired-buffers)))
        (setq alist (cdr alist)))
      result))
  
  (defun dired-advertise ()
!   ;; Advertise in variable `dired-buffers' that we dired `default-directory'.
    ;; With wildcards we actually advertise too much.
!   (let ((expanded-default (expand-file-name default-directory)))
!     (if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
! 	t				; we have already advertised ourselves
!       (setq dired-buffers
! 	    (cons (cons expanded-default (current-buffer))
! 		  dired-buffers)))))
  
  (defun dired-unadvertise (dir)
    ;; Remove DIR from the buffer alist in variable dired-buffers.
***************
*** 1288,1294 ****
    ;; It does not affect buffers in which DIR is a subdir.
    ;; Removing is also done as a side-effect in dired-buffer-for-dir.
    (setq dired-buffers
!       (delq (assoc dir dired-buffers) dired-buffers)))
  
  ;; Tree Dired
  
--- 1290,1296 ----
    ;; It does not affect buffers in which DIR is a subdir.
    ;; Removing is also done as a side-effect in dired-buffer-for-dir.
    (setq dired-buffers
! 	(delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
  
  ;; Tree Dired
  
***************
*** 1297,1303 ****
  (defun dired-in-this-tree (file dir)
    ;;"Is FILE part of the directory tree starting at DIR?"
    (let (case-fold-search)
!     (string-match (concat "^" (regexp-quote (expand-file-name dir))) file)))
  
  (defun dired-normalize-subdir (dir)
    ;; Prepend default-directory to DIR if relative path name.
--- 1299,1305 ----
  (defun dired-in-this-tree (file dir)
    ;;"Is FILE part of the directory tree starting at DIR?"
    (let (case-fold-search)
!     (string-match (concat "^" (regexp-quote dir)) file)))
  
  (defun dired-normalize-subdir (dir)
    ;; Prepend default-directory to DIR if relative path name.

*** dired-aux.el-orig	Mon Jul 11 21:46:11 1994
--- dired-aux.el	Thu Sep 15 14:21:46 1994
***************
*** 707,713 ****
  (defun dired-fun-in-all-buffers (directory fun &rest args)
    ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
    ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
!   (let ((buf-list (dired-buffers-for-dir directory))
  	(obuf (current-buffer))
  	buf success-list)
      (while buf-list
--- 707,713 ----
  (defun dired-fun-in-all-buffers (directory fun &rest args)
    ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
    ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
!   (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)))
  	(obuf (current-buffer))
  	buf success-list)
      (while buf-list
***************
*** 891,902 ****
    (dired-fun-in-all-buffers from-dir
  			    (function dired-rename-subdir-1) from-dir to-dir)
    ;; Update visited file name of all affected buffers
!   (let ((blist (buffer-list)))
      (while blist
        (save-excursion
!         (set-buffer (car blist))
  	(if (and buffer-file-name
! 		 (dired-in-this-tree buffer-file-name from-dir))
  	    (let ((modflag (buffer-modified-p))
  		  (to-file (dired-replace-in-string
  			    (concat "^" (regexp-quote from-dir))
--- 891,903 ----
    (dired-fun-in-all-buffers from-dir
  			    (function dired-rename-subdir-1) from-dir to-dir)
    ;; Update visited file name of all affected buffers
!   (let ((expanded-from-dir (expand-file-name from-dir))
! 	(blist (buffer-list)))
      (while blist
        (save-excursion
! 	(set-buffer (car blist))
  	(if (and buffer-file-name
! 		 (dired-in-this-tree buffer-file-name expanded-from-dir))
  	    (let ((modflag (buffer-modified-p))
  		  (to-file (dired-replace-in-string
  			    (concat "^" (regexp-quote from-dir))
***************
*** 909,920 ****
  (defun dired-rename-subdir-1 (dir to)
    ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
    ;; one of its subdirectories is expanded in this buffer.
!   (let ((alist dired-subdir-alist)
  	(elt nil))
      (while alist
        (setq elt (car alist)
  	    alist (cdr alist))
!       (if (dired-in-this-tree (car elt) dir)
  	  ;; ELT's subdir is affected by the rename
  	  (dired-rename-subdir-2 elt dir to)))
      (if (equal dir default-directory)
--- 910,922 ----
  (defun dired-rename-subdir-1 (dir to)
    ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
    ;; one of its subdirectories is expanded in this buffer.
!   (let ((expanded-dir (expand-file-name dir))
! 	(alist dired-subdir-alist)
  	(elt nil))
      (while alist
        (setq elt (car alist)
  	    alist (cdr alist))
!       (if (dired-in-this-tree (car elt) expanded-dir)
  	  ;; ELT's subdir is affected by the rename
  	  (dired-rename-subdir-2 elt dir to)))
      (if (equal dir default-directory)
***************
*** 1530,1535 ****
--- 1532,1538 ----
    ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
    ;; With optional arg REMEMBER-MARKS, return an alist of marked files."
    (interactive "DKill tree below directory: ")
+   (setq dirname (expand-file-name dirname))
    (let ((s-alist dired-subdir-alist) dir m-alist)
      (while s-alist
        (setq dir (car (car s-alist))

*** dired-x.el-orig	Tue Sep  6 02:56:43 1994
--- dired-x.el	Thu Sep 15 14:25:22 1994
***************
*** 3,10 ****
  ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
  ;;	Lawrence R. Dodd <dodd@roebling.poly.edu>
  ;; Maintainer: Lawrence R. Dodd <dodd@roebling.poly.edu>
! ;; Version: 2.37+
! ;; Date: 1994/08/18 19:27:42
  ;; Keywords: dired extensions
  
  ;; Copyright (C) 1993, 1994 Free Software Foundation
--- 3,10 ----
  ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
  ;;	Lawrence R. Dodd <dodd@roebling.poly.edu>
  ;; Maintainer: Lawrence R. Dodd <dodd@roebling.poly.edu>
! ;; Version: 2.43
! ;; Date: 1994/08/21 21:34:58
  ;; Keywords: dired extensions
  
  ;; Copyright (C) 1993, 1994 Free Software Foundation
***************
*** 301,307 ****
                                  (file-name-nondirectory fn)))
                 (save-excursion ; you never know where kill-buffer leaves you
                   (kill-buffer buf))))
!         (let ((buf-list (dired-buffers-for-dir fn))
                (buf nil))
            (and buf-list
                 (y-or-n-p (format "Kill dired buffer%s of %s, too? "
--- 301,307 ----
                                  (file-name-nondirectory fn)))
                 (save-excursion ; you never know where kill-buffer leaves you
                   (kill-buffer buf))))
!         (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))
                (buf nil))
            (and buf-list
                 (y-or-n-p (format "Kill dired buffer%s of %s, too? "
***************
*** 1364,1370 ****
  (defun dired-find-buffer-nocreate (dirname)
    (if dired-find-subdir
        (let* ((cur-buf (current-buffer))
!              (buffers (nreverse (dired-buffers-for-dir dirname)))
               (cur-buf-matches (and (memq cur-buf buffers)
                                     ;; wildcards must match, too:
                                     (equal dired-directory dirname))))
--- 1364,1371 ----
  (defun dired-find-buffer-nocreate (dirname)
    (if dired-find-subdir
        (let* ((cur-buf (current-buffer))
!              (buffers (nreverse
! 		       (dired-buffers-for-dir (expand-file-name dirname))))
               (cur-buf-matches (and (memq cur-buf buffers)
                                     ;; wildcards must match, too:
                                     (equal dired-directory dirname))))
***************
*** 1388,1418 ****
          (setq list (cdr list)))
        more-recent)))
  
- ;;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93
- ;;; (defun dired-buffers-for-dir-exact (dir)
- ;;; ;; Return a list of buffers that dired DIR (a directory or wildcard)
- ;;; ;; at top level, or as subdirectory.
- ;;; ;; Top level matches must match the wildcard part too, if any.
- ;;; ;; The list is in reverse order of buffer creation, most recent last.
- ;;; ;; As a side effect, killed dired buffers for DIR are removed from
- ;;; ;; dired-buffers.
- ;;;   (let ((alist dired-buffers) result elt)
- ;;;     (while alist
- ;;;       (setq elt (car alist)
- ;;;             alist (cdr alist))
- ;;;       (let ((buf (cdr elt)))
- ;;;         (if (buffer-name buf)
- ;;;             ;; Top level must match exactly against dired-directory in
- ;;;             ;; case one of them is a wildcard.
- ;;;             (if (or (equal dir (save-excursion (set-buffer buf)
- ;;;                                                dired-directory))
- ;;;                     (assoc dir (save-excursion (set-buffer buf)
- ;;;                                                dired-subdir-alist)))
- ;;;                 (setq result (cons buf result)))
- ;;;           ;; else buffer is killed - clean up:
- ;;;           (setq dired-buffers (delq elt dired-buffers)))))
- ;;;     result))
- 
  ;;; REDEFINE.
  ;;; Redefines dired.el's version of `dired-initial-position'
  (defun dired-initial-position (dirname)
--- 1389,1394 ----
***************
*** 1630,1636 ****
  ;;; This section is provided for reports.  It uses Barry A. Warsaw's
  ;;; reporter.el which is bundled with GNU Emacs v19.
  
! (defconst dired-x-version "2.37"
    "Revision number of dired-x.el -- dired extra for GNU Emacs v19.
  Type \\[dired-x-submit-report] to send a bug report.  Available via anonymous
  ftp in
--- 1606,1612 ----
  ;;; This section is provided for reports.  It uses Barry A. Warsaw's
  ;;; reporter.el which is bundled with GNU Emacs v19.
  
! (defconst dired-x-version "2.43"
    "Revision number of dired-x.el -- dired extra for GNU Emacs v19.
  Type \\[dired-x-submit-report] to send a bug report.  Available via anonymous
  ftp in
Technical Details
Message-ID: <9409161518.AA20091@roebling.poly.edu>
Path: arc1-ca.pugleaf.net!bga.com!news.sprintlink.net!howland.reston.ans.net!math.ohio-state.edu!cis.ohio-state.edu!roebling.poly.edu!dodd

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: fb2f1,2e7cff98d1ad23d2,start
X-Google-Attributes: gidfb2f1,public
X-Google-ArrivalTime: 1994-09-17 06:39:56 PST
Path: arc1-ca.pugleaf.net!bga.com!news.sprintlink.net!howland.reston.ans.net!math.ohio-state.edu!cis.ohio-state.edu!roebling.poly.edu!dodd
From: dodd@roebling.poly.edu (Lawrence R. Dodd)
Newsgroups: gnu.emacs.bug
Subject: 19.27: dired-find-subdir, expand dir bug.
Date: 16 Sep 1994 11:21:40 -0400
Organization: GNUs Not Usenet
Lines: 367
Sender: daemon@cis.ohio-state.edu
Approved: bug-gnu-emacs@prep.ai.mit.edu
Distribution: gnu
Message-ID: <9409161518.AA20091@roebling.poly.edu>
Reply-To: dodd@roebling.poly.edu