forked from jkitchin/scimax
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathscimax-contacts.el
395 lines (338 loc) · 13.4 KB
/
scimax-contacts.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
;;; scimax-contacts.el --- org-mode contacts in scimax
;;; Commentary:
;;
;; Scimax contacts library - provides a link and integration with org-db to manage contacts.
;;
;; It relies on org-db to find contacts.
;;
;;; Code:
(require 'org-db)
(defalias 'scimax-contacts 'org-db-contacts "An alias for inserting contacts.")
;; * contact link
;; I have struggled with what the link should use for a path. There are two options in my opinion:
;; 1. An org-id - this is the most unambiguous, and should refer to a single heading but least readable.
;; 2. An email address - this is the most readable, but there may be many headings with this property.
;;
;; 3. A third possibility is to use a more complex syntax like
;; [[contact:[email protected] :id some-uuid]], which might be an editmark.
;;
;; I favor readability over correctness, so I will use an email address. If
;; there is more than one heading with that address, you will just have to
;; choose which one to open.
(defun scimax-contact-store-link ()
"Store a contact link.
If you are in a contact heading we store a link."
(let* ((email (org-entry-get (point) "EMAIL"))
(link (concat "contact:" email)))
(when email
(org-link-store-props
:type "contact"
:link link
:description (or (org-entry-get (point) "NAME")
(nth 4 (org-heading-components)))
:email email)
link)))
(defun scimax-contact-open-link ()
"Follow a contact link."
(interactive)
(let* ((email (org-element-property :path (org-element-context)))
(candidates (cl-loop for (title value tags fname lup begin) in
(with-org-db (emacsql org-db
[:select [headlines:title
headline-properties:value
headlines:tags files:filename files:last-updated headlines:begin]
:from headlines
:inner :join headline-properties
:on (= headlines:rowid headline-properties:headline-id)
:inner :join properties
:on (= properties:rowid headline-properties:property-id)
:inner :join files :on (= files:rowid headlines:filename-id)
:where (and (= properties:property "EMAIL")
(= headline-properties:value $s1))]
email))
collect
(list (format "%40s | %s" title fname) :filename fname :begin begin :email email)))
candidate)
(cond
((s-contains? "@" email)
(cond
((= 1 (length candidates))
(org-db--open-contact (first candidates)))
((> (length candidates) 1)
(ivy-read "Contact: " candidates :action 'org-db--open-contact))
(t
(error "No matching candidates found for %s" email))))
;; assume it is an id
(t
(org-db-goto-id email)))))
(defun scimax-contact-complete (&optional arg)
"Completion function for a scimax-contact.
Optional argument ARG is ignored."
(let* ((contacts (org-db-contacts-candidates))
(contact (cdr (assoc (completing-read "Contact: " contacts) contacts))))
(org-link-store-props
:type "contact"
:link (format "contact:%s" (plist-get contact :email))
:description (plist-get contact :title)
:email (plist-get contact :email))
(format "contact:%s" (plist-get contact :email))))
(setq org-link-make-description-function
(lambda (link desc)
(plist-get org-store-link-plist :description)))
(defun scimax-contact-help-echo (window object position)
"Help-echo for scimax-contact links.
Argument WINDOW is ignored.
Argument OBJECT is ignored.
Argument POSITION is where the mouse cursor is."
(let* ((email (org-element-property :path (org-element-context))))
(cl-loop for (title value tags fname lup begin) in
(with-org-db
(emacsql org-db
[:select [headlines:title
headline-properties:value
headlines:tags files:filename files:last-updated headlines:begin]
:from headlines
:inner :join headline-properties
:on (= headlines:rowid headline-properties:headline-id)
:inner :join properties
:on (= properties:rowid headline-properties:property-id)
:inner :join files :on (= files:rowid headlines:filename-id)
:where (and (= properties:property "EMAIL")
(= headline-properties:value $s1))]
email))
concat
(format "%40s | %s | %s\n" email title fname))))
(defun scimax-contact-email ()
"Send email to contact at point."
(interactive)
(let ((email (org-element-property :path (org-element-context))))
(compose-mail)
(message-goto-to)
(insert email)
(message-goto-subject)))
(defun scimax-contact-add-tag ()
"Add a tag to a contact."
(interactive)
(save-window-excursion
(scimax-contact-open-link)
(org-set-tags
(-uniq
(append
(org-get-tags)
(list (ivy-read "Tag: "
(-flatten (with-org-db (emacsql org-db [:select [tags:tag]
:from tags ]))))))))
(save-buffer)))
(defun scimax-contact-copy-email (&optional name-email)
"Copy email to the clipboard.
With NAME-MAIL copy name <email> instead."
(interactive)
(save-window-excursion
(scimax-contact-open-link)
(kill-new
(if name-email
(format "\"%s\" <%s>"
(nth 4 (org-heading-components))
(org-entry-get (point) "EMAIL"))
(org-entry-get (point) "EMAIL")))))
(defun scimax-contact-to-from (&optional FROM)
"Open mu4e with emails to contact at point.
If FROM is non-nil, emails from the contact."
(interactive)
(unless (fboundp 'mu4e)
(error "mu4e does not seem to be available."))
(org-link-open-from-string
(if FROM
(format "[[mu4e:query:from:%s]]"
(org-element-property :path (org-element-context)))
(format "[[mu4e:query:to:%s]]"
(org-element-property :path (org-element-context))))))
(defun scimax-contact-related ()
"Show documents that have the contact linked in it."
(interactive)
(let* ((email (org-element-property :path (org-element-context)))
(link-candidates (cl-loop
for (rl fn bg) in
(with-org-db
(emacsql org-db [:select [raw-link filename begin ]
:from links
:left :join files :on (= links:filename-id files:rowid)
:where (and
(= links:type "contact")
(= links:path $s1))
:order :by filename]
email))
collect
;; (candidate :filename :begin)
(list (format "%s | %s" rl fn) :filename fn :begin bg)))
(results (with-org-db (emacsql org-db
[:select [headlines:title
properties:property
headline-properties:value
files:filename files:last-updated headlines:begin]
:from headlines
:inner :join headline-properties
:on (= headlines:rowid headline-properties:headline-id)
:inner :join properties
:on (= properties:rowid headline-properties:property-id)
:inner :join files :on (= files:rowid headlines:filename-id)
:where (and (= properties:property "ASSIGNEDTO")
(like headline-properties:value $s1))]
email)))
(assigned-candidates (cl-loop for (title property value fname last-updated begin) in results
collect
(list (format "%s | %s=%s | %s" title property value fname)
:filename fname :begin begin)))
(results (with-org-db (emacsql org-db
[:select [headlines:title
properties:property
headline-properties:value
files:filename files:last-updated headlines:begin]
:from headlines
:inner :join headline-properties
:on (= headlines:rowid headline-properties:headline-id)
:inner :join properties
:on (= properties:rowid headline-properties:property-id)
:inner :join files :on (= files:rowid headlines:filename-id)
:where (and (= properties:property "EMAIL")
(like headline-properties:value $s1))]
email)))
(email-candidates (cl-loop for (title property value fname last-updated begin) in results
collect
(list (format "%s | %s=%s | %s" title property value fname)
:filename fname :begin begin))))
(ivy-read "Choose: " (append assigned-candidates email-candidates link-candidates)
:action (lambda (x)
(let ((candidate (cdr x)))
(find-file (plist-get candidate :filename))
(goto-char (plist-get candidate :begin)))))))
(use-package pretty-hydra)
(pretty-hydra-define scimax-contact
(:title "contacts" :quit-key "q" :color blue)
("actions"
(("o" scimax-contact-open-link "Open contact")
("e" scimax-contact-email "Email contact")
("c" scimax-contact-copy-email "Copy email address")
("C" (scimax-contact-copy-email t) "Copy \"name\" <email>"))
"Edit"
(("g" scimax-contact-add-tag "Add tags"))
"Related"
(("r" scimax-contact-related "Related items")
("f" (scimax-contact-to-from t) "Emails from contact")
("t" scimax-contact-to-from "Emails to contact"))))
(defun scimax-contact-follow-link (&optional path)
"Menu for actions on a contact link.
Optional argument PATH is ignored."
(interactive)
(scimax-contact/body))
(org-link-set-parameters
"contact"
:follow #'scimax-contact-follow-link
:complete #'scimax-contact-complete
:face '(:foreground "OrangeRed1")
:help-echo #'scimax-contact-help-echo
:store #'scimax-contact-store-link)
;; * Speed keys for contact entries
;; These work when you at a contact heading
(defun scimax-contacts-speed-keys (keys)
"Find the command to run for KEYS."
(when (or (and (bolp) (looking-at org-outline-regexp)
(not (null (org-entry-get (point) "EMAIL")))))
(cdr (assoc keys scimax-contacts-speed-commands))))
(defvar scimax-contacts-speed-commands
'(("b" . (lambda ()
"If contact has a URL open it in a browser."
(when (org-entry-get (point) "URL")
(browse-url (org-entry-get (point) "URL")))))
("c" . (lambda ()
"Copy the email address to the clipboard."
(message (kill-new (org-entry-get (point) "EMAIL")))))
("e" . (lambda ()
"Send an email to the contact."
(let ((email (org-entry-get (point) "EMAIL")))
(compose-mail)
(message-goto-to)
(insert email)
(message-goto-subject))))
("l" . (lambda ()
"Store and copy a link to the contact."
(message (kill-new (format "[[contact:%s][%s]]" (org-entry-get (point) "EMAIL") (nth 4 (org-heading-components)))))
(org-store-link nil)))
("m" . (lambda ()
"Copy \"name\ <email>\""
(message (kill-new
(format "\"%s\" <%s>"
(nth 4 (org-heading-components))
(org-entry-get (point) "EMAIL"))))))
("?" . (lambda ()
"Print contacts speed key help."
(with-output-to-temp-buffer "*Help*"
(princ "Contacts Speed commands\n===========================\n")
(mapc #'scimax-contacts-speed-keys scimax-contacts-speed-commands)
(princ "\n")
(princ "User-defined Speed commands\n===========================\n")
(mapc #'org-print-speed-command org-speed-commands-user)
(princ "Built-in Speed commands\n=======================\n")
(mapc #'org-print-speed-command org-speed-commands-default))
(with-current-buffer "*Help*"
(setq truncate-lines t)))))
"Speed key definitions for scimax-contacts.")
(add-hook 'org-speed-command-hook 'scimax-contacts-speed-keys)
(defun scimax-contacts-exists-p (email)
"Return non-nil if the EMAIL address is already in org-db."
(not (null (with-org-db (emacsql org-db
[:select [files:filename headlines:begin headlines:title]
:from headlines
:inner :join headline-properties
:on (= headlines:rowid headline-properties:headline-id)
:inner :join properties
:on (= properties:rowid headline-properties:property-id)
:inner :join files :on (= files:rowid headlines:filename-id)
:where (and (= properties:property "EMAIL")
(= headline-properties:value $s1))]
email)))))
(defvar scimax-message-org-contacts-file
(expand-file-name (locate-user-emacs-file "message-contacts.org"))
"File name to store contacts captured from messages.")
;; * Capture contacts in messages
;; I use this with mu4e, but it should work in any message.
(defun scimax-message-get-emails ()
"Captures emails in a message."
(interactive)
(let* ((captured-results (mapcar 's-trim
(append
(s-split "," (message-field-value "To"))
(s-split "," (message-field-value "From"))
(s-split "," (or (message-field-value "CC") "")))))
(emails (cl-loop for s in captured-results
if (string-match
;; adapted from thing-at-point-email-regexp to add group
"<?\\([-+_.~a-zA-Z][-+_.~:a-zA-Z0-9]*@[-.a-zA-Z0-9]+\\)>?"
s)
collect
(list (s-trim (s-replace (match-string 0 s) "" s))
(match-string 1 s)))))
(with-current-buffer (find-file-noselect scimax-message-org-contacts-file)
(goto-char (point-max))
(when (not (bolp))
(insert "\n"))
(insert (cl-loop for (name email) in emails
unless (scimax-contacts-exists-p email)
concat
(format "* %s
:PROPERTIES:
:ID: %s
:EMAIL: %s
:END:\n\n" (if (string= "" name) email name) (org-id-new) email)))
(save-buffer)
(org-db-update-buffer t))))
;; * mu4e integration
(defvar with-mu4e (fboundp 'mu4e)
"If non-nil it means we have mu4e available.")
;; I want to make sure if I reply, I have contacts.
(when with-mu4e
(advice-add #'mu4e-compose-reply :before #'scimax-message-get-emails)
(define-key mu4e-compose-mode-map "\C-c]" 'scimax-contacts)
(define-key message-mode-map "\C-c]" 'scimax-contacts))
(provide 'scimax-contacts)
;;; scimax-contacts.el ends here