whole bunch of org / hyperbole changes

not sure what to make of this tbh

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)
+;; need to make a hyperbole
-  "Given WORD, generate the absolute filename for that org-vw entry."
+(add-to-list 'hkey-alist '((and
-  (expand-file-name (format "%s.org" (downcase word)) org-vw-dir))
+			    (eq major-mode 'org-mode)
-;; (org-vw-get-filename "wordWERD")
+			    (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
+;; (defun org-vw-show-markup () ;;broken, just use org-appear or sth
-  "When on a line containing hidden characters, show them."
+;;   "When on a line containing hidden characters, show them."
-  (interactive)
+;;   (interactive)
-  (let ((point (point))
+;;   (let ((point (point))
-	(bol (point-at-bol))
+;; 	(bol (point-at-bol))
-	(eol (point-at-eol)))
+;; 	(eol (point-at-eol)))
-    (remove-text-properties bol eol
+;;     (remove-text-properties bol eol
-			    '(invisible nil))
+;; 			    '(invisible nil))
-    t))
+;;     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)
+  ;; (require 'hyperbole)
-  (make-local-variable action-key-default-function)
+  ;; (make-local-variable action-key-default-function)
-  (setq-local action-key-default-function #'org-vw-make-newlink)
+  ;; (setq-local action-key-default-function #'org-vw-make-newlink)
   ;; General:
   (general-define-key
    :keymaps 'local