summaryrefslogtreecommitdiff
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
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 '')
-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)