feat[snippets,archive,evil]: Better archives

I added some code to allow full-subtree archives with SPC-m-A I also enabled C-c to switch to normal mode. Added mermaid snippet
2023-10-29 01:48:10 -04:00 · 2023-10-29 01:48:10 -04:00 · 0073afd67f
commit 0073afd67f
parent b0e455ac12
5 changed files with 344 additions and 31 deletions
--- a/config.el
+++ b/config.el
@ -1,19 +1,22 @@
 (setq tab-always-indent t)
 (setq org-roam-directory "~/org/")

+
+(setq user-full-name "Judah Sotomayor"
+      user-mail-address "")
+
 (setq doom-theme 'doom-dark+)
 (setq doom-font (font-spec :family "Hack Nerd Font Mono" :size 16 :weight 'medium))
-(setq auto-save-default nil)
+(setq auto-save-default nil) ;I don't like autosaving. Let me do it myself.

 (remove-hook '+doom-dashboard-functions #'doom-dashboard-widget-shortmenu)
 (remove-hook '+doom-dashboard-functions #'doom-dashboard-widget-footer)

 (setq fancy-splash-image (concat doom-private-dir "emacs.png"))

-(setq user-full-name "Judah Sotomayor"
-      user-mail-address "")
-
-(map! :desc "Switch to normal mode" "M-c" #'evil-normal-state)
+(map! :desc "Switch to normal mode" :i "C-c" #'evil-normal-state)
+(use-package! noCtrlC
+  :after org-mode)

 (setq org-pretty-entities 0)

@ -235,13 +238,11 @@ If nil it defaults to `split-string-default-separators', normally
 (setq org-log-done 'time)
 (after! org-mode
    (setq org-log-done 'time)
-    (setq org-archive-location "~/org/archive.org")
    (add-to-list 'org-tags-exclude-from-inheritance "hastodos")
    (setq org-hide-emphasis-markers nil))

 (setq org-directory "~/org/")
 (setq org-roam-directory org-directory)
-(setq org-archive-location (concat org-directory "/archive.org::"))

 (setq org-startup-with-inline-images t)

@ -278,6 +279,144 @@ If nil it defaults to `split-string-default-separators', normally
 	:config
 	(org-heatmap-mode))

+(map! :leader
+      :desc "Export to html and diplay with eww"
+      :n "m A" #'org-archive-subtree-default)
+
+(require 'org-archive)
+
+; Set the function to use for org-archive-default  (C-c C-x C-a)
+; (setq org-archive-location (concat org-directory "/archive/%s_archive::"))
+; (setq org-archive-location "archive/archived_%s::")
+
+(setq org-archive-location "~/org/archive.org")
+(setq org-archive-location (concat org-directory "/archive.org::"))
+; unmap org-archive-subtree
+
+; select command to execute via org-archive-subtree-default (C-c C-x C-a)
+(setq org-archive-default-command 'org-archive-subtree-hierarchical)
+
+(defun line-content-as-string ()
+  "Returns the content of the current line as a string"
+  (save-excursion
+    (beginning-of-line)
+    (buffer-substring-no-properties
+     (line-beginning-position) (line-end-position))))
+
+(defun org-child-list (&optional top-level)
+  "This function returns all children of a heading as a list. "
+  (interactive)
+  (save-excursion
+    ;; this only works with org-version > 8.0, since in previous
+    ;; org-mode versions the function (org-outline-level) returns
+    ;; gargabe when the point is not on a heading.
+    (unless top-level
+        (if (= (org-outline-level) 0)
+            (outline-next-visible-heading 1)
+        (org-goto-first-child)))
+    (let ((child-list (list (line-content-as-string))))
+      (while (org-goto-sibling)
+        (setq child-list (cons (line-content-as-string) child-list)))
+      child-list)))
+
+(defun fa/org-struct-subtree ()
+  "This function returns the tree structure in which a subtree belongs as a list."
+  (interactive)
+  (let ((archive-tree nil))
+    (save-excursion
+      (while (org-up-heading-safe)
+        (let ((heading
+               (buffer-substring-no-properties
+                (line-beginning-position) (line-end-position))))
+          (if (eq archive-tree nil)
+              (setq archive-tree (list heading))
+            (setq archive-tree (cons heading archive-tree))))))
+    archive-tree))
+
+(defun org-archive-subtree-hierarchical ()
+  "This function archives a subtree hierarchical"
+  (interactive)
+  (let ((org-tree (fa/org-struct-subtree))
+        (source-buffer (current-buffer))
+        (file (abbreviate-file-name
+                   (or (buffer-file-name (buffer-base-buffer))
+                       (error "No file associated to buffer")))))
+    (save-excursion
+      (setq location (org-archive--compute-location
+                (or (org-entry-get nil "ARCHIVE" 'inherit)
+                    org-archive-location))
+            afile (car location)
+            heading (cdr location)
+            infile-p (equal file (abbreviate-file-name (or afile ""))))
+      (unless afile
+        (error "Invalid `org-archive-location'"))
+      (if (not (equal heading ""))
+          (progn
+            (setq org-tree (cons heading
+                               (mapcar (lambda (s) (concat "*" s)) org-tree)))
+            (org-demote-subtree)))
+      (if (> (length afile) 0)
+        (progn
+          (setq newfile-p (not (file-exists-p afile))
+                visiting (find-buffer-visiting afile)
+                target-buffer (or visiting (find-file-noselect afile))))
+        (progn
+          (setq target-buffer (current-buffer))))
+      (unless target-buffer
+        (error "Cannot access file \"%s\"" afile))
+      (org-cut-subtree)
+      (set-buffer target-buffer)
+      (setq ind-target-buffer (clone-indirect-buffer nil nil))
+      (set-buffer ind-target-buffer)
+      (org-mode)
+      (goto-char (point-min))
+
+      ; simplified version of org-complex-heading-regexp-format
+	  (setq my-org-complex-heading-regexp-format
+	      (concat "^"
+		      "\\(%s\\)"
+		      "\\(?: *\\[[0-9%%/]+\\]\\)*"
+		      "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
+		      "[ \t]*$"))
+      (setq top-level-p t)
+      (while (not (equal org-tree nil))
+        (let ((child-list (org-child-list top-level-p))
+              (re (format my-org-complex-heading-regexp-format (regexp-quote (car org-tree))))
+             )
+          (if (member "______FOUND_MATCH" (mapcar (lambda (s) (replace-regexp-in-string re "______FOUND_MATCH" s)) child-list))
+              (progn
+                (re-search-forward re nil t)
+                (setq org-tree (cdr org-tree)))
+            (progn
+              (if (not top-level-p) (newline))
+              (org-insert-struct org-tree)
+              (setq org-tree nil))))
+        (setq top-level-p nil))
+      (end-of-buffer)
+      (newline)
+      (org-yank)
+      ;; Kill the indirect buffer, returning the current buffer to the direct target buffer
+      (kill-buffer ind-target-buffer)
+      ;; Save and kill the target buffer, if it is not the source buffer.
+      (when (not (eq source-buffer target-buffer))
+            (save-buffer target-buffer)
+            (kill-buffer target-buffer))
+      ;; ensure font-lock and indentation are normal
+      (set-buffer source-buffer)
+      (org-restart-font-lock)
+      (org-indent-mode t)
+      (message "Subtree archived %s"
+               (concat "in file: " (abbreviate-file-name afile))))))
+
+(defun org-insert-struct (struct)
+  "TODO"
+  (interactive)
+  (when struct
+    (insert (car struct))
+    (if  (not (equal (length struct) 1))
+        (newline))
+    (org-insert-struct (cdr struct))))
+
 (setq templates/post-capture-props "#+date: [%<%Y-%m-%d %a>]\n#+lastmod:\n#+categories[]:\n#+tags[]:\n#+images[]: ")
 (setq templates/post-capture-title "#+TITLE: ${title}\n")
 (setq templates/post-capture-template (concat templates/post-capture-title templates/post-capture-props))
@ -522,10 +661,6 @@ If nil it defaults to `split-string-default-separators', normally
         ("c" "encrypted" plain "%?"
          :target (file+head "%<%Y%m%d-%H%M%S>.sec.org.age"
                             "#+TITLE: ${title}\n#+FILETAGS: :secure:noexport:\n#+HTML_HEAD: <link rel=\"stylesheet\" type=\"text/css\" href=\"css/retro.css\" />\n\n\n* No Export Below This Line")
-          :unnarrowed t)
-
-         ("w" "website post" plain "%?"
-          :target (file+head "~/org/website/content/posts/${title}.org" ,templates/post-capture-template)
          :unnarrowed t))))

 (after! org-roam (map! :leader (:prefix ("r" . "roam")
@ -712,3 +847,14 @@ Adding up values for one key is supported."
  (add-to-list 'exec-path-from-shell-variables var))
  (exec-path-from-shell-initialize)
  )
+
+;; file-truename is optional; it seems required when you use symbolic
+;; links, which Org-roam does not resolve
+(use-package! md-roam
+  :config
+  (setq org-roam-file-extensions '("org" "md")) ; enable Org-roam for a markdown extension
+  (setq md-roam-file-extension "md") ; default "md". Specify an extension such as "markdown"
+  (setq md-roam-file-extension-single "md")
+  (setq md-roam-use-org-extract-ref nil)
+
+  (org-roam-db-autosync-mode 1))
--- a/config.org
+++ b/config.org
@ -2,7 +2,6 @@
 #+AUTHOR: Judah Sotomayor
 #+STARTUP: overview

-
 Welcome to my configuration!
 I hope you enjoy your time here :)
 It's not all very well documented, but I have done my best to split everything into a logical order.
@ -13,16 +12,21 @@ Perhaps in 10 years I will still be using it, but who knows.
 #+BEGIN_SRC emacs-lisp
 (setq tab-always-indent t)
 (setq org-roam-directory "~/org/")
+
+
+(setq user-full-name "Judah Sotomayor"
+      user-mail-address "")
 #+END_SRC

 * Theme and Font
 Set the theme.
 /Use something dark/
-+I also prefer relative line numbers because of *evil* mode+ Relative line numbers don't work, because of foling in Org-mode.
+I also prefer relative line numbers because of *evil* mode+
+Relative line numbers don't work, because of foling in Org-mode.
 #+BEGIN_SRC emacs-lisp
 (setq doom-theme 'doom-dark+)
 (setq doom-font (font-spec :family "Hack Nerd Font Mono" :size 16 :weight 'medium))
-(setq auto-save-default nil)
+(setq auto-save-default nil) ;I don't like autosaving. Let me do it myself.
 #+END_SRC

 ** Doom splash screen
@ -37,18 +41,14 @@ Set a sweet splash image
 (setq fancy-splash-image (concat doom-private-dir "emacs.png"))
 #+END_SRC

-
-* User details
-#+BEGIN_SRC emacs-lisp
-(setq user-full-name "Judah Sotomayor"
-      user-mail-address "")
-#+END_SRC
-
 * Evil configuration
 I want a non-ESC way to get back to normal mode:
 #+BEGIN_SRC emacs-lisp
-(map! :desc "Switch to normal mode" "M-c" #'evil-normal-state)
+(map! :desc "Switch to normal mode" :i "C-c" #'evil-normal-state)
+(use-package! noCtrlC
+  :after org-mode)
 #+END_SRC
+
 #+BEGIN_SRC emacs-lisp
    (setq org-pretty-entities 0)
 #+END_SRC
@ -342,13 +342,11 @@ If nil it defaults to `split-string-default-separators', normally
    (setq org-log-done 'time)
    (after! org-mode
        (setq org-log-done 'time)
-        (setq org-archive-location "~/org/archive.org")
        (add-to-list 'org-tags-exclude-from-inheritance "hastodos")
        (setq org-hide-emphasis-markers nil))

    (setq org-directory "~/org/")
    (setq org-roam-directory org-directory)
-    (setq org-archive-location (concat org-directory "/archive.org::"))

 #+END_SRC

@ -445,7 +443,151 @@ Edna allows better dependency handling for todos and the like.
 	:config
 	(org-heatmap-mode))
 #+END_SRC
+** Org-archive with structure
+Many thanks to Mark Edigmar's [[https://gist.github.com/edgimar/072d99d8650abe81a9fe7c8687c0c993][Gist]]
+*** Keymaps
+#+BEGIN_SRC emacs-lisp
+(map! :leader
+      :desc "Export to html and diplay with eww"
+      :n "m A" #'org-archive-subtree-default)
+#+END_SRC

+*** Source
+#+BEGIN_SRC emacs-lisp
+(require 'org-archive)
+
+; Set the function to use for org-archive-default  (C-c C-x C-a)
+; (setq org-archive-location (concat org-directory "/archive/%s_archive::"))
+; (setq org-archive-location "archive/archived_%s::")
+
+(setq org-archive-location "~/org/archive.org")
+(setq org-archive-location (concat org-directory "/archive.org::"))
+; unmap org-archive-subtree
+
+; select command to execute via org-archive-subtree-default (C-c C-x C-a)
+(setq org-archive-default-command 'org-archive-subtree-hierarchical)
+
+(defun line-content-as-string ()
+  "Returns the content of the current line as a string"
+  (save-excursion
+    (beginning-of-line)
+    (buffer-substring-no-properties
+     (line-beginning-position) (line-end-position))))
+
+(defun org-child-list (&optional top-level)
+  "This function returns all children of a heading as a list. "
+  (interactive)
+  (save-excursion
+    ;; this only works with org-version > 8.0, since in previous
+    ;; org-mode versions the function (org-outline-level) returns
+    ;; gargabe when the point is not on a heading.
+    (unless top-level
+        (if (= (org-outline-level) 0)
+            (outline-next-visible-heading 1)
+        (org-goto-first-child)))
+    (let ((child-list (list (line-content-as-string))))
+      (while (org-goto-sibling)
+        (setq child-list (cons (line-content-as-string) child-list)))
+      child-list)))
+
+(defun fa/org-struct-subtree ()
+  "This function returns the tree structure in which a subtree belongs as a list."
+  (interactive)
+  (let ((archive-tree nil))
+    (save-excursion
+      (while (org-up-heading-safe)
+        (let ((heading
+               (buffer-substring-no-properties
+                (line-beginning-position) (line-end-position))))
+          (if (eq archive-tree nil)
+              (setq archive-tree (list heading))
+            (setq archive-tree (cons heading archive-tree))))))
+    archive-tree))
+
+(defun org-archive-subtree-hierarchical ()
+  "This function archives a subtree hierarchical"
+  (interactive)
+  (let ((org-tree (fa/org-struct-subtree))
+        (source-buffer (current-buffer))
+        (file (abbreviate-file-name
+                   (or (buffer-file-name (buffer-base-buffer))
+                       (error "No file associated to buffer")))))
+    (save-excursion
+      (setq location (org-archive--compute-location
+                (or (org-entry-get nil "ARCHIVE" 'inherit)
+                    org-archive-location))
+            afile (car location)
+            heading (cdr location)
+            infile-p (equal file (abbreviate-file-name (or afile ""))))
+      (unless afile
+        (error "Invalid `org-archive-location'"))
+      (if (not (equal heading ""))
+          (progn
+            (setq org-tree (cons heading
+                               (mapcar (lambda (s) (concat "*" s)) org-tree)))
+            (org-demote-subtree)))
+      (if (> (length afile) 0)
+        (progn
+          (setq newfile-p (not (file-exists-p afile))
+                visiting (find-buffer-visiting afile)
+                target-buffer (or visiting (find-file-noselect afile))))
+        (progn
+          (setq target-buffer (current-buffer))))
+      (unless target-buffer
+        (error "Cannot access file \"%s\"" afile))
+      (org-cut-subtree)
+      (set-buffer target-buffer)
+      (setq ind-target-buffer (clone-indirect-buffer nil nil))
+      (set-buffer ind-target-buffer)
+      (org-mode)
+      (goto-char (point-min))
+
+      ; simplified version of org-complex-heading-regexp-format
+	  (setq my-org-complex-heading-regexp-format
+	      (concat "^"
+		      "\\(%s\\)"
+		      "\\(?: *\\[[0-9%%/]+\\]\\)*"
+		      "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
+		      "[ \t]*$"))
+      (setq top-level-p t)
+      (while (not (equal org-tree nil))
+        (let ((child-list (org-child-list top-level-p))
+              (re (format my-org-complex-heading-regexp-format (regexp-quote (car org-tree))))
+             )
+          (if (member "______FOUND_MATCH" (mapcar (lambda (s) (replace-regexp-in-string re "______FOUND_MATCH" s)) child-list))
+              (progn
+                (re-search-forward re nil t)
+                (setq org-tree (cdr org-tree)))
+            (progn
+              (if (not top-level-p) (newline))
+              (org-insert-struct org-tree)
+              (setq org-tree nil))))
+        (setq top-level-p nil))
+      (end-of-buffer)
+      (newline)
+      (org-yank)
+      ;; Kill the indirect buffer, returning the current buffer to the direct target buffer
+      (kill-buffer ind-target-buffer)
+      ;; Save and kill the target buffer, if it is not the source buffer.
+      (when (not (eq source-buffer target-buffer))
+            (save-buffer target-buffer)
+            (kill-buffer target-buffer))
+      ;; ensure font-lock and indentation are normal
+      (set-buffer source-buffer)
+      (org-restart-font-lock)
+      (org-indent-mode t)
+      (message "Subtree archived %s"
+               (concat "in file: " (abbreviate-file-name afile))))))
+
+(defun org-insert-struct (struct)
+  "TODO"
+  (interactive)
+  (when struct
+    (insert (car struct))
+    (if  (not (equal (length struct) 1))
+        (newline))
+    (org-insert-struct (cdr struct))))
+#+END_SRC

 * Website
 ** Capture template
@ -709,7 +851,7 @@ Let's use a package or two to set a decent document class:
 #+END_SRC

 *** Engraving Faces
-Ever wonder why code export sucks with \latex ? Me neither! Let's fix it!
+Ever wonder why code export sucks with \LaTeX ? Me neither! Let's fix it!
 #+BEGIN_SRC emacs-lisp
 (use-package! engrave-faces)
 (setq org-latex-listings 'engraved)
@ -750,11 +892,8 @@ Org-roam enables features essential to a Zettelkasten such as inter-ID linking.
         ("c" "encrypted" plain "%?"
          :target (file+head "%<%Y%m%d-%H%M%S>.sec.org.age"
                             "#+TITLE: ${title}\n#+FILETAGS: :secure:noexport:\n#+HTML_HEAD: <link rel=\"stylesheet\" type=\"text/css\" href=\"css/retro.css\" />\n\n\n* No Export Below This Line")
-          :unnarrowed t)
-
-         ("w" "website post" plain "%?"
-          :target (file+head "~/org/website/content/posts/${title}.org" ,templates/post-capture-template)
          :unnarrowed t))))
+
 #+END_SRC

 *** Keybinds
@ -984,3 +1123,25 @@ I want VIM-like autocompletion, where =C-x o= and friends gives me my autocomple
  (exec-path-from-shell-initialize)
  )
 #+END_SRC
+
+* Md-roam
+#+BEGIN_SRC emacs-lisp
+;; file-truename is optional; it seems required when you use symbolic
+;; links, which Org-roam does not resolve
+(use-package! md-roam
+  :config
+  (setq org-roam-file-extensions '("org" "md")) ; enable Org-roam for a markdown extension
+  (setq md-roam-file-extension "md") ; default "md". Specify an extension such as "markdown"
+  (setq md-roam-file-extension-single "md")
+  (setq md-roam-use-org-extract-ref nil)
+
+  (org-roam-db-autosync-mode 1))
+#+END_SRC
+** COMMENT Capture template for documentation
+#+BEGIN_SRC emacs-lisp
+(add-to-list 'org-roam-capture-templates
+    '("m" "Markdown" plain "" :target
+        (file+head "training-resources/content/${title}.md"
+"---\ntitle: ${title}\nid: %<%Y-%m-%dT%H%M%S>\ncategory: \n---\n")
+    :unnarrowed t))
+#+END_SRC
--- a/init.el
+++ b/init.el
@ -44,7 +44,7 @@
       ophints           ; highlight the region an operation acts on
       (popup +defaults)   ; tame sudden yet inevitable temporary windows
       ;;tabs              ; a tab bar for Emacs
-       ;;treemacs          ; a project drawer, like neotree but cooler
+       treemacs          ; a project drawer, like neotree but cooler
       ;;unicode           ; extended unicode support for various languages
       (vc-gutter +pretty) ; vcs diff in the fringe
       vi-tilde-fringe   ; fringe tildes to mark beyond EOB
--- a/packages.el
+++ b/packages.el
@ -79,3 +79,9 @@
 (package! exec-path-from-shell)
 (package! anki-editor)
 (package! calfw)
+
+(package! noCtrlC
+  :recipe (:host nil :type git :repo "https://git.freedomland.xyz/judahsotomayor/noctrlc"))
+
+(package! md-roam
+  :recipe (:host github :repo "nobiot/md-roam"))
--- a/snippets/org-mode/<mermaid
+++ b/snippets/org-mode/<mermaid
@ -1,6 +1,6 @@
 # -*- mode: snippet -*-
 # name: <mermaidjs
-# uuid:
+# uuid: mermaidsnip
 # key: <mermaidjs
 # condition: t
 # --