mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-12-29 11:02:33 +00:00
Replace org-labels' by let*'
* ob.el (org-babel-sha1-hash, org-babel-noweb-p): Replace `org-labels' by `let*'. * org-bibtex.el (org-bibtex-headline): Ditto. * org-compat.el: Delete `org-labels'.
This commit is contained in:
Bastien Guerry
parent
7f6a127e46
commit
b62604236d
63
lisp/ob.el
63
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)))))
|
||||
(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))) ":")
|
||||
@ -2224,16 +2224,17 @@ 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)) "")))))
|
||||
(let* (intersect
|
||||
(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.
|
||||
|
||||
@ -310,68 +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."
|
||||
(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))
|
||||
(let* ((val (lambda (key lst) (cdr (assoc key lst))))
|
||||
(to (lambda (string) (intern (concat ":" string))))
|
||||
(from (lambda (key) (substring (symbol-name key) 1)))
|
||||
flatten ; silent compiler warning
|
||||
(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)) (val0 (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))
|
||||
val0))))
|
||||
(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)
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user