Mercurial > emacs
comparison lisp/shell.el @ 4677:835ecfabae68
(shell-cd): New function, like `cd' but prepend comint-filename-prefix.
(shell-resync-dirs, shell-process-cd, shell-process-pushd,
shell-process-popd): Use shell-cd in place of cd.
| author | Roland McGrath <roland@gnu.org> |
|---|---|
| date | Wed, 08 Sep 1993 07:06:46 +0000 |
| parents | a95bec390bc3 |
| children | ed9240986f40 |
comparison
equal
deleted
inserted
replaced
| 4676:a95bec390bc3 | 4677:835ecfabae68 |
|---|---|
| 374 ;;; The first regexp is [optional whitespace, (";" or the end of string)]. | 374 ;;; The first regexp is [optional whitespace, (";" or the end of string)]. |
| 375 ;;; The second regexp is [whitespace, (an arg), optional whitespace, | 375 ;;; The second regexp is [whitespace, (an arg), optional whitespace, |
| 376 ;;; (";" or end of string)]. | 376 ;;; (";" or end of string)]. |
| 377 | 377 |
| 378 | 378 |
| 379 ;; Like `cd', but prepends comint-filename-prefix to absolute names. | |
| 380 (defsubst shell-cd (directory) | |
| 381 (if (file-name-absolute-p directory) | |
| 382 (cd-absolute (concat comint-filename-prefix directory)) | |
| 383 (cd directory))) | |
| 384 | |
| 379 ;;; popd [+n] | 385 ;;; popd [+n] |
| 380 (defun shell-process-popd (arg) | 386 (defun shell-process-popd (arg) |
| 381 (let ((num (if (zerop (length arg)) 0 ; no arg means +0 | 387 (let ((num (if (zerop (length arg)) 0 ; no arg means +0 |
| 382 (shell-extract-num arg)))) | 388 (shell-extract-num arg)))) |
| 383 (if (and num (< num (length shell-dirstack))) | 389 (if (and num (< num (length shell-dirstack))) |
| 384 (if (= num 0) ; condition-case because the CD could lose. | 390 (if (= num 0) ; condition-case because the CD could lose. |
| 385 (condition-case nil (progn (cd (concat comint-filename-prefix | 391 (condition-case nil (progn (shell-cd (car shell-dirstack)) |
| 386 (car shell-dirstack))) | |
| 387 (setq shell-dirstack | 392 (setq shell-dirstack |
| 388 (cdr shell-dirstack)) | 393 (cdr shell-dirstack)) |
| 389 (shell-dirstack-message)) | 394 (shell-dirstack-message)) |
| 390 (error (message "Couldn't cd."))) | 395 (error (message "Couldn't cd."))) |
| 391 (let* ((ds (cons nil shell-dirstack)) | 396 (let* ((ds (cons nil shell-dirstack)) |
| 402 (let ((new-dir (cond | 407 (let ((new-dir (cond |
| 403 ((zerop (length arg)) (getenv "HOME")) | 408 ((zerop (length arg)) (getenv "HOME")) |
| 404 ((string-equal "-" arg) shell-last-dir) | 409 ((string-equal "-" arg) shell-last-dir) |
| 405 (t arg)))) | 410 (t arg)))) |
| 406 (setq shell-last-dir default-directory) | 411 (setq shell-last-dir default-directory) |
| 407 (cd (concat comint-filename-prefix new-dir)) | 412 (shell-cd new-dir) |
| 408 (shell-dirstack-message)) | 413 (shell-dirstack-message)) |
| 409 (error (message "Couldn't cd.")))) | 414 (error (message "Couldn't cd.")))) |
| 410 | 415 |
| 411 ;;; pushd [+n | dir] | 416 ;;; pushd [+n | dir] |
| 412 (defun shell-process-pushd (arg) | 417 (defun shell-process-pushd (arg) |
| 413 (if (zerop (length arg)) | 418 (if (zerop (length arg)) |
| 414 ;; no arg -- swap pwd and car of shell stack | 419 ;; no arg -- swap pwd and car of shell stack |
| 415 (condition-case nil (if shell-dirstack | 420 (condition-case nil (if shell-dirstack |
| 416 (let ((old default-directory)) | 421 (let ((old default-directory)) |
| 417 (cd (concat comint-filename-prefix | 422 (shell-cd (car shell-dirstack)) |
| 418 (car shell-dirstack))) | |
| 419 (setq shell-dirstack | 423 (setq shell-dirstack |
| 420 (cons old (cdr shell-dirstack))) | 424 (cons old (cdr shell-dirstack))) |
| 421 (shell-dirstack-message)) | 425 (shell-dirstack-message)) |
| 422 (message "Directory stack empty.")) | 426 (message "Directory stack empty.")) |
| 423 (error | 427 (error |
| 431 (dslen (length ds)) | 435 (dslen (length ds)) |
| 432 (front (nthcdr num ds)) | 436 (front (nthcdr num ds)) |
| 433 (back (reverse (nthcdr (- dslen num) (reverse ds)))) | 437 (back (reverse (nthcdr (- dslen num) (reverse ds)))) |
| 434 (new-ds (append front back))) | 438 (new-ds (append front back))) |
| 435 (condition-case nil | 439 (condition-case nil |
| 436 (progn (cd (concat comint-filename-prefix (car new-ds))) | 440 (progn (shell-cd (car new-ds)) |
| 437 (setq shell-dirstack (cdr new-ds)) | 441 (setq shell-dirstack (cdr new-ds)) |
| 438 (shell-dirstack-message)) | 442 (shell-dirstack-message)) |
| 439 (error (message "Couldn't cd."))))) | 443 (error (message "Couldn't cd."))))) |
| 440 | 444 |
| 441 ;; pushd <dir> | 445 ;; pushd <dir> |
| 442 (let ((old-wd default-directory)) | 446 (let ((old-wd default-directory)) |
| 443 (condition-case nil | 447 (condition-case nil |
| 444 (progn (cd (concat comint-filename-prefix arg)) | 448 (progn (shell-cd arg) |
| 445 (setq shell-dirstack | 449 (setq shell-dirstack |
| 446 (cons old-wd shell-dirstack)) | 450 (cons old-wd shell-dirstack)) |
| 447 (shell-dirstack-message)) | 451 (shell-dirstack-message)) |
| 448 (error (message "Couldn't cd.")))))))) | 452 (error (message "Couldn't cd.")))))))) |
| 449 | 453 |
| 501 (setq ds (cons (substring dl (match-beginning 1) (match-end 1)) | 505 (setq ds (cons (substring dl (match-beginning 1) (match-end 1)) |
| 502 ds)) | 506 ds)) |
| 503 (setq i (match-end 0))) | 507 (setq i (match-end 0))) |
| 504 (let ((ds (reverse ds))) | 508 (let ((ds (reverse ds))) |
| 505 (condition-case nil | 509 (condition-case nil |
| 506 (progn (cd (concat comint-filename-prefix (car ds))) | 510 (progn (shell-cd (car ds)) |
| 507 (setq shell-dirstack (cdr ds)) | 511 (setq shell-dirstack (cdr ds)) |
| 508 (shell-dirstack-message)) | 512 (shell-dirstack-message)) |
| 509 (error (message "Couldn't cd."))))))) | 513 (error (message "Couldn't cd."))))))) |
| 510 | 514 |
| 511 ;;; For your typing convenience: | 515 ;;; For your typing convenience: |