master
gfm.scm
1(use-modules (srfi srfi-1)
2 (ice-9 rdelim)
3 (ncurses curses)
4 (ncurses menu))
5
6(define NAME (basename (car (command-line))))
7
8(define (list-directory path)
9 (let ((dir (opendir path)))
10 (let loop ((file (readdir dir))
11 (files '()))
12 (if (eof-object? file)
13 (begin
14 (closedir dir)
15 (reverse files)
16 (sort files string<?)
17 )
18 (loop (readdir dir)
19 (cons file files))))))
20
21(define stdscr (initscr))
22(cbreak!)
23(noecho!)
24(keypad! stdscr #t)
25
26(format #t "\x1b]0;~a\x07" NAME)
27(force-output)
28
29(let fs ((names (list-directory "."))
30 )
31 (define my-items (map (lambda (name) (new-item name "")) names))
32 (define my-menu (new-menu my-items))
33
34 ;; (move stdscr (- (lines) 2) 0)(addstr ")
35
36 (clear stdscr)(refresh stdscr)
37 (post-menu my-menu)
38
39 (let loop ((c (getch stdscr)))
40 (format #t "\x1b]0;~a: ~a\x07" NAME (item-name (current-item my-menu)))
41 (force-output)
42 (cond
43 ((eqv? c KEY_DOWN)
44 (menu-driver my-menu REQ_DOWN_ITEM)
45 (refresh stdscr)
46 (loop (getch stdscr)))
47
48 ((eqv? c KEY_UP)
49 (menu-driver my-menu REQ_UP_ITEM)
50 (refresh stdscr)
51 (loop (getch stdscr)
52 ))
53
54 ((eqv? c KEY_RIGHT)
55 (catch 'system-error
56 (lambda ()
57 (chdir
58 (format #f "~a/~a" (getcwd) (item-name (current-item my-menu))))
59 (fs (list-directory (getcwd)))
60 )
61 (lambda (key . args)
62 (+ 60 7)
63 )
64 )
65 (fs (list-directory (getcwd)))
66 (loop (getch stdscr)))
67
68 ((eqv? c KEY_LEFT)
69 (catch 'system-error
70 (lambda ()
71 (chdir
72 (format #f "~a/~a" (getcwd) ".."))
73 (fs (list-directory (getcwd)))
74 )
75 (lambda (key . args)
76 (+ 60 7)
77 )
78 )
79 (fs (list-directory (getcwd)))
80 (loop (getch stdscr)))
81
82 ((eqv? c #\o)
83 (system* "xdg-open" (item-name (current-item my-menu)))
84 (loop (getch stdscr)
85 )
86
87 ;;(free-menu my-menu)
88 (refresh stdscr)
89 (loop (getch stdscr))
90 (fs (list-directory (getcwd))
91 )))))