diff --git a/src/package.lisp b/src/package.lisp index b8a3183..e97c148 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -681,6 +681,19 @@ :ipv4-address-p :ipv6-address-p)) +(defpackage :tour-mode-parser + (:use + :cl + :alexandria + :esrap + :cl-ppcre + :text-utils) + (:export + :range-from + :range-to + :range-p + :parse-tour-mode)) + (defpackage :x509 (:use :cl diff --git a/src/tour-mode-parser.lisp b/src/tour-mode-parser.lisp new file mode 100644 index 0000000..be43bfd --- /dev/null +++ b/src/tour-mode-parser.lisp @@ -0,0 +1,45 @@ +;; tinmop: an humble gemini and pleroma client +;; Copyright (C) 2021 cage + +;; 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/][http://www.gnu.org/licenses/]]. + +(in-package :tour-mode-parser) + +(define-constant +-separator+ "/" :test #'string=) + +(defrule digit (character-ranges (#\0 #\9)) + (:text t)) + +(defrule range-delimter #\-) + +(defrule list-delimiter #\Space) + +(defrule number (and digit (* digit)) + (:text t) + (:function parse-integer)) + +(defstruct range from to) + +(defrule range (and number range-delimter number) + (:function (lambda (a) (make-range :from (first a) :to (third a))))) + +(defrule tour-tail (? (and list-delimiter tour)) + (:function rest)) + +(defrule tour (and (or range number) tour-tail) + (:function flatten)) + +(defun parse-tour-mode (data) + (parse 'tour data)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 0ceac50..5d134af 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1868,24 +1868,28 @@ gemini://gemini.circumlunar.space/docs/companion/subscription.gmi (defun tour-mode-on-input-completed-clsr (links) (lambda (data) (when (string-not-empty-p data) - (let ((words (split-words data))) - (if (> (length words) 1) - (let ((indices-list (mapcar - #'num:safe-parse-number - (split-words data)))) - (loop for index in indices-list when index do - (if (<= 0 index (length links)) - (push (elt links index) - tour) - (notify (format nil (_ "Index ~a out of range") index) - :as-error t)))) + (let ((parsed-tour (ignore-errors (tour-mode-parser:parse-tour-mode data)))) + (if (not parsed-tour) (when-let ((scanner (create-scanner data))) (loop for link in links do (when (or (scan scanner (gemini-parser:name link)) (scan scanner (gemini-parser:target link))) (pushnew link tour :test (lambda (a b) (string= (gemini-parser:target a) - (gemini-parser:target b))))))))) + (gemini-parser:target b))))))) + (let ((all-indices ())) + (loop for index in parsed-tour do + (if (tour-mode-parser:range-p index) + (let ((from (tour-mode-parser:range-from index)) + (to (tour-mode-parser:range-to index))) + (loop for i from (min from to) to (max from to) do + (pushnew i all-indices :test #'=))) + (pushnew index all-indices :test #'=))) + (loop for index in (reverse all-indices) do + (if (<= 0 index (length links)) + (push (elt links index) tour) + (notify (format nil (_ "Index ~a out of range") index) + :as-error t)))))) (info-message (_ "Tour saved"))))) (defun tour-mode-link () diff --git a/tinmop.asd b/tinmop.asd index ba43c0b..736b7c5 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -74,6 +74,7 @@ (:file "stack") (:file "uri-parser") (:file "iri-parser") + (:file "tour-mode-parser") (:file "x509-ffi") (:file "x509") (:file "api-pleroma-entities")