commander-s/scheme/std-command.scm

;; ,open let-opt
(define (wait-for-key . optionals)
  (let-optionals optionals
      ((tty-port (current-input-port)))
    (let* ((old (tty-info tty-port))
	   (copy (copy-tty-info old)))
      (set-tty-info:local-flags 
       copy
       (bitwise-and (tty-info:local-flags copy)
		    (bitwise-not ttyl/canonical)))
      (set-tty-info:min copy 1)
      (set-tty-info:time copy 0)
      (set-tty-info/now tty-port copy)
      (let ((c (read-char tty-port)))
	(set-tty-info/now tty-port old)
	c))))

(define (standard-command-plugin-completer command args)
  #f)

(define (show-shell-screen)
  (def-prog-mode)
  (endwin)
  (display "Press any key to return to scsh-nuit...")
  (wait-for-key))

(define (contains-glob-enumerator? arg)
  (if-match
   (regexp-search 
    (rx (: (submatch (* any)) ("{[") (* any) (submatch (* any)) ("]}")))
    arg)
   (whole-arg submatch-before submatch-after)
   (not (or (string-suffix? "\\" submatch-before)
	    (string-suffix? "\\" submatch-after)))
   #f))

(define (contains-glob-wildcard? arg)
  (if-match
   (regexp-search (rx (: (submatch (* any)) ("*?"))) arg)
   (whole-arg submatch-before)
   (not (string-suffix? "\\" submatch-before))
   #f))
   
(define (contains-glob-expression? arg)
  (or (contains-glob-wildcard? arg)
      (contains-glob-enumerator? arg)))

(define (glob-argument arg)
  (let ((files (glob arg)))
    (if (null? files)
	(error "no files match this glob expression" arg (cwd))
	files)))

(define (expand-command-argument arg)
  (let ((expanded (expand-file-name arg)))
    (cond 
     ((contains-glob-expression? arg)
      (glob-argument expanded))
     (else (list expanded)))))

(define (expand-argument-list args)
  (fold-right
   (lambda (arg expanded)
     (append (expand-command-argument arg) expanded))
   '() args))

(define (standard-command-plugin-evaluater command args)
  (def-prog-mode)
  (endwin)
  (newline)
  (let ((status (run (,command ,@(expand-argument-list args)))))
    (newline)
    (display "Press any key to return to scsh-nuit...")
    (wait-for-key)
    status))

(define standard-command-plugin
  (make-command-plugin #f
		       standard-command-plugin-completer
		       standard-command-plugin-evaluater))

;; some common commands

(define no-completer (lambda args #f))

(register-plugin!
 (make-command-plugin 
  "ls"
  no-completer
  (lambda (command args)
    (if (null? args)
        (directory-files (cwd))
        (let ((arg (file-name->fs-object
                    (expand-file-name (car args) (cwd)))))
          (if (file-info-directory? (fs-object-info arg))
              (directory-files (fs-object-complete-path arg))
              arg))))))

(register-plugin!
 (make-command-plugin "ps"
		      no-completer
		      (lambda (command args)
			(pps))))

(register-plugin!
 (make-command-plugin "pwd"
		      no-completer
 		      (lambda (command args)
 			(cwd))))

(register-plugin!
 (make-command-plugin "cd"
		      no-completer
 		      (lambda (command args)
 			(chdir (resolve-file-name (if (null? args)
                                                      "~"
                                                      (car args))))
                        (cwd))))

(register-plugin!
 (make-command-plugin "setenv"
		      no-completer
 		      (lambda (command args)
 			(setenv (car args) (cadr args)))))

(register-plugin!
 (make-command-plugin "getenv"
		      no-completer
		      (lambda (command args)
			(getenv (car args)))))

(register-plugin!
 (make-command-plugin "printenv"
		      no-completer
 		      (lambda (command args)
 			(env->alist))))

(register-plugin!
 (make-command-plugin "exit"
                      no-completer
                      (lambda (command args)
			(clear)
                        (exit (if (null? args)
                                  0
                                  (string->number (car args)))))))

(register-plugin!
 (make-command-plugin "jobs"
		      (lambda (command prefix args arg-pos)
			'("running" "ready" "output" "waiting-for-input"))
		      (lambda (command args)
			(append-map
			 (lambda (arg)
			   ;; #### warn if argument is unknown
			   (cond
			    ((assoc arg
				    `(("running" . ,running-jobs)
				      ("ready" . ,ready-jobs)
				      ("output" . ,jobs-with-new-output)
				      ("input" . ,jobs-waiting-for-input)))
			     => (lambda (p)
				  ((cdr p))))))
			 (delete-duplicates args)))))