contrib: move a few libraries to cl-lib in place of compile-time cl.
Specifically ob-julia, ob-stata, org-contacts, ox-bibtex.
This commit is contained in:
Aaron Ecay
parent
3fa42fb53f
commit
33c5e0582c
1 changed files with 170 additions and 172 deletions
|
|
@ -52,9 +52,7 @@
|
|||
;;
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'org)
|
||||
(require 'gnus-util)
|
||||
(require 'gnus-art)
|
||||
|
|
@ -316,7 +314,7 @@ cell corresponding to the contact properties.
|
|||
(null prop-match)
|
||||
(null tags-match))
|
||||
(org-contacts-db)
|
||||
(loop for contact in (org-contacts-db)
|
||||
(cl-loop for contact in (org-contacts-db)
|
||||
if (or
|
||||
(and name-match
|
||||
(org-string-match-p name-match
|
||||
|
|
@ -344,7 +342,7 @@ 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))
|
||||
(cl-loop with regexp = (concat "\\b" (regexp-quote to-match))
|
||||
with ret = nil
|
||||
with ret-start = nil
|
||||
with ret-end = nil
|
||||
|
|
@ -359,8 +357,8 @@ prefixes rather than just the beginning of the string."
|
|||
do (let ((end (match-end 0))
|
||||
(len (length string)))
|
||||
(if (= end len)
|
||||
(return t)
|
||||
(destructuring-bind (string start end)
|
||||
(cl-return t)
|
||||
(cl-destructuring-bind (string start end)
|
||||
(if (null ret)
|
||||
(values string start end)
|
||||
(org-contacts-common-substring
|
||||
|
|
@ -370,7 +368,7 @@ prefixes rather than just the beginning of the string."
|
|||
ret-start start
|
||||
ret-end end))))
|
||||
|
||||
finally (return
|
||||
finally (cl-return
|
||||
(replace-regexp-in-string "\\`[ \t\n]*" "" ret))))
|
||||
|
||||
(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional ignore-case)
|
||||
|
|
@ -430,7 +428,7 @@ 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))
|
||||
(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)))
|
||||
|
|
@ -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,7 +469,7 @@ 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))
|
||||
(cl-loop with len = (1- (length string))
|
||||
for i upfrom 0 to len
|
||||
if (memq 'org-contacts-prefix
|
||||
(text-properties-at i string))
|
||||
|
|
@ -485,7 +483,7 @@ prefixes rather than just the beginning of the string."
|
|||
'bold)) string)
|
||||
else
|
||||
do (set-text-properties i (1+ i) nil string)
|
||||
finally (return string)))
|
||||
finally (cl-return string)))
|
||||
completions))
|
||||
|
||||
(defun org-contacts-test-completion-prefix (string collection predicate)
|
||||
|
|
@ -520,7 +518,7 @@ 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)
|
||||
(cl-loop for contact in (org-contacts-filter)
|
||||
nconc (org-split-string
|
||||
(or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))))))
|
||||
(list start end
|
||||
|
|
@ -530,7 +528,7 @@ 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
|
||||
(cl-loop for contact in (org-contacts-filter
|
||||
nil
|
||||
tag)
|
||||
;; The contact name is always the car of the assoc-list
|
||||
|
|
@ -541,7 +539,7 @@ A group FOO is composed of contacts with the tag FOO."
|
|||
(or (car (org-contacts-split-property
|
||||
(or
|
||||
(cdr (assoc-string org-contacts-email-property
|
||||
(caddr contact)))
|
||||
(cl-caddr contact)))
|
||||
""))) ""))
|
||||
;; If the user has an email address, append USER <EMAIL>.
|
||||
if email collect (org-contacts-format-email contact-name email))
|
||||
|
|
@ -565,23 +563,23 @@ description."
|
|||
(let ((result
|
||||
(mapconcat
|
||||
'identity
|
||||
(loop for contact in (org-contacts-db)
|
||||
(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
|
||||
(caddr contact)))
|
||||
(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 = (second contact)
|
||||
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 (subseq string 1)))))))
|
||||
(eval (cdr (org-make-tags-matcher (cl-subseq string 1)))))))
|
||||
collect (org-contacts-format-email contact-name email))
|
||||
",")))
|
||||
(when (not (string= "" result))
|
||||
|
|
@ -603,7 +601,7 @@ description."
|
|||
"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)
|
||||
(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)
|
||||
|
|
@ -612,17 +610,17 @@ description."
|
|||
;; been expired
|
||||
for ignore-list = (org-contacts-split-property
|
||||
(or (cdr (assoc-string org-contacts-ignore-property
|
||||
(caddr contact))) ""))
|
||||
(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
|
||||
(caddr contact))) "")))
|
||||
(nth 2 contact))) "")))
|
||||
;; If the user has email addresses…
|
||||
if email-list
|
||||
;; … append a list of USER <EMAIL>.
|
||||
nconc (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)))))
|
||||
(completion-list (org-contacts-all-completions-prefix
|
||||
string
|
||||
|
|
@ -662,7 +660,7 @@ description."
|
|||
(let* ((address (org-contacts-gnus-get-name-email))
|
||||
(name (car address))
|
||||
(email (cadr address)))
|
||||
(cadar (or (org-contacts-filter
|
||||
(cl-cadar (or (org-contacts-filter
|
||||
nil
|
||||
nil
|
||||
(cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b")))
|
||||
|
|
@ -698,10 +696,10 @@ 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)
|
||||
(cl-loop for contact in (org-contacts-filter)
|
||||
for anniv = (let ((anniv (cdr (assoc-string
|
||||
(or field org-contacts-birthday-property)
|
||||
(caddr contact)))))
|
||||
(nth 2 contact)))))
|
||||
(when anniv
|
||||
(calendar-gregorian-from-absolute
|
||||
(org-time-string-to-absolute anniv))))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -1056,7 +1054,7 @@ passed to `org-contacts-export-as-vcard-internal'."
|
|||
(cl-psetf name
|
||||
(when name
|
||||
(read-string "Contact name: "
|
||||
(first (org-contacts-at-point))))
|
||||
(nth 0 (org-contacts-at-point))))
|
||||
file
|
||||
(when (equal name '(16))
|
||||
(read-file-name "File: " nil org-contacts-vcard-file))
|
||||
|
|
@ -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)))))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue