Rewrite C-c C-c using Elements

* lisp/org.el (org-ctrl-c-ctrl-c): Rewrite function using Elements.
This commit is contained in:
Nicolas Goaziou 2013-01-16 17:39:48 +01:00
parent 13e49a6385
commit 60083a5edb
1 changed files with 137 additions and 130 deletions

View File

@ -19538,136 +19538,143 @@ This command does many different things, depending on context:
evaluation requires confirmation. Code block evaluation can be evaluation requires confirmation. Code block evaluation can be
inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
(interactive "P") (interactive "P")
(let ((org-enable-table-editor t)) (cond
(cond ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
((or (and (boundp 'org-clock-overlays) org-clock-overlays) org-occur-highlights
org-occur-highlights org-latex-fragment-image-overlays)
org-latex-fragment-image-overlays) (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
(and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) (org-remove-occur-highlights)
(org-remove-occur-highlights) (org-remove-latex-fragment-image-overlays)
(org-remove-latex-fragment-image-overlays) (message "Temporary highlights/overlays removed from current buffer"))
(message "Temporary highlights/overlays removed from current buffer")) ((and (local-variable-p 'org-finish-function (current-buffer))
((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function))
(fboundp org-finish-function)) (funcall org-finish-function))
(funcall org-finish-function)) ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) (t
((org-in-regexp org-ts-regexp-both) (let* ((context (org-element-context)) (type (org-element-type context)))
(org-timestamp-change 0 'day)) ;; Test if point is within blanks at the end of an element.
((or (looking-at org-property-start-re) (if (save-excursion
(org-at-property-p)) (or (not context)
(call-interactively 'org-property-action)) (beginning-of-line)
((org-at-target-p) (call-interactively 'org-update-radio-target-regexp)) (and (looking-at "[ \t]*$")
((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]") (skip-chars-forward " \r\t\n")
(or (org-at-heading-p) (org-at-item-p))) (>= (point) (org-element-property :end context)))))
(call-interactively 'org-update-statistics-cookies)) (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
((org-at-heading-p) (call-interactively 'org-set-tags)) (user-error "C-c C-c can do nothing useful at this location"))
((org-at-table.el-p) (case type
(message "Use C-c ' to edit table.el tables")) (clock (org-clock-update-time-maybe))
((org-at-table-p) (dynamic-block
(org-table-maybe-eval-formula) (save-excursion
(if arg (goto-char (org-element-property :post-affiliated context))
(call-interactively 'org-table-recalculate) (org-update-dblock)))
(org-table-maybe-recalculate-line)) ((footnote-definition footnote-reference)
(call-interactively 'org-table-align) (call-interactively 'org-footnote-action))
(orgtbl-send-table 'maybe)) ((headline inlinetask)
((or (org-footnote-at-reference-p) (save-excursion (goto-char (org-element-property :begin context))
(org-footnote-at-definition-p)) (call-interactively 'org-set-tags)))
(call-interactively 'org-footnote-action)) (item
((org-at-item-checkbox-p) ;; At an item: a double C-u set checkbox to "[-]"
;; Cursor at a checkbox: repair list and update checkboxes. Send ;; unconditionally, whereas a single one will toggle its
;; list only if at top item. ;; presence. Without an universal argument, if the item
(let* ((cbox (match-string 1)) ;; has a checkbox, toggle it. Otherwise repair the list.
(struct (org-list-struct)) (let* ((box (org-element-property :checkbox context))
(old-struct (copy-tree struct)) (struct (org-element-property :structure context))
(parents (org-list-parents-alist struct)) (old-struct (copy-tree struct))
(orderedp (org-entry-get nil "ORDERED")) (parents (org-list-parents-alist struct))
(firstp (= (org-list-get-top-point struct) (point-at-bol))) (prevs (org-list-prevs-alist struct))
block-item) (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
;; Use a light version of `org-toggle-checkbox' to avoid (org-list-set-checkbox
;; computing list structure twice. (org-element-property :begin context) struct
(let ((new-box (cond (cond ((equal arg '(16)) "[-]")
((equal arg '(16)) "[-]") ((and (not box) (equal arg '(4))) "[ ]")
((equal arg '(4)) nil) ((or (not box) (equal arg '(4))) nil)
((equal "[X]" cbox) "[ ]") ((eq box 'on) "[ ]")
(t "[X]")))) (t "[X]")))
(if (and firstp arg) ;; Mimic `org-list-write-struct' but with grabbing
;; If at first item of sub-list, remove check-box from ;; a return value from `org-list-struct-fix-box'.
;; every item at the same level. (org-list-struct-fix-ind struct parents 2)
(mapc (org-list-struct-fix-item-end struct)
(lambda (pos) (org-list-set-checkbox pos struct new-box)) (org-list-struct-fix-bul struct prevs)
(org-list-get-all-items (org-list-struct-fix-ind struct parents)
(point-at-bol) struct (org-list-prevs-alist struct))) (let ((block-item
(org-list-set-checkbox (point-at-bol) struct new-box))) (org-list-struct-fix-box struct parents prevs orderedp)))
;; Replicate `org-list-write-struct', while grabbing a return (if (and box (equal struct old-struct))
;; value from `org-list-struct-fix-box'. (user-error "Cannot toggle this checkbox (empty subitems?)")
(org-list-struct-fix-ind struct parents 2) (org-list-struct-apply-struct struct old-struct)
(org-list-struct-fix-item-end struct) (org-update-checkbox-count-maybe))
(let ((prevs (org-list-prevs-alist struct))) (when block-item
(org-list-struct-fix-bul struct prevs) (message "Checkboxes were removed due to empty box at line %d"
(org-list-struct-fix-ind struct parents) (org-current-line block-item))))))
(setq block-item (keyword
(org-list-struct-fix-box struct parents prevs orderedp))) (let ((org-inhibit-startup-visibility-stuff t)
(if (equal struct old-struct) (org-startup-align-all-tables nil))
(user-error "Cannot toggle this checkbox (unchecked subitems?)") (when (boundp 'org-table-coordinate-overlays)
(org-list-struct-apply-struct struct old-struct) (mapc 'delete-overlay org-table-coordinate-overlays)
(org-update-checkbox-count-maybe)) (setq org-table-coordinate-overlays nil))
(when block-item (org-save-outline-visibility 'use-markers (org-mode-restart)))
(message (message "Local setup has been refreshed"))
"Checkboxes were removed due to unchecked box at line %d" (plain-list
(org-current-line block-item))) ;; At a plain list, with a double C-u argument, set
(when firstp (org-list-send-list 'maybe)))) ;; checkboxes of each item to "[-]", whereas a single one
((org-at-item-p) ;; will toggle their presence according to the state of the
;; Cursor at an item: repair list. Do checkbox related actions ;; first item in the list. Without an argument, repair the
;; only if function was called with an argument. Send list only ;; list.
;; if at top item. (let* ((begin (org-element-property :contents-begin context))
(let* ((struct (org-list-struct)) (struct (org-element-property :structure context))
(firstp (= (org-list-get-top-point struct) (point-at-bol))) (old-struct (copy-tree struct))
old-struct) (first-box (save-excursion
(when arg (goto-char begin)
(setq old-struct (copy-tree struct)) (looking-at org-list-full-item-re)
(if firstp (match-string-no-properties 3)))
;; If at first item of sub-list, add check-box to every (new-box (cond ((equal arg '(16)) "[-]")
;; item at the same level. ((equal arg '(4)) (unless first-box "[ ]"))
(mapc ((equal first-box "[X]") "[ ]")
(lambda (pos) (t "[X]"))))
(unless (org-list-get-checkbox pos struct) (cond
(org-list-set-checkbox pos struct "[ ]"))) (arg
(org-list-get-all-items (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box))
(point-at-bol) struct (org-list-prevs-alist struct))) (org-list-get-all-items
(org-list-set-checkbox (point-at-bol) struct "[ ]"))) begin struct (org-list-prevs-alist struct))))
(org-list-write-struct ((and first-box (eq (point) begin))
struct (org-list-parents-alist struct) old-struct) ;; For convenience, when point is at bol on the first
(when arg (org-update-checkbox-count-maybe)) ;; item of the list and no argument is provided, simply
(when firstp (org-list-send-list 'maybe)))) ;; toggle checkbox of that item, if any.
((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) (org-list-set-checkbox begin struct new-box)))
;; Dynamic block (org-list-write-struct
(beginning-of-line 1) struct (org-list-parents-alist struct) old-struct)
(save-excursion (org-update-dblock))) (org-update-checkbox-count-maybe))
((save-excursion (org-list-send-list 'maybe))
(let ((case-fold-search t)) ((property-drawer node-property)
(beginning-of-line 1) (call-interactively 'org-property-action))
(looking-at "[ \t]*#\\+\\([a-z]+\\)"))) ((radio-target target)
(cond (call-interactively 'org-update-radio-target-regexp))
((or (equal (match-string 1) "TBLFM") (statistics-cookie
(equal (match-string 1) "tblfm")) (call-interactively 'org-update-statistics-cookies))
;; Recalculate the table before this line ((table table-cell table-row)
(save-excursion ;; At a table, recalculate every field and align it. Also
(beginning-of-line 1) ;; send the table if necessary. If the table has
(skip-chars-backward " \r\n\t") ;; a `table.el' type, just give up. At a table row or
(if (org-at-table-p) ;; cell, maybe recalculate line but always align table.
(org-call-with-arg 'org-table-recalculate (or arg t))))) (if (eq (org-element-property :type context) 'table.el)
(t (message "Use C-c ' to edit table.el tables")
(let ((org-inhibit-startup-visibility-stuff t) (let ((org-enable-table-editor t))
(org-startup-align-all-tables nil)) (if (or (eq type 'table)
(when (boundp 'org-table-coordinate-overlays) ;; Check if point is at a TBLFM line.
(mapc 'delete-overlay org-table-coordinate-overlays) (and (eq type 'table-row)
(setq org-table-coordinate-overlays nil)) (= (point) (org-element-property :end context))))
(org-save-outline-visibility 'use-markers (org-mode-restart))) (save-excursion
(message "Local setup has been refreshed")))) (goto-char (org-element-property :contents-begin context))
((org-clock-update-time-maybe)) (org-call-with-arg 'org-table-recalculate (or arg t))
(t (orgtbl-send-table 'maybe))
(or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) (org-table-maybe-eval-formula)
(error "C-c C-c can do nothing useful at this location")))))) (cond (arg (call-interactively 'org-table-recalculate))
((org-table-maybe-recalculate-line))
(t (org-table-align)))))))
(timestamp (org-timestamp-change 0 'day))
(otherwise
(or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
(user-error
"C-c C-c can do nothing useful at this location")))))))))
(defun org-mode-restart () (defun org-mode-restart ()
"Restart Org-mode, to scan again for special lines. "Restart Org-mode, to scan again for special lines.