cdr.scm

#!/usr/local/bin/gosh
;;; stuff such that .zhistory → “"cdr" function for recent directories etc.”
;;; - http://thread.gmane.org/gmane.comp.shells.zsh.devel/20592
#|
% {
  local -a match mbegin mend
  print -l ${${(@f)"$(\
gosh /tmp/cdr.scm -f $HISTFILE -t $((12 * 60 * 60)) -l 99999 \
  )"}/(#b)(*)/\$"'"${match}"'"}
} > ~/..chpwd-recent-dirs
|#

(use file.util)
(use gauche.process)
(use srfi-1)
(use srfi-13)
(use util.list)
(use util.match)

(define (%resolve-path p)
  (and (guard (e (else #f)) (resolve-path p))
       (simplify-path p)))

(define (x->zhist x)
  ;; rx against an `fc -l -t "%s" -m "cd(r#) *" 0` output.
  ;; For example, "99 108992  cd foo/bar" ⇒ (108992 . foo/bar)
  (rxmatch-let (rxmatch #/\d+\*?\s+(\d+)\s+cdr?\s+(.*)/ x) (#f t d)
    (let1 r (cons t d)
      (if (rxmatch #/\s+/ d)
        (with-output-to-port (standard-error-port)
          (cut print #`"ignoring entry [,|d|:,|r|]")) ;; FIXME:
        r))))

(define (grovel timeoutseconds home hists)
  (define (x->dir-1 x . basedirs)
    (cond ((absolute-path? x) (%resolve-path x))
          ((string-prefix? "~/" x)
           (%resolve-path (build-path home (string-drop x 2))))
          (#t (any (^b (%resolve-path (build-path b x)))
                   basedirs))))
  (define x->dir (cut x->dir-1 <> home <>))
  (define (timeout? t1 t2)
    (cond ((not t1) #f)
          ((not t2) #f)
          (#t (< timeoutseconds (abs (- t1  t2))))))
  ;; TODO: avoid duplicates when resulting the `seed`, then profile.
  (define (rec x xs tm cwd seed)
    (match-let1 (time . dir) x
      (cond ((null? xs)
             (cond-list ((x->dir dir cwd) => (pa$ cons time))
                        (#t @ seed)))
            ((timeout? tm time) seed)
            ((x->dir dir cwd) =>
             (^d (rec (car xs) (cdr xs) tm cwd
                      (rec (car xs) (cdr xs) time d (acons time d seed)))))
            (#t (rec (car xs) (cdr xs) tm cwd seed)))))
  
  (rec (car hists) (cdr hists) #f home '()))

(define zhist=? (match-lambda* (((_ . a) (_ . b)) (equal? a b))))

(define delete-dupzhist (cut delete-duplicates <> zhist=?))

(define (zhist-list histsize zshhistoryfile)
  ;; "/a/b/" ⇒ "/a/b"
  ;; "./a/b" ⇒ "a/b"
  (define cannon-path (.$ (cut string-trim-right <> #\/)
                          (cut regexp-replace #/^\.\// <> "")))
  (define cannon-hist (match-lambda
                        ((t . d) (cons (x->number t) (cannon-path d)))
                        (else #f)))

  ((.$ reverse delete-dupzhist (filter$ pair?))
   (map (.$ cannon-hist x->zhist)
        (process-output->string-list
         `(/bin/zsh -c ,#`"\
setopt extended_glob; HISTSIZE=,histsize; fc -R ,zshhistoryfile &&
  print -l ${${(f)\"$(fc -r -l -t \"%s\" -m \"cd(r#) *\" 0)\"}/( #)/}")))))

(use gauche.parseopt)

(define (main args)
  (let-args (cdr args)
      ((timeout  "t|timeout=i"  (* 9 60 60))
       (homedir  "h|homedir=s"  (sys-getenv "HOME"))
       (histsize "l|histsize=i" 50)
       (histfile "f|histfile=s" "~/.zsh_history"))
    (for-each (match-lambda ((_ . d) (print d)))
              ((.$ delete-dupzhist reverse (cut sort-by <> car))
               (grovel timeout homedir (zhist-list histsize histfile)))))
  0)

#|
(main ((map$ x->string)
       `(/gosh -f ~/.zhistory
               -t ,(* 12 60 60)
               -l 9999)))
|#