contrib: move a few libraries to cl-lib in place of compile-time cl.

Specifically ob-julia, ob-stata, org-contacts, ox-bibtex.

contrib/lisp/ob-julia.el

@@ -30,7 +30,7 @@
 
 ;;; Code:
 (require 'ob)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
 
 (declare-function orgtbl-to-csv "org-table" (table params))
 (declare-function julia "ext:ess-julia" (&optional start-args))
@@ -228,7 +228,7 @@ current code buffer."
 If RESULT-TYPE equals 'output then return standard output as a
 string.  If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
-  (case result-type
+  (cl-case result-type
     (value
      (let ((tmp-file (org-babel-temp-file "julia-")))
        (org-babel-eval org-babel-julia-command
@@ -250,7 +250,7 @@ last statement in BODY, as elisp."
 If RESULT-TYPE equals 'output then return standard output as a
 string.  If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
-  (case result-type
+  (cl-case result-type
     (value
      (with-temp-buffer
        (insert (org-babel-chomp body))

contrib/lisp/ob-stata.el

@@ -42,7 +42,7 @@
 
 ;;; Code:
 (require 'ob)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
 
 (declare-function orgtbl-to-csv "org-table" (table params))
 (declare-function stata "ext:ess-stata" (&optional start-args))
@@ -239,7 +239,7 @@ current code buffer."
 If RESULT-TYPE equals 'output then return standard output as a
 string.  If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
-  (case result-type
+  (cl-case result-type
     (value
      (let ((tmp-file (org-babel-temp-file "stata-")))
        (org-babel-eval org-babel-stata-command
@@ -261,7 +261,7 @@ last statement in BODY, as elisp."
 If RESULT-TYPE equals 'output then return standard output as a
 string.  If RESULT-TYPE equals 'value then return the value of the
 last statement in BODY, as elisp."
-  (case result-type
+  (cl-case result-type
     (value
      (with-temp-buffer
        (insert (org-babel-chomp body))

contrib/lisp/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)))))))
 

contrib/lisp/ox-bibtex.el

@@ -92,7 +92,7 @@
 
 ;; Initialization
 
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
 
 ;;; Internal Functions
 
@@ -136,7 +136,7 @@ contains a list of strings to be passed as options to
 
 (defun org-bibtex-citation-p (object)
   "Non-nil when OBJECT is a citation."
-  (case (org-element-type object)
+  (cl-case (org-element-type object)
     (link (equal (org-element-property :type object) "cite"))
     (latex-fragment
      (string-match "\\`\\\\cite{" (org-element-property :value object)))))