cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues
tinmop/src/gopher-window.lisp

292 lines
14 KiB
Common Lisp
Raw Normal View History

- changed brief description of the program.
2023-10-19 17:49:54 +02:00
;; tinmop: a multiprotocol client
- updated copyright.
2023-10-19 17:46:22 +02:00
;; Copyright © cage
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :gopher-window)
(defclass gopher-window (wrapper-window
focus-marked-window
title-window
border-window
row-oriented-widget)
((page-type
:initarg :page-type
:initform nil
:accessor page-type
:documentation "The type of the page , 0,1,2,i etc.")))
- added bookmarking of gopher addresses.
2022-08-31 14:03:39 +02:00
(defun gopher-window-p (w)
(typep w 'gopher-window))
(defun current-gopher-url ()
(when (gopher-window-p specials:*gopher-window*)
(a:when-let* ((metadata (message-window:metadata specials:*message-window*))
(history (gemini-viewer:gemini-metadata-history metadata))
(link (a:last-elt history)))
link)))
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
(defmethod refresh-config :after ((object gopher-window))
(refresh-config-colors object swconf:+key-gopher-window+)
(let* ((height (win-height *message-window*))
(width (win-width *message-window*))
(x (win-x *message-window*))
(y (win-y *message-window*)))
(win-resize object width height)
(win-move object x y)))
(defmethod draw :after ((object gopher-window))
(with-accessors ((uses-border-p uses-border-p)) object
(when-window-shown (object)
(let ((max-line-size (if uses-border-p
(win-width-no-border object)
(win-width object))))
(let ((rows (renderizable-rows-data object))
(x (if (uses-border-p object)
1
0))
(y-start (if (uses-border-p object)
1
0)))
(loop
for y from y-start
for ct from 0
for row in rows do
(let ((tui-text (if (selectedp row)
(tui:apply-attributes (selected-text row)
:all
(tui:combine-attributes (tui:attribute-reverse)
(tui:attribute-bold)))
(normal-text row))))
(print-text object (right-pad-text (text-ellipsis tui-text max-line-size)
max-line-size)
x y)))
(when (> (rows-length object) 0)
(let* ((current-selected (1+ (row-selected-index object)))
(pages-count-line (format nil
(_ "line ~a of ~a")
current-selected
(rows-length object)))
(x-count-line (- (win-width object)
(length pages-count-line)
1))
(y-count-line (1- (win-height object))))
(print-text object
(text-ellipsis pages-count-line (win-width-no-border object))
x-count-line
y-count-line))))))))
(defgeneric gopher-line->text (line))
(defun %gemline->text-simple (line prefix)
(let* ((prefix-color (swconf:config-gopher-line-prefix-foreground))
(prefix-attribute (swconf:config-gopher-line-prefix-attribute))
- [gopher] removed bad characters when printing lines.
2022-09-25 10:58:38 +02:00
(username (remove-corrupting-utf8-chars (gopher-parser:username line)))
(colorized (message-window::colorize-lines username))
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
(colorized-prefix (tui:make-tui-string prefix
:attributes prefix-attribute
:fgcolor prefix-color)))
(tui:cat-tui-string colorized-prefix
(tui:apply-attributes colorized :all (tui:attribute-bold))
:color-attributes-contagion nil)))
(defmethod gopher-line->text ((line gopher-parser:line-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-text-file)))
(defmethod gopher-line->text ((line gopher-parser:line-dir))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-directory)))
(defmethod gopher-line->text ((line gopher-parser:line-cso))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-error))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-mac-hex-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-dos-archive-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-uuencoded-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-index-search))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-search-index)))
(defmethod gopher-line->text ((line gopher-parser:line-telnet-session))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-binary-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-binary-file)))
(defmethod gopher-line->text ((line gopher-parser:line-redundant-server))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-directory)))
(defmethod gopher-line->text ((line gopher-parser:line-tn3270-session))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-gif-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-gif-file)))
(defmethod gopher-line->text ((line gopher-parser:line-image-file))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-image-file)))
(defmethod gopher-line->text ((line gopher-parser:line-info))
(message-window::colorize-lines (gopher-parser:username line)))
(defmethod gopher-line->text ((line gopher-parser:line-uri))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-uri)))
(defmethod gopher-line->text ((line gopher-parser:line-unknown))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
- allowed empty lines in a gopher map (thanks op!).
2024-02-19 20:49:14 +01:00
(defmethod gopher-line->text ((line gopher-parser:line-empty))
(%gemline->text-simple line ""))
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
(defun print-response-rows (window gopher-lines)
(flet ((make-rows (lines)
(mapcar (lambda (line)
(make-instance 'line
:fields (list :original-object line)
:normal-text (gopher-line->text line)
:selected-text (gopher-line->text line)))
lines)))
(line-oriented-window:update-all-rows window (make-rows gopher-lines))))
(defun init ()
(maybe-close-window *gopher-window*)
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
(setf *gopher-window*
(make-instance 'gopher-window
:uses-border-p t
:title (_ "Gopher menu")
:keybindings keybindings:*gopher-keymap*
:key-config swconf:+key-gopher-window+
:croatoan-window low-level-window))
(refresh-config *gopher-window*)
(draw *gopher-window*)
*gopher-window*))
(defun not-link-line-p (line)
(let ((original-object (message-window:extract-original-object line)))
(not (or (gopher-parser:line-type-info-p original-object)
- allowed empty lines in a gopher map (thanks op!).
2024-02-19 20:49:14 +01:00
(gopher-parser:line-type-error-p original-object)
(gopher-parser:line-type-empty-p original-object)))))
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
(defun go-to-next-link ()
(a:when-let* ((win *gopher-window*)
(1+selected-row-pos (1+ (line-oriented-window:row-selected-index win)))
(link-line-pos (rows-position-if win
#'not-link-line-p
:start 1+selected-row-pos)))
(line-oriented-window:unselect-all win)
(line-oriented-window:row-move win (- link-line-pos (1- 1+selected-row-pos)))
(win-clear win)
(windows:draw win)))
(defun go-to-previous-link ()
(a:when-let* ((win *gopher-window*)
(selected-row-pos (line-oriented-window:row-selected-index win))
(link-line-pos (rows-position-if win
#'not-link-line-p
:from-end t
:end selected-row-pos)))
(line-oriented-window:unselect-all win)
(line-oriented-window:row-move win (- link-line-pos selected-row-pos))
(win-clear win)
(windows:draw win)))
- [gopher] added support for index search lines.
2022-09-21 16:19:03 +02:00
(defun make-search-query (selector search-expression)
(format nil "~a~a~a" selector #\tab search-expression))
(defun search-index-server (host port selector)
(flet ((on-input-complete (search-expression)
(when (string-not-empty-p search-expression)
(program-events:with-enqueued-process ()
(make-request host
port
gopher-parser:+line-type-dir+
(make-search-query selector search-expression))))))
(ui:ask-string-input #'on-input-complete
:prompt (_ "Enter search terms: ")
:complete-fn #'complete:complete-always-empty)))
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
(defun make-request (host port type selector)
(let ((message-win specials:*message-window*))
(gemini-viewer:maybe-initialize-metadata message-win)
- [gopher] fixed going back to net history.
2022-10-01 17:44:40 +02:00
(with-notify-errors
(let ((link (format nil "~a://~a:~a/~a/~a"
gopher-parser:+gopher-scheme+
host
port
type
selector)))
(gemini-viewer:push-url-to-history message-win link)
- [gopher] added notification of any error signaled when making a gopher request.
2022-10-01 17:02:46 +02:00
(cond
((gopher-parser::%line-type-dir-p type)
(let ((data (misc:make-fresh-array 0 :type '(unsigned-int 8))))
(gopher-client:request host
type
:port port
:selector selector
:collect-fn (gopher-client:make-collect-fn data))
(init)
(ui:focus-to-gopher-window)
(print-response-rows *gopher-window*
(gopher-parser:parse-menu (text-utils:to-s data)))
(select-row *gopher-window* 0)
(draw *gopher-window*)))
((gopher-parser::%line-type-index-search-p type)
(search-index-server host port selector))
((gopher-parser::%line-type-file-p type)
- [gopher] prevented crash when opening a gopher link and gopher window is not visible; - [gopher] fixed parsing of text files.
2023-10-03 21:20:09 +02:00
(when *gopher-window*
(win-close *gopher-window*))
- [gopher] added notification of any error signaled when making a gopher request.
2022-10-01 17:02:46 +02:00
(let ((data (misc:make-fresh-array 0 :type '(unsigned-int 8))))
(gopher-client:request host
type
:port port
:selector selector
:collect-fn (gopher-client:make-collect-fn data))
(let* ((text (to-s data))
(raw-lines (split-lines (gopher-parser:parse-text-file text)))
(lines (mapcar (lambda (a)
(message-window:text->rendered-lines-rows *message-window*
a))
raw-lines)))
(line-oriented-window:update-all-rows *message-window* (a:flatten lines))
(draw *message-window*)
(ui:focus-to-message-window))))
(t
(fs:with-anaphoric-temp-file (stream)
(gopher-client:request host
type
:port port
:selector selector
:collect-fn (lambda (buffer)
(write-sequence buffer stream)))
(finish-output stream)
(os-utils:open-resource-with-external-program filesystem-utils:temp-file
nil))))))))
- added a basic gopher implementation.
2022-08-28 13:22:08 +02:00
(defun open-menu-link ()
(a:when-let* ((win *gopher-window*)
(selected-row (selected-row win))
(line (message-window:extract-original-object selected-row)))
(with-accessors ((line-type-id gopher-parser:line-type-id)
(selector gopher-parser:selector)
(host gopher-parser:host)
(port gopher-parser:port)) line
(make-request host port line-type-id selector))))