comparison lisp/shell.el @ 5474:239620e1795d

(shell-cd): Function removed. (shell-prefixed-directory-name): New defsubst. (shell-process-popd, shell-process-pushd, shell-process-cd, shell-resync-dirs): Apply it to ARG when it's a directory name. Use (concat comint-file-name-prefix "~") in place of (getenv "HOME") or "~". Call cd instead of shell-cd.

5473:e080a27c1dd6

		     (shell-process-cd (substitute-in-file-name arg1))))
	      (setq start (progn (string-match "[;\\s ]*" str end) ; skip again
				 (match-end 0)))))
	(error (message "Couldn't cd")))))


;; Like `cd', but prepends comint-file-name-prefix to absolute names.
(defsubst shell-cd (directory)
  (if (file-name-absolute-p directory)
      (cd-absolute (concat comint-file-name-prefix directory))
    (cd directory)))

;;; popd [+n]
(defun shell-process-popd (arg)
  (let ((num (or (shell-extract-num arg) 0)))
    (cond ((and num (= num 0) shell-dirstack)
	   (shell-cd (car shell-dirstack))
	   (setq shell-dirstack (cdr shell-dirstack))
	   (shell-dirstack-message))
	  ((and num (> num 0) (<= num (length shell-dirstack)))
	   (let* ((ds (cons nil shell-dirstack))
		  (cell (nthcdr (1- num) ds)))

	     (setq shell-dirstack (cdr ds))
	     (shell-dirstack-message)))
	  (t
	   (error (message "Couldn't popd."))))))

;;; cd [dir]
(defun shell-process-cd (arg)
  (let ((new-dir (cond ((zerop (length arg)) (getenv "HOME"))
		       ((string-equal "-" arg) shell-last-dir)
		       (t arg))))
    (setq shell-last-dir default-directory)
    (shell-cd new-dir)
    (shell-dirstack-message)))

;;; pushd [+n | dir]
(defun shell-process-pushd (arg)
  (let ((num (shell-extract-num arg)))
    (cond ((zerop (length arg))
	   ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
	   (cond (shell-pushd-tohome
		  (shell-process-pushd "~"))
		 (shell-dirstack
		  (let ((old default-directory))
		    (shell-cd (car shell-dirstack))
		    (setq shell-dirstack
			  (cons old (cdr shell-dirstack)))
		    (shell-dirstack-message)))
		 (t
		  (message "Directory stack empty."))))

		  (error (message "Couldn't cd.")))
		 (shell-pushd-dextract
		  (let ((dir (nth (1- num) shell-dirstack)))
		    (shell-process-popd arg)
		    (shell-process-pushd default-directory)
		    (shell-cd dir)
		    (shell-dirstack-message)))
		 (t
		  (let* ((ds (cons default-directory shell-dirstack))
			 (dslen (length ds))
			 (front (nthcdr num ds))
			 (back (reverse (nthcdr (- dslen num) (reverse ds))))
			 (new-ds (append front back)))
		    (shell-cd (car new-ds))
		    (setq shell-dirstack (cdr new-ds))
		    (shell-dirstack-message)))))
	  (t
	   ;; pushd <dir>
	   (let ((old-wd default-directory))
	     (shell-cd arg)
	     (if (or (null shell-pushd-dunique)
		     (not (member old-wd shell-dirstack)))
		 (setq shell-dirstack (cons old-wd shell-dirstack)))
	     (shell-dirstack-message))))))

	   (ds '())			; new dir stack
	   (i 0))
      (while (< i dl-len)
	;; regexp = optional whitespace, (non-whitespace), optional whitespace
	(string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
	(setq ds (cons (substring dl (match-beginning 1) (match-end 1))
		       ds))
	(setq i (match-end 0)))
      (let ((ds (reverse ds)))
	(condition-case nil
	    (progn (cd (car ds))
		   (setq shell-dirstack (cdr ds))
		   (shell-dirstack-message))
	  (error (message "Couldn't cd.")))))))

5474:239620e1795d

		     (shell-process-cd (substitute-in-file-name arg1))))
	      (setq start (progn (string-match "[;\\s ]*" str end) ; skip again
				 (match-end 0)))))
	(error (message "Couldn't cd")))))

;;; popd [+n]
(defun shell-process-popd (arg)
  (let ((num (or (shell-extract-num arg) 0)))
    (cond ((and num (= num 0) shell-dirstack)
	   (cd (car shell-dirstack))
	   (setq shell-dirstack (cdr shell-dirstack))
	   (shell-dirstack-message))
	  ((and num (> num 0) (<= num (length shell-dirstack)))
	   (let* ((ds (cons nil shell-dirstack))
		  (cell (nthcdr (1- num) ds)))

	     (setq shell-dirstack (cdr ds))
	     (shell-dirstack-message)))
	  (t
	   (error (message "Couldn't popd."))))))

;; Return DIR prefixed with comint-file-name-prefix as appropriate.
(defsubst shell-prefixed-directory-name (dir)
  (if (file-name-absolute-p dir)
      ;; The name is absolute, so prepend the prefix.
      (concat comint-file-name-prefix dir)
    ;; For a relative name we assume default-directory already has the prefix.
    (expand-file-name dir)))

;;; cd [dir]
(defun shell-process-cd (arg)
  (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix
						     "~"))
		       ((string-equal "-" arg) shell-last-dir)
		       (t (shell-prefixed-directory-name arg)))))
    (setq shell-last-dir default-directory)
    (cd new-dir)
    (shell-dirstack-message)))

;;; pushd [+n | dir]
(defun shell-process-pushd (arg)
  (let ((num (shell-extract-num arg)))
    (cond ((zerop (length arg))
	   ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
	   (cond (shell-pushd-tohome
		  (shell-process-pushd (concat comint-file-name-prefix "~")))
		 (shell-dirstack
		  (let ((old default-directory))
		    (cd (car shell-dirstack))
		    (setq shell-dirstack
			  (cons old (cdr shell-dirstack)))
		    (shell-dirstack-message)))
		 (t
		  (message "Directory stack empty."))))

		  (error (message "Couldn't cd.")))
		 (shell-pushd-dextract
		  (let ((dir (nth (1- num) shell-dirstack)))
		    (shell-process-popd arg)
		    (shell-process-pushd default-directory)
		    (cd dir)
		    (shell-dirstack-message)))
		 (t
		  (let* ((ds (cons default-directory shell-dirstack))
			 (dslen (length ds))
			 (front (nthcdr num ds))
			 (back (reverse (nthcdr (- dslen num) (reverse ds))))
			 (new-ds (append front back)))
		    (cd (car new-ds))
		    (setq shell-dirstack (cdr new-ds))
		    (shell-dirstack-message)))))
	  (t
	   ;; pushd <dir>
	   (let ((old-wd default-directory))
	     (cd (shell-prefixed-directory-name arg))
	     (if (or (null shell-pushd-dunique)
		     (not (member old-wd shell-dirstack)))
		 (setq shell-dirstack (cons old-wd shell-dirstack)))
	     (shell-dirstack-message))))))

	   (ds '())			; new dir stack
	   (i 0))
      (while (< i dl-len)
	;; regexp = optional whitespace, (non-whitespace), optional whitespace
	(string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
	(setq ds (cons (concat comint-file-name-prefix
			       (substring dl (match-beginning 1)
					  (match-end 1)))
		       ds))
	(setq i (match-end 0)))
      (let ((ds (nreverse ds)))
	(condition-case nil
	    (progn (cd (car ds))
		   (setq shell-dirstack (cdr ds))
		   (shell-dirstack-message))
	  (error (message "Couldn't cd.")))))))