Skip to content

Commit

Permalink
Add org-brain group feature.
Browse files Browse the repository at this point in the history 
* org-brain.el (org-brain-group-property-name): New variable.
(org-brain-group-face-alist): New variable.
(org-brain-display-face): Handle org-brain group.
(org-brain-get-group): New function.
(org-brain-set-selected-group): New function.
(org-brain-set-group): new function.
(org-brain-group<): New function.
(org-brain-visualize-mode-map, org-brain-select-map): Handle keybindings of group commands
  • Loading branch information
@tumashu
tumashu committed Jul 27, 2020
1 parent 7840aa9 commit 6ae91e6
Showing 1 changed file with 110 additions and 15 deletions.
125 changes: 110 additions & 15 deletions org-brain.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -397,6 +397,12 @@ Must be set before `org-brain' is loaded."
:group 'org-brain
:type '(string))

(defcustom org-brain-group-property-name "BRAIN_GROUP"
"The name for the org-mode property in which entry group info are stored.
Must be set before `org-brain' is loaded."
:group 'org-brain
:type '(string))

(defcustom org-brain-edge-property-prefix-name "BRAIN_EDGE"
"The prefix for the org-mode property in which edge annotations are stored.
Must be set before `org-brain' is loaded."
Expand Down Expand Up @@ -424,6 +430,16 @@ Must be set before `org-brain' is loaded."
(const :tag "Default" default)
(function :tag "Custom function")))

(defcustom org-brain-group-face-alist
'(("red" (:foreground "black" :background "red"))
("green" (:foreground "black" :background "green"))
("blue" (:foreground "black" :background "blue"))
("yellow" (:foreground "black" :background "yellow"))
("orange" (:foreground "black" :background "orange"))
("violet" (:foreground "black" :background "violet"))
(t (:foreground "black" :background "gray")))
"An alist of group face.")

;;;;; Faces and face helper functions

(defface org-brain-title
Expand Down Expand Up @@ -519,17 +535,31 @@ Applies the attributes in `org-brain-edge-annotation-face-template',
`org-brain-selected-face-template', and `org-brain-file-face-template'
as appropriate.
EDGE determines if `org-brain-edge-annotation-face-template' should be used."
(let ((selected-face-attrs
(when (member entry org-brain-selected)
(org-brain-specified-face-attrs 'org-brain-selected-face-template)))
(file-face-attrs
(when (org-brain-filep entry)
(org-brain-specified-face-attrs 'org-brain-file-face-template))))
(append (list :inherit (or face 'org-brain-button))
selected-face-attrs
file-face-attrs
(when edge
(org-brain-specified-face-attrs 'org-brain-edge-annotation-face-template)))))
(let* ((group (org-brain-get-group entry))
(group-face (cadr (or (assoc group org-brain-group-face-alist)
(assoc t org-brain-group-face-alist))))
(selected-face-attrs
(when (member entry org-brain-selected)
(org-brain-specified-face-attrs 'org-brain-selected-face-template)))
(file-face-attrs
(when (org-brain-filep entry)
(org-brain-specified-face-attrs 'org-brain-file-face-template)))
(entry-face
(append (list :inherit (or face 'org-brain-button))
selected-face-attrs
file-face-attrs
(when edge
(org-brain-specified-face-attrs 'org-brain-edge-annotation-face-template)))))
(if (and (listp group-face)
(memq face '(org-brain-local-child
org-brain-child
org-brain-local-sibling
org-brain-sibling
org-brain-local-parent
;; org-brain-parent
org-brain-friend)))
(append entry-face group-face)
entry-face)))

(defface org-brain-selected-face-template
`((t . ,(org-brain-specified-face-attrs 'highlight)))
Expand Down Expand Up @@ -1049,6 +1079,17 @@ Only works on headline entries."
(or (org-id-find (nth 2 entry) t)
(org-brain--missing-id-error entry))))

(defun org-brain-get-group (entry)
"Get group of ENTRY."
(let ((org-use-property-inheritance nil))
(if (org-brain-filep entry)
(ignore-errors
(cdr (assoc org-brain-group-property-name (org-brain-keywords entry))))
(org-with-point-at
(org-brain-entry-marker entry)
(org-entry-get (org-brain-entry-marker entry)
org-brain-group-property-name)))))

(defun org-brain-title (entry &optional capped)
"Get title of ENTRY. If CAPPED is t, max length is `org-brain-title-max-length'."
(let ((title
Expand Down Expand Up @@ -2109,6 +2150,19 @@ Ignores selected entries that are not friends of ENTRY."
(dolist (selected org-brain-selected)
(ignore-errors (org-brain-remove-friendship entry selected))))

(defun org-brain-set-selected-group (group)
"Set the group of the selected entries to GROUP.
If run interactively, get ENTRY from context.
When ENTRY is in the selected list, it is ignored."

(interactive (list (completing-read
"Group: "
(mapcar #'car org-brain-group-face-alist))))
(dolist (entry org-brain-selected)
(ignore-errors (org-brain-set-group entry group)))
(org-brain-clear-selected))

(defun org-brain-delete-selected-entries ()
"Delete all of the selected entries."
(interactive)
Expand Down Expand Up @@ -2176,6 +2230,35 @@ If run interactively, get ENTRY from context."
(save-buffer)))
(org-brain--revert-if-visualizing))

;;;###autoload
(defun org-brain-set-group (entry group)
"ENTRY set a new GROUP.
If run interactively use `org-brain-entry-at-pt' and prompt for GROUP."
(interactive
(let* ((entry-at-pt (org-brain-entry-at-pt t))
(new-group (org-brain-get-group entry-at-pt)))
(list entry-at-pt (completing-read
"Group: " `(,new-group
,@(mapcar #'car org-brain-group-face-alist))))))
(if (org-brain-filep entry)
;; File entry
(org-with-point-at (org-brain-entry-marker entry)
(goto-char (point-min))
(when (assoc org-brain-group-property-name (org-brain-keywords entry))
(re-search-forward (format "^#\\+%s:" org-brain-group-property-name))
(kill-whole-line))
(insert (format "#+%s: %s\n" org-brain-group-property-name group))
(save-buffer))
;; Headline entry
(org-with-point-at
(org-brain-entry-marker entry)
(org-entry-put
(org-brain-entry-marker entry)
org-brain-group-property-name group)
(save-buffer)))
(org-brain--revert-if-visualizing))


;;;###autoload
(defun org-brain-add-nickname (entry nickname)
"ENTRY gets a new NICKNAME.
Expand Down Expand Up @@ -2298,6 +2381,15 @@ function."
Case is significant."
(string< (org-brain-title entry1) (org-brain-title entry2)))

(defun org-brain-group< (entry1 entry2)
"Return non-nil if group of ENTRY1 is less than ENTRY2 in `org-brain-group-face-alist' order.
Case is significant."
(let ((group1 (or (org-brain-get-group entry1) ""))
(group2 (or (org-brain-get-group entry2) ""))
(colors (mapcar #'car org-brain-group-face-alist)))
(< (or (cl-position group1 colors :test #'equal) 10000)
(or (cl-position group2 colors :test #'equal) 10000))))

(defvar org-brain-visualize-sort-function 'org-brain-title<
"How to sort lists of relationships when visualizing.
Should be a function which accepts two entries as arguments.
Expand Down Expand Up @@ -2802,6 +2894,7 @@ point before the buffer was reverted."
(define-key org-brain-visualize-mode-map "b" 'org-brain-visualize-back)
(define-key org-brain-visualize-mode-map "\C-y" 'org-brain-visualize-paste-resource)
(define-key org-brain-visualize-mode-map "T" 'org-brain-set-tags)
(define-key org-brain-visualize-mode-map "G" 'org-brain-set-group)
(define-key org-brain-visualize-mode-map "q" 'org-brain-visualize-quit)
(define-key org-brain-visualize-mode-map "w" 'org-brain-visualize-random)
(define-key org-brain-visualize-mode-map "W" 'org-brain-visualize-wander)
Expand All @@ -2822,6 +2915,7 @@ point before the buffer was reverted."
(define-key org-brain-select-map "P" 'org-brain-remove-selected-parents)
(define-key org-brain-select-map "f" 'org-brain-add-selected-friendships)
(define-key org-brain-select-map "F" 'org-brain-remove-selected-friendships)
(define-key org-brain-select-map "G" 'org-brain-set-selected-group)
(define-key org-brain-select-map "s" 'org-brain-clear-selected)
(define-key org-brain-select-map "S" 'org-brain-clear-selected)
(define-key org-brain-select-map "d" 'org-brain-delete-selected-entries)
Expand Down Expand Up @@ -2999,10 +3093,11 @@ Helper function for `org-brain-visualize'."
(face (if (member entry (org-brain-local-parent child))
'org-brain-local-child
'org-brain-child)))
(if (<= (+ (current-column) (length child-title)) fill-col)
(org-brain-insert-visualize-button child face 'child)
(insert "\n")
(org-brain-insert-visualize-button child face 'child title-max-width))
(when (> (+ (current-column) (length child-title)) fill-col)
(insert "\n"))
(if (< fill-col title-max-width)
(org-brain-insert-visualize-button child face 'child title-max-width)
(org-brain-insert-visualize-button child face 'child))
(insert " "))))))

(defun org-brain--vis-friends (entry)
Expand Down

0 comments on commit 6ae91e6

Please sign in to comment.