forked from mirrors/org-mode
ox: Small refactoring
* lisp/ox.el (org-export--get-min-level): (org-export-install-filters): (org-export--generate-copy-script): (org-export-table-has-special-column-p): (org-export-table-row-is-special-p): (org-export-table-cell-borders): (org-export--dispatch-action): Use dolist instead of `mapc' + `lambda'.
This commit is contained in:
Nicolas Goaziou
parent
8048973bae
commit
47573133a6
214
lisp/ox.el
214
lisp/ox.el
|
|
@ -1686,14 +1686,12 @@ DATA is parsed tree as returned by `org-element-parse-buffer'.
|
|||
OPTIONS is a plist holding export options."
|
||||
(catch 'exit
|
||||
(let ((min-level 10000))
|
||||
(mapc
|
||||
(lambda (blob)
|
||||
(when (and (eq (org-element-type blob) 'headline)
|
||||
(not (org-element-property :footnote-section-p blob))
|
||||
(not (memq blob (plist-get options :ignore-list))))
|
||||
(setq min-level (min (org-element-property :level blob) min-level)))
|
||||
(when (= min-level 1) (throw 'exit 1)))
|
||||
(org-element-contents data))
|
||||
(dolist (datum (org-element-contents data))
|
||||
(when (and (eq (org-element-type datum) 'headline)
|
||||
(not (org-element-property :footnote-section-p datum))
|
||||
(not (memq datum (plist-get options :ignore-list))))
|
||||
(setq min-level (min (org-element-property :level datum) min-level))
|
||||
(when (= min-level 1) (throw 'exit 1))))
|
||||
;; If no headline was found, for the sake of consistency, set
|
||||
;; minimum level to 1 nonetheless.
|
||||
(if (= min-level 10000) 1 min-level))))
|
||||
|
|
@ -2473,29 +2471,27 @@ Return the updated communication channel."
|
|||
(let (plist)
|
||||
;; Install user-defined filters with `org-export-filters-alist'
|
||||
;; and filters already in INFO (through ext-plist mechanism).
|
||||
(mapc (lambda (p)
|
||||
(let* ((prop (car p))
|
||||
(info-value (plist-get info prop))
|
||||
(default-value (symbol-value (cdr p))))
|
||||
(setq plist
|
||||
(plist-put plist prop
|
||||
;; Filters in INFO will be called
|
||||
;; before those user provided.
|
||||
(append (if (listp info-value) info-value
|
||||
(list info-value))
|
||||
default-value)))))
|
||||
org-export-filters-alist)
|
||||
(dolist (p org-export-filters-alist)
|
||||
(let* ((prop (car p))
|
||||
(info-value (plist-get info prop))
|
||||
(default-value (symbol-value (cdr p))))
|
||||
(setq plist
|
||||
(plist-put plist prop
|
||||
;; Filters in INFO will be called
|
||||
;; before those user provided.
|
||||
(append (if (listp info-value) info-value
|
||||
(list info-value))
|
||||
default-value)))))
|
||||
;; Prepend back-end specific filters to that list.
|
||||
(mapc (lambda (p)
|
||||
;; Single values get consed, lists are appended.
|
||||
(let ((key (car p)) (value (cdr p)))
|
||||
(when value
|
||||
(setq plist
|
||||
(plist-put
|
||||
plist key
|
||||
(if (atom value) (cons value (plist-get plist key))
|
||||
(append value (plist-get plist key))))))))
|
||||
(org-export-get-all-filters (plist-get info :back-end)))
|
||||
(dolist (p (org-export-get-all-filters (plist-get info :back-end)))
|
||||
;; Single values get consed, lists are appended.
|
||||
(let ((key (car p)) (value (cdr p)))
|
||||
(when value
|
||||
(setq plist
|
||||
(plist-put
|
||||
plist key
|
||||
(if (atom value) (cons value (plist-get plist key))
|
||||
(append value (plist-get plist key))))))))
|
||||
;; Return new communication channel.
|
||||
(org-combine-plists info plist)))
|
||||
|
||||
|
|
@ -2608,17 +2604,14 @@ The function assumes BUFFER's major mode is `org-mode'."
|
|||
(goto-char ,(point))
|
||||
;; Overlays with invisible property.
|
||||
,@(let (ov-set)
|
||||
(mapc
|
||||
(lambda (ov)
|
||||
(let ((invis-prop (overlay-get ov 'invisible)))
|
||||
(when invis-prop
|
||||
(push `(overlay-put
|
||||
(make-overlay ,(overlay-start ov)
|
||||
,(overlay-end ov))
|
||||
'invisible (quote ,invis-prop))
|
||||
ov-set))))
|
||||
(overlays-in (point-min) (point-max)))
|
||||
ov-set)))))
|
||||
(dolist (ov (overlays-in (point-min) (point-max)) ov-set)
|
||||
(let ((invis-prop (overlay-get ov 'invisible)))
|
||||
(when invis-prop
|
||||
(push `(overlay-put
|
||||
(make-overlay ,(overlay-start ov)
|
||||
,(overlay-end ov))
|
||||
'invisible (quote ,invis-prop))
|
||||
ov-set)))))))))
|
||||
|
||||
(defun org-export--delete-comments ()
|
||||
"Delete commented areas in the buffer.
|
||||
|
|
@ -4534,16 +4527,14 @@ All special columns will be ignored during export."
|
|||
;; only empty cells as special.
|
||||
(let ((special-column-p 'empty))
|
||||
(catch 'exit
|
||||
(mapc
|
||||
(lambda (row)
|
||||
(when (eq (org-element-property :type row) 'standard)
|
||||
(let ((value (org-element-contents
|
||||
(car (org-element-contents row)))))
|
||||
(cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
|
||||
(setq special-column-p 'special))
|
||||
((not value))
|
||||
(t (throw 'exit nil))))))
|
||||
(org-element-contents table))
|
||||
(dolist (row (org-element-contents table))
|
||||
(when (eq (org-element-property :type row) 'standard)
|
||||
(let ((value (org-element-contents
|
||||
(car (org-element-contents row)))))
|
||||
(cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
|
||||
(setq special-column-p 'special))
|
||||
((not value))
|
||||
(t (throw 'exit nil))))))
|
||||
(eq special-column-p 'special))))
|
||||
|
||||
(defun org-export-table-has-header-p (table info)
|
||||
|
|
@ -4591,19 +4582,17 @@ All special rows will be ignored during export."
|
|||
;; ... it contains only alignment cookies and empty cells.
|
||||
(let ((special-row-p 'empty))
|
||||
(catch 'exit
|
||||
(mapc
|
||||
(lambda (cell)
|
||||
(let ((value (org-element-contents cell)))
|
||||
;; Since VALUE is a secondary string, the following
|
||||
;; checks avoid expanding it with `org-export-data'.
|
||||
(cond ((not value))
|
||||
((and (not (cdr value))
|
||||
(stringp (car value))
|
||||
(string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
|
||||
(car value)))
|
||||
(setq special-row-p 'cookie))
|
||||
(t (throw 'exit nil)))))
|
||||
(org-element-contents table-row))
|
||||
(dolist (cell (org-element-contents table-row))
|
||||
(let ((value (org-element-contents cell)))
|
||||
;; Since VALUE is a secondary string, the following
|
||||
;; checks avoid expanding it with `org-export-data'.
|
||||
(cond ((not value))
|
||||
((and (not (cdr value))
|
||||
(stringp (car value))
|
||||
(string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
|
||||
(car value)))
|
||||
(setq special-row-p 'cookie))
|
||||
(t (throw 'exit nil)))))
|
||||
(eq special-row-p 'cookie)))))))
|
||||
|
||||
(defun org-export-table-row-group (table-row info)
|
||||
|
|
@ -4766,14 +4755,13 @@ Returned borders ignore special rows."
|
|||
;; another regular row has to be found above that rule.
|
||||
(let (rule-flag)
|
||||
(catch 'exit
|
||||
(mapc (lambda (row)
|
||||
(cond ((eq (org-element-property :type row) 'rule)
|
||||
(setq rule-flag t))
|
||||
((not (org-export-table-row-is-special-p row info))
|
||||
(if rule-flag (throw 'exit (push 'above borders))
|
||||
(throw 'exit nil)))))
|
||||
;; Look at every row before the current one.
|
||||
(cdr (memq row (reverse (org-element-contents table)))))
|
||||
;; Look at every row before the current one.
|
||||
(dolist (row (cdr (memq row (reverse (org-element-contents table)))))
|
||||
(cond ((eq (org-element-property :type row) 'rule)
|
||||
(setq rule-flag t))
|
||||
((not (org-export-table-row-is-special-p row info))
|
||||
(if rule-flag (throw 'exit (push 'above borders))
|
||||
(throw 'exit nil)))))
|
||||
;; No rule above, or rule found starts the table (ignoring any
|
||||
;; special row): TABLE-CELL is at the top of the table.
|
||||
(when rule-flag (push 'above borders))
|
||||
|
|
@ -4782,14 +4770,13 @@ Returned borders ignore special rows."
|
|||
;; non-regular row below is a rule.
|
||||
(let (rule-flag)
|
||||
(catch 'exit
|
||||
(mapc (lambda (row)
|
||||
(cond ((eq (org-element-property :type row) 'rule)
|
||||
(setq rule-flag t))
|
||||
((not (org-export-table-row-is-special-p row info))
|
||||
(if rule-flag (throw 'exit (push 'below borders))
|
||||
(throw 'exit nil)))))
|
||||
;; Look at every row after the current one.
|
||||
(cdr (memq row (org-element-contents table))))
|
||||
;; Look at every row after the current one.
|
||||
(dolist (row (cdr (memq row (org-element-contents table))))
|
||||
(cond ((eq (org-element-property :type row) 'rule)
|
||||
(setq rule-flag t))
|
||||
((not (org-export-table-row-is-special-p row info))
|
||||
(if rule-flag (throw 'exit (push 'below borders))
|
||||
(throw 'exit nil)))))
|
||||
;; No rule below, or rule found ends the table (modulo some
|
||||
;; special row): TABLE-CELL is at the bottom of the table.
|
||||
(when rule-flag (push 'below borders))
|
||||
|
|
@ -4801,37 +4788,35 @@ Returned borders ignore special rows."
|
|||
(catch 'exit
|
||||
(let ((column (let ((cells (org-element-contents row)))
|
||||
(- (length cells) (length (memq table-cell cells))))))
|
||||
(mapc
|
||||
(lambda (row)
|
||||
(unless (eq (org-element-property :type row) 'rule)
|
||||
(when (equal (org-element-contents
|
||||
(car (org-element-contents row)))
|
||||
'("/"))
|
||||
(let ((column-groups
|
||||
(mapcar
|
||||
(lambda (cell)
|
||||
(let ((value (org-element-contents cell)))
|
||||
(when (member value '(("<") ("<>") (">") nil))
|
||||
(car value))))
|
||||
(org-element-contents row))))
|
||||
;; There's a left border when previous cell, if
|
||||
;; any, ends a group, or current one starts one.
|
||||
(when (or (and (not (zerop column))
|
||||
(member (elt column-groups (1- column))
|
||||
'(">" "<>")))
|
||||
(member (elt column-groups column) '("<" "<>")))
|
||||
(push 'left borders))
|
||||
;; There's a right border when next cell, if any,
|
||||
;; starts a group, or current one ends one.
|
||||
(when (or (and (/= (1+ column) (length column-groups))
|
||||
(member (elt column-groups (1+ column))
|
||||
'("<" "<>")))
|
||||
(member (elt column-groups column) '(">" "<>")))
|
||||
(push 'right borders))
|
||||
(throw 'exit nil)))))
|
||||
;; Table rows are read in reverse order so last column groups
|
||||
;; row has precedence over any previous one.
|
||||
(reverse (org-element-contents table)))))
|
||||
;; Table rows are read in reverse order so last column groups
|
||||
;; row has precedence over any previous one.
|
||||
(dolist (row (reverse (org-element-contents table)))
|
||||
(unless (eq (org-element-property :type row) 'rule)
|
||||
(when (equal (org-element-contents
|
||||
(car (org-element-contents row)))
|
||||
'("/"))
|
||||
(let ((column-groups
|
||||
(mapcar
|
||||
(lambda (cell)
|
||||
(let ((value (org-element-contents cell)))
|
||||
(when (member value '(("<") ("<>") (">") nil))
|
||||
(car value))))
|
||||
(org-element-contents row))))
|
||||
;; There's a left border when previous cell, if
|
||||
;; any, ends a group, or current one starts one.
|
||||
(when (or (and (not (zerop column))
|
||||
(member (elt column-groups (1- column))
|
||||
'(">" "<>")))
|
||||
(member (elt column-groups column) '("<" "<>")))
|
||||
(push 'left borders))
|
||||
;; There's a right border when next cell, if any,
|
||||
;; starts a group, or current one ends one.
|
||||
(when (or (and (/= (1+ column) (length column-groups))
|
||||
(member (elt column-groups (1+ column))
|
||||
'("<" "<>")))
|
||||
(member (elt column-groups column) '(">" "<>")))
|
||||
(push 'right borders))
|
||||
(throw 'exit nil)))))))
|
||||
;; Return value.
|
||||
borders))
|
||||
|
||||
|
|
@ -6464,10 +6449,9 @@ options as CDR."
|
|||
;; path. Indeed, derived backends can share the same
|
||||
;; FIRST-KEY.
|
||||
(t (catch 'found
|
||||
(mapc (lambda (entry)
|
||||
(let ((match (assq key (nth 2 entry))))
|
||||
(when match (throw 'found (nth 2 match)))))
|
||||
(member (assq first-key entries) entries)))))
|
||||
(dolist (entry (member (assq first-key entries) entries))
|
||||
(let ((match (assq key (nth 2 entry))))
|
||||
(when match (throw 'found (nth 2 match))))))))
|
||||
options))
|
||||
;; Otherwise, enter sub-menu.
|
||||
(t (org-export--dispatch-ui options key expertp)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue