blob: d79b920856ed5acb915cafa29101033ce15617ce (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
(define-module (jd features emacs-xyz)
#:use-module (rde features)
#:use-module (rde features emacs)
#:export (feature-emacs-org-uni))
(define* (feature-emacs-org-uni
#:key
(capture-key "u")
(org-uni-task-olp (list "Tasks"))
(org-uni-class-prop-name "UNI-CLASS")
(org-uni-course-prop-name "COURSE"))
(ensure-pred string? capture-key)
(ensure-pred list? org-uni-task-olp)
(ensure-pred string? org-uni-course-prop-name)
(ensure-pred string? org-uni-class-prop-name)
(define emacs-f-name 'org-uni)
(define f-name (symbol-append 'emacs- emacs-f-name))
(define (get-home-services config)
(list
(rde-elisp-configuration-service
emacs-f-name
config
`((defvar org-uni-class-prop-name ,org-uni-class-prop-name)
(defvar org-uni-task-olp (list ,@org-uni-task-olp)
"An outline path to task heading, that start from uni class heading.")
(defun org-uni-normalize (s)
(let ((replacements
'(("ą" . "a") ("ć" . "c") ("ę" . "e") ("ł" . "l")
("ń" . "n") ("ó" . "o") ("ś" . "s") ("ź" . "z") ("ż" . "z")
("Ą" . "A") ("Ć" . "C") ("Ę" . "E") ("Ł" . "L")
("Ń" . "N") ("Ó" . "O") ("Ś" . "S") ("Ź" . "Z") ("Ż" . "Z"))))
(dolist (pair replacements s)
(setq s (replace-regexp-in-string (car pair) (cdr pair) s)))))
(defun org-uni-select-class ()
(require 'dash)
(let* ((choices
(-non-nil
(org-map-entries
(lambda ()
(let* ((heading (nth 4 (org-heading-components)))
(file (buffer-file-name))
(heading-path (org-get-outline-path t))
(heading-norm (replace-regexp-in-string
"[^a-z0-9]+" "_"
(org-uni-normalize (downcase heading)))))
(when (org-entry-get (point) org-uni-class-prop-name)
(cons (format "[%s] %s"
(file-name-nondirectory file)
heading)
(list :file file
:heading-path heading-path
:heading heading
:heading-norm heading-norm)))))
nil
'agenda)))
(selection (completing-read "Select class: "
(mapcar 'car choices) nil t)))
(cdr (assoc selection choices))))
(defun org-uni-goto-class ()
(interactive)
(let* ((sel (org-uni-select-class))
(file (plist-get sel :file))
(olp (plist-get sel :heading-path)))
(find-file file)
(let ((m (org-find-olp olp t)))
(when m
(widen)
(goto-char m)
(org-narrow-to-subtree)
(org-show-subtree)
(set-marker m nil)))))
(defun org-uni-open-course-link ()
(interactive)
(let* ((sel (org-uni-select-class))
(file (plist-get sel :file))
(olp (plist-get sel :heading-path)))
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(let ((m (org-find-olp olp t)))
(when m
(goto-char m)
(let ((course-link (org-entry-get (point) ,org-uni-course-prop-name)))
(when course-link
(org-link-open-from-string course-link))))))))
(defun org-uni-capture-task-function ()
(let* ((sel (org-uni-select-class))
(file (plist-get sel :file))
(heading (plist-get sel :heading))
(heading-path (plist-get sel :heading-path))
(heading-norm (plist-get sel :heading-norm))
(olp (append heading-path org-uni-task-olp))
(path (org-capture-expand-file file))
(m (org-find-olp (cons path olp))))
(org-capture-put :uni-class-tag heading-norm)
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
(goto-char m)
(set-marker m nil)))
(defvar org-uni-map (make-sparse-keymap)
"Keymap for org-uni commands.")
(define-key org-uni-map (kbd "u") 'org-uni-goto-class)
(define-key org-uni-map (kbd "c") 'org-uni-open-course-link)
(define-key rde-app-map (kbd "u") org-uni-map)
(with-eval-after-load
'org-capture
(add-to-list
'org-capture-templates
'(,capture-key
"University task" entry
(function org-uni-capture-task-function)
"* TODO %? :%(org-capture-get :uni-class-tag):\n:PROPERTIES:\n:CREATED: %U\n:END:\n"))))
#:summary "This Emacs Lisp script enhances =org-mode= with a feature for managing university tasks."
#:commentary "This Emacs Lisp script enhances =org-mode= with a feature for managing university tasks."
#:authors (list "Jakub Dlugosz <jakub@jdlugosz.com>")
#:url "https://jdlugosz.com/"
#:keywords '(convenience))))
(feature
(name f-name)
(values '())
(home-services-getter get-home-services)))
|
