cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- hooks:*before-composing-message*; 

- removed memory leak in ssl-utils:dump-certificate;
- added an hook to remove footnotes added by tinmop in post's reply.
This commit is contained in:
cage 2022-04-06 19:34:49 +02:00
parent 662ff561d1
commit a1ec070d03
6 changed files with 87 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
etc/init.lisp
View File

@ -751,3 +751,34 @@
;; (trimmed (text-utils:trim-blanks text))
;; (word-counts (length (text-utils:split-words trimmed))))
;; (< word-counts 10))))
;;; this hook will remove the footnotes to link in the message added by tinmop
(hooks:add-hook 'hooks:*before-composing-message*
(lambda (file)
(let* ((lines (text-utils:split-lines (fs:slurp-file file)))
(re-footnote-reference (cl-ppcre:create-scanner "\\[[0-9]+\\]"))
(re-footnote (cl-ppcre:create-scanner
(text-utils:strcat (swconf:quote-char)
"\\[[0-9]+\\]"
".+")))
(clean-lines (loop for line in lines
collect
(progn
(setf line
(cl-ppcre:regex-replace-all re-footnote
line
""))
(setf line
(cl-ppcre:regex-replace-all re-footnote-reference
line
""))
line))))
(with-open-file (stream
file
:direction :output
:if-does-not-exist :error
:if-exists :supersede)
(loop for line in clean-lines do
(format stream "~a~%" line))))
file))

5
src/hooks.lisp
View File

@ -93,6 +93,11 @@ non-nil.")
message on a message-window (parameters the visible rows and the
message window")
(defparameter *before-composing-message* '()
"Run this hooks before composing the message, this means sending the
message to the chosen editor, th the function takes the path of the
file where the message's contents is stored")
(defparameter *before-sending-message* '()
"Run this hooks before sending the message, note that the message
could be encrypted after this hooks runs, the function takes a

2
src/package.lisp
View File

@ -1491,6 +1491,7 @@
:open-send-message-window-event
:send-message-add-attachment-event
:send-message-event
:with-sending-message-data
:use-ui-notification
:follow-user-event
:unfollow-user-event
@ -1667,6 +1668,7 @@
:*before-quit*
:*before-rendering-message-text*
:*before-rendering-message-visible-rows*
:*before-composing-message*
:*before-sending-message*
:*skip-message-hook*
:*after-saving-message*

63
src/program-events.lisp
View File

@ -731,36 +731,43 @@
:reader use-ui-notification-p
:writer use-ui-notification)))
(defmacro with-sending-message-data ((message-body subject reply-to mentions visibility)
&body body)
(with-gensyms (send-win message-data)
`(let ((,send-win specials:*send-message-window*))
(with-accessors ((,message-data sending-message:message-data)) ,send-win
(with-accessors ((,message-body sending-message:body)
(,subject sending-message:subject)
(,reply-to sending-message:reply-to)
(,mentions sending-message:mentions)
(,visibility sending-message:visibility)) ,message-data
,@body)))))
(defmethod process-event ((object send-message-event))
(let ((send-win specials:*send-message-window*))
(with-accessors ((message-data sending-message:message-data)) send-win
(with-accessors ((body sending-message:body)
(subject sending-message:subject)
(reply-to sending-message:reply-to)
(mentions sending-message:mentions)
(visibility sending-message:visibility)) message-data
(let* ((attachments (line-oriented-window:map-rows send-win
#'line-oriented-window:normal-text)))
(hooks:run-hook 'hooks:*before-sending-message* object)
(msg-utils:maybe-crypt-message send-win
:notify-cant-crypt (use-ui-notification-p object))
(let ((exceeding-characters (ui:message-exceeds-server-limit-p body)))
(if exceeding-characters
(ui:exceeding-characters-notify exceeding-characters)
(let ((actual-message-body (if (text-utils:string-not-empty-p mentions)
(format nil
"~a~a~%~a"
+mention-prefix+
mentions
body)
body)))
(client:send-status actual-message-body
reply-to
attachments
subject
(make-keyword (string-upcase visibility)))
(ui:notify (_ "Message sent."))
(ui:close-send-message-window)))))))))
(with-sending-message-data (body subject reply-to mentions visibility)
(let* ((attachments (line-oriented-window:map-rows send-win
#'line-oriented-window:normal-text)))
(hooks:run-hook 'hooks:*before-sending-message* object)
(msg-utils:maybe-crypt-message send-win
:notify-cant-crypt (use-ui-notification-p object))
(let ((exceeding-characters (ui:message-exceeds-server-limit-p body)))
(if exceeding-characters
(ui:exceeding-characters-notify exceeding-characters)
(let ((actual-message-body (if (text-utils:string-not-empty-p mentions)
(format nil
"~a~a~%~a"
+mention-prefix+
mentions
body)
body)))
(client:send-status actual-message-body
reply-to
attachments
subject
(make-keyword (string-upcase visibility)))
(ui:notify (_ "Message sent."))
(ui:close-send-message-window))))))))
(defun find-user-id-from-exact-acct (username)
(when-let* ((remote-accounts-matching (api-client:search-user username

1
src/ui-goodies.lisp
View File

@ -1251,6 +1251,7 @@ If some posts was deleted before, download them again."
(insert-header-text temp-file)
(prepare-reply-body temp-file)
(add-signature temp-file)
(hooks:run-hook 'hooks:*before-composing-message* temp-file)
(let ((reference-open-file (get-universal-time)))
(croatoan:end-screen)
(tui:with-notify-errors

24
src/x509.lisp
View File

@ -20,14 +20,16 @@
(defun dump-certificate (ssl-stream)
(let* ((cert (cl+ssl:ssl-stream-x509-certificate ssl-stream))
(certificate-length (i2d-x509 cert (cffi:null-pointer))))
(if (< certificate-length 0)
(error "i2d-X509 failed")
(cffi:with-foreign-object (buf* :unsigned-char certificate-length)
(cffi:with-foreign-object (buf** :pointer)
(setf (cffi:mem-ref buf** :pointer) buf*)
(i2d-x509 cert buf**)
(let* ((data (loop for i from 0 below certificate-length collect
(cffi:mem-aref buf* :unsigned-char i)))
(res (misc:make-fresh-array certificate-length 0 '(unsigned-byte 8) t)))
(misc:copy-list-into-array data res)
res))))))
(unwind-protect
(if (< certificate-length 0)
(error "i2d-X509 failed")
(cffi:with-foreign-object (buf* :unsigned-char certificate-length)
(cffi:with-foreign-object (buf** :pointer)
(setf (cffi:mem-ref buf** :pointer) buf*)
(i2d-x509 cert buf**)
(let* ((data (loop for i from 0 below certificate-length collect
(cffi:mem-aref buf* :unsigned-char i)))
(res (misc:make-fresh-array certificate-length 0 '(unsigned-byte 8) t)))
(misc:copy-list-into-array data res)
res))))
(cl+ssl::x509-free cert))))