···
1
+
;;; caledonia.el --- Emacs integration for Caledonia -*- lexical-binding: t -*-
3
+
;; Copyright (C) 2025 Ryan Gibb
5
+
;; Author: Ryan Gibb <ryan@freumh.org>
6
+
;; Maintainer: Ryan Gibb <ryan@freumh.org>
8
+
;; Keywords: calendar
9
+
;; Package-Requires: ((emacs "24.4"))
10
+
;; URL: https://ryan.freumh.org/caledonia.html
12
+
;; This file is not part of GNU Emacs.
16
+
;; This package provides an Emacs interface to the Caledonia calendar CLI.
17
+
;; It communicates with Caledonia using S-expressions for data exchange.
23
+
(require 'pulse nil t)
26
+
(defgroup caledonia nil
27
+
"Interface to Caledonia calendar client."
29
+
:prefix "caledonia-")
31
+
(defcustom caledonia-executable (executable-find "caled")
32
+
"Path to the Caledonia executable."
36
+
(defface caledonia-calendar-name-face
37
+
'((t :inherit font-lock-function-name-face))
38
+
"Face used for calendar names in the events view."
41
+
(defface caledonia-date-face
42
+
'((t :inherit font-lock-string-face))
43
+
"Face used for dates in the events view."
46
+
(defface caledonia-summary-face
47
+
'((t :inherit default))
48
+
"Face used for event summaries in the events view."
51
+
(defface caledonia-location-face
52
+
'((t :inherit font-lock-comment-face))
53
+
"Face used for event locations in the events view."
56
+
(defcustom caledonia-calendar-column-width 0
57
+
"Column width for the Calendar entry."
60
+
(defcustom caledonia-start-column-width 0
61
+
"Column width for the Start entry."
64
+
(defcustom caledonia-end-column-width 0
65
+
"Column width for the End entry."
68
+
(defcustom caledonia-list-from-date "today"
69
+
"Default start date for calendar list view."
73
+
(defcustom caledonia-list-to-date "+3m"
74
+
"Default end date for calendar list view (3 months from today)."
78
+
(defcustom caledonia-search-from-date nil
79
+
"Default start date for calendar search; nil means no start date limit."
83
+
(defcustom caledonia-search-to-date "+75y"
84
+
"Default end date for calendar search (75 years from today)."
88
+
;; Define histories for input fields
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.")
100
+
;; Internal variables
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.")
119
+
(defvar caledonia--server-line-buffer "")
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))
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)))))
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))
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
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.")))
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))))
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)))
192
+
(message "Failed to parse Caledonia output: %s" (error-message-string err))
197
+
(defun caledonia--format-timestamp (iso-string &optional format)
198
+
"Format ISO-8601 time string ISO-STRING to human-readable format.
199
+
FORMAT 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)))
205
+
(defun caledonia--get-key (key event)
206
+
"Get KEY from EVENT as a string."
207
+
(let ((value (cadr (assoc key event))))
210
+
((stringp value) value)
211
+
((symbolp value) (symbol-name value)))))
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)
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))
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)
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))))
257
+
tabulated-list-entries))
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)))
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))))
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))))
277
+
(defun caledonia--make-query (&optional query)
278
+
"Make a query with the QUERY S-expression.
279
+
If QUERY is nil, use the current query stored in `caledonia--current-query`."
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)
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
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)
299
+
(setq tabulated-list-sort-key (cons "Start" nil))
300
+
(tabulated-list-init-header)
301
+
(tabulated-list-print t))
303
+
(defun caledonia--find-and-highlight-event-in-file (file event-id)
304
+
"Find EVENT-ID in FILE, position cursor, and highlight the event.
305
+
Return non-nil if the event was found."
306
+
(when (and file event-id)
307
+
(let ((id-str (format "%s" event-id))
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))
317
+
;; Find start of the VEVENT block
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
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)
336
+
(message "Event ID not found in file"))
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))
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))))
357
+
(insert (propertize "Summary: " 'face 'bold) summary "\n"))
359
+
(insert (propertize "ID: " 'face 'bold) id "\n"))
361
+
(insert (propertize "Calendar: " 'face 'bold) calendar "\n"))
363
+
(insert (propertize "Start: " 'face 'bold) start-str "\n"))
365
+
(insert (propertize "End: " 'face 'bold) end-str "\n"))
367
+
(insert (propertize "Location: " 'face 'bold) location "\n"))
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]
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")
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))))
394
+
(insert "\n" (propertize "Description:" 'face 'bold) "\n"
395
+
(propertize "------------" 'face 'bold) "\n"
396
+
description "\n")))))
397
+
(switch-to-buffer-other-window buf)))
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))))))
409
+
(defun caledonia--read-date-range ()
410
+
"Read a date range from the user with `org-mode' date picker integration.
411
+
Returns a cons cell (from-date . to-date).
412
+
The from-date can be nil to indicate no start date constraint."
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
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))
423
+
;; Query parameter modification functions
425
+
(defun caledonia-query-date-range ()
426
+
"Set the date range for the current calendar view."
428
+
(when (eq major-mode 'caledonia-mode)
429
+
(let* ((dates (caledonia--read-date-range))
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))))
444
+
(defun caledonia-query-calendars ()
445
+
"Set the calendars to filter by for the current calendar view.
446
+
Fetches available calendars from server to allow selection from a list."
448
+
(when (eq major-mode 'caledonia-mode)
449
+
(let* ((available-calendars
450
+
(caledonia--send-request "ListCalendars"))
452
+
(if (and (listp available-calendars)
453
+
(eq (car available-calendars) 'Calendars))
454
+
(cadr available-calendars)
456
+
(message "Failed to get calendar list from server")
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 '())
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))))
479
+
(defun caledonia-query-text ()
480
+
"Set the search text for the current calendar view."
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))
500
+
(push `(search_in ,search-in) new-query))
501
+
;; Execute the updated query
502
+
(caledonia--make-query new-query))))
504
+
(defun caledonia-query-id ()
505
+
"Set the event ID to filter by for the current calendar view."
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))))
519
+
(defun caledonia-query-recurring ()
520
+
"Set whether to filter by recurring events for the current calendar view."
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))))
534
+
(defun caledonia-query-limit ()
535
+
"Set the maximum number of events to show in the current calendar view."
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))
547
+
(push `(limit ,limit) new-query))
548
+
;; Execute the updated query
549
+
(caledonia--make-query new-query))))
551
+
(defun caledonia-query-timezone ()
552
+
"Set the timezone for the current calendar view."
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))
563
+
(push `(timezone ,timezone) new-query))
564
+
;; Execute the updated query
565
+
(caledonia--make-query new-query))))
567
+
;; Buffer functions
569
+
(defun caledonia-show-event ()
570
+
"Show details for the event at point in a separate buffer."
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))))
576
+
(caledonia--display-event-details event)
577
+
(message "No event at point")))))
579
+
(defun caledonia-open-event-file ()
580
+
"Open the file associated with the event at point.
581
+
If the file contains the event ID, the cursor will be positioned at that
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))))
591
+
(message "No event at point"))
593
+
(message "No file associated with this event"))
594
+
((not (file-exists-p file))
595
+
(message "File does not exist: %s" file))
598
+
(caledonia--find-and-highlight-event-in-file file event-id))))))
600
+
(defun caledonia-refresh ()
601
+
"Refresh calendar data from disk and update the current view.
602
+
This is useful when calendar files have been modified outside Emacs."
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))))
614
+
(defun caledonia-query ()
615
+
"Query events with interactive prompts for all filter parameters.
616
+
Opens a series of prompts to build a complete query and then displays the
617
+
results. After the initial query is displayed, you can further refine the
618
+
results using the caledonia-query-* family of functions."
621
+
(dates (caledonia--read-date-range))
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"))
630
+
(if (and (listp available-calendars)
631
+
(eq (car available-calendars) 'Calendars))
632
+
(cadr available-calendars)
634
+
(message "Failed to get calendar list from server")
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)))
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))
665
+
(push `(timezone ,timezone) query))
667
+
(push `(calendars ,calendars) query))
668
+
(when (and text (not (string-empty-p text)))
669
+
(push `(text ,text) query))
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))
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))
684
+
;; Activate our mode and make the query
686
+
(caledonia--make-query query)
687
+
(switch-to-buffer buffer)))))
689
+
(defun caledonia-list (&optional from-date to-date)
690
+
"List calendar in a new buffer within the default date range.
691
+
FROM-DATE and TO-DATE override the default date range if provided. TO-DATE is
692
+
required and will use a default if not specified. With prefix arg, prompts for
693
+
the date range with an interactive calendar."
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))
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
714
+
(caledonia--make-query query)
715
+
(switch-to-buffer buffer)))))
717
+
(defun caledonia-search (&optional expr from-date to-date)
718
+
"Search for query EXPR with optional FROM-DATE and TO-DATE.
719
+
This is an interactive function which asks user for EXPR if not passed as an
720
+
argument. With prefix arg, also prompts for date range with an interactive
721
+
calendar. Use this to find events matching specific text across all calendars.
722
+
TO-DATE is required; a default will be used if not provided."
724
+
(let* ((search-text (read-string "Search for: " nil 'caledonia-search-prompt-history))
725
+
(dates (when current-prefix-arg (caledonia--read-date-range))))
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))
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
743
+
(caledonia--make-query query)
744
+
(switch-to-buffer buffer)))))
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)
760
+
"Keymap for filter commands in Caledonia mode.")
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)
782
+
"Keymap for Caledonia mode.")
784
+
(define-derived-mode caledonia-mode tabulated-list-mode "Caledonia"
785
+
"Major mode for displaying calendar entries in a tabular view.")
787
+
(provide 'caledonia)
788
+
;;; caledonia.el ends here
ryan.freumh.org