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-values (((in out pid) (process "fzf"))
24               ((mapping) (map (lambda (x) (cons (show-proc x) x)) lst)))
25    (write-string (lines->string (map car mapping)) out)
26    (close-output-port out)
27    (let-values (((_ succ? exit-code) (process-wait pid)))
28      (if succ?
29        (let ((recv (port->lines in)))
30          (close-input-port in)
31          (if (null? (car recv))
32            (editor-raise "no element selected")
33            (cdr (assoc (caar recv) mapping))))
34        (editor-raise "failed to spawn fzf")))))
35
36;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37
38;; This code implements a very silly "parser" for the output of
39;; the readtags(1) command which is passed as a list of lines.
40
41(define-record-type Tag
42  (make-tag name file regex)
43  tag?
44  (name tag-name)
45  (file tag-file)
46  (regex tag-regex))
47
48(define (parse-tags lines)
49  (let ((fields (map (lambda (line) (string-split line "\t" #t)) lines)))
50    (map (lambda (lst) (apply make-tag lst)) fields)))
51
52(define (select-tag tags)
53  (define (tag->string tag)
54    (string-append (tag-file tag) ": " (tag-name tag)))
55
56  (if (eq? (length tags) 1)
57    (car tags)
58    (menu-select tag->string tags)))