ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lisp/ob.el
View File

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

121
lisp/org-bibtex.el
View File

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

5
lisp/org-compat.el
View File

@ -111,11 +111,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 ;;;; Emacs/XEmacs compatibility
;; Keys ;; Keys