Skip to content

Instantly share code, notes, and snippets.

@rougier

rougier/nano-agenda.el

Created July 17, 2023 17:33
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rougier/d901759f87bbc44527f2660aa776f081 to your computer and use it in GitHub Desktop.
Save rougier/d901759f87bbc44527f2660aa776f081 to your computer and use it in GitHub Desktop.
Download ZIP
NANO Agenda
Raw
nano-agenda.el
;;; nano-agenda.el --- N Λ N O agenda -*- lexical-binding: t -*-
;; Copyright (C) 2021-2023 Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
;; Maintainer: Nicolas P. Rougier <Nicolas.Rougier@inria.fr>
;; URL: https://github.com/rougier/nano-agenda
;; Version: 0.4.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: applications, org-mode, org-agenda
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; For a full copy of the GNU General Public License
;; see <https://www.gnu.org/licenses/>.
(require 'holidays)
(require 'org-agenda)
(require 'nano-theme)
(require 'nano-calendar)
(defvar nano-agenda--current nil)
(defcustom nano-agenda-sort-function #'nano-agenda-default-sort-function
"Function to sort a day's entries.
This function takes an entries list and returns the list in the desired order."
:group 'nano-agenda)
(defcustom nano-agenda-filter-entry-predicate #'nano-agenda-filter-entry
"Predicate to decide if entry will be shown in the nano-agenda buffer.
This function takes an entry and the selected date. Returns a value if the entry
should be shown, otherwise, returns nil."
:group 'nano-agenda)
(defun nano-agenda-filter-entry (entry &optional date)
"Function to decide whether an entry is
displayed/counted. Default behavior is to select all entries."
(let ((type (get-text-property 0 'type entry)))
(and (not (string-equal type "upcoming-deadline"))
(not (string-search ":CANCELLED:" entry)))))
(defun nano-agenda-default-sort-function (entry-1 entry-2)
"Function to decide the order ENTRIES will be shown to the user.
Returns entries in `time-of-day' order."
(let ((time-1 (get-text-property 0 'time-of-day entry-1))
(time-2 (get-text-property 0 'time-of-day entry-2)))
(cond ((not time-1) t)
((not time-2) nil)
(t (< time-1 time-2)))))
(defun nano-agenda-date-day (date)
"Return DATE day of month (1-31)."
(nth 3 (decode-time date)))
(defun nano-agenda-date-month (date)
"Return DATE month number (1-12)."
(nth 4 (decode-time date)))
(defun nano-agenda-date-year (date)
"Return DATE year."
(nth 5 (decode-time date)))
(defun nano-agenda-date-today ()
"Return today date."
(current-time))
(defun nano-agenda-date-equal (date1 date2)
"Check if DATE1 is equal to DATE2."
(and (eq (nano-agenda-date-day date1)
(nano-agenda-date-day date2))
(eq (nano-agenda-date-month date1)
(nano-agenda-date-month date2))
(eq (nano-agenda-date-year date1)
(nano-agenda-date-year date2))))
(defun nano-agenda-date-inc (date &optional days months years)
"Return DATE + DAYS day & MONTH months & YEARS years"
(let ((days (or days 0))
(months (or months 0))
(years (or years 0))
(day (nano-agenda-date-day date))
(month (nano-agenda-date-month date))
(year (nano-agenda-date-year date)))
(encode-time 0 0 0 (+ day days) (+ month months) (+ year years))))
(defun nano-agenda-date-dec (date &optional days months years)
"Return DATE - DAYS day & MONTH months & YEARS years"
(let ((days (or days 0))
(months (or months 0))
(years (or years 0)))
(nano-agenda-date-inc date (- days) (- months) (- years))))
(defun nano-agenda-string-align (text &optional alignment)
"Pad TEXT with the smallest variable pixel space such as to fit
the text grid. ALIGNMENT allows to specifies where to insert
spaces 'left, 'right or 'both"
(let* ((width (string-pixel-width text))
(char-width (frame-char-width))
(space (- char-width (% width char-width)))
(left-space (/ space 2))
(right-space (- space left-space -1)))
(if (> space 0)
(cond ((eq alignment 'both)
(concat
(propertize " " 'display `(space :width (,left-space)))
text
(propertize " " 'display `(space :width (,right-space)))))
((eq alignment 'right)
(concat
(propertize " " 'display `(space :width (,space)))
text))
(t
(concat
text
(propertize " " 'display `(space :width (,space))))))
text)))
(defvar nano-agenda--help-keys
(let* ((style `(:radius 3
:stroke 2
:foreground ,(face-foreground 'nano-default)
:background ,(face-background 'nano-default nil 'default)
:collection "bootstrap")))
`((shift . ,(propertize " " 'display (svg-lib-icon "shift" style)))
(return . ,(propertize " " 'display (svg-lib-icon "arrow-return-left" style)))
;; (dot . ,(propertize " " 'display (svg-lib-icon "dot" style)))
(tab . ,(propertize " " 'display (svg-lib-icon "indent" style)))
(dot . ,(propertize " " 'display (svg-lib-tag "." style)))
(escape . ,(propertize " " 'display (svg-lib-tag "ESC" style)))
(m . ,(propertize " " 'display (svg-lib-tag "M" style)))
(t . ,(propertize " " 'display (svg-lib-tag "T" style)))
(d . ,(propertize " " 'display (svg-lib-tag "D" style)))
(g . ,(propertize " " 'display (svg-lib-tag "G" style)))
(r . ,(propertize " " 'display (svg-lib-tag "R" style)))
(left . ,(propertize " " 'display (svg-lib-icon "arrow-left" style)))
(right . ,(propertize " " 'display (svg-lib-icon "arrow-right" style)))
(up . ,(propertize " " 'display (svg-lib-icon "arrow-up" style)))
(down . ,(propertize " " 'display (svg-lib-icon "arrow-down" style))))))
(defun nano-agenda-help-key (key)
(cdr (assoc key nano-agenda--help-keys)))
(defun nano-agenda-help-entry (shortcut description &optional width)
(let* ((width (or width 16))
(shortcut (nano-agenda-string-align shortcut))
(shortcut-width (/ (string-pixel-width shortcut) (frame-char-width)))
(dots (make-string (- width 2 shortcut-width) ?.)))
(concat (propertize shortcut 'face 'nano-salient)
(propertize dots 'face 'nano-faded)
description)))
(defun nano-agenda-help ()
"Display agenda help in dedicated buffer."
(interactive)
(switch-to-buffer "*nano-agenda-help*")
(setq-local header-line-format nil)
(setq-local mode-line-format nil)
(erase-buffer)
(let ((center (propertize " " 'display '(space :align-to center)))
(newline "\n"))
(insert (concat
newline
(propertize "Agenda mode" 'face 'nano-strong) center
(propertize "Calendar mode" 'face 'nano-strong) newline
newline
(nano-agenda-help-entry (nano-agenda-help-key 'right) " next day") center
(nano-agenda-help-entry (nano-agenda-help-key 'right) " next day") newline
(nano-agenda-help-entry (nano-agenda-help-key 'left) " prev day") center
(nano-agenda-help-entry (nano-agenda-help-key 'left) " prev day") newline
(nano-agenda-help-entry (nano-agenda-help-key 'up) " prev entry") center
(nano-agenda-help-entry (nano-agenda-help-key 'up) " prev week") newline
(nano-agenda-help-entry (nano-agenda-help-key 'down) " next entry") center
(nano-agenda-help-entry (nano-agenda-help-key 'down) " next week") newline
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'right)) " next month") center
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'right)) " next month") newline
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'left)) " prev month") center
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'left)) " prev month") newline
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'up)) " prev week") center
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'up)) " prev year") newline
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'down)) " next week") center
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'down)) " next year") newline
(nano-agenda-help-entry (nano-agenda-help-key 'dot) " go to today") center
(nano-agenda-help-entry (nano-agenda-help-key 'dot) " go to today") newline
(nano-agenda-help-entry (nano-agenda-help-key 'g) " [G]o to …") center
(nano-agenda-help-entry (nano-agenda-help-key 'r) " [R]ebuild") newline
(nano-agenda-help-entry (nano-agenda-help-key 'd) " new [D]eadline") center
(nano-agenda-help-entry (concat (nano-agenda-help-key 'shift) "" (nano-agenda-help-key 'r)) " rebuild all") newline
(nano-agenda-help-entry (nano-agenda-help-key 'm) " new [M]eeting") center
(nano-agenda-help-entry (nano-agenda-help-key 'return) " select & quit") newline
(nano-agenda-help-entry (nano-agenda-help-key 't) " new [T]ask") center
(nano-agenda-help-entry (nano-agenda-help-key 'escape) " quit") newline
(nano-agenda-help-entry (nano-agenda-help-key 'return) " edit entry") center
newline
(nano-agenda-help-entry (nano-agenda-help-key 'tab) " view entry") center
newline
newline
(propertize "Agenda files" 'face 'nano-strong) center newline
newline
(mapconcat (lambda (file)
(propertize file 'face 'nano-faded))
org-agenda-files "\n"))))
(set-buffer-modified-p nil)
(setq cursor-type nil)
(local-set-key [t] #'kill-current-buffer))
(defun nano-agenda-tag (label &optional face)
"Return a svg tag displaying TAG using the optional nano
FACE (default to nano-default)"
(let* ((face (or face 'nano-default))
(tag (if (member face '(nano-default-i
nano-popout-i
nano-faded-i
nano-salient-i
nano-critical-i))
(svg-lib-tag label nil
:stroke 0
:font-weight 'semibold
:foreground (face-foreground face nil 'default)
:background (face-background face nil 'default))
(svg-lib-tag label nil
:stroke 2
:font-weight 'regular
:foreground (face-foreground face nil 'default)
:background (face-background face nil 'default)))))
(propertize (concat label " ") 'display tag)))
(defun nano-agenda--split-image (image)
"Split IMAGE in two parts (upper . lower)"
(let* ((image-width (car (image-size image t)))
(image-height (cdr (image-size image t)))
(char-height (frame-char-height))
(char-width (frame-char-width))
(text-width (/ image-width char-width)))
(cons
(propertize (make-string text-width ? )
'display (list (list 'slice 0 0 image-width char-height) image)
'line-height t)
(propertize (make-string text-width ? )
'display (list (list 'slice 0 char-height image-width char-height) image)
'line-height t))))
(defun nano-agenda--get-entries (&optional datetime)
"Get agenda entries for a given DATETIME. Each entry is checked with
nano-agenda-filter-entry-predicate to decide whether to include
it or not."
(let* ((datetime (decode-time (or datetime (current-time))))
(day (nth 3 datetime))
(month (nth 4 datetime))
(year (nth 5 datetime))
(date (list month day year))
(entries nil))
(dolist (file (org-agenda-files))
(dolist (entry (org-agenda-get-day-entries file date :timestamp :scheduled :deadline))
(if (funcall nano-agenda-filter-entry-predicate entry date)
(add-to-list 'entries entry))))
;; Sort entries
(sort entries nano-agenda-sort-function)))
(defun nano-agenda--entry-header (entry)
"Return propertized ENTRY header without tags nor todo state"
(let* ((todo (get-text-property 0 'todo-state entry))
(header (get-text-property 0 'txt entry))
(header (org-link-display-format header))
(header (replace-regexp-in-string "[ ]*:.*:$" "" header))
(header (replace-regexp-in-string (or todo "") "" header))
(header (string-trim header)))
(propertize header 'face 'nano-strong)))
(defun nano-agenda--entry-description (entry)
"Return ENTRY propertized description."
(let* ((is-deadline (string= (get-text-property 0 'type entry) "deadline"))
(is-todo (get-text-property 0 'todo-state entry))
(tags (get-text-property 0 'tags entry)))
(cond (is-deadline
(nano-agenda-tag "DEADLINE" 'nano-critical-i))
(is-todo
(nano-agenda-tag "TODO" 'nano-salient-i))
((member "EVENT" tags)
(nano-agenda-tag "EVENT" 'nano-faded-i))
((member "TALK" tags)
(nano-agenda-tag "TALK" 'nano-salient-i))
((member "LUNCH" tags)
(nano-agenda-tag "LUNCH" 'nano-popout-i))
((member "DINNER" tags)
(nano-agenda-tag "DINNER" 'nano-popout-i))
((member "PERSONAL" tags)
(nano-agenda-tag "PERSONAL" 'nano-critical-i))
((member "BREAKFAST" tags)
(nano-agenda-tag "BREAKFAST" 'nano-popout-i))
((member "TEACHING" tags)
(nano-agenda-tag "TEACHING" 'nano-salient-i))
((and (member "MEETING" tags) (member "EXT" tags))
(nano-agenda-tag "MEETING" 'nano-salient-i))
((and (member "MEETING" tags) (member "WEEKLY" tags))
(propertize "Weekly meeting " 'face 'nano-faded))
((and (member "MEETING" tags) (member "ONLINE" tags))
(propertize "Meeting (online)" 'face 'nano-faded))
(t
(propertize "Meeting" 'face 'nano-faded)))))
(defun nano-agenda--has-alarm (entry)
"Return t if ENTRY has an alarm set."
(member "ALARM" (get-text-property 0 'tags entry)))
(defun nano-agenda--is-deadline (entry)
"Return t if ENTRY is a deadline"
(string= (get-text-property 0 'type entry) "deadline"))
(defun nano-agenda--has-link (entry)
"Return t if ENTRY is a deadline"
(let ((txt (get-text-property 0 'txt entry)))
(save-match-data
(when (string-match org-link-bracket-re txt)
(match-string 1 txt)))))
(defun nano-agenda--is-recurrent (entry)
"Return t if ENTRY is a recurrent entry"
(let ((dotime (get-text-property 0 'dotime entry)))
(org-get-repeat dotime)))
(defun nano-agenda--is-todo (entry)
"Return t if ENTRY is a todo"
(get-text-property 0 'todo-state entry))
(defun nano-agenda--entry-time (entry)
"Get ENTRY start and end time (or nil if it is not timestamped)."
(when-let* ((date (get-text-property 0 'date entry))
(time-of-day (get-text-property 0 'time-of-day entry))
(duration (get-text-property 0 'duration entry))
(month (nth 0 date))
(day (nth 1 date))
(year (nth 2 date))
(hour (/ time-of-day 100))
(minutes (- time-of-day (* hour 100)))
(start (encode-time 0 minutes hour day month year))
(end (encode-time 0 (+ minutes (floor duration)) hour day month year)))
(cons start end)))
(defun nano-agenda--entry-format (entry)
"Format ENTRY over two lines. Example:
14:00 │ Weekly meeting
15:00 │ Appointment with XXX
TODO │ [REVIEW]
│ GitHub weekly review
–––– │ [TRAVEL]
│ Going to Paris"
(let* ((is-todo (get-text-property 0 'todo-state entry))
(header (nano-agenda--entry-header entry))
(description (nano-agenda--entry-description entry))
(marker (get-text-property 0 'org-marker entry))
(conflict (get-text-property 0 'conflict entry))
(time (nano-agenda--entry-time entry))
(is-recurrent (nano-agenda--is-recurrent entry))
(alarm (nano-agenda--has-alarm entry))
(has-link (nano-agenda--has-link entry))
(now (and (car time) (cdr time)
(time-less-p (car time) (current-time))
(time-less-p (current-time) (cdr time))))
(separator (cond ((and now conflict)
(propertize "║ " 'face 'nano-salient))
(conflict
(propertize "║ " 'face 'nano-faded))
(now
(propertize "┃ " 'face 'nano-salient))
(t
(propertize "│ " 'face 'nano-faded)))))
(propertize
(concat (propertize (if time
(format-time-string "%H:%M" (car time))
" ————")
'face 'nano-faded)
(propertize " " 'display '(raise +0.5))
separator
description
(cond (now
(concat
(propertize " "
'display `(space :align-to (- right 5)))
(propertize "NOW"
'face '(nano-salient nano-strong))))
(has-link
(concat
(propertize " "
'display `(space :align-to (- right 4)))
(propertize "􀏏"
'help-echo nil
'pointer 'hand
'mouse-face 'nano-salient
'face '(nano-faded nano-strong))))
(is-recurrent
(concat
(propertize " "
'display `(space :align-to (- right 4)))
(propertize "􀧞"
'face '(nano-faded nano-strong))))
(alarm
(concat
(propertize " "
'display `(space :align-to (- right 4)))
(propertize "􀋙"
'face '(nano-faded nano-strong)))))
(propertize " " 'display "\n")
(propertize (if time
(format-time-string "%H:%M" (cdr time))
" ")
'face 'nano-faded)
(propertize " " 'display '(raise -0.5))
separator
header
"\n")
'org-marker marker)))
(defun nano-agenda--entry-conflict (entry-1 entry-2)
"Check if date ranges ITEM-1 and ITEM-2 overlap."
(when-let* ((date-1 (nano-agenda--entry-time entry-1))
(date-2 (nano-agenda--entry-time entry-2))
(beg-1 (car date-1))
(end-1 (cdr date-1))
(beg-2 (car date-2))
(end-2 (cdr date-2))
(conflict (cond ((time-equal-p beg-1 beg-2) t)
((time-equal-p end-1 beg-2) nil)
((time-equal-p end-2 beg-1) nil)
((and (time-less-p beg-1 beg-2)
(time-less-p beg-2 end-1)) t)
((and (time-less-p end-2 end-1)
(time-less-p beg-1 end-2)) t))))
conflict))
(defun nano-agenda--header-label (label)
"Make a two-lines svg displaying LABEL"
(let* ((label (propertize label 'face '(:height 2.25 :family "Roboto")))
(svg-width (string-pixel-width label))
(char-width (frame-char-width))
(svg-width (* (1+ (/ svg-width char-width)) char-width))
(svg-height (* 2 (frame-char-height)))
(svg (svg-create svg-width svg-height)))
(svg-text svg label
:font-family "Roboto"
:font-size (* 2.25 (/ (face-attribute 'default :height) 10))
:font-weight 300
:fill (face-foreground 'nano-faded)
:text-anchor "end"
:x svg-width
:y "0.9em")
(svg-lib--image svg :ascent 'center)))
(defun nano-agenda--header (datetime title subtitle &optional time)
"Return a three lines header with a svg icon on the left
displaying DATETIME, a TITLE, a SUBTITLE and a svg text
representing TIME on the right over two lines.
Example:
JUL | July 14 2023 14:00
14 | (Bastille day) 14:00
------------------------------------------------ "
(let* ((day (nth 3 (decode-time datetime)))
(month (nth 4 (decode-time datetime)))
(year (nth 5 (decode-time datetime)))
(date (list month day year))
(holidays (calendar-check-holidays date))
(diary (catch 'found
(dolist (file (org-agenda-files))
(dolist (entry (org-agenda-get-day-entries file date :sexp))
(if (funcall nano-agenda-filter-entry-predicate entry date)
(let* ((todo (or (get-text-property 0 'todo-state entry) ""))
(text (get-text-property 0 'txt entry))
(text (replace-regexp-in-string ":.*:" "" text))
(text (replace-regexp-in-string todo "" text))
(text (org-link-display-format text))
(text (substring-no-properties text))
(text (string-trim text)))
(throw 'found text)))))))
(subtitle (or subtitle (cond (diary diary)
(holidays (car holidays))
(t ""))))
(date-icon (svg-lib-date datetime nil
:radius 4 :font-family "Roboto"
:foreground (face-foreground 'nano-salient)))
(date-icon (nano-agenda--split-image date-icon))
(time-txt (cond ((stringp time) time)
(t (format-time-string "%H:%M" datetime))))
(time-icon (nano-agenda--header-label time-txt))
(time-icon (nano-agenda--split-image time-icon)))
(cons
(concat (car date-icon) " "
(propertize title 'face 'bold)
(when time
(concat
(propertize " " 'display `(space :align-to (- right ,(length (car time-icon)))))
(car time-icon))))
(concat (cdr date-icon) " "
(propertize subtitle 'face 'font-lock-comment-face)
(when time
(concat
(propertize " " 'display `(space :align-to (- right ,(length (cdr time-icon)))))
(cdr time-icon)))))))
(defun nano-agenda--update-header (&optional datetime)
(with-current-buffer "*nano-agenda-header*"
(let* ((inhibit-read-only t)
(datetime (or datetime
nano-agenda--current
(current-time)))
(title (format-time-string "%A %d %B %Y" datetime))
(subtitle nil)
(time (format-time-string "%H:%M"))
(header (nano-agenda--header datetime title subtitle time)))
(erase-buffer)
(insert (concat (car header) "\n"
(cdr header) "\n"
(propertize "\n" 'face '(:inherit nano-subtle-i
:extend t :strike-through t)))))))
(defun nano-agenda--update-entries (&optional datetime)
(let* ((datetime (or datetime
nano-agenda--current
(current-time))))
(with-current-buffer "*nano-agenda*"
(let* ((inhibit-read-only t)
(point (point))
(entries (nano-agenda--get-entries datetime)))
(erase-buffer)
(dolist (i (number-sequence 0 (1- (length entries))))
;; Time conflict check
(dolist (j (number-sequence (1+ i) (1- (length entries))))
(let* ((entry-1 (nth i entries))
(entry-2 (nth j entries)))
(when (nano-agenda--entry-conflict entry-1 entry-2)
(add-text-properties 0 (length entry-1) '(conflict t) entry-1)
(add-text-properties 0 (length entry-2) '(conflict t) entry-2))))
(insert (nano-agenda--entry-format (nth i entries))))
(goto-char (min point (point-max)))))))
(defun nano-agenda-update ()
(interactive)
(nano-agenda--update-header)
(nano-agenda--update-entries))
(defun nano-agenda (&optional datetime new-frame)
(let* ((datetime (or datetime
nano-agenda--current
(current-time)))
(frame (catch 'frame-found
(dolist (frame (frame-list))
(when (string= "*nano-agenda-frame*" (frame-parameter frame 'name))
(throw 'frame-found frame)))))
(frame (if (and (not frame) new-frame)
(make-frame '((name . "*nano-agenda-frame*")
(height . 39)
(width . 69)
(minibuffer . t)))
frame)))
(when frame
(select-frame-set-input-focus frame)
(delete-other-windows))
;;(delete-other-windows)
(switch-to-buffer "*nano-agenda-header*")
(nano-agenda--update-header datetime)
(setq buffer-read-only t)
(setq header-line-format nil)
(setq mode-line-format nil)
(set-window-fringes nil 0 1)
(setq cursor-type nil)
(goto-char (point-min))
(setq window-size-fixed 'height)
;; (set-window-dedicated-p nil t)
(set-window-parameter nil 'no-other-window t)
(setq truncate-lines t)
(local-set-key [t] 'ignore)
(local-set-key (kbd "C-x C-c") #'my/kill-emacs)
(local-set-key (kbd "C-x 5 0") #'my/kill-emacs)
(select-window
(split-window nil (* 3 (frame-char-height)) 'below t))
(switch-to-buffer "*nano-agenda*")
(nano-agenda--update-entries datetime)
(setq buffer-read-only t)
(setq-local stripes-unit 1)
(face-remap-set-base 'stripes '(:inherit highlight :extend t))
(face-remap-set-base 'hl-line '(:inherit nano-subtle :extend t))
(stripes-mode t)
(setq hl-line-overlay-priority 100)
(hl-line-mode t)
(set-window-fringes nil 0 1)
(setq cursor-type nil)
;; (set-window-dedicated-p (selected-window) t)
(setq mode-line-format nil)
(setq header-line-format nil)
(nano-agenda-mode t)))
(defun nano-agenda-prev-day ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-dec nano-agenda--current 1))
(nano-agenda-update))
(defun nano-agenda-next-day ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-inc nano-agenda--current 1))
(nano-agenda-update))
(defun nano-agenda-prev-month ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-dec nano-agenda--current 0 1))
(nano-agenda-update))
(defun nano-agenda-next-month ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-inc nano-agenda--current 0 1))
(nano-agenda-update))
(defun nano-agenda-prev-week ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-dec nano-agenda--current 7))
(nano-agenda-update))
(defun nano-agenda-next-week ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-inc nano-agenda--current 7))
(nano-agenda-update))
(defun nano-agenda-goto-today ()
(interactive)
(setq nano-agenda--current (nano-agenda-date-today))
(nano-agenda-update))
(defun nano-agenda-goto-tomorrow ()
(interactive)
(setq nano-agenda--current
(nano-agenda-date-inc (nano-agenda-date-today) 1))
(nano-agenda-update))
(defun nano-agenda-prev-entry ()
(interactive)
(forward-line -1))
(defun nano-agenda-next-entry ()
(interactive)
(forward-line 1))
(defun nano-agenda-edit-entry ()
(interactive)
(org-agenda-goto)
(window-resize nil -1)
(setq mode-line-format nil))
(defun nano-agenda--org-capture (oldfun &rest args)
(cl-letf (((symbol-function 'delete-other-windows) 'ignore))
(apply oldfun args)))
(defun nano-agenda-capture-entry ()
(interactive)
(let ((split-width-threshold nil)
(split-height-threshold 0))
(advice-add 'org-capture-place-template :around #'nano-agenda--org-capture)
(org-capture nil "m")
(let ((buttons '(("SAVE" . (org-capture-finalize))
("CANCEL" . (org-capture-kill)))))
(nano-modeline-header
`((nano-modeline-buffer-status "NEW") " "
(nano-modeline-buffer-name "Meeting") " "
)
`((nano-modeline-buttons ,buttons t) " "
(nano-modeline-window-dedicated))))
(advice-remove 'org-capture-place-template #'nano-agenda--org-capture)
(window-resize nil -8)))
(defun nano-agenda-calendar-hook ()
(setq nano-agenda--current nano-calendar--current)
(nano-agenda--update-header)
(nano-agenda--update-entries))
(defun nano-agenda-goto ()
(interactive)
(add-hook 'nano-calendar-date-changed-hook #'nano-agenda-calendar-hook)
(nano-calendar nano-agenda--current))
(defun nano-agenda-calendar-prompt ()
(interactive)
(setq nano-calendar--current nano-agenda--current)
(add-hook 'nano-calendar-date-changed-hook #'nano-agenda-calendar-hook)
(nano-calendar-prompt)
(setq nano-agenda--current nano-calendar--current)
(nano-agenda--update-header)
(nano-agenda--update-entries))
(define-minor-mode nano-agenda-mode
"Minor mode for nano-agenda day view."
:init nil
:keymap `((,(kbd "<left>") . nano-agenda-prev-day)
(,(kbd "p") . nano-agenda-prev-day)
(,(kbd "<right>") . nano-agenda-next-day)
(,(kbd "n") . nano-agenda-next-day)
(,(kbd "<S-left>") . nano-agenda-prev-month)
(,(kbd "<S-right>") . nano-agenda-next-month)
(,(kbd "<S-down>") . nano-agenda-next-week)
(,(kbd "<S-up>") . nano-agenda-prev-week)
(,(kbd "<up>") . nano-agenda-prev-entry)
(,(kbd "<down>") . nano-agenda-next-entry)
(,(kbd "h") . nano-agenda-help)
(,(kbd ".") . nano-agenda-goto-today)
(,(kbd "t") . nano-agenda-goto-tomorrow)
(,(kbd "<return>") . nano-agenda-edit-entry)
(,(kbd "<tab>") . nano-agenda-edit-entry)
(,(kbd "k") . nano-agenda-capture-entry)
(,(kbd "r") . nano-agenda-update)
(,(kbd "G") . nano-agenda-goto)
(,(kbd "g") . nano-agenda-calendar-prompt)))
(nano-agenda nil t)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment