;;; lang/org/autoload/org-link.el -*- lexical-binding: t; -*-

(defun +org--relpath (path root)
  (if (and buffer-file-name (file-in-directory-p buffer-file-name root))
      (file-relative-name path)
    path))

;;;###autoload
(defun +org-def-link (key dir)
  (org-link-set-parameters
   key
   :complete (lambda () (+org--relpath (+org-link-read-file key dir) dir))
   :follow   (lambda (link) (find-file (expand-file-name link dir)))
   :face     (lambda (link)
               (if (file-exists-p (expand-file-name link dir))
                   'org-link
                 'error))))

;;;###autoload
(defun +org-link-read-file (key dir)
  (let ((file (read-file-name (format "%s: " (capitalize key)) dir)))
    (format "%s:%s"
            key
            (file-relative-name file dir))))

;;;###autoload
(defun +org-link-read-directory (key dir)
  (let ((file (read-directory-name (format "%s: " (capitalize key)) dir)))
    (format "%s:%s"
            key
            (file-relative-name file dir))))

;;;###autoload
(defun +org-inline-data-image (_protocol link _description)
  "Interpret LINK as base64-encoded image data."
  (base64-decode-string link))

;;;###autoload
(defun +org-image-link (protocol link _description)
  "Interpret LINK as base64-encoded image data."
  (when (image-type-from-file-name link)
    (if-let* ((buf (url-retrieve-synchronously (concat protocol ":" link))))
        (with-current-buffer buf
          (goto-char (point-min))
          (re-search-forward "\r?\n\r?\n" nil t)
          (buffer-substring-no-properties (point) (point-max)))
      (message "Download of image \"%s\" failed" link)
      nil)))


;;
;;; Commands

;;;###autoload
(defun +org/remove-link ()
  "Unlink the text at point."
  (interactive)
  (unless (org-in-regexp org-link-bracket-re 1)
    (user-error "No link at point"))
  (save-excursion
    (let ((label (if (match-end 2)
                     (match-string-no-properties 2)
                   (org-link-unescape (match-string-no-properties 1)))))
      (delete-region (match-beginning 0) (match-end 0))
      (insert label))))