edward-contrib

 1(import (scheme base)
 2
 3        (chicken port)
 4        (chicken process)
 5        (chicken string)
 6
 7        (edward util)
 8        (edward ed editor))
 9
10;; Returns amount of rows of the terminal associated with the given
11;; port (or the default output port if not specified). If the port
12;; does not refer to a terminal, then a suitable default value is
13;; returned.
14(define (terminal-rows . o)
15    (let*-values (((port) (if (pair? o) (car o) (current-output-port)))
16                  ((rows _) (if (terminal-port? port)
17                              (terminal-size port)
18                              (values 22 72))))
19      rows))
20
21;; Select a single item from a list of strings interactively using FZF.
22(define (menu-select show-proc lst)
23  (let* ((proc (process "fzf"))
24         (output (process-output-port proc))
25         (mapping (map (lambda (x) (cons (show-proc x) x)) lst)))
26    (write-string (lines->string (map car mapping)) output)
27    (close-output-port output)
28    (let-values (((_ succ? exit-code) (process-wait (process-id proc))))
29      (if succ?
30        (let* ((input (process-input-port proc))
31               (recv (port->lines input)))
32          (close-input-port input)
33          (if (null? (car recv))
34            (editor-raise "no element selected")
35            (cdr (assoc (caar recv) mapping))))
36        (editor-raise "failed to spawn fzf")))))
37
38;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39
40;; This code implements a very silly "parser" for the output of
41;; the readtags(1) command which is passed as a list of lines.
42
43(define-record-type Tag
44  (make-tag name file regex)
45  tag?
46  (name tag-name)
47  (file tag-file)
48  (regex tag-regex))
49
50(define (parse-tags lines)
51  (let ((fields (map (lambda (line) (string-split line "\t" #t)) lines)))
52    (map (lambda (lst) (apply make-tag lst)) fields)))
53
54(define (select-tag tags)
55  (define (tag->string tag)
56    (string-append (tag-file tag) ": " (tag-name tag)))
57
58  (if (eq? (length tags) 1)
59    (car tags)
60    (menu-select tag->string tags)))