Don't use `org-labels'

* org-compat.el (org-labels): Remove.

* org-bibtex.el (org-bibtex-headline): Don't use `org-labels'.

* ob.el (org-babel-sha1-hash, org-babel-noweb-p): Ditto.
This commit is contained in:
Bastien Guerry 2012-08-11 10:43:56 +02:00
parent ae21293a2e
commit ba16c3c6f5
3 changed files with 91 additions and 97 deletions

View File

@ -1024,33 +1024,33 @@ the current subtree."
(setf (nth 2 info)
(sort (copy-sequence (nth 2 info))
(lambda (a b) (string< (car a) (car b)))))
(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))))))
(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)))))))
((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 (norm arg)))
(let ((normalized (funcall norm arg)))
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
@ -2223,16 +2223,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."
(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)) "")))))
(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)) "")))))
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.

View File

@ -309,68 +309,67 @@ 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."
(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))
(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)
(mapcar
(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)))))))
(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))))))
(defun org-bibtex-ask (field)
(unless (assoc field org-bibtex-fields)

View File

@ -111,11 +111,6 @@ 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