Command-line and Emacs Calendar Client
ryan.freumh.org
1;;; caledonia.el --- Emacs integration for Caledonia -*- lexical-binding: t -*-
2
3;; Copyright (C) 2025 Ryan Gibb
4
5;; Author: Ryan Gibb <ryan@freumh.org>
6;; Maintainer: Ryan Gibb <ryan@freumh.org>
7;; Version: 0.4.0
8;; Keywords: calendar
9;; Package-Requires: ((emacs "24.4"))
10;; URL: https://ryan.freumh.org/caledonia.html
11
12;; This file is not part of GNU Emacs.
13
14;;; Commentary:
15
16;; This package provides an Emacs interface to the Caledonia calendar CLI.
17;; It communicates with Caledonia using S-expressions for data exchange.
18
19;;; Code:
20
21(require 'cl-lib)
22(require 'calendar)
23(require 'pulse nil t)
24(require 'org)
25
26(defgroup caledonia nil
27 "Interface to Caledonia calendar client."
28 :group 'calendar
29 :prefix "caledonia-")
30
31(defcustom caledonia-executable (executable-find "caled")
32 "Path to the Caledonia executable."
33 :type 'string
34 :group 'caledonia)
35
36(defface caledonia-calendar-name-face
37 '((t :inherit font-lock-function-name-face))
38 "Face used for calendar names in the events view."
39 :group 'caledonia)
40
41(defface caledonia-date-face
42 '((t :inherit font-lock-string-face))
43 "Face used for dates in the events view."
44 :group 'caledonia)
45
46(defface caledonia-summary-face
47 '((t :inherit default))
48 "Face used for event summaries in the events view."
49 :group 'caledonia)
50
51(defface caledonia-location-face
52 '((t :inherit font-lock-comment-face))
53 "Face used for event locations in the events view."
54 :group 'caledonia)
55
56(defcustom caledonia-calendar-column-width 0
57 "Column width for the Calendar entry."
58 :type 'natnum)
59
60(defcustom caledonia-start-column-width 0
61 "Column width for the Start entry."
62 :type 'natnum)
63
64(defcustom caledonia-end-column-width 0
65 "Column width for the End entry."
66 :type 'natnum)
67
68(defcustom caledonia-list-from-date "today"
69 "Default start date for calendar list view."
70 :type 'string
71 :group 'caledonia)
72
73(defcustom caledonia-list-to-date "+3m"
74 "Default end date for calendar list view (3 months from today)."
75 :type 'string
76 :group 'caledonia)
77
78(defcustom caledonia-search-from-date nil
79 "Default start date for calendar search; nil means no start date limit."
80 :type 'string
81 :group 'caledonia)
82
83(defcustom caledonia-search-to-date "+75y"
84 "Default end date for calendar search (75 years from today)."
85 :type 'string
86 :group 'caledonia)
87
88;; Define histories for input fields
89
90(defvar caledonia-from-history nil "History for from date inputs.")
91(defvar caledonia-to-history nil "History for to date inputs.")
92(defvar caledonia-timezone-history nil "History for timezone inputs.")
93(defvar caledonia-calendars-history nil "History for calendar inputs.")
94(defvar caledonia-text-history nil "History for search text inputs.")
95(defvar caledonia-search-fields-history nil "History for search fields inputs.")
96(defvar caledonia-id-history nil "History for event ID inputs.")
97(defvar caledonia-limit-history nil "History for limit inputs.")
98(defvar caledonia-search-prompt-history nil "History for search prompt inputs.")
99
100;; Internal variables
101
102(defvar caledonia--events-buffer "*Caledonia Events*"
103 "Buffer name for displaying Caledonia events.")
104(defvar caledonia--details-buffer "*Caledonia Event Details*"
105 "Buffer name for displaying Caledonia event details.")
106(defvar caledonia--server-process nil
107 "The persistent Caledonia server process.")
108(defvar caledonia--server-buffer-name "*caledonia-server-io*"
109 "Buffer for server process I/O.")
110(defvar caledonia--response-line nil
111 "Last response line received.")
112(defvar caledonia--response-flag nil
113 "Non-nil means a responce has been recieved.")
114(defvar-local caledonia--current-query nil
115 "The current query parameters being displayed in this buffer.")
116
117;; API functions
118
119(defvar caledonia--server-line-buffer "")
120
121(defun caledonia--server-filter (process output)
122 "Filter PROCESS OUTPUT."
123 ;; Append to the ongoing buffer for logging/debugging
124 (when (buffer-live-p (process-buffer process))
125 (with-current-buffer (process-buffer process)
126 (goto-char (point-max))
127 (insert output)))
128 ;; Append new output to line buffer
129 (setq caledonia--server-line-buffer (concat caledonia--server-line-buffer output))
130 ;; Extract full lines
131 (let ((lines (split-string caledonia--server-line-buffer "\n")))
132 ;; Keep the last line (possibly incomplete) for next round
133 (setq caledonia--server-line-buffer (car (last lines)))
134 ;; Process all complete lines
135 (dolist (line (butlast lines))
136 (when (and (not caledonia--response-flag)
137 (not (string-empty-p line)))
138 (setq caledonia--response-line line)
139 (setq caledonia--response-flag t)))))
140
141(defun caledonia--server-sentinel (process event)
142 "Listen on PROCESS for an EVENT."
143 (message "Caledonia Server process event: %s (%s)" process event)
144 (setq caledonia--server-process nil))
145
146(defun caledonia--ensure-server-running ()
147 "Run the caledonia binary in server mode."
148 (unless (and caledonia--server-process (process-live-p caledonia--server-process))
149 (message "Caledonia Starting server...")
150 (setq caledonia--server-process
151 (start-process "caledonia-server"
152 (get-buffer-create caledonia--server-buffer-name)
153 caledonia-executable
154 "server"))
155 (unless (and caledonia--server-process (process-live-p caledonia--server-process))
156 (error "Caledonia Failed to start server process"))
157 (set-process-filter caledonia--server-process #'caledonia--server-filter)
158 (set-process-sentinel caledonia--server-process #'caledonia--server-sentinel)
159 (message "Caledonia Server started.")))
160
161(defun caledonia--send-request (request-str)
162 "Send REQUEST-STR and get responce back."
163 (caledonia--ensure-server-running)
164 (setq caledonia--response-line nil)
165 (setq caledonia--response-flag nil)
166 (process-send-string caledonia--server-process (concat request-str "\n"))
167 ;; Wait for response
168 (let ((start-time (current-time)))
169 (while (and (not caledonia--response-flag)
170 (< (time-to-seconds (time-since start-time)) 5) ; 5 sec timeout
171 (process-live-p caledonia--server-process))
172 (accept-process-output caledonia--server-process 0 100000))) ; Wait 100ms
173 (unless caledonia--response-flag
174 (error "Caledonia Timeout or server died waiting for response"))
175 (condition-case err
176 (let ((response-sexp (read caledonia--response-line)))
177 (unless (and (listp response-sexp) (memq (car response-sexp) '(Ok Error)))
178 (error "Caledonia Invalid response format: %S" response-sexp))
179 (if (eq (car response-sexp) 'Error)
180 (error "Caledonia Server Error: %s" (cadr response-sexp))
181 ;; Return the (Ok ...) payload
182 (cadr response-sexp)))
183 (error "Caledonia Failed to parse response line: %s"
184 caledonia--response-line (error-message-string err))))
185
186(defun caledonia--get-events (event-payload)
187 "Parse EVENT-PAYLOAD of structure (Events (events...))."
188 (if (and (listp event-payload) (eq (car event-payload) 'Events))
189 (let ((event-list (cadr event-payload)))
190 event-list)
191 (error
192 (message "Failed to parse Caledonia output: %s" (error-message-string err))
193 nil)))
194
195;; UI functions
196
197(defun caledonia--format-timestamp (iso-string &optional format)
198 "Format ISO-8601 time string ISO-STRING to human-readable format.
199FORMAT defaults to \"%Y-%m-%d %H:%M\" if not specified."
200 (let* ((parsed (parse-time-string iso-string))
201 (time (apply #'encode-time
202 (append (cl-subseq parsed 0 6) (list nil -1)))))
203 (format-time-string (or format "%Y-%m-%d %H:%M") time)))
204
205(defun caledonia--get-key (key event)
206 "Get KEY from EVENT as a string."
207 (let ((value (cadr (assoc key event))))
208 (cond
209 ((null value) nil)
210 ((stringp value) value)
211 ((symbolp value) (symbol-name value)))))
212
213(defun caledonia--tabulated-list-entries (events)
214 "Convert EVENTS for a format suitable for showing via a tabulated-list-mode'."
215 (let ((max-calendar-width 0)
216 (max-start-width 0)
217 (max-end-width 0)
218 (tabulated-list-entries nil))
219 ;; first pass: calculate maximum widths
220 (dolist (event events)
221 (let* ((calendar (caledonia--get-key 'calendar event))
222 (start (caledonia--get-key 'start event))
223 (end (caledonia--get-key 'end event))
224 (cal-str (if (not calendar) "unkown" calendar))
225 (start-str (caledonia--format-timestamp start))
226 (end-str (when end
227 (caledonia--format-timestamp (format "%s" end)))))
228 (setq max-calendar-width (max max-calendar-width (length cal-str)))
229 (setq max-start-width (max max-start-width (+ (length start-str) 2)))
230 (setq max-end-width (max max-end-width (length end-str)))))
231 (setq caledonia-calendar-column-width (max max-calendar-width (length "Calendar")))
232 (setq caledonia-start-column-width (max max-start-width (length "Start")))
233 (setq caledonia-end-column-width (max max-end-width (length "End")))
234 ;; second pass: prepare tabulated-list entries with properties
235 (setq tabulated-list-entries
236 (mapcar (lambda (event)
237 (let* (
238 (id (caledonia--get-key 'id event))
239 (summary (caledonia--get-key 'summary event))
240 (start (caledonia--get-key 'start event))
241 (end (caledonia--get-key 'end event))
242 (location (caledonia--get-key 'location event))
243 (calendar (caledonia--get-key 'calendar event))
244 (start-str (caledonia--format-timestamp start))
245 (end-str (if end (caledonia--format-timestamp (format "%s" end)) ""))
246 (start-str (if end (format "%s -" start-str) start-str))
247 (location-str (if location (concat " @ " location) ""))
248 (cal-prop (propertize calendar 'face 'caledonia-calendar-name-face))
249 (start-prop (propertize start-str 'face 'caledonia-date-face))
250 (end-prop (propertize end-str 'face 'caledonia-date-face))
251 (summary-prop (propertize (concat summary location-str)
252 'face 'caledonia-summary-face))
253 ;; Store the full event data as a text property for retrieval
254 (entry-id (propertize (format "%s" id) 'event-data event)))
255 (list entry-id (vector cal-prop start-prop end-prop summary-prop))))
256 events))
257 tabulated-list-entries))
258
259(defun caledonia--sort-calendar (A B)
260 "Sort function for calendar column between A and B."
261 (let ((a (aref (cadr A) 0))
262 (b (aref (cadr B) 0)))
263 (string< a b)))
264
265(defun caledonia--sort-start (A B)
266 "Sort function for date/time column between A and B."
267 (let ((a (aref (cadr A) 1))
268 (b (aref (cadr B) 1)))
269 (time-less-p (date-to-time a) (date-to-time b))))
270
271(defun caledonia--sort-end (A B)
272 "Sort function for date/time column between A and B."
273 (let ((a (aref (cadr A) 2))
274 (b (aref (cadr B) 2)))
275 (time-less-p (date-to-time a) (date-to-time b))))
276
277(defun caledonia--make-query (&optional query)
278 "Make a query with the QUERY S-expression.
279If QUERY is nil, use the current query stored in `caledonia--current-query`."
280 (interactive)
281 (let* ((query-to-use (or query caledonia--current-query '())) ;; Use current query if available
282 ;; Ensure to date is set if not present in query
283 (query-to-use (if (assq 'to query-to-use)
284 query-to-use
285 (cons `(to ,caledonia-list-to-date) query-to-use)))
286 (request-str (format "(Query %s)" (prin1-to-string query-to-use)))
287 (payload (caledonia--send-request request-str))
288 (events (caledonia--get-events payload))
289 (entries (caledonia--tabulated-list-entries events)))
290 ;; Save this query for future refreshes if explicitly provided
291 (when query
292 (setq-local caledonia--current-query query-to-use))
293 (setq tabulated-list-entries entries))
294 (setq tabulated-list-format
295 `[("Calendar" ,caledonia-calendar-column-width caledonia--sort-calendar)
296 ("Start" ,caledonia-start-column-width caledonia--sort-start)
297 ("End" ,caledonia-end-column-width caledonia--sort-end)
298 ("Summary" 0 t)])
299 (setq tabulated-list-sort-key (cons "Start" nil))
300 (tabulated-list-init-header)
301 (tabulated-list-print t))
302
303(defun caledonia--find-and-highlight-event-in-file (file event-id)
304 "Find EVENT-ID in FILE, position cursor, and highlight the event.
305Return non-nil if the event was found."
306 (when (and file event-id)
307 (let ((id-str (format "%s" event-id))
308 (found nil))
309 ;; Try to find and highlight iCalendar VEVENT block
310 (goto-char (point-min))
311 (when (and (string-match-p "\\.ics$" file)
312 (search-forward (format "UID:%s" id-str) nil t))
313 ;; Found the UID in an ICS file, try to highlight the VEVENT block
314 (let ((uid-pos (match-beginning 0))
315 (vevent-start nil)
316 (vevent-end nil))
317 ;; Find start of the VEVENT block
318 (save-excursion
319 (goto-char uid-pos)
320 (if (search-backward "BEGIN:VEVENT" nil t)
321 (setq vevent-start (match-beginning 0))
322 (setq vevent-start uid-pos)))
323 ;; Find end of the VEVENT block
324 (save-excursion
325 (goto-char uid-pos)
326 (if (search-forward "END:VEVENT" nil t)
327 (setq vevent-end (match-end 0))
328 (setq vevent-end (line-end-position))))
329 ;; Highlight the whole VEVENT block if found
330 (when (and vevent-start vevent-end)
331 (goto-char vevent-start)
332 (caledonia--highlight-region vevent-start vevent-end)
333 (recenter)
334 (setq found t))))
335 (unless found
336 (message "Event ID not found in file"))
337 found)))
338
339(defun caledonia--display-event-details (event)
340 "Display details for EVENT in a separate buffer."
341 (let ((buf (get-buffer-create caledonia--details-buffer)))
342 (with-current-buffer buf
343 (let ((inhibit-read-only t))
344 (erase-buffer)
345 (special-mode)
346 (let* ((id (caledonia--get-key 'id event))
347 (summary (caledonia--get-key 'summary event))
348 (description (caledonia--get-key 'description event))
349 (start (caledonia--get-key 'start event))
350 (end (caledonia--get-key 'end event))
351 (location (caledonia--get-key 'location event))
352 (calendar (caledonia--get-key 'calendar event))
353 (file (caledonia--get-key 'file event))
354 (start-str (when start (caledonia--format-timestamp start)))
355 (end-str (when end (caledonia--format-timestamp end))))
356 (when id
357 (insert (propertize "Summary: " 'face 'bold) summary "\n"))
358 (when id
359 (insert (propertize "ID: " 'face 'bold) id "\n"))
360 (when calendar
361 (insert (propertize "Calendar: " 'face 'bold) calendar "\n"))
362 (when start-str
363 (insert (propertize "Start: " 'face 'bold) start-str "\n"))
364 (when end-str
365 (insert (propertize "End: " 'face 'bold) end-str "\n"))
366 (when location
367 (insert (propertize "Location: " 'face 'bold) location "\n"))
368 (when file
369 (insert (propertize "File: " 'face 'bold)
370 (propertize file 'face 'link
371 'mouse-face 'highlight
372 'help-echo "Click to open file with highlighting"
373 'keymap (let ((map (make-sparse-keymap))
374 (event-copy event))
375 (define-key map [mouse-1]
376 (lambda ()
377 (interactive)
378 (let ((file-path file)
379 (id-val (caledonia--get-key 'id event-copy)))
380 (find-file file-path)
381 (caledonia--find-and-highlight-event-in-file
382 file-path id-val))))
383 (define-key map (kbd "RET")
384 (lambda ()
385 (interactive)
386 (let ((file-path file)
387 (id-val (caledonia--get-key 'id event-copy)))
388 (find-file file-path)
389 (caledonia--find-and-highlight-event-in-file
390 file-path id-val))))
391 map))
392 "\n"))
393 (when description
394 (insert "\n" (propertize "Description:" 'face 'bold) "\n"
395 (propertize "------------" 'face 'bold) "\n"
396 description "\n")))))
397 (switch-to-buffer-other-window buf)))
398
399(defun caledonia--highlight-region (start end)
400 "Highlight the region between START and END."
401 (when (fboundp 'pulse-momentary-highlight-region)
402 (pulse-momentary-highlight-region start end))
403 ;; Fallback for when pulse is not available
404 (unless (fboundp 'pulse-momentary-highlight-region)
405 (let ((overlay (make-overlay start end)))
406 (overlay-put overlay 'face 'highlight)
407 (run-with-timer 0.5 nil (lambda () (delete-overlay overlay))))))
408
409(defun caledonia--read-date-range ()
410 "Read a date range from the user with `org-mode' date picker integration.
411Returns a cons cell (from-date . to-date).
412The from-date can be nil to indicate no start date constraint."
413 (let (from to)
414 (setq from
415 (if (y-or-n-p "Set a start date? ")
416 (org-read-date nil nil nil "From date: " nil nil t)
417 ; empty string differentiates from nil for optional args later on
418 ""))
419 ;; Use org-mode's date picker for To date (must have a value)
420 (setq to (org-read-date nil nil nil "To date: " nil nil t))
421 (cons from to)))
422
423;; Query parameter modification functions
424
425(defun caledonia-query-date-range ()
426 "Set the date range for the current calendar view."
427 (interactive)
428 (when (eq major-mode 'caledonia-mode)
429 (let* ((dates (caledonia--read-date-range))
430 (from (car dates))
431 (to (cdr dates))
432 (current-query caledonia--current-query)
433 (new-query (copy-tree current-query)))
434 ;; Update the query with the new date range
435 (setq new-query (assq-delete-all 'from new-query))
436 (setq new-query (assq-delete-all 'to new-query))
437 (when (and from (not (string-empty-p from)))
438 (push `(from ,from) new-query))
439 (when (and to (not (string-empty-p to)))
440 (push `(to ,to) new-query))
441 ;; Execute the updated query
442 (caledonia--make-query new-query))))
443
444(defun caledonia-query-calendars ()
445 "Set the calendars to filter by for the current calendar view.
446Fetches available calendars from server to allow selection from a list."
447 (interactive)
448 (when (eq major-mode 'caledonia-mode)
449 (let* ((available-calendars
450 (caledonia--send-request "ListCalendars"))
451 (calendars-list
452 (if (and (listp available-calendars)
453 (eq (car available-calendars) 'Calendars))
454 (cadr available-calendars)
455 (progn
456 (message "Failed to get calendar list from server")
457 nil)))
458 ;; Use completing-read-multiple to select from available calendars
459 (selected-calendars
460 (completing-read-multiple
461 "Select calendars (comma-separated, empty for all): "
462 ;; Use empty list if no calendars found
463 (or calendars-list '())
464 nil nil
465 (let ((current-calendars (cdr (assq 'calendars caledonia--current-query))))
466 (when current-calendars
467 (mapconcat #'identity current-calendars ",")))
468 'caledonia-calendars-history))
469 (calendars (mapcar #'string-trim selected-calendars))
470 (current-query caledonia--current-query)
471 (new-query (copy-tree current-query)))
472 ;; Update the query with the new calendars
473 (setq new-query (assq-delete-all 'calendars new-query))
474 (when (and calendars (not (null calendars)))
475 (push `(calendars ,calendars) new-query))
476 ;; Execute the updated query
477 (caledonia--make-query new-query))))
478
479(defun caledonia-query-text ()
480 "Set the search text for the current calendar view."
481 (interactive)
482 (when (eq major-mode 'caledonia-mode)
483 (let* ((text (read-string "Search text (leave empty for no text search): "
484 nil 'caledonia-text-history))
485 (search-in-str (when (and text (not (string-empty-p text)))
486 (read-string "Search in (summary,description,location - leave empty for all): "
487 nil 'caledonia-search-fields-history)))
488 (search-in (when (and search-in-str (not (string-empty-p search-in-str)))
489 (mapcar (lambda (field)
490 (intern (string-trim field)))
491 (split-string search-in-str "," t))))
492 (current-query caledonia--current-query)
493 (new-query (copy-tree current-query)))
494 ;; Update the query with the new text search parameters
495 (setq new-query (assq-delete-all 'text new-query))
496 (setq new-query (assq-delete-all 'search_in new-query))
497 (when (and text (not (string-empty-p text)))
498 (push `(text ,text) new-query))
499 (when search-in
500 (push `(search_in ,search-in) new-query))
501 ;; Execute the updated query
502 (caledonia--make-query new-query))))
503
504(defun caledonia-query-id ()
505 "Set the event ID to filter by for the current calendar view."
506 (interactive)
507 (when (eq major-mode 'caledonia-mode)
508 (let* ((id (read-string "Event ID (leave empty for all events): "
509 nil 'caledonia-id-history))
510 (current-query caledonia--current-query)
511 (new-query (copy-tree current-query)))
512 ;; Update the query with the new ID
513 (setq new-query (assq-delete-all 'id new-query))
514 (when (and id (not (string-empty-p id)))
515 (push `(id ,id) new-query))
516 ;; Execute the updated query
517 (caledonia--make-query new-query))))
518
519(defun caledonia-query-recurring ()
520 "Set whether to filter by recurring events for the current calendar view."
521 (interactive)
522 (when (eq major-mode 'caledonia-mode)
523 (let* ((recurring (completing-read "Recurring events (yes/no/all, leave empty for all): "
524 '("" "yes" "no") nil nil nil))
525 (current-query caledonia--current-query)
526 (new-query (copy-tree current-query)))
527 ;; Update the query with the recurring filter
528 (setq new-query (assq-delete-all 'recurring new-query))
529 (when (not (string-empty-p recurring))
530 (push `(recurring ,(if (string= recurring "yes") t nil)) new-query))
531 ;; Execute the updated query
532 (caledonia--make-query new-query))))
533
534(defun caledonia-query-limit ()
535 "Set the maximum number of events to show in the current calendar view."
536 (interactive)
537 (when (eq major-mode 'caledonia-mode)
538 (let* ((limit-str (read-string "Maximum events to show (leave empty for no limit): "
539 nil 'caledonia-limit-history))
540 (limit (when (and limit-str (not (string-empty-p limit-str)))
541 (string-to-number limit-str)))
542 (current-query caledonia--current-query)
543 (new-query (copy-tree current-query)))
544 ;; Update the query with the new limit
545 (setq new-query (assq-delete-all 'limit new-query))
546 (when limit
547 (push `(limit ,limit) new-query))
548 ;; Execute the updated query
549 (caledonia--make-query new-query))))
550
551(defun caledonia-query-timezone ()
552 "Set the timezone for the current calendar view."
553 (interactive)
554 (when (eq major-mode 'caledonia-mode)
555 (let* ((timezone-str (read-string "Timezone (e.g. Europe/London, leave empty for default): "
556 nil 'caledonia-timezone-history))
557 (timezone (when (not (string-empty-p timezone-str)) timezone-str))
558 (current-query caledonia--current-query)
559 (new-query (copy-tree current-query)))
560 ;; Update the query with the new timezone
561 (setq new-query (assq-delete-all 'timezone new-query))
562 (when timezone
563 (push `(timezone ,timezone) new-query))
564 ;; Execute the updated query
565 (caledonia--make-query new-query))))
566
567;; Buffer functions
568
569(defun caledonia-show-event ()
570 "Show details for the event at point in a separate buffer."
571 (interactive)
572 (when (eq major-mode 'caledonia-mode)
573 (let* ((id (tabulated-list-get-id))
574 (event (when id (get-text-property 0 'event-data id))))
575 (if event
576 (caledonia--display-event-details event)
577 (message "No event at point")))))
578
579(defun caledonia-open-event-file ()
580 "Open the file associated with the event at point.
581If the file contains the event ID, the cursor will be positioned at that
582location."
583 (interactive)
584 (when (eq major-mode 'caledonia-mode)
585 (let* ((id (tabulated-list-get-id))
586 (event (when id (get-text-property 0 'event-data id)))
587 (file (when event (caledonia--get-key 'file event)))
588 (event-id (when event (caledonia--get-key 'id event))))
589 (cond
590 ((not event)
591 (message "No event at point"))
592 ((not file)
593 (message "No file associated with this event"))
594 ((not (file-exists-p file))
595 (message "File does not exist: %s" file))
596 (t
597 (find-file file)
598 (caledonia--find-and-highlight-event-in-file file event-id))))))
599
600(defun caledonia-refresh ()
601 "Refresh calendar data from disk and update the current view.
602This is useful when calendar files have been modified outside Emacs."
603 (interactive)
604 (when (eq major-mode 'caledonia-mode)
605 ;; Send a refresh command to clear the server's cache
606 (caledonia--send-request "Refresh")
607 ;; Re-apply the current query to update the view
608 (when (string= (buffer-name) caledonia--events-buffer)
609 ;; Just use caledonia--make-query without args to use the stored query
610 (caledonia--make-query))))
611
612;; Entry functions
613
614(defun caledonia-query ()
615 "Query events with interactive prompts for all filter parameters.
616Opens a series of prompts to build a complete query and then displays the
617results. After the initial query is displayed, you can further refine the
618results using the caledonia-query-* family of functions."
619 (interactive)
620 (let* (
621 (dates (caledonia--read-date-range))
622 (from (car dates))
623 (to (cdr dates))
624 (timezone-str (read-string "Timezone (e.g. Europe/London, leave empty for default): "
625 nil 'caledonia-timezone-history))
626 (timezone (when (not (string-empty-p timezone-str)) timezone-str))
627 (available-calendars
628 (caledonia--send-request "ListCalendars"))
629 (calendars-list
630 (if (and (listp available-calendars)
631 (eq (car available-calendars) 'Calendars))
632 (cadr available-calendars)
633 (progn
634 (message "Failed to get calendar list from server")
635 nil)))
636 (selected-calendars
637 (completing-read-multiple
638 "Select calendars (comma-separated, empty for all): "
639 (or calendars-list '()) nil nil nil 'caledonia-calendars-history))
640 (calendars (mapcar #'string-trim selected-calendars))
641 (text (read-string "Search text (leave empty for no text search): "
642 nil 'caledonia-text-history))
643 (search-in-str (when (and text (not (string-empty-p text)))
644 (read-string "Search in (summary,description,location - leave empty for all): "
645 nil 'caledonia-search-fields-history)))
646 (search-in (when (and search-in-str (not (string-empty-p search-in-str)))
647 (mapcar (lambda (field)
648 (intern (string-trim field)))
649 (split-string search-in-str "," t))))
650 (id (read-string "Event ID (leave empty for all events): "
651 nil 'caledonia-id-history))
652 (recurring (completing-read "Recurring events (yes/no/all, leave empty for all): "
653 '("" "yes" "no") nil nil nil))
654 (limit-str (read-string "Maximum events to show (leave empty for no limit): "
655 nil 'caledonia-limit-history))
656 (limit (when (and limit-str (not (string-empty-p limit-str)))
657 (string-to-number limit-str)))
658 (query nil))
659 ;; Build query based on parameters
660 (when (and from (not (string-empty-p from)))
661 (push `(from ,from) query))
662 (when (and to (not (string-empty-p to)))
663 (push `(to ,to) query))
664 (when timezone
665 (push `(timezone ,timezone) query))
666 (when calendars
667 (push `(calendars ,calendars) query))
668 (when (and text (not (string-empty-p text)))
669 (push `(text ,text) query))
670 (when search-in
671 (push `(search_in ,search-in) query))
672 (when (and id (not (string-empty-p id)))
673 (push `(id ,id) query))
674 (when (not (string-empty-p recurring))
675 (push `(recurring ,(if (string= recurring "yes") t nil)) query))
676 (when limit
677 (push `(limit ,limit) query))
678 ;; Create buffer and execute query
679 (let ((buffer (get-buffer-create caledonia--events-buffer)))
680 (with-current-buffer buffer
681 ;; Clear the buffer and reset it
682 (let ((inhibit-read-only t))
683 (erase-buffer))
684 ;; Activate our mode and make the query
685 (caledonia-mode)
686 (caledonia--make-query query)
687 (switch-to-buffer buffer)))))
688
689(defun caledonia-list (&optional from-date to-date)
690 "List calendar in a new buffer within the default date range.
691FROM-DATE and TO-DATE override the default date range if provided. TO-DATE is
692required and will use a default if not specified. With prefix arg, prompts for
693the date range with an interactive calendar."
694 (interactive
695 (when current-prefix-arg
696 (let* ((dates (caledonia--read-date-range)))
697 (list (car dates) (cdr dates)))))
698 (let ((buffer (get-buffer-create caledonia--events-buffer))
699 (from (or from-date caledonia-list-from-date))
700 ;; Ensure to date is always provided
701 (to (or (and to-date (not (string-empty-p to-date)) to-date)
702 caledonia-list-to-date)))
703 (with-current-buffer buffer
704 ;; Clear the buffer and reset it
705 (let ((inhibit-read-only t))
706 (erase-buffer))
707 ;; Build the query
708 (let* ((query `((to ,to))))
709 ;; Add from date only if specified
710 (when (and from (not (string-empty-p from)))
711 (setq query (append query `((from ,from)))))
712 ;; Activate our mode and make the query
713 (caledonia-mode)
714 (caledonia--make-query query)
715 (switch-to-buffer buffer)))))
716
717(defun caledonia-search (&optional expr from-date to-date)
718 "Search for query EXPR with optional FROM-DATE and TO-DATE.
719This is an interactive function which asks user for EXPR if not passed as an
720argument. With prefix arg, also prompts for date range with an interactive
721calendar. Use this to find events matching specific text across all calendars.
722TO-DATE is required; a default will be used if not provided."
723 (interactive
724 (let* ((search-text (read-string "Search for: " nil 'caledonia-search-prompt-history))
725 (dates (when current-prefix-arg (caledonia--read-date-range))))
726 (list search-text
727 (when current-prefix-arg (car dates))
728 (when current-prefix-arg (cdr dates)))))
729 (let ((buffer (get-buffer-create caledonia--events-buffer))
730 (from (or from-date caledonia-search-from-date))
731 (to (or to-date caledonia-search-to-date)))
732 (with-current-buffer buffer
733 ;; Clear the buffer and reset it
734 (let ((inhibit-read-only t))
735 (erase-buffer))
736 ;; Build the query
737 (let* ((query `((text ,expr)(to ,to))))
738 ;; Add from date only if specified
739 (when (and from (not (string-empty-p from)))
740 (setq query (append query `((from ,from)))))
741 ;; Activate our mode and make the query
742 (caledonia-mode)
743 (caledonia--make-query query)
744 (switch-to-buffer buffer)))))
745
746;; Modes
747;;;###autoload
748
749;; Create a filter prefix map for query refinement
750(defvar caledonia-filter-map
751 (let ((map (make-sparse-keymap)))
752 (define-key map (kbd "d") 'caledonia-query-date-range)
753 (define-key map (kbd "c") 'caledonia-query-calendars)
754 (define-key map (kbd "t") 'caledonia-query-text)
755 (define-key map (kbd "i") 'caledonia-query-id)
756 (define-key map (kbd "r") 'caledonia-query-recurring)
757 (define-key map (kbd "l") 'caledonia-query-limit)
758 (define-key map (kbd "z") 'caledonia-query-timezone)
759 map)
760 "Keymap for filter commands in Caledonia mode.")
761
762(defvar caledonia-mode-map
763 (let ((map (make-sparse-keymap)))
764 (set-keymap-parent map tabulated-list-mode-map)
765 (define-key map (kbd "RET") 'caledonia-show-event)
766 (define-key map (kbd "M-RET") 'caledonia-open-event-file)
767 (define-key map (kbd "l") 'caledonia-list)
768 (define-key map (kbd "s") 'caledonia-search)
769 (define-key map (kbd "r") 'caledonia-refresh)
770 (define-key map (kbd "q") 'quit-window)
771 ;; Individual filter command bindings
772 (define-key map (kbd "C-c d") 'caledonia-query-date-range)
773 (define-key map (kbd "C-c c") 'caledonia-query-calendars)
774 (define-key map (kbd "C-c t") 'caledonia-query-text)
775 (define-key map (kbd "C-c i") 'caledonia-query-id)
776 (define-key map (kbd "C-c r") 'caledonia-query-recurring)
777 (define-key map (kbd "C-c l") 'caledonia-query-limit)
778 (define-key map (kbd "C-c z") 'caledonia-query-timezone)
779 ;; Use f prefix for filter commands
780 (define-key map (kbd "C-c f") caledonia-filter-map)
781 map)
782 "Keymap for Caledonia mode.")
783
784(define-derived-mode caledonia-mode tabulated-list-mode "Caledonia"
785 "Major mode for displaying calendar entries in a tabular view.")
786
787(provide 'caledonia)
788;;; caledonia.el ends here