Prompt for filename when saving, store bytes directly - holymoly - A tor enabled gopher client written in CHICKEN scheme
(HTM) git clone git://vernunftzentrum.de/holymoly.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
(DIR) commit 0a9c37e9adfba3f5c643b06f32a90c68ff104763
(DIR) parent e85ae8fc44a31816b3b4c1f56756e20cc205b399
(HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
Date: Tue, 13 Mar 2018 22:52:00 +0100
Prompt for filename when saving, store bytes directly
Diffstat:
holymoly.scm | 46 +++++++++++++++++--------------
1 file changed, 25 insertions(+), 21 deletions(-)
---
(DIR) diff --git a/holymoly.scm b/holymoly.scm
@@ -89,16 +89,15 @@
((113) (k #f)) ; q
(else pos)))))))))
-(define (get-user-input)
+(define (get-user-input #!optional (prompt "Enter query:") (suggestion ""))
(let* ((l c (getmaxyx (stdscr)))
- (w (newwin 3 c (quotient l 2) 0))
- (query "Enter query:"))
- (let input-loop ((r '()))
+ (w (newwin 3 c (quotient l 2) 0)))
+ (let input-loop ((r (reverse (string->list suggestion))))
(define (refresh r)
(wclear w)
(box w 0 0)
(mvwprintw w 0 (- (quotient c 2)
- (quotient (string-length query) 2)) query)
+ (quotient (string-length prompt) 2)) prompt)
(mvwprintw w 1 2 "~a" (list->string (reverse r)))
(mvwchgat w 1 (+ 2 (length r)) 1 A_BLINK 0 #f)
(wrefresh w))
@@ -146,20 +145,22 @@
(let-values (((i o _) (connect/socksv5 (car (proxy)) (cdr (proxy)) server port)))
(new-status "connected.")
(display (string-append resource (string #\linefeed #\return)) o)
- (let ((response (read-until (if until-eof? #f ".") i)))
+ (let ((response (if until-eof?
+ (read-u8vector #f i)
+ (read-until "." i))))
(close-input-port i)
(close-output-port o)
response))
(e (exn i/o net)
- (endwin)
- (new-status "Network error: ~a" ((condition-property-accessor 'exn 'message) e))
- (sleep 1)
- (beep)
- (select-entry (previous-page)))
+ (endwin)
+ (new-status "Network error: ~a" ((condition-property-accessor 'exn 'message) e))
+ (sleep 1)
+ (beep)
+ (select-entry (previous-page)))
(e ()
- (endwin)
- (pp (condition->list e))
- (abort e))))
+ (endwin)
+ (pp (condition->list e))
+ (abort e))))
(define mapping-table
@@ -236,18 +237,21 @@
(links (get-indices p (lambda (e) (not (equal? (entry-type e) 'info))))))
(pager p win: (main-win) renderer: render-entry use-cursor: (not (null? links)) selectables: links)))
-(define nop values)
-
(define type-handlers
`((file . ,(lambda (c) (pager c win: (main-win)) (previous-page)))
(directory . ,render-directory)
(index-search . ,render-directory)))
(define (save-selector entry content)
- (let ((filename (string-append "/tmp/" (last (string-split (entry-selector entry) "/")) (if (equal? (entry-type entry) 'gif) ".gif" ""))))
- (with-output-to-file filename
- (lambda () (map display content)))
- (system (string-append "xdg-open file://" filename))))
+ (let* ((filename (string-append "/tmp/"
+ (last (string-split (entry-selector entry) "/"))))
+ (path (get-user-input "Where to save the file:" filename)))
+ (unless (string-null? path)
+ (with-output-to-file path
+ (lambda () (write-u8vector content)))
+ (new-status "~a saved." path)
+ (sleep 2))
+ (previous-page)))
(define (select-entry e)
(when (and (equal? (entry-type e) 'index-search)
@@ -259,7 +263,7 @@
(entry-selector-set! e (string-append (car (string-split old-selector "?")) "?" (string-intersperse (string-split query) "+"))))))
(unless (equal? e (current-page))
(push! e history))
- (let* ((res (request-resource (entry-host e) (entry-selector e) (entry-port e) (memq (entry-type e) '(dos-archive binary))))
+ (let* ((res (request-resource (entry-host e) (entry-selector e) (entry-port e) (memq (entry-type e) '(dos-archive binary gif))))
(handler (or
(alist-ref (entry-type e) type-handlers)
(lambda (c) (save-selector e c))))