/usr/share/emacs/site-lisp/howm/howm-reminder.el is in howm 1.4.2-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 | ;;; howm-reminder.el --- Wiki-like note-taking tool
;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
;;; HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
;;; $Id: howm-reminder.el,v 1.83 2012-12-29 08:57:18 hira Exp $
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; The GNU General Public License is available by anonymouse ftp from
;;; prep.ai.mit.edu in pub/gnu/COPYING. Alternately, you can write to
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
;;; USA.
;;--------------------------------------------------------------------
(provide 'howm-reminder)
(require 'howm)
(defvar howm-list-schedule-name "{schedule}")
(defvar howm-list-todo-name "{todo}")
; "This is used for buffer name of `howm-list-reminder'.
; See `howm-view-summary-name'.")
(howm-defvar-risky howm-todo-priority-func
'(("-" . howm-todo-priority-normal)
(" " . howm-todo-priority-normal)
("+" . howm-todo-priority-todo)
("~" . howm-todo-priority-defer)
("!" . howm-todo-priority-deadline)
("@" . howm-todo-priority-schedule)
("." . howm-todo-priority-done)))
(defvar howm-todo-priority-normal-laziness 1)
(defvar howm-todo-priority-todo-laziness 7)
(defvar howm-todo-priority-todo-init -7)
(defvar howm-todo-priority-defer-laziness 30)
(defvar howm-todo-priority-defer-init -14)
(defvar howm-todo-priority-defer-peak 0)
(defvar howm-todo-priority-deadline-laziness 7)
(defvar howm-todo-priority-deadline-init -2)
(defvar howm-todo-priority-schedule-laziness 1)
(defvar howm-todo-priority-normal-bottom (- howm-huge))
(defvar howm-todo-priority-todo-bottom (- howm-huge))
(defvar howm-todo-priority-defer-bottom (- howm-huge))
(defvar howm-todo-priority-deadline-bottom (- howm-huge))
(defvar howm-todo-priority-schedule-bottom (- howm-huge++)
"Base priority of schedules in the bottom.
Its default value is extremely negative so that you never see
schedules outside the range in %reminder in the menu.")
(defvar howm-todo-priority-deadline-top howm-huge)
(defvar howm-todo-priority-schedule-top howm-huge)
(defvar howm-todo-priority-unknown-top howm-huge+)
(defvar howm-action-lock-reminder-done-default nil)
(defvar howm-congrats-count 0)
;;; --- level ? ---
;; Fix me: redundant (howm-date-* & howm-reminder-*)
;; (defun howm-reminder-regexp-grep (types)
;; (howm-inhibit-warning-in-compilation))
;; (defun howm-reminder-regexp (types)
;; (howm-inhibit-warning-in-compilation))
(if howm-reminder-old-format
(progn ;; old format
(defvar howm-reminder-regexp-grep-format
"@\\[[0-9][0-9][0-9][0-9]/[0-9][0-9]/[0-9][0-9]\\]%s")
(defvar howm-reminder-regexp-format
"\\(@\\)\\[\\([0-9][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)\\]\\(%s\\)\\([0-9]*\\)")
(defun howm-reminder-regexp-grep (types)
(format howm-reminder-regexp-grep-format types))
(defun howm-reminder-regexp (types)
(format howm-reminder-regexp-format types))
(defvar howm-reminder-regexp-command-pos 1)
(defvar howm-reminder-regexp-year-pos 2)
(defvar howm-reminder-regexp-month-pos 3)
(defvar howm-reminder-regexp-day-pos 4)
(defvar howm-reminder-regexp-type-pos 5)
(defvar howm-reminder-regexp-laziness-pos 6)
(defvar howm-reminder-today-format "@[%Y/%m/%d]")
(howm-defvar-risky howm-reminder-font-lock-keywords
`(
(,(howm-reminder-regexp "[-]?") (0 howm-reminder-normal-face prepend))
(,(howm-reminder-regexp "[+]") (0 howm-reminder-todo-face prepend))
(,(howm-reminder-regexp "[~]") (0 howm-reminder-defer-face prepend))
(,(howm-reminder-regexp "[!]")
(0 howm-reminder-deadline-face prepend)
(,howm-reminder-regexp-type-pos (howm-reminder-deadline-type-face) prepend))
(,(howm-reminder-regexp "[@]") (0 howm-reminder-schedule-face prepend))
(,(howm-reminder-regexp "[.]") (0 howm-reminder-done-face prepend))
))
(defun howm-reminder-font-lock-keywords ()
howm-reminder-font-lock-keywords)
(defun howm-action-lock-done (&optional command)
(save-excursion
(let ((at-beg (match-beginning howm-reminder-regexp-command-pos))
(at-end (match-end howm-reminder-regexp-command-pos))
(type-beg (match-beginning howm-reminder-regexp-type-pos))
(type-end (match-end howm-reminder-regexp-type-pos))
(lazy-beg (match-beginning howm-reminder-regexp-laziness-pos))
(lazy-end (match-end howm-reminder-regexp-laziness-pos)))
(let* ((s (or command
(read-from-minibuffer
"RET (done), x (cancel), symbol (type), num (laziness): ")))
(c (cond ((string= s "") ".")
((= 0 (string-to-number s)) ". give up")
(t nil))))
(when (string= s "")
(howm-congrats))
(if c
(progn
(goto-char at-beg)
(delete-region at-beg at-end)
(insert (howm-reminder-today))
(insert (format "%s " c)))
(progn
(goto-char lazy-beg)
(delete-region lazy-beg lazy-end)
(when (string= (buffer-substring-no-properties type-beg type-end)
" ")
(goto-char type-beg)
(insert "-")) ;; "no type" = "normal"
(insert s)))))))
)
(progn ;; new format
(defvar howm-reminder-regexp-grep-format
(concat "\\[" howm-date-regexp-grep "[ :0-9]*\\]%s"))
(defvar howm-reminder-regexp-format
(concat "\\(\\[" howm-date-regexp "[ :0-9]*\\]\\)\\(\\(%s\\)\\([0-9]*\\)\\)"))
;; (defvar howm-reminder-regexp-grep-format
;; (concat "\\[" howm-date-regexp-grep "\\]%s"))
;; (defvar howm-reminder-regexp-format
;; (concat "\\[" howm-date-regexp "\\]\\(\\(%s\\)\\([0-9]*\\)\\)"))
(defun howm-reminder-regexp-grep (types)
(format howm-reminder-regexp-grep-format types))
(defun howm-reminder-regexp (types)
(format howm-reminder-regexp-format types))
(defvar howm-reminder-regexp-date-pos 1)
(defvar howm-reminder-regexp-year-pos (+ howm-date-regexp-year-pos 1))
(defvar howm-reminder-regexp-month-pos (+ howm-date-regexp-month-pos 1))
(defvar howm-reminder-regexp-day-pos (+ howm-date-regexp-day-pos 1))
(defvar howm-reminder-regexp-command-pos 5)
(defvar howm-reminder-regexp-type-pos 6)
(defvar howm-reminder-regexp-laziness-pos 7)
(defvar howm-reminder-today-format
(format howm-insert-date-format howm-date-format))
(howm-defvar-risky howm-reminder-font-lock-keywords
`(
(,(howm-reminder-regexp "[-]") (0 howm-reminder-normal-face prepend))
(,(howm-reminder-regexp "[+]") (0 howm-reminder-todo-face prepend))
(,(howm-reminder-regexp "[~]") (0 howm-reminder-defer-face prepend))
(,(howm-reminder-regexp "[!]")
(0 howm-reminder-deadline-face prepend)
(,howm-reminder-regexp-type-pos (howm-reminder-deadline-type-face) prepend))
(,(howm-reminder-regexp "[@]") (0 howm-reminder-schedule-face prepend))
(,(howm-reminder-regexp "[.]") (0 howm-reminder-done-face prepend))
))
(defun howm-reminder-font-lock-keywords ()
howm-reminder-font-lock-keywords)
(defun howm-action-lock-done-prompt ()
(format "RET (done), x (%s), symbol (type), num (laziness): "
howm-reminder-cancel-string))
(defun howm-action-lock-done (&optional command)
;; parse line
(let* ((pos (point))
(beg (match-beginning 0))
(end (match-end 0))
(date (match-string-no-properties howm-reminder-regexp-date-pos))
(type (match-string-no-properties howm-reminder-regexp-type-pos))
(lazy (match-string-no-properties howm-reminder-regexp-laziness-pos))
(desc (buffer-substring-no-properties end (line-end-position))))
;; parse input command
(let* ((s (or command
(howm-read-string (howm-action-lock-done-prompt)
"x-+~!.@"
"0123456789")))
(type-or-lazy (string-match (format "^\\(%s?\\)\\([0-9]*\\)$"
howm-reminder-types)
s))
(new-type (and type-or-lazy (match-string-no-properties 1 s)))
(new-lazy (and type-or-lazy (match-string-no-properties 2 s))))
(when (string= new-type "")
(setq new-type type))
(when (string= new-lazy "")
(setq new-lazy lazy))
;; dispatch and get new contents
(let ((new (cond ((string= s "")
(howm-action-lock-done-done date type lazy desc))
((string= s "x")
(howm-action-lock-done-cancel date type lazy
desc))
(type-or-lazy
(howm-action-lock-done-modify date
new-type new-lazy
desc))
(t
(error "Can't understand %s" s)))))
;; replace contents
(goto-char beg)
(delete-region (point) (line-end-position))
(insert new)
(goto-char pos)))))
(defun howm-action-lock-done-done (date type lazy desc &optional done-mark)
(when (null done-mark)
(setq done-mark ".")
(howm-congrats))
(concat (howm-reminder-today) done-mark " "
date ":" type lazy desc))
(defun howm-action-lock-done-cancel (date type lazy desc)
(howm-action-lock-done-done date type lazy desc
(format ". %s" howm-reminder-cancel-string)))
(defun howm-action-lock-done-modify (date type lazy desc)
(concat date type lazy desc))
))
(defun howm-reminder-deadline-type-face ()
(let ((late (cadr (howm-todo-parse-string (match-string-no-properties 0)))))
(if (>= late 0)
howm-reminder-late-deadline-face
howm-reminder-deadline-face)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Reminder: schedule & todo
(define-key howm-view-summary-mode-map "." 'howm-reminder-goto-today)
;; Clean me.
;; I cannot remember why I wrote howm-with-schedule-summary-format.
(defmacro howm-with-schedule-summary-format (&rest body)
(declare (indent 0))
`(let ((howm-view-summary-format (if howm-view-split-horizontally ;; dirty!
""
howm-view-summary-format)))
,@body))
(defun howm-list-schedule ()
(interactive)
(howm-with-need
(howm-with-schedule-summary-format
(let ((items (need (howm-list-reminder-internal howm-schedule-types))))
(howm-list-reminder-final-setup howm-list-schedule-name
(howm-schedule-sort-items items)))
(howm-reminder-goto-today)
(howm-view-summary-check))))
(defun howm-list-reminder-internal (types)
(let* ((r (howm-reminder-regexp types))
(rg (howm-reminder-regexp-grep types))
(summarizer (howm-reminder-summarizer r t))
(folder (howm-reminder-search-path-folder)))
(third (howm-view-search-folder-internal rg folder nil summarizer))))
(defun howm-list-reminder-final-setup (&optional name item-list)
(howm-view-summary name item-list
(append (howm-reminder-add-font-lock-internal)
(howm-mode-add-font-lock-internal)))
(let ((action-lock-default-rules
(howm-action-lock-reminder-forward-rules t)))
(action-lock-mode t)))
(let ((rs (mapcar #'regexp-quote
(list howm-date-format howm-reminder-today-format))))
(defcustom howm-highlight-date-regexp-format (car rs)
"Time format for highlight of today and tommorow.
This value is passed to `format-time-string', and the result must be a regexp."
:type `(radio ,@(mapcar (lambda (r) `(const ,r)) rs)
string)
:group 'howm-faces))
(defun howm-reminder-today-font-lock-keywords ()
(let ((today (howm-reminder-today 0 howm-highlight-date-regexp-format))
(tomorrow (howm-reminder-today 1 howm-highlight-date-regexp-format)))
`((,today (0 howm-reminder-today-face prepend))
(,tomorrow (0 howm-reminder-tomorrow-face prepend)))))
(defun howm-reminder-add-font-lock ()
(cheat-font-lock-append-keywords (howm-reminder-add-font-lock-internal)))
(defun howm-reminder-add-font-lock-internal ()
(append (howm-reminder-font-lock-keywords)
(howm-reminder-today-font-lock-keywords)))
(defun howm-reminder-omit-before (regexp str)
(string-match regexp str)
(substring str (match-beginning 0)))
(defun howm-reminder-summarizer (regexp &optional show-day-of-week)
`(lambda (file line content)
(let ((s (howm-reminder-omit-before ,regexp content)))
;; (string-match ,regexp content)
;; (substring content (match-beginning 0)))))
,(if show-day-of-week
'(let* ((p (howm-todo-parse-string s))
(late (floor (nth 1 p)))
(dow (howm-day-of-week-string (nth 4 p))))
(format "%s%3s %s" dow late s))
's))))
(defun howm-reminder-today (&optional days-after fmt)
(format-time-string (or fmt howm-reminder-today-format)
(howm-days-after (current-time) (or days-after 0))))
;; dirty. peek howm-view-*
(defun howm-reminder-goto-today ()
(interactive)
(let* ((today (howm-reminder-today))
(r (howm-reminder-regexp "."))
(summaries (mapcar (lambda (item)
(howm-reminder-omit-before
r (howm-view-item-summary item)))
(howm-view-item-list))))
;; (summaries (mapcar 'howm-view-item-summary (howm-view-item-list))))
(let ((rest summaries)
(n 0))
(while (and rest
(string< (car rest) today))
(setq rest (cdr rest)
n (1+ n)))
(howm-goto-line (1+ n)))))
(defun howm-schedule-menu (days &optional days-before)
(let* ((today (howm-encode-day t))
(from (- today (or days-before 0)))
(to (+ today days 1))
(howm-schedule-types howm-schedule-menu-types) ;; dirty
(raw (howm-reminder-search howm-schedule-types))
(filtered (howm-cl-remove-if #'(lambda (item)
(let ((s (howm-schedule-date item)))
(or (< s from)
(< to s))))
raw)))
(howm-schedule-sort-items filtered)))
(defun howm-schedule-sort-items (items &optional reverse-p)
(when reverse-p
(error "Not supported."))
(howm-with-schedule-summary-format
(howm-sort #'howm-schedule-sort-converter #'howm-schedule-sort-comparer
items)))
(defun howm-schedule-sort-by-date ()
(interactive)
(howm-view-sort-doit #'howm-schedule-sort-items))
(defun howm-schedule-sort-converter (item)
(let ((z (howm-reminder-parse item)))
(cons (car z)
(if howm-schedule-sort-by-time
(howm-item-summary item)
(nth 5 z)))))
(defun howm-schedule-sort-comparer (a b)
(if (= (car a) (car b))
(string< (cdr a) (cdr b))
(< (car a) (car b))))
(defun howm-schedule-date (item)
(car (howm-reminder-parse item)))
(defun howm-reminder-search (types)
(let* ((r (howm-reminder-regexp types))
(rg (howm-reminder-regexp-grep types))
(summarizer (howm-reminder-summarizer r))
(folder (howm-reminder-search-path-folder)))
(howm-view-search-folder-items rg folder summarizer)))
(defun howm-list-todo ()
(interactive)
(howm-list-todo-sub))
;; experimental [2006-06-26]
(defun howm-todo-sleeping-p (item)
;; (- howm-huge-) should be replaced with an appropreate variable.
(< (howm-todo-priority item) (- howm-huge-)))
(defun howm-list-active-todo ()
(interactive)
(howm-list-todo-sub (lambda (item)
(not (howm-todo-sleeping-p item)))))
(defun howm-list-sleeping-todo ()
(interactive)
(howm-list-todo-sub #'howm-todo-sleeping-p))
(defun howm-list-todo-sub (&optional pred)
(howm-with-need
(howm-with-schedule-summary-format
(let ((items (need (howm-list-reminder-internal howm-todo-types))))
(when pred
(setq items
(need (howm-cl-remove-if-not pred items))))
(setq items (howm-todo-sort-items items))
(when howm-todo-separators
(setq items
(howm-todo-insert-separators items
howm-todo-separators)))
(howm-list-reminder-final-setup howm-list-todo-name items)))))
(defun howm-todo-menu (n limit-priority separators)
"Find top N todo items, or all todo items if N is nil.
Returned value is a sorted list of items (see `howm-make-item').
Items whose priority is worse than LIMIT-PRIORITY are eliminated.
Separator strings are inserted to the returned list according to
the rule given as SEPARATORS.
See docstring of the variable `howm-menu-reminder-separators' for details."
(let* ((cutted (howm-cl-remove-if (lambda (item)
(< (howm-todo-priority item)
limit-priority))
(howm-reminder-search howm-todo-menu-types)))
(sorted (howm-todo-sort-items cutted)))
(howm-todo-insert-separators (if n (howm-first-n sorted n) sorted)
separators t)))
(defun howm-reminder-menu (n limit-priority separators)
(howm-with-reminder-setting
(howm-todo-menu n limit-priority separators)))
(defun howm-todo-insert-separators (item-list separators
&optional relative-date-p)
(let ((is (mapcar (lambda (item) (cons (howm-todo-priority item) item))
item-list))
(sep (mapcar (lambda (pair)
(cons (if relative-date-p
(- howm-todo-priority-schedule-top
(or (car pair) howm-huge-))
(or (car pair) (- howm-huge-)))
(howm-make-item (howm-make-page:nil) (cdr pair))))
separators)))
(mapcar #'cdr
(sort (append is sep) #'(lambda (x y) (> (car x) (car y)))))))
(defun howm-todo-sort-items (items &optional reverse-p)
(when reverse-p
(error "Not supported."))
(howm-sort #'howm-todo-priority-ext #'howm-todo-priority-ext-gt
items))
(defun howm-todo-sort-by-priority ()
(howm-view-sort-doit #'howm-todo-sort-items))
;; Clean me.
(defun howm-reminder-parse (item)
(howm-todo-parse-string (howm-view-item-summary item)))
(defun howm-todo-parse (item)
(cdr (howm-reminder-parse item)))
(defun howm-todo-parse-string (str)
"Parse reminder format.
Example: (howm-todo-parse-string \"abcde [2004-11-04]@ hogehoge\")
==> (12725.625 0.022789351851315587 \"@\" nil 4 \" hogehoge\")"
(let ((summary str))
(string-match (howm-reminder-regexp ".") summary)
(let ((y (match-string-no-properties howm-reminder-regexp-year-pos
summary))
(m (match-string-no-properties howm-reminder-regexp-month-pos
summary))
(d (match-string-no-properties howm-reminder-regexp-day-pos
summary))
(ty (match-string-no-properties howm-reminder-regexp-type-pos
summary))
(lz (match-string-no-properties howm-reminder-regexp-laziness-pos
summary))
(description (substring str (match-end 0))))
(let* ((day (howm-encode-day d m y))
(today (howm-encode-day))
(late (- today day))
(type (substring (or ty "-") 0 1)) ;; "-" for old format
(lazy (cond ((string= type " ") nil)
((null lz) nil)
(t (let ((z (string-to-number lz)))
(if (= z 0) nil z)))))
;; (lazy (if (string= type " ")
;; 0
;; (string-to-number (or lz "0"))))
(day-of-week (nth 6
(decode-time (apply #'encode-time
(mapcar #'string-to-number
(list "0" "0" "0"
d m y)))))))
(list day late type lazy day-of-week description)))))
(defun howm-todo-priority (item)
(let* ((p (howm-todo-parse item))
(late (car p))
(type (second p))
(lazy (third p))
(f (or (cdr (assoc type howm-todo-priority-func))
#'howm-todo-priority-unknown)))
(funcall f late lazy item)))
(defun howm-todo-priority-ext (item)
(cons (howm-todo-priority item) (howm-view-item-summary item)))
(defun howm-todo-priority-ext-gt (e1 e2)
"Compare two results E1 and E2 of `howm-todo-priority-ext'.
Return true if E1 has higher priority than E2."
(cond ((> (car e1) (car e2)) t)
((< (car e1) (car e2)) nil)
(t (string< (cdr e1) (cdr e2)))))
(defun howm-todo-relative-late (late laziness default-laziness)
(/ late (float (or laziness default-laziness))))
(defun howm-todo-priority-normal (late lz item)
(let ((r (howm-todo-relative-late late lz
howm-todo-priority-normal-laziness)))
(cond ((< r 0) (+ r howm-todo-priority-normal-bottom))
(t (- r)))))
(defun howm-todo-priority-todo (late lz item)
(let ((r (howm-todo-relative-late late lz
howm-todo-priority-todo-laziness))
(c (- howm-todo-priority-todo-init)))
(cond ((< r 0) (+ r howm-todo-priority-todo-bottom))
(t (* c (- r 1))))))
(defun howm-todo-priority-defer (late lz item)
(let* ((r (howm-todo-relative-late late lz
howm-todo-priority-defer-laziness))
(p howm-todo-priority-defer-peak)
(c (- p howm-todo-priority-defer-init)))
(let ((v (* 2 (abs (- (mod r 1) 0.5)))))
(cond ((< r 0) (+ r howm-todo-priority-defer-bottom))
(t (- p (* c v)))))))
;; ;; Clean me.
;; (defvar howm-todo-schedule-days nil)
;; (defvar howm-todo-schedule-days-before nil)
;; (defmacro howm-with-schedule-days (days days-before &rest body)
;; `(let ((howm-todo-schedule-days ,days)
;; (howm-todo-schedule-days-before ,days-before))
;; ,@body))
;; (put 'howm-with-schedule-days 'lisp-indent-hook 2)
;; (defun howm-todo-priority-schedule (late lz item)
;; (setq lz (or lz howm-todo-priority-schedule-laziness))
;; (cond ((< late (- howm-todo-schedule-days))
;; (+ late howm-todo-priority-schedule-bottom))
;; ((< late (+ lz howm-todo-schedule-days-before))
;; (+ late howm-todo-priority-schedule-top))
;; (t
;; (+ late howm-todo-priority-schedule-bottom))))
(defun howm-todo-priority-deadline (late lz item)
(if howm-reminder-schedule-interval
(howm-todo-priority-deadline-1 late lz item)
(howm-todo-priority-deadline-2 late lz item)))
(defun howm-todo-priority-deadline-1 (late lz item)
(let ((r (howm-todo-relative-late late lz
howm-todo-priority-deadline-laziness))
(c (- howm-todo-priority-deadline-init))
(d (- (howm-reminder-schedule-interval-to)))
(top howm-todo-priority-deadline-top)
(bot howm-todo-priority-deadline-bottom))
;; I dare to use late in the first case below so that
;; deadline behaves like schedule after its deadline date.
(cond ((< d late) (+ top late))
((< r -1) (+ bot r))
(t (* c r)))))
(defun howm-todo-priority-deadline-2 (late lz item)
"This function may be obsolete in future.
`howm-todo-priority-deadline-1' will be used instead."
(let ((r (howm-todo-relative-late late lz
howm-todo-priority-deadline-laziness))
(c (- howm-todo-priority-deadline-init)))
(cond ((> r 0) (+ r howm-todo-priority-deadline-top))
((< r -1) (+ r howm-todo-priority-deadline-bottom))
(t (* c r)))))
(defun howm-todo-priority-schedule (late lz item)
(if howm-reminder-schedule-interval
(howm-todo-priority-schedule-1 late lz item)
(howm-todo-priority-schedule-2 late lz item)))
(defun howm-todo-priority-schedule-1 (late lz item)
(let ((lazy (or lz howm-todo-priority-schedule-laziness))
(from (howm-reminder-schedule-interval-from))
(to (howm-reminder-schedule-interval-to))
(top howm-todo-priority-schedule-top)
(bot howm-todo-priority-schedule-bottom))
(cond ((< late (- to)) (+ bot late))
((< late (+ from lazy)) (+ top late))
(t (+ bot late)))))
(defun howm-todo-priority-schedule-2 (late lz item)
"This function may be obsolete in future.
`howm-todo-priority-schedule-1' will be used instead."
(let ((r (howm-todo-relative-late late lz
howm-todo-priority-schedule-laziness)))
(cond ((> r 0) (+ r howm-todo-priority-schedule-bottom))
(t r))))
(defun howm-todo-priority-done (late lz item)
(+ late howm-todo-priority-done-bottom))
(defun howm-todo-priority-unknown (late lz item)
(+ late howm-todo-priority-unknown-top))
(defun howm-encode-day (&optional d m y)
"Convert date Y-M-D to a float number, days from the reference date.
When D is omitted, the current time is encoded.
When D is t, the beginning of today is encoded."
(let* ((e (apply #'encode-time (cond ((eq d t)
(let ((now (howm-decode-time)))
(append '(0 0 0) (cdddr now))))
(d
(mapcar #'string-to-number
(list "0" "0" "0" d m y)))
(t
(howm-decode-time)))))
(hi (car e))
(low (second e))
(daysec (* 60 60 24.0)))
(+ (* hi (/ 65536 daysec)) (/ low daysec))))
(defun howm-congrats ()
(setq howm-congrats-count (1+ howm-congrats-count))
(let* ((n (length howm-congrats-format))
(r (random n)))
(message (nth r howm-congrats-format) howm-congrats-count)
(when howm-congrats-command
(howm-congrats-run howm-congrats-command))
(run-hooks 'howm-congrats-hook)))
(defun howm-congrats-run (com-arg-list)
(let* ((name "howm-congrats")
(command (car com-arg-list))
(args (cdr com-arg-list))
(prev (get-process name)))
(when prev
(delete-process prev))
(apply #'start-process-shell-command `(,name nil ,command ,@args))))
(defun howm-action-lock-reminder-done-rule ()
(list (howm-reminder-regexp howm-reminder-types)
`(lambda (&optional arg)
(let ((command (if arg
nil
howm-action-lock-reminder-done-default)))
(howm-action-lock-done command)))
howm-reminder-regexp-command-pos))
(defun howm-reminder-search-path ()
(howm-search-path t))
(defun howm-reminder-search-path-folder ()
(howm-search-path-folder t))
;;; direct manipulation of items from todo list
;; I'm sorry for dirty procedure here.
;; If we use naive howm-date-regexp, it matches to file name "2004-05-11.txt"
;; in summary mode.
(defun howm-action-lock-reminder-forward-rules (&optional summary-mode-p)
(let* ((action-maker (lambda (pos)
`(lambda (&optional dummy)
(howm-action-lock-forward (match-beginning ,pos)))))
(reminder-rule (list (howm-reminder-regexp howm-reminder-types)
(funcall action-maker 0)
howm-reminder-regexp-command-pos))
(summary-date-reg (format ".*%s.*\\(%s\\)"
(regexp-quote howm-view-summary-sep)
howm-date-regexp))
(summary-date-reg-pos 1)
(summary-date-rule (list summary-date-reg
(funcall action-maker summary-date-reg-pos)
summary-date-reg-pos))
(menu-date-rule (list howm-date-regexp
(funcall action-maker 0)))
(date-rule (if summary-mode-p
summary-date-rule
menu-date-rule)))
(list reminder-rule date-rule)))
(defvar howm-action-lock-forward-wconf nil
"for internal use")
(defun howm-action-lock-forward-escape ()
(setq howm-action-lock-forward-wconf
(current-window-configuration)))
(defmacro howm-action-lock-forward-block (&rest body)
(declare (indent 0))
`(prog2
(setq howm-action-lock-forward-wconf nil)
(progn
,@body)
(when howm-action-lock-forward-wconf
(set-window-configuration howm-action-lock-forward-wconf))))
(defun howm-action-lock-forward (form-pos)
(howm-action-lock-forward-block
(let* ((cursor-pos (point))
(form-reg (howm-line-tail-regexp form-pos))
(cursor-reg (howm-line-tail-regexp cursor-pos)))
(let* ((mt (buffer-modified-tick))
(original-tail (buffer-substring form-pos (line-end-position)))
(modified-tail (howm-action-lock-forward-invoke form-reg
cursor-reg))
(untouched-p (= mt (buffer-modified-tick))))
;; Current-buffer may be already updated according to
;; howm-menu-refresh-after-save because save-buffer in
;; howm-action-lock-forward-invoke can run howm-after-save-hook.
;; We have to exclude such cases.
(when (and untouched-p
(not (string= original-tail modified-tail)))
(let ((buffer-read-only nil))
(howm-menu-list-getput-item original-tail modified-tail)
(delete-region form-pos (line-end-position))
(insert modified-tail)))
(goto-char cursor-pos)
(howm-action-lock-forward-update)))))
(defun howm-line-tail-regexp (pos)
(concat (regexp-quote (buffer-substring-no-properties pos
(line-end-position)))
"$"))
(defun howm-action-lock-forward-invoke (form-reg cursor-reg)
(howm-modify-in-background (lambda (&rest dummy)
;; open the target file
;; and go to the corresponding line
(howm-action-lock-forward-open))
(lambda (form-reg cursor-reg)
(howm-action-lock-forward-modify-current-line
form-reg cursor-reg))
howm-action-lock-forward-save-buffer
howm-action-lock-forward-kill-buffer
form-reg
cursor-reg))
(defun howm-modify-in-background (opener modifier save-p kill-p &rest args)
(save-excursion
(save-window-excursion
(let ((original-buffers (buffer-list)))
(apply opener args)
;; We are in the target buffer now.
(let ((initially-modified-p (buffer-modified-p)))
(prog1
(apply modifier args)
(when (and save-p
(not initially-modified-p)
(buffer-modified-p))
(save-buffer))
(when (and kill-p
(not (buffer-modified-p))
(not (member (current-buffer) original-buffers)))
(kill-buffer (current-buffer)))))))))
(defun howm-action-lock-forward-modify-current-line (form-reg cursor-reg)
(howm-modify-form #'action-lock-invoke form-reg cursor-reg))
(defun howm-modify-form (proc form-reg cursor-reg &rest args)
(labels
((f-cursor ()
(beginning-of-line)
(re-search-forward cursor-reg
(line-end-position
(+ 1 howm-action-lock-forward-fuzziness))
t))
(b-cursor ()
(end-of-line)
(re-search-backward cursor-reg
(line-beginning-position
(- 1 howm-action-lock-forward-fuzziness))
t))
(b-form ()
(end-of-line)
(re-search-backward form-reg (line-beginning-position) t)))
(or (save-excursion (and (f-cursor) (b-form)))
(save-excursion (and (b-cursor) (b-form)))
(error "Can't find corresponding line.")))
(goto-char (match-beginning 0))
;; Now we are at the beginning of the form.
;; Remember this position to report the modified tail.
(save-excursion
(when (not (re-search-forward cursor-reg (line-end-position) t))
(error "Can't find corresponding string."))
(goto-char (match-beginning 0))
;; update display. I don't understand why this is needed.
;; Without this, cursor is placed at the end of buffer if I delete many
;; lines before the form position in the below setting (GNU Emacs 21.4.1).
;; (setq howm-menu-refresh-after-save nil)
;; (setq howm-menu-expiry-hours 3)
;; (setq howm-action-lock-forward-fuzziness 20000)
;; Sigh...
(switch-to-buffer (current-buffer) t)
;; Now we are at the corresponding position.
;; Let's call proc to modify the form!
(undo-boundary)
(apply proc args))
;; We are back to the beginning of the form.
;; Report the modified tail.
(buffer-substring-no-properties (point) (line-end-position)))
(defun howm-action-lock-forward-open ()
(cond ((eq major-mode 'howm-menu-mode)
(progn
(howm-menu-list-action)
(when (eq major-mode 'howm-view-summary-mode)
(error "Several candidates."))))
((eq major-mode 'howm-view-summary-mode)
(howm-view-summary-open))
(t
(error "Not supported on this buffer."))))
(defun howm-action-lock-forward-update ()
(cond ((eq major-mode 'howm-menu-mode)
nil) ; do nothing
((eq major-mode 'howm-view-summary-mode)
(howm-view-summary-check t))
(t
(error "Not supported on this buffer."))))
;;; extend deadlines (experimental)
(put 'howm-extend-deadlines 'disabled t)
(defun howm-extend-deadlines (days)
"Extend all overdue deadlines for DAYS from today."
(interactive "nHow many days? ")
(let ((hit (howm-cl-remove-if (lambda (item)
(< (second (howm-reminder-parse item)) 0))
(howm-reminder-search "!"))))
(mapc (lambda (item)
(howm-modify-in-background (lambda (item dummy)
(howm-view-open-item item))
#'howm-extend-deadline-here
nil nil item days))
hit)
(howm-menu-refresh-background)
(message "Extended %s deadline(s)." (length hit))))
(defun howm-extend-deadline-here (item days)
(apply (lambda (form-reg cursor-reg) ;; use apply for destructuring-bind
(howm-modify-form #'howm-extend-deadline-doit
form-reg cursor-reg days))
(let ((summary (howm-item-summary item)))
(string-match (howm-reminder-regexp ".") summary)
(mapcar (lambda (p)
(concat (regexp-quote
(substring summary (match-beginning p)))
"$"))
(list howm-reminder-regexp-date-pos
howm-reminder-regexp-year-pos)))))
(defun howm-extend-deadline-doit (days)
(or (looking-at howm-date-regexp)
(re-search-backward howm-date-regexp (line-beginning-position) t)
(error "Can't find corresponding date form."))
(howm-datestr-replace
(howm-datestr-shift (howm-time-to-datestr) 0 0 days)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; customize
(defun howm-define-reminder (letter priority-func face schedule todo
&optional reminder)
"Define reminder type LETTER whose priority is determined by PRIORITY-FUNC.
It appears with FACE in schedule list when SCHEDULE is non-nil, and in
todo list when TODO is non-nil. It also appears in menu if SCHEDULE
or TODO is t."
(add-to-list 'howm-todo-priority-func
(cons letter priority-func))
(add-to-list 'howm-reminder-font-lock-keywords
`(,(howm-reminder-regexp (format "[%s]" letter))
(0 ,face prepend)))
(let* ((schedule-menu (eq schedule t))
(todo-menu (eq todo t))
(reminder-menu (or schedule-menu todo-menu)))
;; Don't modify howm-reminder-marks.
;; Otherwise, defcustom will be confused for howm-reminder-menu-types, etc.
(howm-cl-mapcar* (lambda (var flag)
(howm-modify-reminder-types var letter flag))
'(howm-reminder-types
howm-schedule-types howm-todo-types
howm-schedule-menu-types howm-todo-menu-types
howm-reminder-menu-types)
(list t schedule todo
schedule-menu todo-menu reminder-menu))))
(defun howm-modify-reminder-types (var letter flag)
"Modify variable VAR whose value is \"[...]\".
Example:
(setq foo \"[abc]\")
(howm-modify-reminder-types 'foo \"d\" t) foo ==> \"[abcd]\"
(howm-modify-reminder-types 'foo \"b\" nil) foo ==> \"[acd]\"
"
(let ((val (symbol-value var)))
(when (not (string-match "^\\[\\(.*\\)\\]$" val))
(error "Wrong format - %s: %s" var val))
(let* ((old (match-string-no-properties 1 val))
(removed (remove (string-to-char letter) old))
(new (if flag
;; This order is important when val is "[-+~!.]".
(concat removed letter)
removed)))
(set var (format "[%s]" new)))))
;; (example)
;; If you write like below in your memo, it will appear
;; under today's schedule in reminder list.
;; The date "2004-11-01" is dummy and "0" means the position "today - 0".
;; [2004-11-01]_0 ========================
;; (defun howm-todo-priority-separator (late lazy item)
;; (- howm-huge (or lazy 0) -1))
;; (defface howm-reminder-separator-face
;; ;; invisible :p
;; '((((class color) (background light)) (:foreground "white"))
;; (((class color) (background dark)) (:foreground "black"))
;; (t ()))
;; "Face for `howm-list-reminder'. This is obsolete and will be removed in future."
;; :group 'howm-faces)
;; (defvar howm-reminder-separator-face 'howm-reminder-separator-face)
;; (defvar howm-reminder-separator-type "_")
;; (howm-define-reminder howm-reminder-separator-type
;; #'howm-todo-priority-separator
;; 'howm-reminder-separator-face t t)
;;; howm-reminder.el ends here
|