Browse Source

Revert "Don't use `org-labels'"

This reverts commit ba16c3c6f50738b070769040586945436439be76.
Bastien Guerry 12 years ago
parent
commit
525e96a97e
3 changed files with 97 additions and 91 deletions
  1. 31 31
      lisp/ob.el
  2. 61 60
      lisp/org-bibtex.el
  3. 5 0
      lisp/org-compat.el

+ 31 - 31
lisp/ob.el

@@ -1025,33 +1025,33 @@ the current subtree."
     (setf (nth 2 info)
 	  (sort (copy-sequence (nth 2 info))
 		(lambda (a b) (string< (car a) (car b)))))
-    (let* ((rm (lambda (lst)
-		 (dolist (p '("replace" "silent" "append" "prepend"))
-		   (setq lst (remove p lst)))
-		 lst))
-	   (norm (lambda (arg)
-		   (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
-				(copy-sequence (cdr arg))
-			      (cdr arg))))
-		     (when (and v (not (and (sequencep v)
-					    (not (consp v))
-					    (= (length v) 0))))
-		       (cond
-			((and (listp v) ; lists are sorted
-			      (member (car arg) '(:result-params)))
-			 (sort (funcall rm v) #'string<))
-			((and (stringp v) ; strings are sorted
-			      (member (car arg) '(:results :exports)))
-			 (mapconcat #'identity (sort (funcall rm (split-string v))
-						     #'string<) " "))
-			(t v)))))))
+    (org-labels ((rm (lst)
+		     (dolist (p '("replace" "silent" "append" "prepend"))
+		       (setq lst (remove p lst)))
+		     lst)
+		 (norm (arg)
+		       (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
+				    (copy-sequence (cdr arg))
+				  (cdr arg))))
+			 (when (and v (not (and (sequencep v)
+						(not (consp v))
+						(= (length v) 0))))
+			   (cond
+			    ((and (listp v) ; lists are sorted
+				  (member (car arg) '(:result-params)))
+			     (sort (rm v) #'string<))
+			    ((and (stringp v) ; strings are sorted
+				  (member (car arg) '(:results :exports)))
+			     (mapconcat #'identity (sort (rm (split-string v))
+							 #'string<) " "))
+			    (t v))))))
       ((lambda (hash)
 	 (when (org-called-interactively-p 'interactive) (message hash)) hash)
        (let ((it (format "%s-%s"
 			 (mapconcat
 			  #'identity
 			  (delq nil (mapcar (lambda (arg)
-					      (let ((normalized (funcall norm arg)))
+					      (let ((normalized (norm arg)))
 						(when normalized
 						  (format "%S" normalized))))
 					    (nth 2 info))) ":")
@@ -2224,16 +2224,16 @@ header argument from buffer or subtree wide properties.")
 (defun org-babel-noweb-p (params context)
   "Check if PARAMS require expansion in CONTEXT.
 CONTEXT may be one of :tangle, :export or :eval."
-  (letrec ((intersect (lambda (as bs)
-			(when as
-			  (if (member (car as) bs)
-			      (car as)
-			    (funcall intersect (cdr as) bs))))))
-    (funcall intersect (case context
-			 (:tangle '("yes" "tangle" "no-export" "strip-export"))
-			 (:eval   '("yes" "no-export" "strip-export" "eval"))
-			 (:export '("yes")))
-	     (split-string (or (cdr (assoc :noweb params)) "")))))
+  (org-labels ((intersect (as bs)
+			  (when as
+			    (if (member (car as) bs)
+				(car as)
+			      (intersect (cdr as) bs)))))
+    (intersect (case context
+		 (:tangle '("yes" "tangle" "no-export" "strip-export"))
+		 (:eval   '("yes" "no-export" "strip-export" "eval"))
+		 (:export '("yes")))
+	       (split-string (or (cdr (assoc :noweb params)) "")))))
 
 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
   "Expand Noweb references in the body of the current source code block.

+ 61 - 60
lisp/org-bibtex.el

@@ -310,67 +310,68 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
 
 (defun org-bibtex-headline ()
   "Return a bibtex entry of the given headline as a string."
-  (letrec ((val (lambda (key lst) (cdr (assoc key lst))))
-	   (to (lambda (string) (intern (concat ":" string))))
-	   (from (lambda (key) (substring (symbol-name key) 1)))
-	   (flatten (lambda (&rest lsts)
-		      (apply #'append (mapcar
-				       (lambda (e)
-					 (if (listp e) (apply flatten e) (list e)))
-				       lsts))))
-	   (notes (buffer-string))
-	   (id (org-bibtex-get org-bibtex-key-property))
-	   (type (org-bibtex-get org-bibtex-type-property-name))
-	   (tags (when org-bibtex-tags-are-keywords
-		   (delq nil
-			 (mapcar
-			  (lambda (tag)
-			    (unless (member tag
-					    (append org-bibtex-tags
-						    org-bibtex-no-export-tags))
-			      tag))
-			  (org-get-local-tags-at))))))
-    (when type
-      (let ((entry (format
-		    "@%s{%s,\n%s\n}\n" type id
-		    (mapconcat
-		     (lambda (pair)
-		       (format "  %s={%s}" (car pair) (cdr pair)))
-		     (remove nil
-			     (if (and org-bibtex-export-arbitrary-fields
-				      org-bibtex-prefix)
+  (org-labels
+      ((val (key lst) (cdr (assoc key lst)))
+       (to (string) (intern (concat ":" string)))
+       (from (key) (substring (symbol-name key) 1))
+       (flatten (&rest lsts)
+		(apply #'append (mapcar
+				 (lambda (e)
+				   (if (listp e) (apply #'flatten e) (list e)))
+				 lsts))))
+    (let ((notes (buffer-string))
+          (id (org-bibtex-get org-bibtex-key-property))
+          (type (org-bibtex-get org-bibtex-type-property-name))
+	  (tags (when org-bibtex-tags-are-keywords
+		  (delq nil
+			(mapcar
+			 (lambda (tag)
+			   (unless (member tag
+					   (append org-bibtex-tags
+						   org-bibtex-no-export-tags))
+			     tag))
+			 (org-get-local-tags-at))))))
+      (when type
+        (let ((entry (format
+                      "@%s{%s,\n%s\n}\n" type id
+                      (mapconcat
+                       (lambda (pair)
+			 (format "  %s={%s}" (car pair) (cdr pair)))
+                       (remove nil
+			       (if (and org-bibtex-export-arbitrary-fields
+					org-bibtex-prefix)
+				   (mapcar
+				    (lambda (kv)
+				      (let ((key (car kv)) (val (cdr kv)))
+					(when (and
+					       (string-match org-bibtex-prefix key)
+					       (not (string=
+						     (downcase (concat org-bibtex-prefix
+								       org-bibtex-type-property-name))
+						     (downcase key))))
+					  (cons (downcase (replace-regexp-in-string
+							   org-bibtex-prefix "" key))
+						val))))
+				    (org-entry-properties nil 'standard))
 				 (mapcar
-				  (lambda (kv)
-				    (let ((key (car kv)) (val (cdr kv)))
-				      (when (and
-					     (string-match org-bibtex-prefix key)
-					     (not (string=
-						   (downcase (concat org-bibtex-prefix
-								     org-bibtex-type-property-name))
-						   (downcase key))))
-					(cons (downcase (replace-regexp-in-string
-							 org-bibtex-prefix "" key))
-					      val))))
-				  (org-entry-properties nil 'standard))
-			       (mapcar
-				(lambda (field)
-				  (let ((value (or (org-bibtex-get (funcall from field))
-						   (and (equal :title field)
-							(nth 4 (org-heading-components))))))
-				    (when value (cons (funcall from field) value))))
-				(funcall flatten
-					 (funcall val :required (funcall val (funcall to type) org-bibtex-types))
-					 (funcall val :optional (funcall val (funcall to type) org-bibtex-types))))))
-		     ",\n"))))
-	(with-temp-buffer
-	  (insert entry)
-	  (when tags
-	    (bibtex-beginning-of-entry)
-	    (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
-		(progn (goto-char (match-end 1)) (insert ", "))
-	      (bibtex-make-field "keywords" t t))
-	    (insert (mapconcat #'identity tags ", ")))
-	  (buffer-string))))))
+				  (lambda (field)
+				    (let ((value (or (org-bibtex-get (from field))
+						     (and (equal :title field)
+							  (nth 4 (org-heading-components))))))
+				      (when value (cons (from field) value))))
+				  (flatten
+				   (val :required (val (to type) org-bibtex-types))
+				   (val :optional (val (to type) org-bibtex-types))))))
+                       ",\n"))))
+          (with-temp-buffer
+            (insert entry)
+	    (when tags
+	      (bibtex-beginning-of-entry)
+	      (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
+	    	  (progn (goto-char (match-end 1)) (insert ", "))
+	    	(bibtex-make-field "keywords" t t))
+	      (insert (mapconcat #'identity tags ", ")))
+            (buffer-string)))))))
 
 (defun org-bibtex-ask (field)
   (unless (assoc field org-bibtex-fields)

+ 5 - 0
lisp/org-compat.el

@@ -111,6 +111,11 @@ any other entries, and any resulting duplicates will be removed entirely."
       t)))
 
 
+;;; cl macros no longer available in the trunk
+(defalias 'org-labels (if (org-version-check "24.1.50" "cl" :predicate)
+			  'cl-labels
+			'labels))
+
 ;;;; Emacs/XEmacs compatibility
 
 ;; Keys