emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Archive an task which has un-indented logbook caused error


From: stardiviner
Subject: Archive an task which has un-indented logbook caused error
Date: Tue, 8 Dec 2020 10:49:20 +0800

I have an Org task like this:
```org
** DONE lantern [2/2]
   CLOSED: [2019-02-16 Sat 23:45]
:LOGBOOK:
- State "DONE"       from "TODO"       [2019-02-16 Sat 23:45] \\
  Arch Linux install lantern from AUR.
CLOCK: [2019-02-16 Sat 23:38]--[2019-02-16 Sat 23:45] =>  0:07
- State "TODO"       from              [2016-01-09 Sat 10:37]
:END:

happey ending!
```
You can noticed that there are three spaces offset before `CLOSED`.
And NO spaces before the `:LOGBOOK:` drawer. When I press `[C-c C-x C-a]`. I got following error.

Here is the error after I `toggle-debug-on-error`.
```
Debugger entered--Lisp error: (wrong-type-argument wholenump -1)
  move-to-column(-1 t)
  indent-line-to(-1)
  (while (and (not (> (point) end-marker)) (>= ci diff)) (indent-line-to (+ ci diff)) (forward-line))
  (let ((end-marker (move-marker (make-marker) (match-end 0))) (ci (current-indentation))) (while (and (not (> (point) end-marker)) (>= ci diff)) (indent-line-to (+ ci diff)) (forward-line)))
  (progn (let ((end-marker (move-marker (make-marker) (match-end 0))) (ci (current-indentation))) (while (and (not (> (point) end-marker)) (>= ci diff)) (indent-line-to (+ ci diff)) (forward-line))))
  (if (looking-at org-logbook-drawer-re) (progn (let ((end-marker (move-marker (make-marker) (match-end 0))) (ci (current-indentation))) (while (and (not (> (point) end-marker)) (>= ci diff)) (indent-line-to (+ ci diff)) (forward-line)))))
  (save-restriction (widen) (narrow-to-region (line-beginning-position) (save-excursion (if (progn (defvar org-called-with-limited-levels) (defvar org-outline-regexp) (defvar outline-regexp) (defvar org-outline-regexp-bol) (let* ((org-called-with-limited-levels t) (org-outline-regexp ...) (outline-regexp org-outline-regexp) (org-outline-regexp-bol ...)) (org-at-heading-p))) (progn (defvar org-called-with-limited-levels) (defvar org-outline-regexp) (defvar outline-regexp) (defvar org-outline-regexp-bol) (let* ((org-called-with-limited-levels t) (org-outline-regexp ...) (outline-regexp org-outline-regexp) (org-outline-regexp-bol ...)) (outline-next-heading))) (org-inlinetask-goto-end)) (point))) (forward-line) (if (looking-at-p org-planning-line-re) (progn (org-indent-line) (forward-line))) (if (looking-at org-property-drawer-re) (progn (goto-char (match-end 0)) (forward-line) (org-indent-region (match-beginning 0) (match-end 0)))) (if (looking-at org-logbook-drawer-re) (progn (let ((end-marker (move-marker (make-marker) (match-end 0))) (ci (current-indentation))) (while (and (not (> ... end-marker)) (>= ci diff)) (indent-line-to (+ ci diff)) (forward-line))))) (catch 'no-shift (if (or (= 0 diff) (not (eq org-adapt-indentation t))) (progn (throw 'no-shift nil))) (let ((case-fold-search t)) (if (< diff 0) (progn (let ((diff ...) (forbidden-re ...)) (save-excursion (while ... ...))))) (while (not (eobp)) (cond ((and (looking-at-p org-footnote-definition-re) (let ... ...))) ((looking-at-p org-outline-regexp) (forward-line)) ((looking-at-p "[ \11]*$") (forward-line)) (t (indent-line-to (+ ... diff)) (beginning-of-line) (or (and ... ...) (forward-line))))))))
  (save-excursion (save-restriction (widen) (narrow-to-region (line-beginning-position) (save-excursion (if (progn (defvar org-called-with-limited-levels) (defvar org-outline-regexp) (defvar outline-regexp) (defvar org-outline-regexp-bol) (let* (... ... ... ...) (org-at-heading-p))) (progn (defvar org-called-with-limited-levels) (defvar org-outline-regexp) (defvar outline-regexp) (defvar org-outline-regexp-bol) (let* (... ... ... ...) (outline-next-heading))) (org-inlinetask-goto-end)) (point))) (forward-line) (if (looking-at-p org-planning-line-re) (progn (org-indent-line) (forward-line))) (if (looking-at org-property-drawer-re) (progn (goto-char (match-end 0)) (forward-line) (org-indent-region (match-beginning 0) (match-end 0)))) (if (looking-at org-logbook-drawer-re) (progn (let ((end-marker (move-marker ... ...)) (ci (current-indentation))) (while (and (not ...) (>= ci diff)) (indent-line-to (+ ci diff)) (forward-line))))) (catch 'no-shift (if (or (= 0 diff) (not (eq org-adapt-indentation t))) (progn (throw 'no-shift nil))) (let ((case-fold-search t)) (if (< diff 0) (progn (let (... ...) (save-excursion ...)))) (while (not (eobp)) (cond ((and ... ...)) ((looking-at-p org-outline-regexp) (forward-line)) ((looking-at-p "[ \11]*$") (forward-line)) (t (indent-line-to ...) (beginning-of-line) (or ... ...))))))))
  org-fixup-indentation(-1)
  (progn (org-fixup-indentation (- diff)))
  (if org-adapt-indentation (progn (org-fixup-indentation (- diff))))
  (if (= level 1) nil (if org-auto-align-tags (progn (org-align-tags))) (if org-adapt-indentation (progn (org-fixup-indentation (- diff)))))
  (let* ((after-change-functions (remq 'flyspell-after-change-function after-change-functions)) (level (let ((save-match-data-internal (match-data))) (unwind-protect (progn (funcall outline-level)) (set-match-data save-match-data-internal 'evaporate)))) (up-head (concat (make-string (org-get-valid-level level -1) 42) " ")) (diff (abs (- level (length up-head) -1)))) (cond ((and (= level 1) org-allow-promoting-top-level-subtree) (replace-match "# " nil t)) ((= level 1) (user-error "Cannot promote to level 0.  UNDO to recover if nec...")) (t (replace-match up-head nil t))) (if (= level 1) nil (if org-auto-align-tags (progn (org-align-tags))) (if org-adapt-indentation (progn (org-fixup-indentation (- diff))))) (run-hooks 'org-after-promote-entry-hook))
  (save-restriction (widen) (org-back-to-heading t) (let* ((after-change-functions (remq 'flyspell-after-change-function after-change-functions)) (level (let ((save-match-data-internal (match-data))) (unwind-protect (progn (funcall outline-level)) (set-match-data save-match-data-internal 'evaporate)))) (up-head (concat (make-string (org-get-valid-level level -1) 42) " ")) (diff (abs (- level (length up-head) -1)))) (cond ((and (= level 1) org-allow-promoting-top-level-subtree) (replace-match "# " nil t)) ((= level 1) (user-error "Cannot promote to level 0.  UNDO to recover if nec...")) (t (replace-match up-head nil t))) (if (= level 1) nil (if org-auto-align-tags (progn (org-align-tags))) (if org-adapt-indentation (progn (org-fixup-indentation (- diff))))) (run-hooks 'org-after-promote-entry-hook)))
  (save-excursion (save-restriction (widen) (org-back-to-heading t) (let* ((after-change-functions (remq 'flyspell-after-change-function after-change-functions)) (level (let ((save-match-data-internal ...)) (unwind-protect (progn ...) (set-match-data save-match-data-internal ...)))) (up-head (concat (make-string (org-get-valid-level level -1) 42) " ")) (diff (abs (- level (length up-head) -1)))) (cond ((and (= level 1) org-allow-promoting-top-level-subtree) (replace-match "# " nil t)) ((= level 1) (user-error "Cannot promote to level 0.  UNDO to recover if nec...")) (t (replace-match up-head nil t))) (if (= level 1) nil (if org-auto-align-tags (progn (org-align-tags))) (if org-adapt-indentation (progn (org-fixup-indentation (- diff))))) (run-hooks 'org-after-promote-entry-hook))))
  org-promote()
  funcall(org-promote)
  (progn (funcall fun))
  (if (and (re-search-forward org-outline-regexp-bol nil t) (< (point) end)) (progn (funcall fun)))
  (save-excursion (setq end (copy-marker end)) (goto-char beg) (if (and (re-search-forward org-outline-regexp-bol nil t) (< (point) end)) (progn (funcall fun))) (while (and (progn (outline-next-heading) (< (point) end)) (not (eobp))) (funcall fun)))
  (let ((org-ignore-region t)) (save-excursion (setq end (copy-marker end)) (goto-char beg) (if (and (re-search-forward org-outline-regexp-bol nil t) (< (point) end)) (progn (funcall fun))) (while (and (progn (outline-next-heading) (< (point) end)) (not (eobp))) (funcall fun))))
  org-map-region(org-promote 187514 187890)
  (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift)))
  (save-restriction (narrow-to-region beg end) (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max)))
  (if (= shift 0) nil (save-restriction (narrow-to-region beg end) (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max))))
  (let* ((visp (not (org-invisible-p))) (txt tree) (old-level (if (string-match org-outline-regexp-bol txt) (- (match-end 0) (match-beginning 0) 1) -1)) (force-level (cond (level (prefix-numeric-value level)) ((and (org-match-line "^\\*+[ \11]*$") (not (eq 42 ...))) (org-outline-level)) ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) (previous-level (save-excursion (org-previous-visible-heading 1) (if (org-at-heading-p) (org-outline-level) 1))) (next-level (save-excursion (if (org-at-heading-p) (org-outline-level) (org-next-visible-heading 1) (if (org-at-heading-p) (org-outline-level) 1)))) (new-level (or force-level (max previous-level next-level))) (shift (if (or (= old-level -1) (= new-level -1) (= old-level new-level)) 0 (- new-level old-level))) (delta (if (> shift 0) -1 1)) (func (if (> shift 0) #'org-demote #'org-promote)) (org-odd-levels-only nil) beg end newend) (if (and force-level (not level)) (progn (delete-region (line-beginning-position) (point)))) (if (and (bolp) (org-at-heading-p)) nil (org-next-visible-heading 1) (if (bolp) nil (insert "\n"))) (setq beg (point)) (if (fboundp 'org-id-paste-tracker) (progn (org-id-paste-tracker txt))) (insert-before-markers txt) (if (string-suffix-p "\n" txt) nil (insert "\n")) (setq newend (point)) (org-reinstall-markers-in-region beg) (setq end (point)) (goto-char beg) (skip-chars-forward " \11\n\15") (setq beg (point)) (if (and (org-invisible-p) visp) (progn (save-excursion (outline-show-heading)))) (if (= shift 0) nil (save-restriction (narrow-to-region beg end) (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max)))) (if (or for-yank (called-interactively-p 'interactive)) (progn (message "Clipboard pasted as level %d subtree" new-level))) (if (and (not for-yank) kill-ring (equal org-subtree-clip (current-kill 0)) org-subtree-clip-folded) (progn (org-flag-subtree t))) (if for-yank (progn (goto-char newend))) (if remove (progn (car-safe (prog1 kill-ring (setq kill-ring (cdr kill-ring)))))))
  (let* ((org-called-with-limited-levels t) (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) (org-outline-regexp-bol (concat "^" org-outline-regexp))) (let* ((visp (not (org-invisible-p))) (txt tree) (old-level (if (string-match org-outline-regexp-bol txt) (- (match-end 0) (match-beginning 0) 1) -1)) (force-level (cond (level (prefix-numeric-value level)) ((and (org-match-line "^\\*+[ \11]*$") (not ...)) (org-outline-level)) ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) (previous-level (save-excursion (org-previous-visible-heading 1) (if (org-at-heading-p) (org-outline-level) 1))) (next-level (save-excursion (if (org-at-heading-p) (org-outline-level) (org-next-visible-heading 1) (if (org-at-heading-p) (org-outline-level) 1)))) (new-level (or force-level (max previous-level next-level))) (shift (if (or (= old-level -1) (= new-level -1) (= old-level new-level)) 0 (- new-level old-level))) (delta (if (> shift 0) -1 1)) (func (if (> shift 0) #'org-demote #'org-promote)) (org-odd-levels-only nil) beg end newend) (if (and force-level (not level)) (progn (delete-region (line-beginning-position) (point)))) (if (and (bolp) (org-at-heading-p)) nil (org-next-visible-heading 1) (if (bolp) nil (insert "\n"))) (setq beg (point)) (if (fboundp 'org-id-paste-tracker) (progn (org-id-paste-tracker txt))) (insert-before-markers txt) (if (string-suffix-p "\n" txt) nil (insert "\n")) (setq newend (point)) (org-reinstall-markers-in-region beg) (setq end (point)) (goto-char beg) (skip-chars-forward " \11\n\15") (setq beg (point)) (if (and (org-invisible-p) visp) (progn (save-excursion (outline-show-heading)))) (if (= shift 0) nil (save-restriction (narrow-to-region beg end) (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max)))) (if (or for-yank (called-interactively-p 'interactive)) (progn (message "Clipboard pasted as level %d subtree" new-level))) (if (and (not for-yank) kill-ring (equal org-subtree-clip (current-kill 0)) org-subtree-clip-folded) (progn (org-flag-subtree t))) (if for-yank (progn (goto-char newend))) (if remove (progn (car-safe (prog1 kill-ring (setq kill-ring (cdr kill-ring))))))))
  (progn (defvar org-called-with-limited-levels) (defvar org-outline-regexp) (defvar outline-regexp) (defvar org-outline-regexp-bol) (let* ((org-called-with-limited-levels t) (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) (org-outline-regexp-bol (concat "^" org-outline-regexp))) (let* ((visp (not (org-invisible-p))) (txt tree) (old-level (if (string-match org-outline-regexp-bol txt) (- (match-end 0) (match-beginning 0) 1) -1)) (force-level (cond (level (prefix-numeric-value level)) ((and ... ...) (org-outline-level)) ((looking-at-p org-outline-regexp-bol) (org-outline-level)))) (previous-level (save-excursion (org-previous-visible-heading 1) (if (org-at-heading-p) (org-outline-level) 1))) (next-level (save-excursion (if (org-at-heading-p) (org-outline-level) (org-next-visible-heading 1) (if ... ... 1)))) (new-level (or force-level (max previous-level next-level))) (shift (if (or (= old-level -1) (= new-level -1) (= old-level new-level)) 0 (- new-level old-level))) (delta (if (> shift 0) -1 1)) (func (if (> shift 0) #'org-demote #'org-promote)) (org-odd-levels-only nil) beg end newend) (if (and force-level (not level)) (progn (delete-region (line-beginning-position) (point)))) (if (and (bolp) (org-at-heading-p)) nil (org-next-visible-heading 1) (if (bolp) nil (insert "\n"))) (setq beg (point)) (if (fboundp 'org-id-paste-tracker) (progn (org-id-paste-tracker txt))) (insert-before-markers txt) (if (string-suffix-p "\n" txt) nil (insert "\n")) (setq newend (point)) (org-reinstall-markers-in-region beg) (setq end (point)) (goto-char beg) (skip-chars-forward " \11\n\15") (setq beg (point)) (if (and (org-invisible-p) visp) (progn (save-excursion (outline-show-heading)))) (if (= shift 0) nil (save-restriction (narrow-to-region beg end) (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max)))) (if (or for-yank (called-interactively-p 'interactive)) (progn (message "Clipboard pasted as level %d subtree" new-level))) (if (and (not for-yank) kill-ring (equal org-subtree-clip (current-kill 0)) org-subtree-clip-folded) (progn (org-flag-subtree t))) (if for-yank (progn (goto-char newend))) (if remove (progn (car-safe (prog1 kill-ring (setq kill-ring ...))))))))
  org-paste-subtree(1)
  (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) (org-todo-kwd-alist tr-org-todo-kwd-alist) (org-done-keywords tr-org-done-keywords) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) (org-show-all '(headings blocks)) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward (concat "^" (regexp-quote heading) "\\([ \11]+:\\(" org-tag-re ":\\)+\\)?[ \11]*$") nil t) (goto-char (match-end 0)) (goto-char (point-max)) (or (bolp) (insert "\n")) (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) (outline-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) (outline-next-heading)) (org-end-of-subtree t)) (skip-chars-backward " \11\15\n") (and (looking-at "[ \11\15\n]*") (replace-match (if datetree-date "\n" "\n\n")))) (if org-archive-reversed-order (progn (goto-char (point-min)) (if (org-at-heading-p) nil (outline-next-heading))) (goto-char (point-max)) (if (and datetree-date (bolp)) nil (insert "\n")))) (org-paste-subtree (org-get-valid-level level (and heading 1))) (and inherited-tags (or (and (eq org-archive-subtree-add-inherited-tags 'infile) infile-p) (eq org-archive-subtree-add-inherited-tags t)) (org-set-tags all-tags)) (if (and org-archive-mark-done (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) (or (not (match-end 2)) (not (member (match-string 2) org-done-keywords)))) (progn (let (org-log-done org-todo-log-states) (org-todo (car (or (member org-archive-mark-done org-done-keywords) org-done-keywords)))))) (let ((--dolist-tail-- org-archive-save-context-info)) (while --dolist-tail-- (let ((item (car --dolist-tail--))) (let ((value (cdr ...))) (if (org-string-nw-p value) (progn (org-entry-put ... ... value)))) (setq --dolist-tail-- (cdr --dolist-tail--))))) (if (eq this-buffer buffer) nil (if (or (eq org-archive-subtree-save-file-p t) (eq org-archive-subtree-save-file-p (if (boundp 'org-archive-from-agenda) 'from-agenda 'from-org))) (progn (save-buffer)))) (widen))
  (let* ((all-tags (org-get-tags)) (local-tags (cl-remove-if #'(lambda (tag) (get-text-property 0 'inherited tag)) all-tags)) (inherited-tags (cl-remove-if-not #'(lambda (tag) (get-text-property 0 'inherited tag)) all-tags)) (context (list (cons 'category (org-get-category nil 'force-refresh)) (cons 'file file) (cons 'itags (mapconcat #'identity inherited-tags " ")) (cons 'ltags (mapconcat #'identity local-tags " ")) (cons 'olpath (mapconcat #'identity (org-get-outline-path) "/")) (cons 'time time) (cons 'todo (org-entry-get (point) "TODO"))))) (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) (if (not (derived-mode-p 'org-mode)) (let ((org-insert-mode-line-in-empty-file t) (org-inhibit-startup t)) (call-interactively 'org-mode))) (if (and newfile-p org-archive-file-header-format) (progn (goto-char (point-max)) (insert (format org-archive-file-header-format (buffer-file-name this-buffer))))) (if datetree-date (progn (require 'org-datetree) (org-datetree-find-date-create datetree-date) (org-narrow-to-subtree))) (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) (org-todo-kwd-alist tr-org-todo-kwd-alist) (org-done-keywords tr-org-done-keywords) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) (org-show-all '(headings blocks)) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward (concat "^" (regexp-quote heading) "\\([ \11]+:\\(" org-tag-re ":\\)+\\)?[ \11]*$") nil t) (goto-char (match-end 0)) (goto-char (point-max)) (or (bolp) (insert "\n")) (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) (outline-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) (outline-next-heading)) (org-end-of-subtree t)) (skip-chars-backward " \11\15\n") (and (looking-at "[ \11\15\n]*") (replace-match (if datetree-date "\n" "\n\n")))) (if org-archive-reversed-order (progn (goto-char (point-min)) (if (org-at-heading-p) nil (outline-next-heading))) (goto-char (point-max)) (if (and datetree-date (bolp)) nil (insert "\n")))) (org-paste-subtree (org-get-valid-level level (and heading 1))) (and inherited-tags (or (and (eq org-archive-subtree-add-inherited-tags 'infile) infile-p) (eq org-archive-subtree-add-inherited-tags t)) (org-set-tags all-tags)) (if (and org-archive-mark-done (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) (or (not (match-end 2)) (not (member (match-string 2) org-done-keywords)))) (progn (let (org-log-done org-todo-log-states) (org-todo (car (or ... org-done-keywords)))))) (let ((--dolist-tail-- org-archive-save-context-info)) (while --dolist-tail-- (let ((item (car --dolist-tail--))) (let ((value ...)) (if (org-string-nw-p value) (progn ...))) (setq --dolist-tail-- (cdr --dolist-tail--))))) (if (eq this-buffer buffer) nil (if (or (eq org-archive-subtree-save-file-p t) (eq org-archive-subtree-save-file-p (if (boundp ...) 'from-agenda 'from-org))) (progn (save-buffer)))) (widen)))
  (save-excursion (org-back-to-heading t) (let* ((all-tags (org-get-tags)) (local-tags (cl-remove-if #'(lambda (tag) (get-text-property 0 ... tag)) all-tags)) (inherited-tags (cl-remove-if-not #'(lambda (tag) (get-text-property 0 ... tag)) all-tags)) (context (list (cons 'category (org-get-category nil 'force-refresh)) (cons 'file file) (cons 'itags (mapconcat #'identity inherited-tags " ")) (cons 'ltags (mapconcat #'identity local-tags " ")) (cons 'olpath (mapconcat #'identity (org-get-outline-path) "/")) (cons 'time time) (cons 'todo (org-entry-get (point) "TODO"))))) (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) (if (not (derived-mode-p 'org-mode)) (let ((org-insert-mode-line-in-empty-file t) (org-inhibit-startup t)) (call-interactively 'org-mode))) (if (and newfile-p org-archive-file-header-format) (progn (goto-char (point-max)) (insert (format org-archive-file-header-format (buffer-file-name this-buffer))))) (if datetree-date (progn (require 'org-datetree) (org-datetree-find-date-create datetree-date) (org-narrow-to-subtree))) (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) (org-todo-kwd-alist tr-org-todo-kwd-alist) (org-done-keywords tr-org-done-keywords) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) (org-show-all '(headings blocks)) (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward (concat "^" ... "\\([ \11]+:\\(" org-tag-re ":\\)+\\)?[ \11]*$") nil t) (goto-char (match-end 0)) (goto-char (point-max)) (or (bolp) (insert "\n")) (insert (if datetree-date "" "\n") heading "\n") (end-of-line 0)) (outline-show-subtree) (if org-archive-reversed-order (progn (org-back-to-heading t) (outline-next-heading)) (org-end-of-subtree t)) (skip-chars-backward " \11\15\n") (and (looking-at "[ \11\15\n]*") (replace-match (if datetree-date "\n" "\n\n")))) (if org-archive-reversed-order (progn (goto-char (point-min)) (if (org-at-heading-p) nil (outline-next-heading))) (goto-char (point-max)) (if (and datetree-date (bolp)) nil (insert "\n")))) (org-paste-subtree (org-get-valid-level level (and heading 1))) (and inherited-tags (or (and (eq org-archive-subtree-add-inherited-tags 'infile) infile-p) (eq org-archive-subtree-add-inherited-tags t)) (org-set-tags all-tags)) (if (and org-archive-mark-done (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) (or (not (match-end 2)) (not (member ... org-done-keywords)))) (progn (let (org-log-done org-todo-log-states) (org-todo (car ...))))) (let ((--dolist-tail-- org-archive-save-context-info)) (while --dolist-tail-- (let ((item ...)) (let (...) (if ... ...)) (setq --dolist-tail-- (cdr --dolist-tail--))))) (if (eq this-buffer buffer) nil (if (or (eq org-archive-subtree-save-file-p t) (eq org-archive-subtree-save-file-p (if ... ... ...))) (progn (save-buffer)))) (widen))))
  (let* ((tr-org-todo-keywords-1 org-todo-keywords-1) (tr-org-todo-kwd-alist org-todo-kwd-alist) (tr-org-done-keywords org-done-keywords) (tr-org-todo-regexp org-todo-regexp) (tr-org-todo-line-regexp org-todo-line-regexp) (tr-org-odd-levels-only org-odd-levels-only) (this-buffer (current-buffer)) (time (format-time-string (substring (cdr org-time-stamp-formats) 1 -1))) (file (abbreviate-file-name (or (buffer-file-name (buffer-base-buffer)) (error "No file associated to buffer")))) (location (org-archive--compute-location (or (org-entry-get nil "ARCHIVE" 'inherit) org-archive-location))) (afile (car location)) (heading (cdr location)) (infile-p (equal file (abbreviate-file-name (or afile "")))) (newfile-p (and (org-string-nw-p afile) (not (file-exists-p afile)))) (buffer (cond ((not (org-string-nw-p afile)) this-buffer) ((find-buffer-visiting afile)) ((find-file-noselect afile)) (t (error "Cannot access file \"%s\"" afile)))) (org-odd-levels-only (if (local-variable-p 'org-odd-levels-only (current-buffer)) org-odd-levels-only tr-org-odd-levels-only)) level datetree-date datetree-subheading-p) (if (string-match "\\`datetree/\\(\\**\\)" heading) (progn (let ((nsub (length (match-string 1 heading)))) (setq heading (concat (make-string (+ ... ...) 42) (substring heading (match-end 0)))) (setq datetree-subheading-p (> nsub 0))) (setq datetree-date (org-date-to-gregorian (or (org-entry-get nil "CLOSED" t) time))))) (if (and (> (length heading) 0) (string-match "^\\*+" heading)) (setq level (match-end 0)) (setq heading nil level 0)) (save-excursion (org-back-to-heading t) (let* ((all-tags (org-get-tags)) (local-tags (cl-remove-if #'(lambda ... ...) all-tags)) (inherited-tags (cl-remove-if-not #'(lambda ... ...) all-tags)) (context (list (cons 'category (org-get-category nil ...)) (cons 'file file) (cons 'itags (mapconcat ... inherited-tags " ")) (cons 'ltags (mapconcat ... local-tags " ")) (cons 'olpath (mapconcat ... ... "/")) (cons 'time time) (cons 'todo (org-entry-get ... "TODO"))))) (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) (if (not (derived-mode-p 'org-mode)) (let ((org-insert-mode-line-in-empty-file t) (org-inhibit-startup t)) (call-interactively 'org-mode))) (if (and newfile-p org-archive-file-header-format) (progn (goto-char (point-max)) (insert (format org-archive-file-header-format (buffer-file-name this-buffer))))) (if datetree-date (progn (require 'org-datetree) (org-datetree-find-date-create datetree-date) (org-narrow-to-subtree))) (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) (org-todo-kwd-alist tr-org-todo-kwd-alist) (org-done-keywords tr-org-done-keywords) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) (org-show-all '(headings blocks)) (if (and heading (not (and datetree-date ...))) (progn (if (re-search-forward ... nil t) (goto-char ...) (goto-char ...) (or ... ...) (insert ... heading "\n") (end-of-line 0)) (outline-show-subtree) (if org-archive-reversed-order (progn ... ...) (org-end-of-subtree t)) (skip-chars-backward " \11\15\n") (and (looking-at "[ \11\15\n]*") (replace-match ...))) (if org-archive-reversed-order (progn (goto-char ...) (if ... nil ...)) (goto-char (point-max)) (if (and datetree-date ...) nil (insert "\n")))) (org-paste-subtree (org-get-valid-level level (and heading 1))) (and inherited-tags (or (and (eq org-archive-subtree-add-inherited-tags ...) infile-p) (eq org-archive-subtree-add-inherited-tags t)) (org-set-tags all-tags)) (if (and org-archive-mark-done (let (...) (looking-at org-todo-line-regexp)) (or (not ...) (not ...))) (progn (let (org-log-done org-todo-log-states) (org-todo ...)))) (let ((--dolist-tail-- org-archive-save-context-info)) (while --dolist-tail-- (let (...) (let ... ...) (setq --dolist-tail-- ...)))) (if (eq this-buffer buffer) nil (if (or (eq org-archive-subtree-save-file-p t) (eq org-archive-subtree-save-file-p ...)) (progn (save-buffer)))) (widen)))) (run-hooks 'org-archive-hook) (let (this-command) (org-cut-subtree)) (if (featurep 'org-inlinetask) (progn (org-inlinetask-remove-END-maybe))) (setq org-markers-to-move nil) (if org-provide-todo-statistics (progn (save-excursion (org-up-heading-safe) (org-update-statistics-cookies nil)))) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) (concat "in file: " (abbreviate-file-name afile)))))
  (cond ((equal find-done '(4)) (org-archive-all-done)) ((equal find-done '(16)) (org-archive-all-old)) (t (let* ((tr-org-todo-keywords-1 org-todo-keywords-1) (tr-org-todo-kwd-alist org-todo-kwd-alist) (tr-org-done-keywords org-done-keywords) (tr-org-todo-regexp org-todo-regexp) (tr-org-todo-line-regexp org-todo-line-regexp) (tr-org-odd-levels-only org-odd-levels-only) (this-buffer (current-buffer)) (time (format-time-string (substring (cdr org-time-stamp-formats) 1 -1))) (file (abbreviate-file-name (or (buffer-file-name ...) (error "No file associated to buffer")))) (location (org-archive--compute-location (or (org-entry-get nil "ARCHIVE" ...) org-archive-location))) (afile (car location)) (heading (cdr location)) (infile-p (equal file (abbreviate-file-name (or afile "")))) (newfile-p (and (org-string-nw-p afile) (not (file-exists-p afile)))) (buffer (cond ((not ...) this-buffer) ((find-buffer-visiting afile)) ((find-file-noselect afile)) (t (error "Cannot access file \"%s\"" afile)))) (org-odd-levels-only (if (local-variable-p 'org-odd-levels-only (current-buffer)) org-odd-levels-only tr-org-odd-levels-only)) level datetree-date datetree-subheading-p) (if (string-match "\\`datetree/\\(\\**\\)" heading) (progn (let ((nsub ...)) (setq heading (concat ... ...)) (setq datetree-subheading-p (> nsub 0))) (setq datetree-date (org-date-to-gregorian (or ... time))))) (if (and (> (length heading) 0) (string-match "^\\*+" heading)) (setq level (match-end 0)) (setq heading nil level 0)) (save-excursion (org-back-to-heading t) (let* ((all-tags (org-get-tags)) (local-tags (cl-remove-if ... all-tags)) (inherited-tags (cl-remove-if-not ... all-tags)) (context (list ... ... ... ... ... ... ...))) (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) (if (not (derived-mode-p ...)) (let (... ...) (call-interactively ...))) (if (and newfile-p org-archive-file-header-format) (progn (goto-char ...) (insert ...))) (if datetree-date (progn (require ...) (org-datetree-find-date-create datetree-date) (org-narrow-to-subtree))) (let ((org-todo-line-regexp tr-org-todo-line-regexp) (org-todo-keywords-1 tr-org-todo-keywords-1) (org-todo-kwd-alist tr-org-todo-kwd-alist) (org-done-keywords tr-org-done-keywords) (org-todo-regexp tr-org-todo-regexp) (org-todo-line-regexp tr-org-todo-line-regexp)) (goto-char (point-min)) (org-show-all '...) (if (and heading ...) (progn ... ... ... ... ...) (if org-archive-reversed-order ... ... ...)) (org-paste-subtree (org-get-valid-level level ...)) (and inherited-tags (or ... ...) (org-set-tags all-tags)) (if (and org-archive-mark-done ... ...) (progn ...)) (let (...) (while --dolist-tail-- ...)) (if (eq this-buffer buffer) nil (if ... ...)) (widen)))) (run-hooks 'org-archive-hook) (let (this-command) (org-cut-subtree)) (if (featurep 'org-inlinetask) (progn (org-inlinetask-remove-END-maybe))) (setq org-markers-to-move nil) (if org-provide-todo-statistics (progn (save-excursion (org-up-heading-safe) (org-update-statistics-cookies nil)))) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) (concat "in file: " (abbreviate-file-name afile)))))))
  (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) 'region-start-level 'region)) org-loop-over-headlines-in-active-region) (org-map-entries (list 'progn '(setq org-map-continue-from (progn (org-back-to-heading) (point))) (list 'org-archive-subtree find-done)) org-loop-over-headlines-in-active-region cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (cond ((equal find-done '(4)) (org-archive-all-done)) ((equal find-done '(16)) (org-archive-all-old)) (t (let* ((tr-org-todo-keywords-1 org-todo-keywords-1) (tr-org-todo-kwd-alist org-todo-kwd-alist) (tr-org-done-keywords org-done-keywords) (tr-org-todo-regexp org-todo-regexp) (tr-org-todo-line-regexp org-todo-line-regexp) (tr-org-odd-levels-only org-odd-levels-only) (this-buffer (current-buffer)) (time (format-time-string (substring ... 1 -1))) (file (abbreviate-file-name (or ... ...))) (location (org-archive--compute-location (or ... org-archive-location))) (afile (car location)) (heading (cdr location)) (infile-p (equal file (abbreviate-file-name ...))) (newfile-p (and (org-string-nw-p afile) (not ...))) (buffer (cond (... this-buffer) (...) (...) (t ...))) (org-odd-levels-only (if (local-variable-p ... ...) org-odd-levels-only tr-org-odd-levels-only)) level datetree-date datetree-subheading-p) (if (string-match "\\`datetree/\\(\\**\\)" heading) (progn (let (...) (setq heading ...) (setq datetree-subheading-p ...)) (setq datetree-date (org-date-to-gregorian ...)))) (if (and (> (length heading) 0) (string-match "^\\*+" heading)) (setq level (match-end 0)) (setq heading nil level 0)) (save-excursion (org-back-to-heading t) (let* ((all-tags ...) (local-tags ...) (inherited-tags ...) (context ...)) (let (this-command) (org-copy-subtree 1 nil t)) (set-buffer buffer) (if (not ...) (let ... ...)) (if (and newfile-p org-archive-file-header-format) (progn ... ...)) (if datetree-date (progn ... ... ...)) (let (... ... ... ... ... ...) (goto-char ...) (org-show-all ...) (if ... ... ...) (org-paste-subtree ...) (and inherited-tags ... ...) (if ... ...) (let ... ...) (if ... nil ...) (widen)))) (run-hooks 'org-archive-hook) (let (this-command) (org-cut-subtree)) (if (featurep 'org-inlinetask) (progn (org-inlinetask-remove-END-maybe))) (setq org-markers-to-move nil) (if org-provide-todo-statistics (progn (save-excursion (org-up-heading-safe) (org-update-statistics-cookies nil)))) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) (concat "in file: " (abbreviate-file-name afile))))))) (org-reveal) (if (looking-at "^[ \11]*$") (outline-next-visible-heading 1)))
  org-archive-subtree(nil)
  funcall-interactively(org-archive-subtree nil)
  call-interactively(org-archive-subtree)
  org-archive-subtree-default()
  funcall-interactively(org-archive-subtree-default)
  call-interactively(org-archive-subtree-default nil nil)
  command-execute(org-archive-subtree-default)
```


[stardiviner]           <Hack this world!>      GPG key ID: 47C32433
IRC(freeenode): stardiviner                     Twitter:  @numbchild
Key fingerprint = 9BAA 92BC CDDD B9EF 3B36  CB99 B8C4 B8E5 47C3 2433
Blog: http://stardiviner.github.io/

reply via email to

[Prev in Thread] Current Thread [Next in Thread]