diff --git a/lisp/mir-orgstuff.el b/lisp/mir-orgstuff.el index 676981a..5e5ab47 100644 --- a/lisp/mir-orgstuff.el +++ b/lisp/mir-orgstuff.el @@ -7,37 +7,170 @@ ;;; Code: +(require 'dash) +(require 'f) +(require 'ox-publish) +(require 'hyperbole) + (defvar org-directory (expand-file-name "org/" "~")) (defvar org-agenda-files '("~/org/")) -(defvar org-vw-dir org-directory) ;; whoops +(defvar org-vw-staging-dir "/unicron_shared/webbed-site/staging/") +(defvar org-vw-export-dir "/unicron_shared/webbed-site/public/") (defvar org-wiki-regex "\\`[^.].*\\.org\\'") +(defvar org-vw--link-re (rx "[[" (* any) (+ alnum) + ".org][" (* any) "]]")) -(defun org-vw-get-filename (word) - "Given WORD, generate the absolute filename for that org-vw entry." - (expand-file-name (format "%s.org" (downcase word)) org-vw-dir)) -;; (org-vw-get-filename "wordWERD") +;; need to make a hyperbole +(add-to-list 'hkey-alist '((and + (eq major-mode 'org-mode) + (not (smart-org))) + . ((org-vw-make-newlink) . nil))) + +;; ------------------- links and exporting ------------------------------------- +(defun org-vw-link-at-point () + (interactive) + (save-match-data + (string-match org-vw--link-re (thing-at-point 'line)) + (with-current-buffer ( + ;; it was at this point that she gave up from scratch + )) + (buffer-substring-no-properties match-beginning match-end))) +(defun org-vw--get-link-basename (link) + (if (string-match-p org-vw--link-re link) + (--> link + (split-string it "]\\[") + (car it) + (string-trim it "\\[\\[" "]]") + (string-trim-right it "/index\.org$")) + (error "malformed link, what are you doing"))) +;; (org-vw--get-link-basename "[[lasdfjl/index.org][asdlkfj]]") +(defun fix-links-temporarily-in-current-buffer () + "Run every link thru `org-vw-preexp-link'." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (save-excursion + (re-search-forward + org-vw--link-re nil 'no-error)) + (goto-char (match-beginning 0)) + (org-vw-preexp-link)))) +(string-match-p org-vw--link-re + "[[maybe-not.org][maybe not]]") +(defun htmlize-current-buffer-to-file (file) + "Run `htmlize-buffer' and save the result to FILE." + (interactive "sWrite to file: ") + (with-current-buffer (htmlize-buffer) + (write-file file) + (kill-buffer (current-buffer)))) +(defun mir/export-buffer-to-html-fixed-links (file) + "Synthesis of `fix-links-temporarily-in-current-buffer' and `htmlize-current-buffer-to-file'. FILE is to be written." + (interactive "sExport to file: ") + (ignore-errors + (evil-with-single-undo + (fix-links-temporarily-in-current-buffer) + (htmlize-current-buffer-to-file file)) + (evil-undo-pop)) ;todo later: can we wrap in something less evil? + ) +(defun org-vw-get-index-name (source basedir) + "Given SOURCE, return the org link pointing to the corresponding html." + (let* ((basename (file-name-directory source))) + (if (string= (expand-file-name "index" basedir) basename) + "./" + (progn + ;; (ignore-errors (mkdir (format "%s/%s/" basedir basename) t)) + (format "./%s/" basename)) ))) +;; (file-name-directory "test/index.tft") + +;; big folder level export +(defun all-orgs-mds-in-dir (dir) + "Return a list of every markdown and org file in DIR." + (let ((default-directory dir)) + (--remove + (or + (f-directory-p it) + (not (or + (string= (f-ext it) "md") + (string= (f-ext it) "org") + )) + ) + (f-entries dir nil t)))) +;; (all-orgs-mds-in-dir "/unicron_shared/webbed-site/public/") +;; loop over this + +(defun do-file-in-sitedir (file sitedir) + "too tired to write words. only code sry" + (with-current-buffer (or (get-file-buffer file) (find-file file)) + (mir/export-buffer-to-html-fixed-links + (org-vw-get-index-name file sitedir)))) +(defun org-vw-export () + "htmlize recursively all org files in SITEDIR." + (interactive "sDirectory (leave blank for current): ") + (let* ((orgs-mds (all-orgs-mds-in-dir org-vw-staging-dir))) + (message "------- org and markdown files: %s" orgs-mds) + (--map + (progn + (message "operating on %s" it) + (do-file-in-sitedir it (org-vw-get-index-name it sitedir))) + orgs-mds) + )) + +;; -------------------- + +;; --------------------- below be dragons -------------------------------------- + +(defun org-vw-preexp-link () + "Re-format the next instance of name.org to name/ ." + (let* ((link-regex org-vw--link-re) + (endpoint (re-search-forward link-regex)) + (startpoint (re-search-backward link-regex)) + (old-link-text (buffer-substring-no-properties startpoint endpoint)) + (old-link-components + (--map (string-trim it (rx (+ "[")) (rx (+ "]"))) + (split-string old-link-text "]\\[" t))) + (new-link-components + (list (org-vw-get-index-name + (car old-link-components) + org-vw-export-dir + ;; default-directory ; figure because we're necessarily in the buffer right? + ) + (cadr old-link-components))) + (new-link-text (format "[[%s][%s]]" + (car new-link-components) + (cadr new-link-components))) + (length-diff (- (length old-link-text) (length new-link-text)))) + (delete-region startpoint endpoint) + (insert new-link-text) + ) + ) +;; ----------- that was a big dragon. carry on --------------------------------- + +(defun org-vw-named-index-org (word) + "given word, generate the absolute filename for that org-vw entry." + (expand-file-name + (format "%s/index.org" (downcase word)) org-vw-staging-dir)) (defun org-vw-make-newlink () "Make the word at point the link to an org file, like in VimWiki." (interactive) + ;; todo: can we use `save-excusion' ? (let* ((oldpoint (point)) (current-word (thing-at-point 'word 'no-properties)) - (cw-file-name (org-vw-get-filename current-word))) + (cw-file-name (org-vw-named-index-org current-word))) (backward-word) (kill-word 1) (org-insert-link nil cw-file-name current-word) (goto-char oldpoint))) ;; (org-insert-link nil "~/" "a file or sth") -(defun org-vw-show-markup () ;;broken, just use org-appear or sth - "When on a line containing hidden characters, show them." - (interactive) - (let ((point (point)) - (bol (point-at-bol)) - (eol (point-at-eol))) - (remove-text-properties bol eol - '(invisible nil)) - t)) +;; (defun org-vw-show-markup () ;;broken, just use org-appear or sth +;; "When on a line containing hidden characters, show them." +;; (interactive) +;; (let ((point (point)) +;; (bol (point-at-bol)) +;; (eol (point-at-eol))) +;; (remove-text-properties bol eol +;; '(invisible nil)) +;; t)) (defun org-vw-back () "Go back to the previous org file and bury this buffer." (interactive) @@ -56,9 +189,9 @@ (run-hooks org-vw-pre-hook) ;; TODO: This is a hack, because hyperbole is scary. Ideal implementation ;; would add a proper case rather than this weird fallback. - (require 'hyperbole) - (make-local-variable action-key-default-function) - (setq-local action-key-default-function #'org-vw-make-newlink) + ;; (require 'hyperbole) + ;; (make-local-variable action-key-default-function) + ;; (setq-local action-key-default-function #'org-vw-make-newlink) ;; General: (general-define-key :keymaps 'local