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

This reverts commit 9d4e1517b6.
This commit is contained in:
Eric Schulte 2012-08-13 08:17:46 -06:00
parent 9d4e1517b6
commit 37e19ea2d0
3 changed files with 55 additions and 49 deletions

View File

@ -1025,37 +1025,38 @@ the current subtree."
(setf (nth 2 info)
(sort (copy-sequence (nth 2 info))
(lambda (a b) (string< (car a) (car b)))))
(letrec ((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)))))))
(let* ((it (format "%s-%s"
(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 ((n (funcall norm arg)))
(when n (format "%S" n))))
(let ((normalized (norm arg)))
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
(nth 1 info)))
(hash (sha1 it)))
(when (org-called-interactively-p 'interactive) (message hash)) hash))))
(nth 1 info))))
(sha1 it))))))
(defun org-babel-current-result-hash ()
"Return the current in-buffer hash."
@ -2223,12 +2224,12 @@ 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
(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")))

View File

@ -310,15 +310,15 @@ 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)))))
(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))
@ -342,8 +342,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
org-bibtex-prefix)
(mapcar
(lambda (kv)
(let ((key (car kv))
(val (cdr kv)))
(let ((key (car kv)) (val (cdr kv)))
(when (and
(string-match org-bibtex-prefix key)
(not (string=
@ -356,13 +355,13 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
(org-entry-properties nil 'standard))
(mapcar
(lambda (field)
(let ((value (or (org-bibtex-get (funcall from field))
(let ((value (or (org-bibtex-get (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))))))
(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)

View File

@ -110,6 +110,12 @@ any other entries, and any resulting duplicates will be removed entirely."
t))
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