Org-mode config is back baby! With a vengeance!

modules/defuns/defuns-org-notebook.el

@@ -0,0 +1,113 @@
+;;; defuns-org-notebook.el
+
+;; Keep track of attachments
+(defvar narf-org-attachments-list '() "A list of attachments for the current buffer")
+(make-variable-buffer-local 'narf-org-attachments-list)
+
+;;;###autoload
+(defun narf/org-start ()
+  (interactive)
+  (narf:workgroup-new nil "*ORG*" t)
+  (cd org-directory)
+  (let ((helm-full-frame t))
+    (helm-find-files nil))
+  (save-excursion
+    (neotree-show)))
+
+;;;###autoload
+(defun narf/org-notebook-new ()
+  (interactive)
+  (projectile-invalidate-cache nil)
+  (let* ((default-directory org-directory)
+         (dir (projectile-complete-dir))
+         (narf-org-quicknote-dir dir))
+    (when dir
+      (narf/org-notebook-quick-note))))
+
+;;;###autoload
+(defun narf/org-notebook-quick-note ()
+  (interactive)
+  (let (text)
+    (when (evil-visual-state-p)
+      (setq text (buffer-substring-no-properties evil-visual-beginning evil-visual-end)))
+    (switch-to-buffer (generate-new-buffer "*quick-note*"))
+    (setq default-directory narf-org-quicknote-dir)
+    (erase-buffer)
+    (insert text)))
+
+;;;###autoload
+(defun narf/org-download-dnd (uri action)
+  (if (and (eq major-mode 'org-mode)
+           (not (image-type-from-file-name uri)))
+      (narf:org-attach uri)
+    (let ((dnd-protocol-alist
+           (rassq-delete-all 'narf/org-download-dnd (copy-alist dnd-protocol-alist))))
+      (dnd-handle-one-url nil action uri))))
+
+;;;###autoload (autoload 'narf:org-attach "defuns-org-notebook" nil t)
+(evil-define-command narf:org-attach (&optional uri)
+  (interactive "<a>")
+  (if uri
+      (let* ((rel-path (org-download--fullname uri))
+             (new-path (f-expand rel-path)))
+        (cond ((string-match-p (concat "^" (regexp-opt '("http" "https" "nfs" "ftp" "file")) "://") uri)
+               (url-copy-file uri new-path))
+              (t (copy-file uri new-path)))
+        (unless new-path
+          (user-error "No file was provided"))
+        (if (evil-visual-state-p)
+            (org-insert-link nil (format "./%s" rel-path)
+                             (concat (buffer-substring-no-properties (region-beginning) (region-end))
+                                     " " (narf/org-attach-icon rel-path)))
+          (insert (format "%s [[./%s][%s]]"
+                          (narf/org-attach-icon rel-path)
+                          rel-path (f-filename rel-path))))
+        (when (string-match-p (regexp-opt '("jpg" "jpeg" "gif" "png")) (f-ext rel-path))
+          (org-toggle-inline-images)))
+    (let ((attachments (narf-org-attachments)))
+      (unless attachments
+        (user-error "No attachments in this file"))
+      (helm :sources (helm-build-sync-source "Attachments" :candidates attachments)))))
+
+;;;###autoload
+(defun narf/org-attach-icon (path)
+  (char-to-string (pcase (downcase (f-ext path))
+                    ("jpg" ?) ("jpeg" ?) ("png" ?) ("gif" ?)
+                    ("pdf" ?)
+                    ("ppt" ?) ("pptx" ?)
+                    ("xls" ?) ("xlsx" ?)
+                    ("doc" ?) ("docx" ?)
+                    ("ogg" ?) ("mp3" ?) ("wav" ?)
+                    ("mp4" ?) ("mov" ?) ("avi" ?)
+                    ("zip" ?) ("gz" ?) ("tar" ?) ("7z" ?) ("rar" ?)
+                    (t ?))))
+
+;;;###autoload
+(defun narf/org-attachments ()
+  (let ((attachments '())
+        element
+        file)
+    (save-excursion
+      (goto-char (point-min))
+      (while (progn (org-next-link) (not org-link-search-failed))
+        (setq element (org-element-lineage (org-element-context) '(link) t))
+        (when element
+          (setq file (expand-file-name (org-element-property :path element)))
+          (when (and (string= (org-element-property :type element) "file")
+                     (string= (concat (f-base (f-dirname file)) "/") org-attach-directory)
+                     (file-exists-p file))
+            (push file attachments)))))
+    (-distinct attachments)))
+
+;;;###autoload
+(defun narf/org-cleanup-attachments ()
+  (let* ((attachments (narf/org-attachments))
+         (to-delete (-difference narf-org-attachments-list attachments)))
+    (mapc (lambda (f)
+            (message "Deleting attachment: %s" f)
+            (delete-file f t))
+          to-delete)
+    (setq narf-org-attachments-list attachments)))
+
+(provide 'defuns-org-notebook)
+;;; defuns-org-notebook.el ends here

modules/defuns/defuns-org.el

@@ -0,0 +1,300 @@
+;;; defuns-org.el
+
+;;;###autoload
+(defun narf/org-find-file-in-notes ()
+  (interactive)
+  (in! (f-slash org-directory)
+    (helm-projectile-find-file)))
+
+;;;###autoload
+(defun narf/org-find-file ()
+  (interactive)
+  (in! (f-slash org-directory)
+    (helm-find-files nil)))
+
+;;;###autoload
+(defun narf/org-find-exported-file ()
+  (interactive)
+  (in! (f-slash narf-org-export-directory)
+    (helm-find-files nil)))
+
+;;;###autoload
+(defun narf/org-get-property (name)
+  (interactive)
+  (save-excursion
+    (goto-char 1)
+    (re-search-forward (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name)) nil t)
+    (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
+
+;;;###autoload
+(defun narf/org-insert-item (direction)
+  "Inserts a new heading or item, depending on the context."
+  (interactive)
+  (let* ((context (org-element-lineage
+                   (org-element-context)
+                   '(table table-row headline inlinetask item plain-list)
+                   t))
+         (type (org-element-type context)))
+    (cond ((eq type 'item)
+           (cl-case direction
+             ('below
+              (org-end-of-line)
+              (org-insert-heading))
+             ('above
+              (evil-first-non-blank)
+              (org-insert-heading)))
+           (when (org-element-property :checkbox context)
+             (insert "[ ] ")))
+          ((memq type '(table table-row))
+           (cl-case direction
+             ('below
+              (org-table-insert-row))
+             ('above
+              (narf/org-table-prepend-row-or-shift-up))))
+          (t
+           (cl-case direction
+             ('below
+              (org-insert-heading-after-current))
+             ('above
+              (org-back-to-heading)
+              (org-insert-heading)))
+           (when (org-element-property :todo-type context)
+             (org-todo 'todo))))
+    (evil-append-line 1)))
+
+;;;###autoload
+(defun narf/org-toggle-checkbox ()
+  (interactive)
+  (let ((context (org-element-lineage (org-element-context) '(item) t)))
+    (when context
+      (org-end-of-line)
+      (org-beginning-of-line)
+      (if (org-element-property :checkbox context)
+          (when (search-backward-regexp "\\[[ +-]\\]" (line-beginning-position) t)
+            (delete-char 4))
+        (insert "[ ] ")))))
+
+;;;###autoload
+(defun narf/org-dwim-at-point ()
+  (interactive)
+  (let* ((scroll-pt (window-start))
+         (context (org-element-context))
+         (type (org-element-type context))
+         (value (org-element-property :value context)))
+    (cond
+     ((memq type '(table table-row))
+      (if (org-element-property :tblfm (org-element-property :parent context))
+          (org-table-recalculate t)
+        (org-table-align)))
+
+     ((and (memq type '(item))
+           (org-element-property :checkbox context))
+      (org-toggle-checkbox))
+
+     ((and (memq type '(headline))
+           (org-element-property :todo-type context))
+      (org-todo
+       (if (eq (org-element-property :todo-type context) 'done) 'todo 'done)))
+
+     ((and (memq type '(headline))
+           (string= "ARCHIVE" (car-safe (org-get-tags))))
+      (org-force-cycle-archived))
+
+     ((memq type '(headline))
+      (org-remove-latex-fragment-image-overlays)
+      (org-preview-latex-fragment '(4)))
+
+     ((memq type '(babel-call))
+      (org-babel-lob-execute-maybe))
+
+     ((memq type '(src-block inline-src-block))
+      (org-babel-execute-src-block))
+
+     ((memq type '(latex-fragment latex-environment))
+      (org-preview-latex-fragment))
+
+     ((memq type '(link))
+      (let ((path (org-element-property :path (org-element-lineage (org-element-context) '(link) t))))
+        (if (and path (image-type-from-file-name path))
+            (narf/org-refresh-inline-images)
+          (org-open-at-point))))
+
+     (t (narf/org-refresh-inline-images)))
+    (set-window-start nil scroll-pt)))
+
+;;;###autoload
+(defun narf/org-refresh-inline-images ()
+  (interactive)
+  (if (> (length org-inline-image-overlays) 0)
+      (org-remove-inline-images)
+    (org-display-inline-images
+     t t
+     (if (org-before-first-heading-p)
+         (line-beginning-position)
+       (save-excursion (org-back-to-heading) (point)))
+     (if (org-before-first-heading-p)
+         (line-end-position)
+       (save-excursion (org-end-of-subtree) (point))))))
+
+;; Formatting shortcuts
+;;;###autoload
+(defun narf/org-surround (delim)
+  (if (region-active-p)
+      (save-excursion
+        (goto-char (region-beginning))
+        (insert delim)
+        (goto-char (region-end))
+        (insert delim))
+    (insert delim)
+    (save-excursion (insert delim))))
+
+;;;###autoload
+(defun narf/org-word-count (beg end &optional count-footnotes?)
+  "Report the number of words in the Org mode buffer or selected region.
+Ignores:
+- comments
+- tables
+- source code blocks (#+BEGIN_SRC ... #+END_SRC, and inline blocks)
+- hyperlinks (but does count words in hyperlink descriptions)
+- tags, priorities, and TODO keywords in headers
+- sections tagged as 'not for export'.
+
+The text of footnote definitions is ignored, unless the optional argument
+COUNT-FOOTNOTES? is non-nil."
+  (interactive "r")
+  (unless mark-active
+    (setf beg (point-min)
+          end (point-max)))
+  (let ((wc 0))
+    (save-excursion
+      (goto-char beg)
+      (while (< (point) end)
+        (cond
+         ;; Ignore comments.
+         ((or (org-at-comment-p) (org-at-table-p))
+          nil)
+         ;; Ignore hyperlinks. But if link has a description, count
+         ;; the words within the description.
+         ((looking-at org-bracket-link-analytic-regexp)
+          (when (match-string-no-properties 5)
+            (let ((desc (match-string-no-properties 5)))
+              (save-match-data
+                (incf wc (length (remove "" (org-split-string
+                                             desc "\\W")))))))
+          (goto-char (match-end 0)))
+         ((looking-at org-any-link-re)
+          (goto-char (match-end 0)))
+         ;; Ignore source code blocks.
+         ((org-between-regexps-p "^#\\+BEGIN_SRC\\W" "^#\\+END_SRC\\W")
+          nil)
+         ;; Ignore inline source blocks, counting them as 1 word.
+         ((save-excursion
+            (backward-char)
+            (looking-at org-babel-inline-src-block-regexp))
+          (goto-char (match-end 0))
+          (setf wc (+ 2 wc)))
+         ;; Ignore footnotes.
+         ((and (not count-footnotes?)
+               (or (org-footnote-at-definition-p)
+                   (org-footnote-at-reference-p)))
+          nil)
+         (t
+          (let ((contexts (org-context)))
+            (cond
+             ;; Ignore tags and TODO keywords, etc.
+             ((or (assoc :todo-keyword contexts)
+                  (assoc :priority contexts)
+                  (assoc :keyword contexts)
+                  (assoc :checkbox contexts))
+              nil)
+             ;; Ignore sections marked with tags that are
+             ;; excluded from export.
+             ((assoc :tags contexts)
+              (if (intersection (org-get-tags-at) org-export-exclude-tags
+                                :test 'equal)
+                  (org-forward-same-level 1)
+                nil))
+             (t
+              (incf wc))))))
+        (re-search-forward "\\w+\\W*")))
+    (message (format "%d words in %s." wc
+                     (if mark-active "region" "buffer")))))
+
+;;;###autoload
+(defun narf/org-remove-link ()
+  "Replace an org link by its description or if empty its address"
+  (interactive)
+  (if (org-in-regexp org-bracket-link-regexp 1)
+      (let ((remove (list (match-beginning 0) (match-end 0)))
+            (description (if (match-end 3)
+                             (org-match-string-no-properties 3)
+                           (org-match-string-no-properties 1))))
+        (apply 'delete-region remove)
+        (insert description))))
+
+;;;###autoload
+(defun narf/org-table-next-row ()
+  (interactive)
+  (if (org-at-table-p) (org-table-next-row) (org-down-element)))
+
+;;;###autoload
+(defun narf/org-table-previous-row ()
+  (interactive)
+  (if (org-at-table-p) (narf--org-table-previous-row) (org-up-element)))
+
+;;;###autoload
+(defun narf/org-table-next-field ()
+  (interactive)
+  (if (org-at-table-p) (org-table-next-field) (org-end-of-line)))
+
+;;;###autoload
+(defun narf/org-table-previous-field ()
+  (interactive)
+  (if (org-at-table-p) (org-table-previous-field) (org-beginning-of-line)))
+
+;;;###autoload
+(defun narf/org-table-append-field-or-shift-right ()
+  (interactive)
+  (org-shiftmetaright)
+  (when (org-at-table-p) (org-metaright)))
+
+;;;###autoload
+(defun narf/org-table-prepend-field-or-shift-left ()
+  (interactive)
+  (if (org-at-table-p)
+      (org-shiftmetaright)
+    (org-shiftmetaleft)))
+
+;;;###autoload
+(defun narf/org-table-append-row-or-shift-down ()
+  (interactive)
+  (org-shiftmetadown)
+  (when (org-at-table-p) (org-metadown)))
+
+;;;###autoload
+(defun narf/org-table-prepend-row-or-shift-up ()
+  (interactive)
+  (if (org-at-table-p)
+      (org-shiftmetadown)
+    (org-shiftmetaup)))
+
+(defun narf--org-table-previous-row ()
+  "Go to the previous row (same column) in the current table. Before doing so,
+re-align the table if necessary. (Necessary because org-mode has a
+`org-table-next-row', but not `org-table-previous-row')"
+  (interactive)
+  (org-table-maybe-eval-formula)
+  (org-table-maybe-recalculate-line)
+  (if (and org-table-automatic-realign
+           org-table-may-need-update)
+      (org-table-align))
+  (let ((col (org-table-current-column)))
+    (beginning-of-line 0)
+    (when (or (not (org-at-table-p)) (org-at-table-hline-p))
+      (beginning-of-line))
+    (org-table-goto-column col)
+    (skip-chars-backward "^|\n\r")
+    (when (org-looking-at-p " ") (forward-char))))
+
+(provide 'defuns-org)
+;;; defuns-org.el ends here

modules/defuns/macros-org.el

@@ -0,0 +1,45 @@
+;;; macros-org.el
+
+;;;###autoload
+(defmacro define-org-section! (type directory &optional id-func link-glob)
+  (setq directory (f-slash directory))
+  (let* ((type-str (symbol-name type))
+         (link-sym (intern (format "narf/org-link-%s" type-str)))
+         (dir-var (intern (format "org-directory-%s" type-str))))
+    `(progn
+       ;; Variable containing directory: `org-directory-%s'
+       (defvar ,dir-var ,(expand-file-name directory org-directory))
+
+       ;; Open helm in directory: `narf/helm-org-%s'
+       (evil-define-command ,(intern (format "narf:org-search-%s" type-str)) ()
+         (interactive)
+         (let ((default-directory (concat ,dir-var "/" (format-time-string "%Y") "/")))
+           (helm-find-files nil)))
+
+       ;; Open helm in directory: `narf/helm-org-%s'
+       (defun ,(intern (format "narf/helm-org-find-file-in-%s" type-str)) ()
+         (interactive)
+         (helm-do-ag (f-slash ,dir-var)))
+
+       ;; Org link handler
+       (defun ,link-sym (id)
+         (let ((path (f-glob (format (or ,link-glob "%s.org") id) ,dir-var)))
+           (unless path
+             (error "ID not found: %s" id))
+           (org-open-file (car path) t)))
+       (org-add-link-type ,type-str ',link-sym)
+
+       ;; Org completion handler
+       (defun ,(intern (format "org-%s-complete-link" type-str)) ()
+         (let* ((default-directory (f-slash ,dir-var))
+                (file (org-iread-file-name "> "))
+                (relpath (f-relative file ,dir-var)))
+           (when (and (not (file-exists-p file))
+                      (y-or-n-p (format "Create %s?" relpath)))
+             (write-region "" nil file)
+             (message "Created %s" file))
+           (format "%s:%s" ,type-str ,(if id-func `(funcall ,id-func relpath) '(f-no-ext relpath)))
+           )))))
+
+(provide 'macros-org)
+;;; macros-org.el ends here