From 59eebb95c98be552b15272a9ef4b3cd310365889 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 6 Mar 2016 22:54:04 -0500 Subject: [PATCH] Large org-mode update including improved shackle integration for agenda and other popups --- core/core-popup.el | 29 ++++++++-- modules/defuns/defuns-org-notebook.el | 65 ++++++++++++--------- modules/defuns/defuns-org.el | 83 +++++++++++++++++++++------ modules/module-org-notebook.el | 2 +- modules/module-org.el | 35 ++++++----- 5 files changed, 148 insertions(+), 66 deletions(-) diff --git a/core/core-popup.el b/core/core-popup.el index e5926e635..1a7995b82 100644 --- a/core/core-popup.el +++ b/core/core-popup.el @@ -32,9 +32,9 @@ ;; Org ("^\\*Org Src .+\\*$" :regexp t :align below :size 0.4 :select t) ("^\\*Org-Babel.*\\*$" :regexp t :align below :size 0.4) - (org-agenda-mode :align below :size 0.4) - ("*Org Agenda*" :align below :size 0.4) - ("*Agenda Commands*" :align below :size 0.5) + ("^\\*Org Agenda.+" :regexp t :align below :size 0.4) + ("*Calendar*" :align below :size 0.4) + (" *Agenda Commands*" :align below :size 30) (" *Org todo*" :align below :size 5 :noselect t) ("*Org Links*" :align below :size 5) @@ -181,7 +181,28 @@ (mapc (lambda (b) (let ((buf (if (stringp b) (get-buffer-create b) b))) (pop-to-buffer buf t t))) - args))) + args)) + + ;; Taming Org-agenda! + (defun narf/org-agenda-quit () + "Necessary to finagle org-agenda into shackle popups and behave properly on quit." + (interactive) + (if org-agenda-columns-active + (org-columns-quit) + (let ((buf (current-buffer))) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window)) + (kill-buffer buf) + (setq org-agenda-archives-mode nil + org-agenda-buffer nil)))) + + (map! :map org-agenda-mode-map + :e "" 'narf/org-agenda-quit + :e "ESC" 'narf/org-agenda-quit + :e [escape] 'narf/org-agenda-quit + "q" 'narf/org-agenda-quit + "Q" 'narf/org-agenda-quit)) (after! flycheck (map! :map flycheck-error-list-mode-map diff --git a/modules/defuns/defuns-org-notebook.el b/modules/defuns/defuns-org-notebook.el index 9f13f2a56..18fa2ea47 100644 --- a/modules/defuns/defuns-org-notebook.el +++ b/modules/defuns/defuns-org-notebook.el @@ -7,12 +7,16 @@ ;;;###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))) + (let ((wg (wg-get-workgroup "*ORG*" t)) + orig-win) + (ignore-errors + (if (eq wg (wg-current-workgroup t)) + (wg-switch-to-workgroup wg) + (narf:workgroup-new nil "*ORG*" t))) + (setq orig-win (selected-window)) + (find-file (expand-file-name "Todo.org" org-directory)) + (narf/neotree) + (select-window orig-win t))) ;;;###autoload (defun narf/org-notebook-new () @@ -37,8 +41,7 @@ ;;;###autoload (defun narf/org-download-dnd (uri action) - (if (and (eq major-mode 'org-mode) - (not (image-type-from-file-name uri))) + (if (eq major-mode 'org-mode) (narf:org-attach uri) (let ((dnd-protocol-alist (rassq-delete-all 'narf/org-download-dnd (copy-alist dnd-protocol-alist)))) @@ -49,8 +52,9 @@ (interactive "") (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) + (new-path (f-expand rel-path)) + (image-p (image-type-from-file-name uri))) + (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 @@ -59,9 +63,12 @@ (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)))) + + (insert (if image-p + (format "[[./%s]]" rel-path) + (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))) @@ -84,23 +91,27 @@ ;;;###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))) + "Retrieves a list of all the attachments pertinent to the currect org-mode buffer." + (org-save-outline-visibility nil + (let ((attachments '()) + element + file) + (when (> (length (f-glob (concat (f-slash org-attach-directory) "*"))) 0) + (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 () + "Deletes any attachments that are no longer present in the org-mode buffer." (let* ((attachments (narf/org-attachments)) (to-delete (-difference narf-org-attachments-list attachments))) (mapc (lambda (f) diff --git a/modules/defuns/defuns-org.el b/modules/defuns/defuns-org.el index 3f73e9298..bbecd73c2 100644 --- a/modules/defuns/defuns-org.el +++ b/modules/defuns/defuns-org.el @@ -26,9 +26,31 @@ (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-indent () + (interactive) + (cond + ((and (org-on-heading-p) + (looking-back "^\\*+ +" (line-beginning-position))) + (ignore-errors + (org-demote))) + (t (call-interactively 'self-insert-command)))) + +;;;###autoload +(defun narf/org-dedent () + (interactive) + (cond + ((and (org-on-heading-p) + (looking-back "^\\*+ +" (line-beginning-position))) + (ignore-errors + (org-promote))) + (t (call-interactively 'self-insert-command)))) + ;;;###autoload (defun narf/org-insert-item (direction) - "Inserts a new heading or item, depending on the context." + "Inserts a new heading or item, depending on the context. I use this instead of +`org-insert-item' or `org-insert-heading' because they try to do too much and end up doing +this otherwise simple task wrong (e.g. whitespace in the wrong places)." (interactive) (let* ((context (org-element-lineage (org-element-context) @@ -36,13 +58,15 @@ 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))) + (let ((marker (org-element-property :bullet context))) + (cl-case direction + ('below + (goto-char (line-end-position)) + (insert (concat "\n" marker))) + ('above + (goto-char (line-beginning-position)) + (insert marker) + (save-excursion (insert "\n"))))) (when (org-element-property :checkbox context) (insert "[ ] "))) ((memq type '(table table-row)) @@ -52,14 +76,31 @@ ('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)))) + (let ((level (save-excursion + (org-back-to-heading) + (org-element-property + :level (org-element-lineage (org-element-context) + '(headline) t))))) + (cl-case direction + ('below + (let ((at-eol (= (point) (1- (line-end-position))))) + (goto-char (line-end-position)) + (org-end-of-subtree) + (insert (concat "\n" + (when (= level 1) + (if at-eol + (ignore (cl-incf level)) + "\n")) + (make-string level ?*) + " ")))) + ('above + (org-back-to-heading) + (org-insert-heading) + (when (= level 1) + (save-excursion (evil-open-above 1)) + (save-excursion (insert "\n"))))) + (when (org-element-property :todo-type context) + (org-todo 'todo))))) (evil-append-line 1))) ;;;###autoload @@ -82,6 +123,9 @@ (type (org-element-type context)) (value (org-element-property :value context))) (cond + ((memq type '(planning timestamp)) + (org-follow-timestamp-link)) + ((memq type '(table table-row)) (if (org-element-property :tblfm (org-element-property :parent context)) (org-table-recalculate t) @@ -296,5 +340,12 @@ re-align the table if necessary. (Necessary because org-mode has a (skip-chars-backward "^|\n\r") (when (org-looking-at-p " ") (forward-char)))) +;;;###autoload (autoload 'narf:org-link "defuns-org" nil t) +(evil-define-command narf:org-link (link) + (interactive "") + (let ((beg evil-visual-beginning) + (end evil-visual-end)) + (org-insert-link nil link (when (and beg end) (buffer-substring-no-properties beg end))))) + (provide 'defuns-org) ;;; defuns-org.el ends here diff --git a/modules/module-org-notebook.el b/modules/module-org-notebook.el index 7a53bfca4..5fde7de5a 100644 --- a/modules/module-org-notebook.el +++ b/modules/module-org-notebook.el @@ -59,7 +59,7 @@ ;; (defun narf|org-export-init () - (setq org-export-backends '(ascii html latex md opml) + (setq org-export-backends '(ascii html latex md) org-export-with-toc t org-export-with-author t) diff --git a/modules/module-org.el b/modules/module-org.el index d2eece70b..7a912c4f6 100644 --- a/modules/module-org.el +++ b/modules/module-org.el @@ -17,12 +17,8 @@ (defun narf|org-hook () (evil-org-mode +1) - (org-indent-mode +1) (setq line-spacing 1) - ;; Highlight plaintext links - (highlight-regexp org-any-link-re 'org-link) - ;; If saveplace places the point in a folded position, unfold it on load (when (outline-invisible-p) (ignore-errors @@ -32,27 +28,23 @@ (defun narf|org-update () (when (file-exists-p buffer-file-name) - (org-update-statistics-cookies t) - (org-align-all-tags))) + (org-update-statistics-cookies t))) (add-hook 'before-save-hook 'narf|org-update nil t) (add-hook 'evil-insert-state-exit-hook 'narf|org-update nil t)) (defun narf|org-init () (setq-default - org-agenda-files - (f-entries org-directory (lambda (path) (string-suffix-p ".org" path))) - ;; Appearance org-indent-mode-turns-on-hiding-stars t org-adapt-indentation nil org-blank-before-new-entry '((heading . nil) (plain-list-item . auto)) - org-bullets-bullet-list '("•" "◦" "•" "◦" "•" "◦") + ;; org-bullets-bullet-list '("•" "◦" "•" "◦" "•" "◦") org-cycle-separator-lines 1 org-ellipsis 'hs-face org-entities-user '(("flat" "\\flat" nil "" "" "266D" "♭") ("sharp" "\\sharp" nil "" "" "266F" "♯")) - org-fontify-done-headline t + org-fontify-done-headline nil org-fontify-quote-and-verse-blocks t org-fontify-whole-heading-line t org-footnote-auto-label 'plain @@ -63,13 +55,13 @@ org-pretty-entities t org-pretty-entities-include-sub-superscripts nil org-startup-folded t - org-startup-indented nil + org-startup-indented t org-startup-with-inline-images nil - org-tags-column 70 + org-tags-column 0 org-use-sub-superscripts '{} ;; Behavior - org-catch-invisible-edits nil + org-catch-invisible-edits 'show org-checkbox-hierarchical-statistics nil org-completion-use-ido nil ; Use helm for refiling org-confirm-elisp-link-function nil @@ -87,10 +79,14 @@ org-refile-targets '((nil . (:maxlevel . 2))) ; display full path in refile completion ;; Agenda - org-agenda-restore-windows-after-quit t - org-agenda-skip-unavailable-files t - org-agenda-window-setup 'other-window - org-todo-keywords '((sequence "TODO(t)" "|" "DONE(d)") + org-agenda-restore-windows-after-quit nil + org-agenda-skip-unavailable-files nil + org-agenda-window-setup 'other-frame + org-agenda-dim-blocked-tasks nil + org-agenda-inhibit-startup t + org-agenda-files (f-entries org-directory (lambda (path) (f-ext? path "org"))) + org-todo-keywords '((sequence "[ ](t)" "[-](p)" "|" "[X](d)") + (sequence "TODO(T)" "|" "DONE(D)") (sequence "IDEA(i)" "NEXT(n)" "ACTIVE(a)" "WAITING(w)" "LATER(l)" "|" "CANCELLED(c)")) ;; Babel @@ -218,6 +214,8 @@ :i "C-e" 'org-end-of-line :i "C-a" 'org-beginning-of-line + :i "" 'narf/org-indent + :i "" 'narf/org-dedent :nv "j" 'evil-next-visual-line :nv "k" 'evil-previous-visual-line @@ -266,6 +264,7 @@ :n "D" 'org-time-stamp-inactive :n "i" 'narf/org-toggle-inline-images-at-point :n "t" (λ! (org-todo (if (org-entry-is-todo-p) 'none 'todo))) + :v "t" (λ! (evil-ex-normal evil-visual-beginning evil-visual-end "\\t")) :n "T" 'org-todo :n "s" 'org-schedule :n "r" 'org-refile