[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org-contacts 33c5e0582c 085/154: contrib: move a few li
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/org-contacts 33c5e0582c 085/154: contrib: move a few libraries to cl-lib in place of compile-time cl. |
|
Date: |
Fri, 9 Sep 2022 15:58:36 -0400 (EDT) |
branch: externals/org-contacts
commit 33c5e0582c6e648f8d5fb61e2430136aefbff75f
Author: Aaron Ecay <aaronecay@gmail.com>
Commit: Aaron Ecay <aaronecay@gmail.com>
contrib: move a few libraries to cl-lib in place of compile-time cl.
Specifically ob-julia, ob-stata, org-contacts, ox-bibtex.
---
org-contacts.el | 352 ++++++++++++++++++++++++++++----------------------------
1 file changed, 175 insertions(+), 177 deletions(-)
diff --git a/org-contacts.el b/org-contacts.el
index c0f054fcd3..ebc7bcd138 100644
--- a/org-contacts.el
+++ b/org-contacts.el
@@ -52,9 +52,7 @@
;;
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(require 'cl-lib)
(require 'org)
(require 'gnus-util)
(require 'gnus-art)
@@ -316,22 +314,22 @@ cell corresponding to the contact properties.
(null prop-match)
(null tags-match))
(org-contacts-db)
- (loop for contact in (org-contacts-db)
- if (or
- (and name-match
- (org-string-match-p name-match
- (first contact)))
- (and prop-match
- (org-find-if (lambda (prop)
- (and (string= (car prop-match) (car prop))
- (org-string-match-p (cdr prop-match)
(cdr prop))))
- (caddr contact)))
- (and tags-match
- (org-find-if (lambda (tag)
- (org-string-match-p tags-match tag))
- (org-split-string
- (or (cdr (assoc-string "ALLTAGS" (caddr
contact))) "") ":"))))
- collect contact)))
+ (cl-loop for contact in (org-contacts-db)
+ if (or
+ (and name-match
+ (org-string-match-p name-match
+ (first contact)))
+ (and prop-match
+ (org-find-if (lambda (prop)
+ (and (string= (car prop-match) (car prop))
+ (org-string-match-p (cdr prop-match)
(cdr prop))))
+ (caddr contact)))
+ (and tags-match
+ (org-find-if (lambda (tag)
+ (org-string-match-p tags-match tag))
+ (org-split-string
+ (or (cdr (assoc-string "ALLTAGS" (caddr
contact))) "") ":"))))
+ collect contact)))
(when (not (fboundp 'completion-table-case-fold))
;; That function is new in Emacs 24...
@@ -344,34 +342,34 @@ cell corresponding to the contact properties.
"Custom implementation of `try-completion'.
This version works only with list and alist and it looks at all
prefixes rather than just the beginning of the string."
- (loop with regexp = (concat "\\b" (regexp-quote to-match))
- with ret = nil
- with ret-start = nil
- with ret-end = nil
-
- for el in collection
- for string = (if (listp el) (car el) el)
-
- for start = (when (or (null predicate) (funcall predicate string))
- (string-match regexp string))
-
- if start
- do (let ((end (match-end 0))
- (len (length string)))
- (if (= end len)
- (return t)
- (destructuring-bind (string start end)
- (if (null ret)
- (values string start end)
- (org-contacts-common-substring
- ret ret-start ret-end
- string start end))
- (setf ret string
- ret-start start
- ret-end end))))
-
- finally (return
- (replace-regexp-in-string "\\`[ \t\n]*" "" ret))))
+ (cl-loop with regexp = (concat "\\b" (regexp-quote to-match))
+ with ret = nil
+ with ret-start = nil
+ with ret-end = nil
+
+ for el in collection
+ for string = (if (listp el) (car el) el)
+
+ for start = (when (or (null predicate) (funcall predicate string))
+ (string-match regexp string))
+
+ if start
+ do (let ((end (match-end 0))
+ (len (length string)))
+ (if (= end len)
+ (cl-return t)
+ (cl-destructuring-bind (string start end)
+ (if (null ret)
+ (values string start end)
+ (org-contacts-common-substring
+ ret ret-start ret-end
+ string start end))
+ (setf ret string
+ ret-start start
+ ret-end end))))
+
+ finally (cl-return
+ (replace-regexp-in-string "\\`[ \t\n]*" "" ret))))
(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional
ignore-case)
"Compare the contents of two strings, using `compare-strings'.
@@ -430,22 +428,22 @@ This function returns a list whose contains:
"Custom version of `all-completions'.
This version works only with list and alist and it looks at all
prefixes rather than just the beginning of the string."
- (loop with regexp = (concat "\\b" (regexp-quote to-match))
- for el in collection
- for string = (if (listp el) (car el) el)
- for match? = (when (and (or (null predicate) (funcall predicate
string)))
- (string-match regexp string))
- if match?
- collect (progn
- (let ((end (match-end 0)))
- (org-no-properties string)
- (when (< end (length string))
- ;; Here we add a text property that will be used
- ;; later to highlight the character right after
- ;; the common part between each addresses.
- ;; See `org-contacts-display-sort-function'.
- (put-text-property end (1+ end) 'org-contacts-prefix 't
string)))
- string)))
+ (cl-loop with regexp = (concat "\\b" (regexp-quote to-match))
+ for el in collection
+ for string = (if (listp el) (car el) el)
+ for match? = (when (and (or (null predicate) (funcall predicate
string)))
+ (string-match regexp string))
+ if match?
+ collect (progn
+ (let ((end (match-end 0)))
+ (org-no-properties string)
+ (when (< end (length string))
+ ;; Here we add a text property that will be used
+ ;; later to highlight the character right after
+ ;; the common part between each addresses.
+ ;; See `org-contacts-display-sort-function'.
+ (put-text-property end (1+ end) 'org-contacts-prefix
't string)))
+ string)))
(defun org-contacts-make-collection-prefix (collection)
"Make a collection function from COLLECTION which will match on prefixes."
@@ -460,7 +458,7 @@ prefixes rather than just the beginning of the string."
((eq flag 'lambda)
(org-contacts-test-completion-prefix string collection predicate))
((and (listp flag) (eq (car flag) 'boundaries))
- (destructuring-bind (to-ignore &rest suffix)
+ (cl-destructuring-bind (to-ignore &rest suffix)
flag
(org-contacts-boundaries-prefix string collection predicate
suffix)))
((eq flag 'metadata)
@@ -471,21 +469,21 @@ prefixes rather than just the beginning of the string."
(defun org-contacts-display-sort-function (completions)
"Sort function for contacts display."
(mapcar (lambda (string)
- (loop with len = (1- (length string))
- for i upfrom 0 to len
- if (memq 'org-contacts-prefix
- (text-properties-at i string))
- do (set-text-properties
- i (1+ i)
- (list 'font-lock-face
- (if (char-equal (aref string i)
- (string-to-char " "))
- ;; Spaces can't be bold.
- 'underline
- 'bold)) string)
- else
- do (set-text-properties i (1+ i) nil string)
- finally (return string)))
+ (cl-loop with len = (1- (length string))
+ for i upfrom 0 to len
+ if (memq 'org-contacts-prefix
+ (text-properties-at i string))
+ do (set-text-properties
+ i (1+ i)
+ (list 'font-lock-face
+ (if (char-equal (aref string i)
+ (string-to-char " "))
+ ;; Spaces can't be bold.
+ 'underline
+ 'bold)) string)
+ else
+ do (set-text-properties i (1+ i) nil string)
+ finally (cl-return string)))
completions))
(defun org-contacts-test-completion-prefix (string collection predicate)
@@ -520,9 +518,9 @@ A group FOO is composed of contacts with the tag FOO."
(propertize (concat org-contacts-group-prefix group)
'org-contacts-group group))
(org-uniquify
- (loop for contact in (org-contacts-filter)
- nconc (org-split-string
- (or (cdr (assoc-string "ALLTAGS" (caddr
contact))) "") ":")))))))
+ (cl-loop for contact in (org-contacts-filter)
+ nconc (org-split-string
+ (or (cdr (assoc-string "ALLTAGS" (caddr
contact))) "") ":")))))))
(list start end
(if (= (length completion-list) 1)
;; We've found the correct group, returns the address
@@ -530,21 +528,21 @@ A group FOO is composed of contacts with the tag FOO."
(car completion-list))))
(lambda (string pred &optional to-ignore)
(mapconcat 'identity
- (loop for contact in (org-contacts-filter
- nil
- tag)
- ;; The contact name is always the car of
the assoc-list
- ;; returned by `org-contacts-filter'.
- for contact-name = (car contact)
- ;; Grab the first email of the contact
- for email = (org-contacts-strip-link
- (or (car
(org-contacts-split-property
- (or
- (cdr
(assoc-string org-contacts-email-property
-
(caddr contact)))
- ""))) ""))
- ;; If the user has an email address,
append USER <EMAIL>.
- if email collect
(org-contacts-format-email contact-name email))
+ (cl-loop for contact in (org-contacts-filter
+ nil
+ tag)
+ ;; The contact name is always the car
of the assoc-list
+ ;; returned by `org-contacts-filter'.
+ for contact-name = (car contact)
+ ;; Grab the first email of the contact
+ for email = (org-contacts-strip-link
+ (or (car
(org-contacts-split-property
+ (or
+ (cdr
(assoc-string org-contacts-email-property
+
(cl-caddr contact)))
+ ""))) ""))
+ ;; If the user has an email address,
append USER <EMAIL>.
+ if email collect
(org-contacts-format-email contact-name email))
", ")))
;; We haven't found the correct group
(completion-table-case-fold completion-list
@@ -565,24 +563,24 @@ description."
(let ((result
(mapconcat
'identity
- (loop for contact in (org-contacts-db)
- for contact-name = (car contact)
- for email = (org-contacts-strip-link (or (car
(org-contacts-split-property
- (or
- (cdr
(assoc-string org-contacts-email-property
-
(caddr contact)))
- ""))) ""))
- for tags = (cdr (assoc "TAGS" (nth 2 contact)))
- for tags-list = (if tags
- (split-string (substring (cdr (assoc
"TAGS" (nth 2 contact))) 1 -1) ":")
- '())
- for marker = (second contact)
- if (with-current-buffer (marker-buffer marker)
- (save-excursion
- (goto-char marker)
- (let (todo-only)
- (eval (cdr (org-make-tags-matcher (subseq string
1)))))))
- collect (org-contacts-format-email contact-name email))
+ (cl-loop for contact in (org-contacts-db)
+ for contact-name = (car contact)
+ for email = (org-contacts-strip-link (or (car
(org-contacts-split-property
+ (or
+ (cdr
(assoc-string org-contacts-email-property
+
(cl-caddr contact)))
+ "")))
""))
+ for tags = (cdr (assoc "TAGS" (nth 2 contact)))
+ for tags-list = (if tags
+ (split-string (substring (cdr (assoc
"TAGS" (nth 2 contact))) 1 -1) ":")
+ '())
+ for marker = (nth 1 contact)
+ if (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (let (todo-only)
+ (eval (cdr (org-make-tags-matcher (cl-subseq
string 1)))))))
+ collect (org-contacts-format-email contact-name email))
",")))
(when (not (string= "" result))
;; return (start end function)
@@ -593,37 +591,37 @@ description."
(defun org-contacts-remove-ignored-property-values (ignore-list list)
"Remove all ignore-list's elements from list and you can use
regular expressions in the ignore list."
- (cl-remove-if (lambda (el)
- (org-find-if (lambda (x)
- (string-match-p x el))
- ignore-list))
- list))
+ (cl-remove-if (lambda (el)
+ (org-find-if (lambda (x)
+ (string-match-p x el))
+ ignore-list))
+ list))
(defun org-contacts-complete-name (start end string)
"Complete text at START with a user name and email."
(let* ((completion-ignore-case org-contacts-completion-ignore-case)
(completion-list
- (loop for contact in (org-contacts-filter)
- ;; The contact name is always the car of the assoc-list
- ;; returned by `org-contacts-filter'.
- for contact-name = (car contact)
-
- ;; Build the list of the email addresses which has
- ;; been expired
- for ignore-list = (org-contacts-split-property
- (or (cdr (assoc-string
org-contacts-ignore-property
- (caddr contact))) ""))
- ;; Build the list of the user email addresses.
- for email-list = (org-contacts-remove-ignored-property-values
- ignore-list
- (org-contacts-split-property
- (or (cdr (assoc-string
org-contacts-email-property
- (caddr contact)))
"")))
- ;; If the user has email addresses…
- if email-list
- ;; … append a list of USER <EMAIL>.
- nconc (loop for email in email-list
- collect (org-contacts-format-email contact-name
(org-contacts-strip-link email)))))
+ (cl-loop for contact in (org-contacts-filter)
+ ;; The contact name is always the car of the assoc-list
+ ;; returned by `org-contacts-filter'.
+ for contact-name = (car contact)
+
+ ;; Build the list of the email addresses which has
+ ;; been expired
+ for ignore-list = (org-contacts-split-property
+ (or (cdr (assoc-string
org-contacts-ignore-property
+ (nth 2 contact)))
""))
+ ;; Build the list of the user email addresses.
+ for email-list = (org-contacts-remove-ignored-property-values
+ ignore-list
+ (org-contacts-split-property
+ (or (cdr (assoc-string
org-contacts-email-property
+ (nth 2 contact)))
"")))
+ ;; If the user has email addresses…
+ if email-list
+ ;; … append a list of USER <EMAIL>.
+ nconc (cl-loop for email in email-list
+ collect (org-contacts-format-email
contact-name (org-contacts-strip-link email)))))
(completion-list (org-contacts-all-completions-prefix
string
(org-uniquify completion-list))))
@@ -662,13 +660,13 @@ description."
(let* ((address (org-contacts-gnus-get-name-email))
(name (car address))
(email (cadr address)))
- (cadar (or (org-contacts-filter
- nil
- nil
- (cons org-contacts-email-property (concat "\\b" (regexp-quote
email) "\\b")))
- (when name
- (org-contacts-filter
- (concat "^" name "$")))))))
+ (cl-cadar (or (org-contacts-filter
+ nil
+ nil
+ (cons org-contacts-email-property (concat "\\b"
(regexp-quote email) "\\b")))
+ (when name
+ (org-contacts-filter
+ (concat "^" name "$")))))))
(defun org-contacts-gnus-article-from-goto ()
"Go to contact in the From address of current Gnus message."
@@ -698,23 +696,23 @@ Format is a string matching the following format
specification:
(let ((calendar-date-style 'american)
(entry ""))
(unless format (setq format org-contacts-birthday-format))
- (loop for contact in (org-contacts-filter)
- for anniv = (let ((anniv (cdr (assoc-string
- (or field
org-contacts-birthday-property)
- (caddr contact)))))
- (when anniv
- (calendar-gregorian-from-absolute
- (org-time-string-to-absolute anniv))))
- ;; Use `diary-anniversary' to compute anniversary.
- if (and anniv (apply 'diary-anniversary anniv))
- collect (format-spec format
- `((?l . ,(org-with-point-at (cadr contact)
(org-store-link nil)))
- (?h . ,(car contact))
- (?y . ,(- (calendar-extract-year date)
- (calendar-extract-year anniv)))
- (?Y . ,(let ((years (- (calendar-extract-year
date)
- (calendar-extract-year
anniv))))
- (format "%d%s" years
(diary-ordinal-suffix years)))))))))
+ (cl-loop for contact in (org-contacts-filter)
+ for anniv = (let ((anniv (cdr (assoc-string
+ (or field
org-contacts-birthday-property)
+ (nth 2 contact)))))
+ (when anniv
+ (calendar-gregorian-from-absolute
+ (org-time-string-to-absolute anniv))))
+ ;; Use `diary-anniversary' to compute anniversary.
+ if (and anniv (apply 'diary-anniversary anniv))
+ collect (format-spec format
+ `((?l . ,(org-with-point-at (cadr contact)
(org-store-link nil)))
+ (?h . ,(car contact))
+ (?y . ,(- (calendar-extract-year date)
+ (calendar-extract-year anniv)))
+ (?Y . ,(let ((years (-
(calendar-extract-year date)
+
(calendar-extract-year anniv))))
+ (format "%d%s" years
(diary-ordinal-suffix years)))))))))
(defun org-completing-read-date (prompt collection
&optional predicate require-match
initial-input
@@ -995,7 +993,7 @@ to do our best."
(defun org-contacts-vcard-format (contact)
"Formats CONTACT in VCard 3.0 format."
- (let* ((properties (caddr contact))
+ (let* ((properties (nth 2 contact))
(name (org-contacts-vcard-escape (car contact)))
(n (org-contacts-vcard-encode-name name))
(email (cdr (assoc-string org-contacts-email-property properties)))
@@ -1054,15 +1052,15 @@ passed to `org-contacts-export-as-vcard-internal'."
(interactive "P")
(when (called-interactively-p 'any)
(cl-psetf name
- (when name
- (read-string "Contact name: "
- (first (org-contacts-at-point))))
- file
- (when (equal name '(16))
- (read-file-name "File: " nil org-contacts-vcard-file))
- to-buffer
- (when (equal name '(64))
- (read-buffer "Buffer: "))))
+ (when name
+ (read-string "Contact name: "
+ (nth 0 (org-contacts-at-point))))
+ file
+ (when (equal name '(16))
+ (read-file-name "File: " nil org-contacts-vcard-file))
+ to-buffer
+ (when (equal name '(64))
+ (read-buffer "Buffer: "))))
(org-contacts-export-as-vcard-internal name file to-buffer))
(defun org-contacts-export-as-vcard-internal (&optional name file to-buffer)
@@ -1094,9 +1092,9 @@ Requires google-maps-el."
(error "`org-contacts-show-map' requires `google-maps-el'"))
(google-maps-static-show
:markers
- (loop
+ (cl-loop
for contact in (org-contacts-filter name)
- for addr = (cdr (assoc-string org-contacts-address-property (caddr
contact)))
+ for addr = (cdr (assoc-string org-contacts-address-property (nth 2
contact)))
if addr
collect (cons (list addr) (list :label (string-to-char (car contact)))))))
- [elpa] externals/org-contacts f6d87ee7f3 044/154: contrib/lisp/org-contacts.el: Fix compiler warnings., (continued)
- [elpa] externals/org-contacts f6d87ee7f3 044/154: contrib/lisp/org-contacts.el: Fix compiler warnings., ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts b789764458 047/154: contrib/lisp/*el: Fix license information and add "This file is not part...", ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 58afa03d8c 050/154: Let org-contacts.el has the ability which can export email-address list, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts ea8cbe4ca1 013/154: Fix copyright years for elisp files in core and contrib., ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts fb87d0eac0 032/154: contrib/lisp/org-contacts.el: Delete trailing whitespaces, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 43d2cdde45 057/154: contrib/lisp/org-contacts: Fix two typos in comments, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 271ec25b43 062/154: contrib/lisp/org-contacts.el: Permit to unload properly `org-contacts', ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 4d41ad256d 074/154: Merge branch 'maint', ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 36c6b30ec2 077/154: contrib/lisp/org-contacts.el: Add a hook to allow users to plug completion functions, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 2ec03e18b8 086/154: org-contacts: Fix org-contacts-matcher for BIRTHDAYs, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 33c5e0582c 085/154: contrib: move a few libraries to cl-lib in place of compile-time cl.,
ELPA Syncer <=
- [elpa] externals/org-contacts 27bec00a60 089/154: org-agenda: Remove unnecessary visibility modification, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts f07048b75d 092/154: Use `string-match-p' instead of `org-string-match-p', ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 4e3f139857 095/154: Fix function declarations, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts eedaff3498 103/154: org-contacts.el: Only use org-id-store-link if org-id is loaded, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 4540f987ec 111/154: Clean up some more headers, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts c98281fcfe 113/154: Remove compatibility code, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts c1d2b6dfbc 122/154: prototype of org-contacts contact complete, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 1991ef0ecd 106/154: Fix typo in 304fd01fe, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts 038a608e79 119/154: Fix AVATAR property value not exist problem, ELPA Syncer, 2022/09/09
- [elpa] externals/org-contacts abe24d6f34 137/154: Display company-mode doc buffer bellow current window, ELPA Syncer, 2022/09/09