diff options
| author | Stephen Berman | 2013-06-19 14:22:46 +0200 |
|---|---|---|
| committer | Stephen Berman | 2013-06-19 14:22:46 +0200 |
| commit | 5e7b7e2bb367991fee4129476f4a362515ac6a65 (patch) | |
| tree | dfec7a7bff63e413023199bf4073ca0bb7b639cf | |
| parent | 857b9748a7e765e752b6651df7bbb99b957b7b59 (diff) | |
| download | emacs-5e7b7e2bb367991fee4129476f4a362515ac6a65.tar.gz emacs-5e7b7e2bb367991fee4129476f4a362515ac6a65.zip | |
* todos.el (todos-convert-legacy-files): Add code to make it work
after the new version is renamed and has the same namespace as the
old version. This also requires there to be no live todo buffers
when this command is called.
| -rw-r--r-- | lisp/calendar/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/calendar/todos.el | 307 |
2 files changed, 177 insertions, 137 deletions
diff --git a/lisp/calendar/ChangeLog b/lisp/calendar/ChangeLog index 63a1ca71295..a1292a6a0fe 100644 --- a/lisp/calendar/ChangeLog +++ b/lisp/calendar/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2013-06-19 Stephen Berman <stephen.berman@gmx.net> | ||
| 2 | |||
| 3 | * todos.el (todos-convert-legacy-files): Add code to make it work | ||
| 4 | after the new version is renamed and has the same namespace as the | ||
| 5 | old version. This also requires there to be no live todo buffers | ||
| 6 | when this command is called. | ||
| 7 | |||
| 1 | 2013-06-18 Stephen Berman <stephen.berman@gmx.net> | 8 | 2013-06-18 Stephen Berman <stephen.berman@gmx.net> |
| 2 | 9 | ||
| 3 | * todos.el: Reinstate current copyright dates and original | 10 | * todos.el: Reinstate current copyright dates and original |
diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el index f96dc97f4c8..667b69a66f3 100644 --- a/lisp/calendar/todos.el +++ b/lisp/calendar/todos.el | |||
| @@ -4479,148 +4479,181 @@ Helper function for `todos-convert-legacy-files'." | |||
| 4479 | 4479 | ||
| 4480 | (defun todos-convert-legacy-files () | 4480 | (defun todos-convert-legacy-files () |
| 4481 | "Convert legacy Todo files to the current Todos format. | 4481 | "Convert legacy Todo files to the current Todos format. |
| 4482 | The files `todo-file-do' and `todo-file-done' are converted and | 4482 | The old-style files named by the variables `todo-file-do' and |
| 4483 | saved (the latter as a Todos Archive file) with a new name in | 4483 | `todo-file-done' from the old package are converted to the new |
| 4484 | `todos-directory'. See also the documentation string of | 4484 | format and saved (the latter as a Todos Archive file) with a new |
| 4485 | name in `todos-directory'. See also the documentation string of | ||
| 4485 | `todos-legacy-date-time-regexp' for further details." | 4486 | `todos-legacy-date-time-regexp' for further details." |
| 4486 | (interactive) | 4487 | (interactive) |
| 4487 | (eval-when-compile (require 'todo-mode)) | 4488 | (if todos-file-buffers |
| 4488 | ;; Convert `todo-file-do'. | 4489 | (message "Before converting you must kill all todo file buffers") |
| 4489 | (if (file-exists-p todo-file-do) | 4490 | ;; Before loading legacy code we have to void symbols whose names |
| 4490 | (let ((default "todo-do-conv") | 4491 | ;; are the same in the old and new versions, so use placeholders |
| 4491 | file archive-sexp) | 4492 | ;; during conversion and restore them afterwards. |
| 4492 | (with-temp-buffer | 4493 | (let ((todos-categories-tem todos-categories) |
| 4493 | (insert-file-contents todo-file-do) | 4494 | (todos-prefix-tem todos-prefix) |
| 4494 | (let ((end (search-forward ")" (line-end-position) t)) | 4495 | (todos-category-beg-tem todos-category-beg)) |
| 4495 | (beg (search-backward "(" (line-beginning-position) t))) | 4496 | (fset 'todos-mode-tem 'todos-mode) |
| 4496 | (setq todo-categories | 4497 | (makunbound 'todos-categories) |
| 4497 | (read (buffer-substring-no-properties beg end)))) | 4498 | (makunbound 'todos-prefix) |
| 4498 | (todo-mode) | 4499 | (makunbound 'todos-category-beg) |
| 4499 | (delete-region (line-beginning-position) (1+ (line-end-position))) | 4500 | (fmakunbound 'todos-mode) |
| 4500 | (while (not (eobp)) | 4501 | (when (eq this-command 'todos-convert-legacy-files) |
| 4501 | (cond | 4502 | ;; We can't use require because the feature provided by the |
| 4502 | ((looking-at (regexp-quote (concat todo-prefix todo-category-beg))) | 4503 | ;; old version is the same as the new version's. |
| 4503 | (replace-match todos-category-beg)) | 4504 | (load "todo-mode")) |
| 4504 | ((looking-at (regexp-quote todo-category-end)) | 4505 | ;; Convert `todo-file-do'. |
| 4505 | (replace-match "")) | 4506 | (if (file-exists-p todo-file-do) |
| 4506 | ((looking-at (regexp-quote (concat todo-prefix " " | 4507 | (let ((default "todo-do-conv") |
| 4507 | todo-category-sep))) | 4508 | file archive-sexp) |
| 4508 | (replace-match todos-category-done)) | 4509 | (with-temp-buffer |
| 4509 | ((looking-at (concat (regexp-quote todo-prefix) " " | 4510 | (insert-file-contents todo-file-do) |
| 4510 | todos-legacy-date-time-regexp " " | 4511 | (let ((end (search-forward ")" (line-end-position) t)) |
| 4511 | (regexp-quote todo-initials) ":")) | 4512 | (beg (search-backward "(" (line-beginning-position) t))) |
| 4512 | (todos-convert-legacy-date-time))) | 4513 | (setq todo-categories |
| 4513 | (forward-line)) | 4514 | (read (buffer-substring-no-properties beg end)))) |
| 4514 | (setq file (concat todos-directory | 4515 | (todo-mode) |
| 4515 | (read-string | 4516 | (delete-region (line-beginning-position) (1+ (line-end-position))) |
| 4516 | (format "Save file as (default \"%s\"): " default) | ||
| 4517 | nil nil default) | ||
| 4518 | ".todo")) | ||
| 4519 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | ||
| 4520 | (with-temp-buffer | ||
| 4521 | (insert-file-contents file) | ||
| 4522 | (let ((todos-categories (todos-make-categories-list t))) | ||
| 4523 | (todos-update-categories-sexp)) | ||
| 4524 | (write-region (point-min) (point-max) file nil 'nomessage)) | ||
| 4525 | ;; Convert `todo-file-done'. | ||
| 4526 | (when (file-exists-p todo-file-done) | ||
| 4527 | (with-temp-buffer | ||
| 4528 | (insert-file-contents todo-file-done) | ||
| 4529 | (let ((beg (make-marker)) | ||
| 4530 | (end (make-marker)) | ||
| 4531 | cat cats comment item) | ||
| 4532 | (while (not (eobp)) | 4517 | (while (not (eobp)) |
| 4533 | (when (looking-at todos-legacy-date-time-regexp) | 4518 | (cond |
| 4534 | (set-marker beg (point)) | 4519 | ((looking-at (regexp-quote (concat todo-prefix todo-category-beg))) |
| 4535 | (todos-convert-legacy-date-time) | 4520 | (replace-match todos-category-beg-tem)) |
| 4536 | (set-marker end (point)) | 4521 | ((looking-at (regexp-quote todo-category-end)) |
| 4537 | (goto-char beg) | ||
| 4538 | (insert "[" todos-done-string) | ||
| 4539 | (goto-char end) | ||
| 4540 | (insert "]") | ||
| 4541 | (forward-char) | ||
| 4542 | (when (looking-at todos-legacy-date-time-regexp) | ||
| 4543 | (todos-convert-legacy-date-time)) | ||
| 4544 | (when (looking-at (concat " " | ||
| 4545 | (regexp-quote todo-initials) ":")) | ||
| 4546 | (replace-match ""))) | ||
| 4547 | (if (re-search-forward | ||
| 4548 | (concat "^" todos-legacy-date-time-regexp) nil t) | ||
| 4549 | (goto-char (match-beginning 0)) | ||
| 4550 | (goto-char (point-max))) | ||
| 4551 | (backward-char) | ||
| 4552 | (when (looking-back "\\[\\([^][]+\\)\\]") | ||
| 4553 | (setq cat (match-string 1)) | ||
| 4554 | (goto-char (match-beginning 0)) | ||
| 4555 | (replace-match "")) | 4522 | (replace-match "")) |
| 4556 | ;; If the item ends with a non-comment parenthesis not | 4523 | ((looking-at (regexp-quote (concat todo-prefix " " |
| 4557 | ;; followed by a period, we lose (but we inherit that problem | 4524 | todo-category-sep))) |
| 4558 | ;; from todo-mode.el). | 4525 | (replace-match todos-category-done)) |
| 4559 | (when (looking-back "(\\(.*\\)) ") | 4526 | ((looking-at (concat (regexp-quote todo-prefix) " " |
| 4560 | (setq comment (match-string 1)) | 4527 | todos-legacy-date-time-regexp " " |
| 4561 | (replace-match "") | 4528 | (regexp-quote todo-initials) ":")) |
| 4562 | (insert "[" todos-comment-string ": " comment "]")) | 4529 | ;; FIXME: Should todo-initials be converted? That |
| 4563 | (set-marker end (point)) | 4530 | ;; would require changes to item insertion and editing. |
| 4564 | (if (member cat cats) | 4531 | (todos-convert-legacy-date-time))) |
| 4565 | ;; If item is already in its category, leave it there. | ||
| 4566 | (unless (save-excursion | ||
| 4567 | (re-search-backward | ||
| 4568 | (concat "^" (regexp-quote todos-category-beg) | ||
| 4569 | "\\(.*\\)$") nil t) | ||
| 4570 | (string= (match-string 1) cat)) | ||
| 4571 | ;; Else move it to its category. | ||
| 4572 | (setq item (buffer-substring-no-properties beg end)) | ||
| 4573 | (delete-region beg (1+ end)) | ||
| 4574 | (set-marker beg (point)) | ||
| 4575 | (re-search-backward | ||
| 4576 | (concat "^" | ||
| 4577 | (regexp-quote (concat todos-category-beg cat)) | ||
| 4578 | "$") | ||
| 4579 | nil t) | ||
| 4580 | (forward-line) | ||
| 4581 | (if (re-search-forward | ||
| 4582 | (concat "^" (regexp-quote todos-category-beg) | ||
| 4583 | "\\(.*\\)$") nil t) | ||
| 4584 | (progn (goto-char (match-beginning 0)) | ||
| 4585 | (newline) | ||
| 4586 | (forward-line -1)) | ||
| 4587 | (goto-char (point-max))) | ||
| 4588 | (insert item "\n") | ||
| 4589 | (goto-char beg)) | ||
| 4590 | (push cat cats) | ||
| 4591 | (goto-char beg) | ||
| 4592 | (insert todos-category-beg cat "\n\n" todos-category-done "\n")) | ||
| 4593 | (forward-line)) | 4532 | (forward-line)) |
| 4594 | (set-marker beg nil) | 4533 | (setq file (concat todos-directory |
| 4595 | (set-marker end nil)) | 4534 | (read-string |
| 4596 | (setq file (concat (file-name-sans-extension file) ".toda")) | 4535 | (format "Save file as (default \"%s\"): " default) |
| 4597 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | 4536 | nil nil default) |
| 4598 | (with-temp-buffer | 4537 | ".todo")) |
| 4599 | (insert-file-contents file) | 4538 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) |
| 4600 | (let ((todos-categories (todos-make-categories-list t))) | 4539 | (with-temp-buffer |
| 4601 | (todos-update-categories-sexp)) | 4540 | (insert-file-contents file) |
| 4602 | (write-region (point-min) (point-max) file nil 'nomessage) | 4541 | (let* ((todos-category-beg todos-category-beg-tem) ; Used by t-m-c-l. |
| 4603 | (setq archive-sexp (read (buffer-substring-no-properties | 4542 | (todos-categories (todos-make-categories-list t))) |
| 4604 | (line-beginning-position) | 4543 | (todos-update-categories-sexp)) |
| 4605 | (line-end-position))))) | 4544 | (write-region (point-min) (point-max) file nil 'nomessage)) |
| 4606 | (setq file (concat (file-name-sans-extension file) ".todo")) | 4545 | ;; Convert `todo-file-done'. |
| 4607 | ;; Update categories sexp of converted Todos file again, adding | 4546 | (when (file-exists-p todo-file-done) |
| 4608 | ;; counts of archived items. | 4547 | (with-temp-buffer |
| 4609 | (with-temp-buffer | 4548 | (insert-file-contents todo-file-done) |
| 4610 | (insert-file-contents file) | 4549 | (let ((beg (make-marker)) |
| 4611 | (let ((sexp (read (buffer-substring-no-properties | 4550 | (end (make-marker)) |
| 4612 | (line-beginning-position) | 4551 | cat cats comment item) |
| 4613 | (line-end-position))))) | 4552 | (while (not (eobp)) |
| 4614 | (dolist (cat sexp) | 4553 | (when (looking-at todos-legacy-date-time-regexp) |
| 4615 | (let ((archive-cat (assoc (car cat) archive-sexp))) | 4554 | (set-marker beg (point)) |
| 4616 | (if archive-cat | 4555 | (todos-convert-legacy-date-time) |
| 4617 | (aset (cdr cat) 3 (aref (cdr archive-cat) 2))))) | 4556 | (set-marker end (point)) |
| 4618 | (delete-region (line-beginning-position) (line-end-position)) | 4557 | (goto-char beg) |
| 4619 | (prin1 sexp (current-buffer))) | 4558 | (insert "[" todos-done-string) |
| 4620 | (write-region (point-min) (point-max) file nil 'nomessage))) | 4559 | (goto-char end) |
| 4621 | (todos-reevaluate-filelist-defcustoms) | 4560 | (insert "]") |
| 4622 | (message "Format conversion done.")) | 4561 | (forward-char) |
| 4623 | (user-error "No legacy Todo file exists"))) | 4562 | (when (looking-at todos-legacy-date-time-regexp) |
| 4563 | (todos-convert-legacy-date-time)) | ||
| 4564 | (when (looking-at (concat " " | ||
| 4565 | (regexp-quote todo-initials) ":")) | ||
| 4566 | ;; FIXME: Should todo-initials be converted? | ||
| 4567 | (replace-match ""))) | ||
| 4568 | (if (re-search-forward | ||
| 4569 | (concat "^" todos-legacy-date-time-regexp) nil t) | ||
| 4570 | (goto-char (match-beginning 0)) | ||
| 4571 | (goto-char (point-max))) | ||
| 4572 | (backward-char) | ||
| 4573 | (when (looking-back "\\[\\([^][]+\\)\\]") | ||
| 4574 | (setq cat (match-string 1)) | ||
| 4575 | (goto-char (match-beginning 0)) | ||
| 4576 | (replace-match "")) | ||
| 4577 | ;; If the item ends with a non-comment parenthesis not | ||
| 4578 | ;; followed by a period, we lose (but we inherit that problem | ||
| 4579 | ;; from todo-mode.el). | ||
| 4580 | (when (looking-back "(\\(.*\\)) ") | ||
| 4581 | (setq comment (match-string 1)) | ||
| 4582 | (replace-match "") | ||
| 4583 | (insert "[" todos-comment-string ": " comment "]")) | ||
| 4584 | (set-marker end (point)) | ||
| 4585 | (if (member cat cats) | ||
| 4586 | ;; If item is already in its category, leave it there. | ||
| 4587 | (unless (save-excursion | ||
| 4588 | (re-search-backward | ||
| 4589 | (concat "^" (regexp-quote todos-category-beg-tem) | ||
| 4590 | "\\(.*\\)$") nil t) | ||
| 4591 | (string= (match-string 1) cat)) | ||
| 4592 | ;; Else move it to its category. | ||
| 4593 | (setq item (buffer-substring-no-properties beg end)) | ||
| 4594 | (delete-region beg (1+ end)) | ||
| 4595 | (set-marker beg (point)) | ||
| 4596 | (re-search-backward | ||
| 4597 | (concat "^" | ||
| 4598 | (regexp-quote (concat todos-category-beg-tem cat)) | ||
| 4599 | "$") | ||
| 4600 | nil t) | ||
| 4601 | (forward-line) | ||
| 4602 | (if (re-search-forward | ||
| 4603 | (concat "^" (regexp-quote todos-category-beg-tem) | ||
| 4604 | "\\(.*\\)$") nil t) | ||
| 4605 | (progn (goto-char (match-beginning 0)) | ||
| 4606 | (newline) | ||
| 4607 | (forward-line -1)) | ||
| 4608 | (goto-char (point-max))) | ||
| 4609 | (insert item "\n") | ||
| 4610 | (goto-char beg)) | ||
| 4611 | (push cat cats) | ||
| 4612 | (goto-char beg) | ||
| 4613 | (insert todos-category-beg-tem cat "\n\n" | ||
| 4614 | todos-category-done "\n")) | ||
| 4615 | (forward-line)) | ||
| 4616 | (set-marker beg nil) | ||
| 4617 | (set-marker end nil)) | ||
| 4618 | (setq file (concat (file-name-sans-extension file) ".toda")) | ||
| 4619 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | ||
| 4620 | (with-temp-buffer | ||
| 4621 | (insert-file-contents file) | ||
| 4622 | (let* ((todos-category-beg todos-category-beg-tem) ; Used by t-m-c-l. | ||
| 4623 | (todos-categories (todos-make-categories-list t))) | ||
| 4624 | (todos-update-categories-sexp)) | ||
| 4625 | (write-region (point-min) (point-max) file nil 'nomessage) | ||
| 4626 | (setq archive-sexp (read (buffer-substring-no-properties | ||
| 4627 | (line-beginning-position) | ||
| 4628 | (line-end-position))))) | ||
| 4629 | (setq file (concat (file-name-sans-extension file) ".todo")) | ||
| 4630 | ;; Update categories sexp of converted Todos file again, adding | ||
| 4631 | ;; counts of archived items. | ||
| 4632 | (with-temp-buffer | ||
| 4633 | (insert-file-contents file) | ||
| 4634 | (let ((sexp (read (buffer-substring-no-properties | ||
| 4635 | (line-beginning-position) | ||
| 4636 | (line-end-position))))) | ||
| 4637 | (dolist (cat sexp) | ||
| 4638 | (let ((archive-cat (assoc (car cat) archive-sexp))) | ||
| 4639 | (if archive-cat | ||
| 4640 | (aset (cdr cat) 3 (aref (cdr archive-cat) 2))))) | ||
| 4641 | (delete-region (line-beginning-position) (line-end-position)) | ||
| 4642 | (prin1 sexp (current-buffer))) | ||
| 4643 | (write-region (point-min) (point-max) file nil 'nomessage))) | ||
| 4644 | (todos-reevaluate-filelist-defcustoms) | ||
| 4645 | (message "Format conversion done.")) | ||
| 4646 | (message "No legacy Todo file exists")) | ||
| 4647 | ;; (setq todos-categories todos-categories-tem | ||
| 4648 | ;; todos-prefix todos-prefix-tem | ||
| 4649 | ;; todos-category-beg todos-category-beg-tem) | ||
| 4650 | ;; (fset 'todos-mode 'todos-mode-tem) | ||
| 4651 | ;; (makunbound 'todos-categories-tem) | ||
| 4652 | ;; (makunbound 'todos-prefix-tem) | ||
| 4653 | ;; (makunbound 'todos-category-beg-tem) | ||
| 4654 | ;; (fmakunbound 'todos-mode-tem) | ||
| 4655 | (unload-feature 'todos) | ||
| 4656 | (require 'todos)))) | ||
| 4624 | 4657 | ||
| 4625 | ;; ----------------------------------------------------------------------------- | 4658 | ;; ----------------------------------------------------------------------------- |
| 4626 | ;;; Utility functions for Todos files, categories and items | 4659 | ;;; Utility functions for Todos files, categories and items |