fix wonky org window behavior

This commit is contained in:
petrucci4prez 2018-05-19 14:45:43 -04:00
parent 4aef52dbb5
commit fb9dd25438
2 changed files with 181 additions and 23 deletions

95
conf.el
View File

@ -169,6 +169,26 @@
(global-undo-tree-mode)
(setq undo-tree-visualizer-diff t))
;; lovingly stolen from aaron harris
(defmacro nd/with-advice (adlist &rest body)
"Execute BODY with temporary advice in ADLIST.
Each element of ADLIST should be a list of the form
(SYMBOL WHERE FUNCTION [PROPS])
suitable for passing to `advice-add'. The BODY is wrapped in an
`unwind-protect' form, so the advice will be removed even in the
event of an error or nonlocal exit."
(declare (debug ((&rest (&rest form)) body))
(indent 1))
`(progn
,@(mapcar (lambda (adform)
(cons 'advice-add adform))
adlist)
(unwind-protect (progn ,@body)
,@(mapcar (lambda (adform)
`(advice-remove ,(car adform) ,(nth 2 adform)))
adlist))))
(defun split-and-follow-horizontally ()
(interactive)
(split-window-below)
@ -258,6 +278,41 @@
(add-hook 'org-mode-hook 'nd/org-ui-heading-same-font-height)
(defun nd/org-todo-position (buffer alist)
(let ((win (car (cl-delete-if-not
(lambda (window)
(with-current-buffer (window-buffer window)
(memq major-mode
'(org-mode org-agenda-mode))))
(window-list)))))
(when win
(let ((new (split-window win -4 'below)))
(set-window-buffer new buffer)
new))))
(defun nd/org-todo-window-advice (orig-fn)
"Advice to fix window placement in `org-fast-todo-selection'."
(let ((override '("\\*Org todo\\*" nd/org-todo-position)))
(add-to-list 'display-buffer-alist override)
(nd/with-advice
((#'org-switch-to-buffer-other-window :override #'pop-to-buffer))
(unwind-protect (funcall orig-fn)
(setq display-buffer-alist
(delete override display-buffer-alist))))))
(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice)
(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table)
"Advice to fix window placement in `org-fast-tags-selection'."
(nd/with-advice
((#'delete-other-windows :override #'ignore)
;; pretty sure I just got lucky here...
(#'split-window-vertically :override #'(lambda (&optional size)
(split-window-below (or size -9)))))
(unwind-protect (funcall orig-fn current inherited table todo-table))))
(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice)
;;(add-hook 'org-capture-mode-hook 'evil-append)
(add-to-list 'org-structure-template-alist
@ -352,6 +407,7 @@
(add-to-list 'org-default-properties "PARENT_TYPE")
(add-to-list 'org-default-properties "OWNER")
(add-to-list 'org-default-properties "GOAL")
(setq org-global-properties
'(("PARENT_TYPE_ALL" . "periodical iterator")
("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")))
@ -397,6 +453,7 @@
;; (setq org-agenda-files '("~/Org/reference/agendatest.org"))
(setq org-agenda-dim-blocked-tasks nil)
(setq org-agenda-compact-blocks t)
(setq org-agenda-window-setup 'only-window)
(defun nd/get-date-property (date-property)
"Helper function to get the date property and convert to a number.
@ -754,7 +811,7 @@ tags that do not have tags in neg-tags-list"
(not (nd/heading-has-children 'nd/is-timestamped-heading-p))))
(nd/skip-heading))))
(defun nd/skip-non-keyword-project-tasks (skip-keyword)
(defun nd/skip-non-project-tasks ()
(save-restriction
(widen)
(let ((keyword (nd/is-todoitem-p)))
@ -767,7 +824,8 @@ tags that do not have tags in neg-tags-list"
(not (nd/is-timestamped-heading-p))
(not (nd/is-scheduled-heading-p))
(not (nd/is-deadlined-heading-p))
(equal keyword skip-keyword)))
;; (equal keyword skip-keyword)
))
(nd/skip-heading)))
(nd/skip-heading)))))
@ -867,6 +925,20 @@ tasks with context tags"
(tags . " %-12:c%-7:e")
(search . " %-12:c")))
(defconst nd/org-agenda-todo-sort-order '("NEXT" "WAIT" "HOLD" "TODO"))
(setq org-agenda-cmp-user-defined
'(lambda (a b)
(let ((pa (- (length (member
(get-text-property 1 'todo-state a)
nd/org-agenda-todo-sort-order))))
(pb (- (length (member
(get-text-property 1 'todo-state b)
nd/org-agenda-todo-sort-order)))))
(cond ((or (null pa) (null pb)) nil)
((> pa pb) +1)
((< pa pb) -1)))))
(defun nd/agenda-base-header-command (match header skip-fun)
`(tags
,match
@ -874,13 +946,14 @@ tasks with context tags"
(org-agenda-skip-function ,skip-fun)
(org-agenda-sorting-strategy '(category-keep)))))
(defun nd/agenda-base-task-command (match header skip-fun)
(defun nd/agenda-base-task-command (match header skip-fun &optional sort)
(or sort (setq sort ''(category-keep)))
`(tags-todo
,match
((org-agenda-overriding-header ,header)
(org-agenda-skip-function ,skip-fun)
(org-agenda-todo-ignore-with-date t)
(org-agenda-sorting-strategy '(category-keep)))))
(org-agenda-sorting-strategy ,sort))))
(defun nd/agenda-base-project-command (match header statuscode)
`(tags
@ -898,10 +971,13 @@ tasks with context tags"
`(("t"
"Task View"
((agenda "" (org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc"))))
,(nd/agenda-base-task-command task-match "Next Project Tasks" ''(nd/skip-non-keyword-project-tasks "NEXT"))
,(nd/agenda-base-task-command task-match "Waiting Project Tasks" ''(nd/skip-non-keyword-project-tasks "WAIT"))
,(nd/agenda-base-task-command project-match "Atomic Tasks" ''nd/skip-non-atomic-tasks)
,(nd/agenda-base-task-command task-match "Held Project Tasks" ''(nd/skip-non-keyword-project-tasks "HOLD"))))
,(nd/agenda-base-task-command project-match
"Project Tasks"
''nd/skip-non-project-tasks
''(user-defined-up category-keep))
,(nd/agenda-base-task-command project-match
"Atomic Tasks"
''nd/skip-non-atomic-tasks)))
("p"
"Project View"
(,(nd/agenda-base-project-command project-match "Stuck Projects" :stuck)
@ -933,9 +1009,6 @@ tasks with context tags"
((tags "REFILE"
((org-agenda-overriding-header "Tasks to Refile"))
(org-tags-match-list-sublevels nil))
,(nd/agenda-base-task-command "-NA-REFILE-%inc/TODO|NEXT|WAIT" "Project Tasks Without Context" ''nd/skip-project-tasks-with-context)
,(nd/agenda-base-task-command "-NA-REFILE-%inc/!" "Atomic Tasks Without Context" ''nd/skip-atomic-tasks-with-context)
;; ,(nd/agenda-base-task-command "-NA-REFILE-%subdiv/TODO|NEXT|WAIT" "Tasks Without Effort" ''nd/skip-tasks-with-effort)
,(nd/agenda-base-task-command task-match "Discontinous Project" ''nd/skip-non-discontinuous-project-tasks)
,(nd/agenda-base-project-command project-match "Invalid Todostate" :invalid-todostate)))
("e"

109
conf.org
View File

@ -264,6 +264,30 @@ vim is all about escape, not...ctrl+g???
(global-undo-tree-mode)
(setq undo-tree-visualizer-diff t))
#+END_SRC
* library
A place for duct tape code that I developed (or lovingly stole from others)
** macros
#+BEGIN_SRC emacs-lisp
;; lovingly stolen from aaron harris
(defmacro nd/with-advice (adlist &rest body)
"Execute BODY with temporary advice in ADLIST.
Each element of ADLIST should be a list of the form
(SYMBOL WHERE FUNCTION [PROPS])
suitable for passing to `advice-add'. The BODY is wrapped in an
`unwind-protect' form, so the advice will be removed even in the
event of an error or nonlocal exit."
(declare (debug ((&rest (&rest form)) body))
(indent 1))
`(progn
,@(mapcar (lambda (adform)
(cons 'advice-add adform))
adlist)
(unwind-protect (progn ,@body)
,@(mapcar (lambda (adform)
`(advice-remove ,(car adform) ,(nth 2 adform)))
adlist))))
#+END_SRC
* custom functions
** follow window splitting
#+BEGIN_SRC emacs-lisp
@ -383,7 +407,7 @@ vim is all about escape, not...ctrl+g???
(add-hook 'org-mode-hook (lambda () (org-bullets-mode))))
#+END_SRC
*** font height
the fonts in org headings bug me, make them smaller and less invasive
The fonts in org headings bug me, make them smaller and less invasive
#+BEGIN_SRC emacs-lisp
(defun nd/org-ui-heading-same-font-height ()
(let ((heading-height 1.15))
@ -395,6 +419,49 @@ the fonts in org headings bug me, make them smaller and less invasive
(add-hook 'org-mode-hook 'nd/org-ui-heading-same-font-height)
#+END_SRC
*** window splitting
Org mode is great and all, but the windows never show up in the right place
**** todo selection
I only need a teeny tiny window below my current window for todo selection
#+BEGIN_SRC emacs-lisp
(defun nd/org-todo-position (buffer alist)
(let ((win (car (cl-delete-if-not
(lambda (window)
(with-current-buffer (window-buffer window)
(memq major-mode
'(org-mode org-agenda-mode))))
(window-list)))))
(when win
(let ((new (split-window win -4 'below)))
(set-window-buffer new buffer)
new))))
(defun nd/org-todo-window-advice (orig-fn)
"Advice to fix window placement in `org-fast-todo-selection'."
(let ((override '("\\*Org todo\\*" nd/org-todo-position)))
(add-to-list 'display-buffer-alist override)
(nd/with-advice
((#'org-switch-to-buffer-other-window :override #'pop-to-buffer))
(unwind-protect (funcall orig-fn)
(setq display-buffer-alist
(delete override display-buffer-alist))))))
(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice)
#+END_SRC
**** tag selection
By default, the tag selection window obliterates all but the current window...how disorienting :/
#+BEGIN_SRC emacs-lisp
(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table)
"Advice to fix window placement in `org-fast-tags-selection'."
(nd/with-advice
((#'delete-other-windows :override #'ignore)
;; pretty sure I just got lucky here...
(#'split-window-vertically :override #'(lambda (&optional size)
(split-window-below (or size -9)))))
(unwind-protect (funcall orig-fn current inherited table todo-table))))
(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice)
#+END_SRC
** evil modes
#+BEGIN_SRC emacs-lisp
;;(add-hook 'org-capture-mode-hook 'evil-append)
@ -520,6 +587,7 @@ There are several types of tags I use:
#+BEGIN_SRC emacs-lisp
(add-to-list 'org-default-properties "PARENT_TYPE")
(add-to-list 'org-default-properties "OWNER")
(add-to-list 'org-default-properties "GOAL")
(setq org-global-properties
'(("PARENT_TYPE_ALL" . "periodical iterator")
("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")))
@ -581,6 +649,7 @@ There are several types of tags I use:
;; (setq org-agenda-files '("~/Org/reference/agendatest.org"))
(setq org-agenda-dim-blocked-tasks nil)
(setq org-agenda-compact-blocks t)
(setq org-agenda-window-setup 'only-window)
#+END_SRC
*** task helper functions
These are the building blocks for skip functions.
@ -1003,7 +1072,7 @@ futher action. (TODO = stuck which I take care
of at the project level, and DONE/CANC = archivable
which is dealt with similarly)
#+BEGIN_SRC emacs-lisp
(defun nd/skip-non-keyword-project-tasks (skip-keyword)
(defun nd/skip-non-project-tasks ()
(save-restriction
(widen)
(let ((keyword (nd/is-todoitem-p)))
@ -1016,7 +1085,8 @@ which is dealt with similarly)
(not (nd/is-timestamped-heading-p))
(not (nd/is-scheduled-heading-p))
(not (nd/is-deadlined-heading-p))
(equal keyword skip-keyword)))
;; (equal keyword skip-keyword)
))
(nd/skip-heading)))
(nd/skip-heading)))))
@ -1130,6 +1200,20 @@ Note that this is used for "normal" projects as well as iterators
(tags . " %-12:c%-7:e")
(search . " %-12:c")))
(defconst nd/org-agenda-todo-sort-order '("NEXT" "WAIT" "HOLD" "TODO"))
(setq org-agenda-cmp-user-defined
'(lambda (a b)
(let ((pa (- (length (member
(get-text-property 1 'todo-state a)
nd/org-agenda-todo-sort-order))))
(pb (- (length (member
(get-text-property 1 'todo-state b)
nd/org-agenda-todo-sort-order)))))
(cond ((or (null pa) (null pb)) nil)
((> pa pb) +1)
((< pa pb) -1)))))
(defun nd/agenda-base-header-command (match header skip-fun)
`(tags
,match
@ -1137,13 +1221,14 @@ Note that this is used for "normal" projects as well as iterators
(org-agenda-skip-function ,skip-fun)
(org-agenda-sorting-strategy '(category-keep)))))
(defun nd/agenda-base-task-command (match header skip-fun)
(defun nd/agenda-base-task-command (match header skip-fun &optional sort)
(or sort (setq sort ''(category-keep)))
`(tags-todo
,match
((org-agenda-overriding-header ,header)
(org-agenda-skip-function ,skip-fun)
(org-agenda-todo-ignore-with-date t)
(org-agenda-sorting-strategy '(category-keep)))))
(org-agenda-sorting-strategy ,sort))))
(defun nd/agenda-base-project-command (match header statuscode)
`(tags
@ -1161,10 +1246,13 @@ Note that this is used for "normal" projects as well as iterators
`(("t"
"Task View"
((agenda "" (org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc"))))
,(nd/agenda-base-task-command task-match "Next Project Tasks" ''(nd/skip-non-keyword-project-tasks "NEXT"))
,(nd/agenda-base-task-command task-match "Waiting Project Tasks" ''(nd/skip-non-keyword-project-tasks "WAIT"))
,(nd/agenda-base-task-command project-match "Atomic Tasks" ''nd/skip-non-atomic-tasks)
,(nd/agenda-base-task-command task-match "Held Project Tasks" ''(nd/skip-non-keyword-project-tasks "HOLD"))))
,(nd/agenda-base-task-command project-match
"Project Tasks"
''nd/skip-non-project-tasks
''(user-defined-up category-keep))
,(nd/agenda-base-task-command project-match
"Atomic Tasks"
''nd/skip-non-atomic-tasks)))
("p"
"Project View"
(,(nd/agenda-base-project-command project-match "Stuck Projects" :stuck)
@ -1196,9 +1284,6 @@ Note that this is used for "normal" projects as well as iterators
((tags "REFILE"
((org-agenda-overriding-header "Tasks to Refile"))
(org-tags-match-list-sublevels nil))
,(nd/agenda-base-task-command "-NA-REFILE-%inc/TODO|NEXT|WAIT" "Project Tasks Without Context" ''nd/skip-project-tasks-with-context)
,(nd/agenda-base-task-command "-NA-REFILE-%inc/!" "Atomic Tasks Without Context" ''nd/skip-atomic-tasks-with-context)
;; ,(nd/agenda-base-task-command "-NA-REFILE-%subdiv/TODO|NEXT|WAIT" "Tasks Without Effort" ''nd/skip-tasks-with-effort)
,(nd/agenda-base-task-command task-match "Discontinous Project" ''nd/skip-non-discontinuous-project-tasks)
,(nd/agenda-base-project-command project-match "Invalid Todostate" :invalid-todostate)))
("e"