From 47fa796bc665db84c3a918aef4a4d3ea2cbc825b Mon Sep 17 00:00:00 2001
From: cage <cage-invalid@invalid>
Date: Sun, 27 Dec 2020 14:51:59 +0100
Subject: [PATCH] - added a module to share a gemini page on pleroma.

---
 etc/init.lisp                  |  4 ++++
 modules/share-gemini-link.lisp | 35 ++++++++++++++++++++++++++++++++++
 src/package.lisp               |  2 ++
 src/ui-goodies.lisp            | 16 ++++++++++++++--
 4 files changed, 55 insertions(+), 2 deletions(-)
 create mode 100644 modules/share-gemini-link.lisp

diff --git a/etc/init.lisp b/etc/init.lisp
index d6f8c08..902d1dc 100644
--- a/etc/init.lisp
+++ b/etc/init.lisp
@@ -37,6 +37,10 @@
 
 (load-module "next-previous-open.lisp")
 
+;; share a gemini page
+
+(load-module "share-gemini-link.lisp")
+
 ;; keybindings syntax:
 
 ;; a command is executed after a sequence  of one or more keys.  a key
diff --git a/modules/share-gemini-link.lisp b/modules/share-gemini-link.lisp
new file mode 100644
index 0000000..5ab00c3
--- /dev/null
+++ b/modules/share-gemini-link.lisp
@@ -0,0 +1,35 @@
+;; Tinmop module to share the link pointing to the current gemini page
+;; on pleroma.
+;; Copyright © 2020 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/>.
+
+(in-package :modules)
+
+(defun gemini-window-p ()
+  (gemini-viewer:gemini-metadata-p (message-window:metadata specials:*message-window*)))
+
+(defun share-gemini-link ()
+  "Share the link pointing to the current gemini page on pleroma."
+  (if (gemini-window-p)
+      (let* ((metadata    (message-window:metadata specials:*message-window*))
+             (link        (last-elt (gemini-viewer:gemini-metadata-history metadata)))
+             (source      (gemini-viewer:gemini-metadata-source-file metadata))
+             (source-head (with-input-from-string (stream source)
+                            (read-line stream nil "...")))
+             (headline    (format nil "~a~2%~a~%" source-head link)))
+        (compose-message :message-header-text headline))
+      (error-message (_ "The window is not displaying a gemini document"))))
+
+(define-key "M-x s l" #'share-gemini-link *gemini-message-keymap*)
diff --git a/src/package.lisp b/src/package.lisp
index 85072bf..029b365 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -2104,6 +2104,7 @@
    :make-gemini-metadata
    :gemini-metadata-links
    :gemini-metadata-source-file
+   :gemini-metadata-history
    :gemini-metadata-p
    :copy-gemini-metadata
    :append-metadata-link
@@ -2342,6 +2343,7 @@
    :text-utils
    :resources-utils
    :specials
+   :db-utils
    :windows
    :sending-message
    :keybindings
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index 1ba161e..644fbe3 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -931,7 +931,7 @@ Force the checking for new message in the thread the selected message belong."
                              exceeding)
                          exceeding)))
 
-(defun compose-message (&optional timeline folder reply-id subject (visibility +status-public-visibility+))
+(defun compose-message (&key timeline folder reply-id subject (visibility +status-public-visibility+) (message-header-text nil))
   "Compose a new message"
   (setf *message-to-send* (make-instance 'sending-message:message-ready-to-send
                                          :visibility visibility
@@ -992,8 +992,16 @@ Force the checking for new message in the thread the selected message belong."
                                 :element-type 'character
                                 :if-exists    :append)
                  (write-sequence signature stream))))
+           (insert-header-text (file)
+             (when (string-not-empty-p file)
+               (with-open-file (stream file
+                                       :if-exists    :append
+                                       :direction    :output
+                                       :element-type 'character)
+                 (format stream "~a~%" message-header-text))))
            (add-body ()
              (let ((temp-file (fs:temporary-file)))
+               (insert-header-text temp-file)
                (prepare-reply-body temp-file)
                (add-signature temp-file)
                (let ((reference-open-file (get-universal-time)))
@@ -1025,7 +1033,11 @@ Force the checking for new message in the thread the selected message belong."
               (visibility       (db:row-message-visibility actual-message))
               (reply-id         (actual-author-message-id  actual-message)))
     (let* ((subject (db:row-message-subject actual-message)))
-      (compose-message timeline folder reply-id subject visibility))))
+      (compose-message :timeline   timeline
+                       :folder     folder
+                       :reply-id   reply-id
+                       :subject    subject
+                       :visibility visibility))))
 
 (defun send-message ()
   "Send message"