summary refs log tree commit diff
path: root/emacs.d/custom
diff options
context:
space:
mode:
authorFranck Cuny <franck.cuny@gmail.com>2019-12-09 12:52:37 -0800
committerFranck Cuny <franck.cuny@gmail.com>2019-12-09 12:52:37 -0800
commit0490a5a4f1936b6888a070e840740e152f04c3de (patch)
tree9d47c1bb51e823a60c50e46d0e981adfabdbc494 /emacs.d/custom
parent[org] add `orgit` to my configuration. (diff)
downloademacs.d-0490a5a4f1936b6888a070e840740e152f04c3de.tar.gz
[org] put all configs related to org together
Instead of having functions related to org in another file, move
everything in a single file, this makes it easier to find dead code
and update some functions.
Diffstat (limited to 'emacs.d/custom')
-rw-r--r--emacs.d/custom/fcuny-defuns.el240
-rw-r--r--emacs.d/custom/fcuny-org.el43
2 files changed, 44 insertions, 239 deletions
diff --git a/emacs.d/custom/fcuny-defuns.el b/emacs.d/custom/fcuny-defuns.el
index cb117f4..955650c 100644
--- a/emacs.d/custom/fcuny-defuns.el
+++ b/emacs.d/custom/fcuny-defuns.el
@@ -74,245 +74,6 @@
                             (decode-coding-string title 'utf-8))
       (concat "[[" url "][" title "]]"))))
 
-(defun fcuny/org-archive-subtree-as-completed ()
-  "Archives the current subtree to today's current journal entry."
-  (interactive)
-  (ignore-errors
-    ;; According to the docs for `org-archive-subtree', the state should be
-    ;; automatically marked as DONE, but I don't notice that:
-    (when (not (equal "DONE" (org-get-todo-state)))
-      (org-todo "DONE")))
-
-  (let* ((org-archive-file (or org-default-completed-file
-                               (fcuny/this-month-archive-entry)))
-         (org-archive-location (format "%s::" org-archive-file)))
-    (org-archive-subtree)))
-
-(defun fcuny/this-month-archive-entry ()
-  "Return the full pathname to the month's archive entry file.
-Granted, this assumes each journal's file entry to be formatted
-with year/month, as in `201901' for January 4th.
-
-Note: `org-journal-dir' variable must be set to the directory
-where all good journal entries live, e.g. ~/journal."
-  (let* ((daily-name   (format "%s-archive.org" (format-time-string "%Y-%m")))
-         (file-name    (concat org-archive-dir daily-name)))
-    (expand-file-name file-name)))
-
-(defun fcuny/org-subtree-region ()
-  "Return a list of the start and end of a subtree."
-  (save-excursion
-    (list (progn (org-back-to-heading) (point))
-          (progn (org-end-of-subtree)  (point)))))
-
-(defun fcuny/org-refile-directly (file-dest)
-  "Move the current subtree to the end of FILE-DEST.
-If SHOW-AFTER is non-nil, show the destination window,
-otherwise, this destination buffer is not shown."
-  (interactive "fDestination: ")
-
-  (defun dump-it (file contents)
-    (find-file-other-window file-dest)
-    (goto-char (point-max))
-    (insert "\n" contents))
-
-  (save-excursion
-    (let* ((region (fcuny/org-subtree-region))
-           (contents (buffer-substring (first region) (second region))))
-      (apply 'kill-region region)
-      (save-window-excursion (dump-it file-dest contents)))))
-
-(defun fcuny/org-refile-to-task ()
-  "Refile (move) the current Org subtree to `org-default-tasks-file'."
-  (interactive)
-  (fcuny/org-refile-directly org-default-tasks-file))
-
-(defun fcuny/org-refile-to-task ()
-  "Refile (move) the current Org subtree to `org-default-tasks-file'."
-  (interactive)
-  (fcuny/org-refile-directly org-default-tasks-file))
-
-(defun fcuny/org-refile-to-personal-notes ()
-  "Refile (move) the current Org subtree to `org-default-notes-file'."
-  (interactive)
-  (fcuny/org-refile-directly org-default-notes-file))
-
-(defun fcuny/org-refile-subtree-to-file (dir)
-  "Archive the org-mode subtree and create an entry in the
-directory folder specified by DIR. It attempts to move as many of
-the subtree's properties and other features to the new file."
-  (interactive "DDestination: ")
-  (let* ((props      (fcuny/org-subtree-metadata))
-         (head       (plist-get props :header))
-         (body       (plist-get props :body))
-         (tags       (plist-get props :tags))
-         (properties (plist-get props :properties))
-         (area       (plist-get props :region))
-         (filename   (fcuny/org-filename-from-title head))
-         (filepath   (format "%s/%s.org" dir filename)))
-    (apply #'delete-region area)
-    (fcuny/org-create-org-file filepath head body tags properties)))
-
-(defun fcuny/org-set-file-property (key value &optional spot)
-  "Make sure file contains a top-level, file-wide property.
-KEY is something like `TITLE' or `FILETAGS'. This function makes
-sure that the property contains the contents of VALUE, and if the
-file doesn't have the property, it is inserted at either SPOT, or
-if nil,the top of the file."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((case-fold-search t))
-      (if (re-search-forward (format "^#\\+%s:\s*\\(.*\\)" key) nil t)
-          (replace-match value nil nil nil 1)
-
-        (cond
-         ;; if SPOT is a number, go to it:
-         ((numberp spot) (goto-char spot))
-         ;; If SPOT is not given, jump to first blank line:
-         ((null spot) (progn (goto-char (point-min))
-                             (re-search-forward "^\s*$" nil t)))
-         (t (goto-char (point-min))))
-
-        (insert (format "#+%s: %s\n" (upcase key) value))))))
-
-(defun fcuny/org-create-org-file (filepath header body tags properties)
-  "Create a new Org file by FILEPATH. The contents of the file is
-pre-populated with the HEADER, BODY and any associated TAGS."
-  (find-file-other-window filepath)
-  (fcuny/org-set-file-property "TITLE" header t)
-  (when tags
-    (fcuny/org-set-file-property "FILETAGS" (s-join " " tags)))
-
-  ;; Insert any drawer properties as #+PROPERTY entries:
-  (when properties
-    (goto-char (point-min))
-    (or (re-search-forward "^\s*$" nil t) (point-max))
-    (--map (insert (format "#+PROPERTY: %s %s" (first it) (second it))) properties))
-
-  ;; My auto-insert often adds an initial headline for a subtree, and in this
-  ;; case, I don't want that... Yeah, this isn't really globally applicable,
-  ;; but it shouldn't cause a problem for others.
-  (when (re-search-forward "^\\* [0-9]$" nil t)
-    (replace-match ""))
-
-  (delete-blank-lines)
-  (goto-char (point-max))
-  (insert "\n")
-  (insert body))
-
-(defun fcuny/org-subtree-metadata ()
-  "Return a list of key aspects of an org-subtree. Includes the
-following: header text, body contents, list of tags, region list
-of the start and end of the subtree."
-  (save-excursion
-    ;; Jump to the parent header if not already on a header
-    (when (not (org-at-heading-p))
-      (org-previous-visible-heading 1))
-
-    (let* ((context (org-element-context))
-           (attrs   (second context))
-           (props   (org-entry-properties)))
-
-      (list :region     (list (plist-get attrs :begin) (plist-get attrs :end))
-            :header     (plist-get attrs :title)
-            :tags       (fcuny/org-get-subtree-tags props)
-            :properties (fcuny/org-get-subtree-properties attrs)
-            :body       (fcuny/org-get-subtree-content attrs)))))
-
-(defun fcuny/org-filename-from-title (title)
-  "Creates a useful filename based on a header string, TITLE.
-For instance, given the string:    What's all this then?
-     This function will return:    whats-all-this-then"
-  (let* ((no-letters (rx (one-or-more (not alphanumeric))))
-         (init-try (->> title
-                        downcase
-                        (replace-regexp-in-string "'" "")
-                        (replace-regexp-in-string no-letters "-"))))
-    (string-trim init-try "-+" "-+")))
-
-(defun fcuny/org-get-subtree-content (attributes)
-  "Return the contents of the current subtree as a string."
-  (let ((header-components '(clock diary-sexp drawer headline inlinetask
-                             node-property planning property-drawer section)))
-
-      (goto-char (plist-get attributes :contents-begin))
-
-      ;; Walk down past the properties, etc.
-      (while
-          (let* ((cntx (org-element-context))
-                 (elem (first cntx))
-                 (props (second cntx)))
-            (when (member elem header-components)
-              (goto-char (plist-get props :end)))))
-
-      ;; At this point, we are at the beginning of what we consider
-      ;; the contents of the subtree, so we can return part of the buffer:
-      (buffer-substring-no-properties (point) (org-end-of-subtree))))
-
-(defun fcuny/org-get-subtree-properties (attributes)
-  "Return a list of tuples of a subtrees properties where the keys are strings."
-
-  (defun symbol-upcase? (sym)
-    (let ((case-fold-search nil))
-      (string-match-p "^:[A-Z]+$" (symbol-name sym))))
-
-  (defun convert-tuple (tup)
-    (let ((key (first tup))
-          (val (second tup)))
-      (list (substring (symbol-name key) 1) val)))
-
-  (->> attributes
-       (-partition 2)                         ; Convert plist to list of tuples
-       (--filter (symbol-upcase? (first it))) ; Remove lowercase tuples
-       (-map 'convert-tuple)))
-
-(defun fcuny/org-get-subtree-tags (&optional props)
-  "Given the properties, PROPS, from a call to
-`org-entry-properties', return a list of tags."
-  (unless props
-     (setq props (org-entry-properties)))
-  (let ((tag-label "ALLTAGS" ))
-    (-some->> props
-         (assoc tag-label)
-         cdr
-         substring-no-properties
-         (s-split ":")
-         (--filter (not (equalp "" it))))))
-
-(defun fcuny/org-refile-to-projects-dir ()
-  "Move the current subtree to a file in the `projects' directory."
-  (interactive)
-  (fcuny/org-refile-subtree-to-file org-default-projects-dir))
-
-(defun fcuny/org-refile-to-personal-dir ()
-  "Move the current subtree to a file in the `personal' directory."
-  (interactive)
-  (fcuny/org-refile-subtree-to-file org-default-personal-dir))
-
-(defun fcuny/org-refile-to-incubate ()
-  "Refile (move) the current Org subtree to `org-default-incubate-fire'."
-  (interactive)
-  (fcuny/org-refile-directly org-default-incubate-file))
-
-(defun fcuny/org-refile-to-technical-dir ()
-  "Move the current subtree to a file in the `technical' directory."
-  (interactive)
-  (fcuny/org-refile-subtree-to-file org-default-technical-dir))
-
-(defun fcuny/org-journal-date-format-func (time)
-  "Custom function to insert journal date header.
-
-  When buffer is empty prepend a header in front the entry header."
-  (concat (when (= (buffer-size) 0)
-            (concat
-             (pcase org-journal-file-type
-               (`daily "#+TITLE: Daily Journal")
-               (`weekly "#+TITLE: Weekly Journal")
-               (`monthly "#+TITLE: Monthly Journal")
-               (`yearly "#+TITLE: Yearly Journal"))))
-          org-journal-date-prefix
-          (format-time-string "%x (%A)" time)))
-
 (defun fcuny/uniquify-region-lines (beg end)
   "Remove duplicate adjacent lines in region."
   (interactive "*r")
@@ -322,6 +83,7 @@ For instance, given the string:    What's all this then?
       (replace-match "\\1"))))
 
 (defun fcuny/gocs ()
+  """Custom function to research a term using go/cs"
   (interactive)
   (let ((text (read-string "Search for: " (thing-at-point 'word))))
     (browse-url (format "http://go/cs/%s" text))))
diff --git a/emacs.d/custom/fcuny-org.el b/emacs.d/custom/fcuny-org.el
index dae6c7a..8ab36f4 100644
--- a/emacs.d/custom/fcuny-org.el
+++ b/emacs.d/custom/fcuny-org.el
@@ -293,4 +293,47 @@ The current time is used if the entry has no timestamp."
   (interactive)
   (fcuny/org-refile-to-datetree org-default-work-journal-file))
 
+(defun fcuny/org-subtree-region ()
+  "Return a list of the start and end of a subtree."
+  (save-excursion
+    (list (progn (org-back-to-heading) (point))
+          (progn (org-end-of-subtree)  (point)))))
+
+(defun fcuny/org-refile-directly (file-dest)
+  "Move the current subtree to the end of FILE-DEST.
+If SHOW-AFTER is non-nil, show the destination window,
+otherwise, this destination buffer is not shown."
+  (interactive "fDestination: ")
+
+  (defun dump-it (file contents)
+    (find-file-other-window file-dest)
+    (goto-char (point-max))
+    (insert "\n" contents))
+
+  (save-excursion
+    (let* ((region (fcuny/org-subtree-region))
+           (contents (buffer-substring (first region) (second region))))
+      (apply 'kill-region region)
+      (save-window-excursion (dump-it file-dest contents)))))
+
+(defun fcuny/org-refile-to-task ()
+  "Refile (move) the current Org subtree to `org-default-tasks-file'."
+  (interactive)
+  (fcuny/org-refile-directly org-default-tasks-file))
+
+(defun fcuny/org-refile-to-personal ()
+  "Refile (move) the current Org subtree to `org-default-personal-file'."
+  (interactive)
+  (fcuny/org-refile-directly org-default-personal-file))
+
+(defun fcuny/org-refile-to-notes ()
+  "Refile (move) the current Org subtree to `org-default-notes-file'."
+  (interactive)
+  (fcuny/org-refile-directly org-default-notes-file))
+
+(defun fcuny/org-refile-to-work ()
+  "Refile (move) the current Org subtree to `org-default-work-file'."
+  (interactive)
+  (fcuny/org-refile-directly org-default-work-file))
+
 (provide 'fcuny-org)