md.el

;;; md.el --- Description -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2023 Manuel Odendahl
;;
;; Author: Manuel Odendahl <wesen@ruinwesen.com>
;; Maintainer: Manuel Odendahl <wesen@ruinwesen.com>
;; Created: July 06, 2023
;; Modified: July 06, 2023
;; Version: 0.0.1
;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp
;; Homepage: https://github.com/wesen/md
;; Package-Requires: ((emacs "25.1"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;;  Description
;;
;;; Code:


(require 's)
(require 'seq)
(require 'org-element)

(defvar md-markdown-code-regexp "^```\\(.*\\)\n\\(\\(.\\|\n\\)*?\\)```")

(defun md-get-match (s location)
  "S is a pair (START . END). GET-MATCH returns the string between START and END."
  (let ((start (car location))
        (end (cdr location)))
    (substring s start end)))

(defun md-get-regexp-matches (s subexp-level)
  "MD-GET-REGEXP-MATCHES call S-MATCHED-POSITIONS-ALL with the given SUBEXP-LEVEL
and returns the substrings of the matches."
  (let ((matches (s-matched-positions-all md-markdown-code-regexp s subexp-level)))
    (print matches)
    (mapcar (lambda (match)
              (md-get-match s match))
            matches)))

(defun md-get-code-blocks (s)
  "MD-GET-CODE-BLOCKS returns a list of (LANGUAGE . CODE) pairs."
  ;; get all matches at subexp level 1 (language) and 2 (code)
  (let ((languages (md-get-regexp-matches s 1))
        (codes (md-get-regexp-matches s 2)))
    ;; zip the 2 lists together
        (seq-mapn (lambda (language code)
                    (cons (s-trim language) code))
                  languages
                  codes)))

(defun md-find-special-block (element block-type)
  "Finds the first special block of type BLOCK-TYPE in ELEMENT."
  (let ((type (org-element-type element))
        (block-type- (org-element-property :type element)))
    (message "type: %s block-type: %s" type block-type-)
    (if (eq type 'special-block)
        (if (string= (s-upcase block-type-) (s-upcase block-type))
            element
          nil)
      (let ((parent (org-element-property :parent element)))
        (when parent (md-find-special-block parent block-type))))))

(defun md-get-org-block-content ()
  "Gets the content of the surrounding #+BEGIN_AI / #+END_AI block."
  (save-excursion
    (let* ((ai-block (md-find-special-block (org-element-at-point) "AI")))
      (if ai-block
          (buffer-substring (org-element-property :contents-begin ai-block)
                            (org-element-property :contents-end ai-block))
        ""))))

(defun md-src-org-preamble (language)
  "If LANGUAGE is of the format LANG (NAME) then output a named source block,
otherwise just a normal source block."
  (let ((matches (s-match "^\\(.*\\) (\\(.*\\))$" language)))
    (if matches
        (format "#+NAME: %s\n#+BEGIN_SRC %s\n" (nth 2 matches) (nth 1 matches))
      (format "#+BEGIN_SRC %s\n" language))))

(defun md-extract-source-blocks ()
  (interactive)
  (save-excursion
    (let* ((org-block-content (md-get-org-block-content))
           (code-blocks (md-get-code-blocks org-block-content)))
      ;; Go to the end of buffer
      (goto-char (point-max))
      (newline)
      ;; Insert each block as an org source block
      (seq-each (lambda (code-block)
                  (insert (format "%s\n%s\n#+END_SRC\n\n"
                                  (md-src-org-preamble (car code-block))
                                  (s-trim-right (cdr code-block)))))
                code-blocks))))

(provide 'md)
;;; md.el ends here