mirror of
https://codeberg.org/cage/tinmop/
synced 2025-03-03 10:07:36 +01:00
- [fediverse] stripped footnote reference in body of the quoted text, when replying.
This commit is contained in:
parent
39e567bd4e
commit
e323c81a1c
@ -116,6 +116,24 @@
|
|||||||
|
|
||||||
(defparameter *ordered-list-item-number* 0)
|
(defparameter *ordered-list-item-number* 0)
|
||||||
|
|
||||||
|
(defun append-footnote-reference (text reference-number)
|
||||||
|
(strcat text
|
||||||
|
(format nil
|
||||||
|
"~a~a"
|
||||||
|
#\ZERO_WIDTH_SPACE
|
||||||
|
(number->superscripts reference-number))))
|
||||||
|
|
||||||
|
(defun footnote-reference-re (&key (enforce-end-string t))
|
||||||
|
(format nil
|
||||||
|
"~a[~a]+~@[$~]"
|
||||||
|
#\ZERO_WIDTH_SPACE
|
||||||
|
+digits-superscripts+
|
||||||
|
enforce-end-string))
|
||||||
|
|
||||||
|
(let ((scanner (cl-ppcre:create-scanner (footnote-reference-re))))
|
||||||
|
(defun strip-footnote-reference (word)
|
||||||
|
(cl-ppcre:regex-replace scanner word "")))
|
||||||
|
|
||||||
(defun html->text (html &key
|
(defun html->text (html &key
|
||||||
(add-link-footnotes t) (body-footnotes-separator "")
|
(add-link-footnotes t) (body-footnotes-separator "")
|
||||||
(quote-prefix "> ") (list-item-prefix "* "))
|
(quote-prefix "> ") (list-item-prefix "* "))
|
||||||
@ -160,10 +178,8 @@ Some convenience functions are provided to works with these structures.
|
|||||||
link-count))
|
link-count))
|
||||||
(descend-children node)
|
(descend-children node)
|
||||||
(when add-link-footnotes
|
(when add-link-footnotes
|
||||||
(format body-stream
|
(write-string (append-footnote-reference "" link-count)
|
||||||
"~a~a "
|
body-stream))))
|
||||||
#\ZERO_WIDTH_SPACE
|
|
||||||
(number->superscripts link-count)))))
|
|
||||||
((tag= +tag-break+ node)
|
((tag= +tag-break+ node)
|
||||||
(let ((*block-tag* nil))
|
(let ((*block-tag* nil))
|
||||||
(format body-stream "~%")
|
(format body-stream "~%")
|
||||||
|
@ -37,8 +37,10 @@
|
|||||||
first-mention)))))
|
first-mention)))))
|
||||||
|
|
||||||
(defun line-find-all-usernames (message-line)
|
(defun line-find-all-usernames (message-line)
|
||||||
(let ((words (split-words message-line)))
|
(let ((words (split-words message-line))
|
||||||
(mapcar (lambda (a) (subseq a (length +mention-prefix+))) ; remove the @
|
(mention-prefix-length (length +mention-prefix+)))
|
||||||
|
(mapcar (lambda (a)
|
||||||
|
(html-utils:strip-footnote-reference (subseq a mention-prefix-length))) ; remove the @
|
||||||
(remove-if-not (lambda (word)
|
(remove-if-not (lambda (word)
|
||||||
(cl-ppcre:scan (strcat "^" +mention-prefix+) word))
|
(cl-ppcre:scan (strcat "^" +mention-prefix+) word))
|
||||||
words))))
|
words))))
|
||||||
@ -59,11 +61,14 @@
|
|||||||
usernames)))
|
usernames)))
|
||||||
|
|
||||||
(defun local-mention->acct (text-line usernames-table)
|
(defun local-mention->acct (text-line usernames-table)
|
||||||
"Substitute in `text-line' '@user' with '@user@server', if '@user'
|
"Substitute in `text-line' '@user' with '@user@server', if '@user'
|
||||||
is found as key in the alist `usernames-table'"
|
is found as key in the alist `usernames-table'"
|
||||||
(let ((results text-line))
|
(let ((results text-line))
|
||||||
(loop for (local-mention . actual-mention) in usernames-table do
|
(loop for (local-mention . actual-mention) in usernames-table do
|
||||||
(let ((local-mention-re (strcat "(\\s|^)" local-mention)))
|
(let ((local-mention-re (strcat "(\\s|^)"
|
||||||
|
local-mention
|
||||||
|
(html-utils:footnote-reference-re :enforce-end-string nil))))
|
||||||
|
(misc:dbg "table ~a" local-mention-re)
|
||||||
(setf results (regex-replace-all local-mention-re
|
(setf results (regex-replace-all local-mention-re
|
||||||
results
|
results
|
||||||
(strcat " " actual-mention)))))
|
(strcat " " actual-mention)))))
|
||||||
|
@ -453,6 +453,7 @@
|
|||||||
(:export
|
(:export
|
||||||
:+float-regexp+
|
:+float-regexp+
|
||||||
:+integer-regexp+
|
:+integer-regexp+
|
||||||
|
:+digits-superscripts+
|
||||||
:*blanks*
|
:*blanks*
|
||||||
:uchar-length
|
:uchar-length
|
||||||
:starts-with-prefix-p
|
:starts-with-prefix-p
|
||||||
@ -526,6 +527,9 @@
|
|||||||
:find-tag
|
:find-tag
|
||||||
:position-tag
|
:position-tag
|
||||||
:node->link
|
:node->link
|
||||||
|
:append-footnote-reference
|
||||||
|
:strip-footnote-reference
|
||||||
|
:footnote-reference-re
|
||||||
:html->text))
|
:html->text))
|
||||||
|
|
||||||
(defpackage :resources-utils
|
(defpackage :resources-utils
|
||||||
|
Loading…
x
Reference in New Issue
Block a user