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	)))))