diff --git a/lisp/ox.el b/lisp/ox.el index 4d5d838db..d78e29c89 100644 --- a/lisp/ox.el +++ b/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)))))