From 0f4ff250b31d0ca11f7603fc662d6d43bfcafa6c Mon Sep 17 00:00:00 2001 From: Jakub Dlugosz Date: Fri, 31 Oct 2025 13:02:34 +0100 Subject: Add feature-emacs-uni with its code and apply it for user config --- src/jd/features/emacs-xyz.scm | 127 ++++++++++++++++++++++++++++++++++++++++++ src/jd/user.scm | 4 ++ 2 files changed, 131 insertions(+) create mode 100644 src/jd/features/emacs-xyz.scm (limited to 'src/jd') diff --git a/src/jd/features/emacs-xyz.scm b/src/jd/features/emacs-xyz.scm new file mode 100644 index 0000000..d79b920 --- /dev/null +++ b/src/jd/features/emacs-xyz.scm @@ -0,0 +1,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 ") + #:url "https://jdlugosz.com/" + #:keywords '(convenience)))) + + (feature + (name f-name) + (values '()) + (home-services-getter get-home-services))) diff --git a/src/jd/user.scm b/src/jd/user.scm index ba32c01..15857a0 100644 --- a/src/jd/user.scm +++ b/src/jd/user.scm @@ -22,6 +22,7 @@ #:use-module (guix inferior) #:use-module (guix packages) + #:use-module (jd features emacs-xyz) #:use-module (jd features mail) #:use-module (jd features networking) #:use-module (jd features nextcloud) @@ -311,6 +312,9 @@ (feature-emacs-keycast #:turn-on? #f) (feature-emacs-org-agenda #:org-agenda-files '("/home/jakub/docs/notes/personal.org" "/home/jakub/docs/notes/s22425.org")) + (feature-emacs-org-agenda #:org-agenda-files '("/data/jakub/notes/personal.org" + "/data/jakub/notes/s32526.org")) + (feature-emacs-org-uni) (feature-emacs-org-dailies #:encrypted? #t) (feature-emacs-org #:org-directory "/home/jakub/docs/notes" #:org-indent? #t) -- cgit v1.2.3