whole bunch of org / hyperbole changes

not sure what to make of this tbh
This commit is contained in:
Miranda Marquez 2024-10-20 09:16:54 -08:00
parent f8ae2a6225
commit 3996ec5605

View File

@ -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