cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2024-12-22 23:47:56 +01:00
Code Issues

- allowed empty lines in a gopher map (thanks op!).

Browse Source
This commit is contained in:
cage 2024-02-19 20:49:14 +01:00
parent bc8c34f2f6
commit e23ca2c131
3 changed files with 34 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/gopher-window.lisp
View File

@ -152,6 +152,9 @@
(defmethod gopher-line->text ((line gopher-parser:line-unknown))
(%gemline->text-simple line (swconf:config-gopher-line-prefix-unknown)))
(defmethod gopher-line->text ((line gopher-parser:line-empty))
(%gemline->text-simple line ""))
(defun print-response-rows (window gopher-lines)
(flet ((make-rows (lines)
(mapcar (lambda (line)
@ -179,7 +182,8 @@
(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)
(gopher-parser:line-type-error-p original-object)))))
(gopher-parser:line-type-error-p original-object)
(gopher-parser:line-type-empty-p original-object)))))
(defun go-to-next-link ()
(a:when-let* ((win *gopher-window*)

2
src/gopher/package.lisp
View File

@ -62,11 +62,13 @@
:line-info
:line-uri
:line-unknown
:line-empty
:line-type-file-p
:line-type-info-p
:line-type-dir-p
:line-type-cso-p
:line-type-error-p
:line-type-empty-p
:line-type-mac-hex-file-p
:line-type-dos-archive-file-p
:line-type-uuencoded-file-p

38
src/gopher/parser.lisp
View File

@ -42,7 +42,8 @@
(gif-image-file "g" "identifier for an image in GIF")
(image-file "I" "identifier for an image file")
(info "i" "information line")
(uri "h" "hyperlink")))
(uri "h" "hyperlink")
(empty "" "empty line")))
(a:define-constant +gopher-scheme+ "gopher" :test #'string=)
@ -86,6 +87,8 @@
(%gen-check-line-predicate uri +line-type-uri+)
(%gen-check-line-predicate empty +line-type-empty+)
(defclass gopher-line ()
((line-type-id
:initarg :line-type-id
@ -160,6 +163,8 @@
(gen-selector-class line-unknown)
(gen-selector-class line-empty)
(defun check-line-type (data reference)
(typep data reference))
@ -200,7 +205,9 @@
(gen-check-line-predicate uri 'line-uri)
(gen-check-line-predicate unknown 'unknown)
(gen-check-line-predicate unknown 'line-unknown)
(gen-check-line-predicate empty 'line-empty)
(defrule line-separator (and #\Return #\Newline)
(:constant :line-separator))
@ -246,16 +253,23 @@
(defrule port digit-sequence
(:function parse-integer))
(defrule dir-entity (and line-type user-name field-separator
selector field-separator
host field-separator
port line-separator)
(defrule dir-entity (or (and line-type user-name field-separator
selector field-separator
host field-separator
port line-separator)
line-separator)
(:function (lambda (line)
(list :type (first line)
:user-name (second line)
:selector (fourth line)
:host (sixth line)
:port (elt line 7)))))
(if (listp line)
(list :type (first line)
:user-name (second line)
:selector (fourth line)
:host (sixth line)
:port (elt line 7))
(list :type +line-type-empty+
:user-name ""
:selector ""
:host ""
:port "")))))
(defrule menu (and (* dir-entity) (? last-line))
(:function first))
@ -298,6 +312,8 @@
(make-instance 'line-info))
((%line-type-uri-p line-type)
(make-instance 'line-uri))
((%line-type-empty-p line-type)
(make-instance 'line-empty))
(t
(make-instance 'line-unknown)))))
(setf (line-type-id instance) (getf entry :type)