commit 60cda63

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