pushd.scm 1.1 KB

123456789101112131415161718192021222324252627282930
  1. (commands pushd)
  2. ;; TODO: write to output port
  3. (define pushd
  4. (lambda* (#:optional
  5. (filename ".")
  6. #:key
  7. ;; command interface
  8. (previous-result '())
  9. (shell-state default-shell-state)
  10. (silent #f))
  11. "Change the current working directory, pushing the new working
  12. directory onto the directory stack."
  13. (let ([filename (if (null? previous-result)
  14. filename
  15. (car previous-result))])
  16. (receive (cd-result _) (cd filename #:silent #t)
  17. (let ([new-pwd (car cd-result)])
  18. (let* ([updated-dir-stack
  19. (cons new-pwd
  20. (get-shell-state shell-state 'directory-stack))]
  21. [updated-shell-state
  22. (update-shell-state* shell-state
  23. '(current-working-directory directory-stack)
  24. (list new-pwd updated-dir-stack))])
  25. (values updated-dir-stack
  26. updated-shell-state)))))))
  27. (alias push-directory pushd)