1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-28 07:44:49 +00:00

Don't use `org-labels'

Reworking the previous commit which attempted to remove 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:
Eric Schulte 2012-08-13 07:42:17 -06:00
parent d59acaa632
commit 9d4e1517b6
3 changed files with 49 additions and 55 deletions

View File

@ -1025,38 +1025,37 @@ 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))))))
((lambda (hash)
(when (org-called-interactively-p 'interactive) (message hash)) hash)
(let ((it (format "%s-%s"
(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"
(mapconcat
#'identity
(delq nil (mapcar (lambda (arg)
(let ((normalized (norm arg)))
(when normalized
(format "%S" normalized))))
(let ((n (funcall norm arg)))
(when n (format "%S" n))))
(nth 2 info))) ":")
(nth 1 info))))
(sha1 it))))))
(nth 1 info)))
(hash (sha1 it)))
(when (org-called-interactively-p 'interactive) (message hash)) hash))))
(defun org-babel-current-result-hash ()
"Return the current in-buffer hash."
@ -2224,12 +2223,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."
(org-labels ((intersect (as bs)
(when as
(if (member (car as) bs)
(car as)
(intersect (cdr as) bs)))))
(intersect (case context
(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")))

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."
(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))))
(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)))))
(let ((notes (buffer-string))
(id (org-bibtex-get org-bibtex-key-property))
(type (org-bibtex-get org-bibtex-type-property-name))
@ -342,7 +342,8 @@ 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=
@ -355,13 +356,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 (from field))
(let ((value (or (org-bibtex-get (funcall 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))))))
(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)

View File

@ -110,12 +110,6 @@ 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