aliens/org-contacts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Tidy up whitespace

Browse source
This commit is contained in:
Morgan Smith 2021-10-28 02:20:49 -04:00 committed by stardiviner
parent 80ab4708b7
commit 0a91557ef9
1 changed files with 383 additions and 378 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
org-contacts.el
View file

@ -247,16 +247,16 @@ A regexp matching strings of whitespace, `,' and `;'.")
(org-contacts-files)) (org-contacts-files))
(org-contacts-db-has-dead-markers-p org-contacts-db))) (org-contacts-db-has-dead-markers-p org-contacts-db)))
(defun org-contacts-db-has-dead-markers-p (org-contacts-db) (defun org-contacts-db-has-dead-markers-p (db)
"Returns t if at least one dead marker is found in "Return t if at least one dead marker is found in DB.
ORG-CONTACTS-DB. A dead marker in this case is a marker pointing A dead marker in this case is a marker pointing to dead or no
to dead or no buffer." buffer."
;; Scan contacts list looking for dead markers, and return t at first found. ;; Scan contacts list looking for dead markers, and return t at first found.
(catch 'dead-marker-found (catch 'dead-marker-found
(while org-contacts-db (while db
(unless (marker-buffer (nth 1 (car org-contacts-db))) (unless (marker-buffer (nth 1 (car db)))
(throw 'dead-marker-found t)) (throw 'dead-marker-found t))
(setq org-contacts-db (cdr org-contacts-db))) (setq db (cdr db)))
nil)) nil))
(defun org-contacts-db () (defun org-contacts-db ()
@ -460,9 +460,7 @@ prefixes rather than just the beginning of the string."
((eq flag 'lambda) ((eq flag 'lambda)
(org-contacts-test-completion-prefix string collection predicate)) (org-contacts-test-completion-prefix string collection predicate))
((and (listp flag) (eq (car flag) 'boundaries)) ((and (listp flag) (eq (car flag) 'boundaries))
(cl-destructuring-bind (to-ignore &rest suffix) (org-contacts-boundaries-prefix string collection predicate (cdr flag)))
flag
(org-contacts-boundaries-prefix string collection predicate suffix)))
((eq flag 'metadata) ((eq flag 'metadata)
(org-contacts-metadata-prefix string collection predicate)) (org-contacts-metadata-prefix string collection predicate))
(t nil ; operation unsupported (t nil ; operation unsupported
@ -563,21 +561,21 @@ description."
'identity 'identity
(cl-loop for contact in (org-contacts-db) (cl-loop for contact in (org-contacts-db)
for contact-name = (car contact) for contact-name = (car contact)
for email = (org-contacts-strip-link (or (car (org-contacts-split-property for email = (org-contacts-strip-link
(or (car (org-contacts-split-property
(or (or
(cdr (assoc-string org-contacts-email-property (cdr (assoc-string org-contacts-email-property
(cl-caddr contact))) (cl-caddr contact)))
""))) "")) ""))) ""))
for tags = (cdr (assoc "TAGS" (nth 2 contact))) ;; for tags = (cdr (assoc "TAGS" (nth 2 contact)))
for tags-list = (if tags ;; for tags-list = (if tags
(split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":") ;; (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":")
'()) ;; '())
for marker = (nth 1 contact) for marker = (nth 1 contact)
if (with-current-buffer (marker-buffer marker) if (with-current-buffer (marker-buffer marker)
(save-excursion (save-excursion
(goto-char marker) (goto-char marker)
(let (todo-only) (eval (cdr (org-make-tags-matcher (cl-subseq string 1))))))
(eval (cdr (org-make-tags-matcher (cl-subseq string 1)))))))
collect (org-contacts-format-email contact-name email)) collect (org-contacts-format-email contact-name email))
","))) ",")))
(when (not (string= "" result)) (when (not (string= "" result))
@ -616,7 +614,8 @@ description."
if email-list if email-list
;; … append a list of USER <EMAIL>. ;; … append a list of USER <EMAIL>.
nconc (cl-loop for email in email-list nconc (cl-loop for email in email-list
collect (org-contacts-format-email contact-name (org-contacts-strip-link email))))) collect (org-contacts-format-email
contact-name (org-contacts-strip-link email)))))
(completion-list (org-contacts-all-completions-prefix (completion-list (org-contacts-all-completions-prefix
string string
(org-uniquify completion-list)))) (org-uniquify completion-list))))
@ -760,7 +759,8 @@ This function should be called from `gnus-article-prepare-hook'."
(let ((org-agenda-files (org-contacts-files)) (let ((org-agenda-files (org-contacts-files))
(org-agenda-skip-function (org-agenda-skip-function
(lambda () (org-agenda-skip-if nil `(notregexp ,name)))) (lambda () (org-agenda-skip-if nil `(notregexp ,name))))
(org-agenda-prefix-format (propertize (org-agenda-prefix-format
(propertize
"%(org-contacts-icon-as-string)% s%(org-contacts-irc-number-of-unread-messages) " "%(org-contacts-icon-as-string)% s%(org-contacts-irc-number-of-unread-messages) "
'keymap org-contacts-keymap)) 'keymap org-contacts-keymap))
(org-agenda-overriding-header (org-agenda-overriding-header
@ -996,9 +996,12 @@ to do our best."
(nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties)))) (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
(head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)) (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))
emails-list result phones-list) emails-list result phones-list)
(concat head (concat
(when email (progn head
(setq emails-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property email))) (when email
(progn
(setq emails-list (org-contacts-remove-ignored-property-values
ignore-list (org-contacts-split-property email)))
(setq result "") (setq result "")
(while emails-list (while emails-list
(setq result (concat result "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n")) (setq result (concat result "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n"))
@ -1006,11 +1009,14 @@ to do our best."
result)) result))
(when addr (when addr
(format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr))) (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
(when tel (progn (when tel
(setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel))) (progn
(setq phones-list (org-contacts-remove-ignored-property-values
ignore-list (org-contacts-split-property tel)))
(setq result "") (setq result "")
(while phones-list (while phones-list
(setq result (concat result "TEL:" (org-contacts-strip-link (org-link-unescape (car phones-list))) "\n")) (setq result (concat result "TEL:" (org-contacts-strip-link
(org-link-unescape (car phones-list))) "\n"))
(setq phones-list (cdr phones-list))) (setq phones-list (cdr phones-list)))
result)) result))
(when bday (when bday
@ -1161,10 +1167,9 @@ are effectively trimmed). If nil, all zero-length substrings are retained."
:type "org-contact" :type "org-contact"
:link headline-str :link headline-str
:description headline-str) :description headline-str)
(setq desc headline-str) (let ((link (concat "org-contact:" headline-str)))
(setq link (concat "org-contact:" headline-str)) (org-link-add-props :link link :description headline-str)
(org-add-link-props :link link :description desc) link)))))
link))))
(defun org-contacts--all-contacts () (defun org-contacts--all-contacts ()
"Return an alist (name . (file . position)) of all contacts in `org-contacts-files'." "Return an alist (name . (file . position)) of all contacts in `org-contacts-files'."