howm-menu.el

   1 ;;; howm-menu.el --- Wiki-like note-taking tool
   2 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016, 2017
   3 ;;;   HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
   4 ;;; $Id: howm-menu.el,v 1.106 2012-09-23 11:34:59 hira Exp $
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 1, or (at your option)
   9 ;;; any later version.
  10 ;;;
  11 ;;; This program is distributed in the hope that it will be useful,
  12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; The GNU General Public License is available by anonymouse ftp from
  17 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  18 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  19 ;;; USA.
  20 ;;;--------------------------------------------------------------------
  21
  22 (provide 'howm-menu)
  23 (require 'howm)
  24
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;; customize
  27
  28 ;;; general
  29
  30 (howm-defvar-risky howm-menu-mode-map nil)
  31 (let ((m (make-keymap)))
  32   (define-key m action-lock-magic-return-key 'howm-menu-invoke)
  33   (define-key m [tab] 'action-lock-goto-next-link)
  34   (define-key m [(meta tab)] 'action-lock-goto-previous-link)
  35   (define-key m "\C-i" 'action-lock-goto-next-link)
  36   (define-key m "\M-\C-i" 'action-lock-goto-previous-link)
  37   (define-key m " " 'scroll-up)
  38   (define-key m [backspace] 'scroll-down)
  39   (define-key m "\C-h" 'scroll-down)
  40   (define-key m "q" 'bury-buffer)
  41   (define-key m "?" 'describe-mode)
  42   (setq howm-menu-mode-map m)
  43   )
  44
  45 ;;; schedule, todo, recent, random
  46
  47 ;; Set random seed.
  48 ;; snap://Info-mode/elisp#Random Numbers
  49 (defvar howm-randomize t)
  50 (when howm-randomize
  51   (random t))
  52
  53 (defvar howm-menu-reminder-format "> %s | %s"
  54   "Format to show schedule/todo list in `howm-menu-mode'.")
  55 (defvar howm-menu-list-format
  56   (let* ((path (format-time-string howm-file-name-format))
  57          (width (length (file-name-sans-extension
  58                          (file-name-nondirectory path)))))
  59     (concat "> %-" (format "%s" width) "s | %s"))
  60   "Format to show recent/random list in `howm-menu-mode'.")
  61 (defvar howm-menu-list-regexp "^\\(>\\([^|\r\n]*|\\)\\) +\\(.*\\)$"
  62   "Regexp to find and parse schedule/todo/recent/random list in `howm-menu-mode'.
  63 `howm-menu-list-regexp-action-pos' must cover header part.
  64 Otherwise, `howm-action-lock-forward' may be invoked unintentionally.")
  65 (defvar howm-menu-list-regexp-key-pos 3
  66   "Position of target string for action-lock in history buffer.
  67 This target is searched when action-lock is invoked.")
  68 (defvar howm-menu-list-regexp-action-pos 1
  69   "Position of action-lock hilight on schedule/todo/recent/random list
  70 in `howm-menu-mode'.")
  71 (defvar howm-menu-list-regexp-face-pos 2
  72   "Position to apply `howm-menu-list-face' on schedule/todo/recent/random list
  73 in `howm-menu-mode'.")
  74
  75 ;;; shortcut
  76
  77 ;; %"..." or %"...%"
  78 (defvar howm-menu-key-regexp
  79   "%\"\\(\\([^\r\n%\"]\\)[^\r\n%\"]*\\(%+[^\r\n%\"]+\\)*\\)\\(%\\)?\"")
  80 (defvar howm-menu-key-regexp-word-pos 1)
  81 (defvar howm-menu-key-regexp-key-pos 2)
  82 (defvar howm-menu-key-regexp-moveonly-pos 4)
  83
  84 ;;; dynamic contents
  85
  86 (howm-defvar-risky howm-menu-allow
  87   '(howm-menu-schedule
  88     howm-menu-todo
  89     howm-menu-reminder
  90     howm-menu-recent
  91     howm-menu-random
  92     howm-menu-search
  93     howm-menu-categorized-reminder
  94     ))
  95
  96 (howm-defvar-risky howm-menu-display-rules
  97   `(
  98     ;; static
  99     ("%sdays"    . "%here%howm-menu-schedule-days")
 100     ("%tnum"     . "%here%howm-menu-todo-num")
 101     ("%schedule" . "%here%(howm-menu-schedule)")
 102     ("%todo"     . "%here%(howm-menu-todo)")
 103     ("%reminder" . "%here%(howm-menu-reminder)")
 104     ("%recent"   . "%here%(howm-menu-recent)")
 105     ("%random"   . "%here%(howm-menu-random)")
 106     ;; dynamic
 107     ("%here%" . howm-menu-here)
 108     (,howm-menu-key-regexp . howm-menu-shortcut)
 109     )
 110   "List of rules for dynamic contents in howm menu.
 111 ((R1 . T1) (R2 . T2) ...):
 112 Regexp R1 is replaced by T1 if T1 is a string.
 113 (T1) is called at R1 if T1 is a function.")
 114
 115 ;;; command table
 116
 117 ;; howm-menu-command-table-* = ((MATCHER FUNC ONBUF) ...)
 118 ;;
 119 ;; (FUNC) is evalueted on ONBUF when return key is hit on MATCHER.
 120 ;;
 121 ;; MATCHER = regexp | (regexp position)
 122 ;; (optional) ONBUF = nil | 'previous | 'current
 123 ;;   nil: previous non-menu buffer (set-buffer)
 124 ;;   'previous: previous non-menu buffer (switch-to-buffer)
 125 ;;   'current: current menu buffer
 126
 127 (howm-defvar-risky howm-menu-command-table-common
 128   '(
 129     (("%eval%\\(.*$\\)" 1) howm-menu-eval previous)
 130     (("%call%\\(.*$\\)" 1) howm-menu-call previous)
 131      ))
 132
 133 ;;; which is opened as menu?
 134
 135 (howm-defvar-risky howm-menu-keyword-regexp "^%.*%$")
 136 (howm-defvar-risky howm-menu-top "%menu%")
 137
 138 ;;; misc.
 139
 140 (howm-defvar-risky howm-menu-toggle-invisible "%|")
 141
 142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 143 ;; internal
 144
 145 (defvar *howm-menu-force-refresh* nil) ;; dirty. clean me. [2003/09/29 21:39]
 146
 147 (defvar *howm-menu-shortcut-keys* nil)
 148 (defvar *howm-menu-shortcut-multidef-keys* nil)
 149 (defvar *howm-menu-shortcut-markers* nil)
 150 (make-variable-buffer-local '*howm-menu-shortcut-markers*)
 151
 152 (defvar howm-menu-previous-buffer nil)
 153 (defvar howm-menu-next-expiry-time (current-time))
 154 (defvar howm-menu-last-time (current-time))
 155 (defvar howm-menu-buffer-file nil)
 156 (defvar howm-menu-buffer-file-place nil)
 157 (howm-defvar-risky howm-menu-mode-local-map nil)
 158 (make-variable-buffer-local 'howm-menu-previous-buffer)
 159 (make-variable-buffer-local 'howm-menu-next-expiry-time)
 160 (make-variable-buffer-local 'howm-menu-last-time)
 161 (make-variable-buffer-local 'howm-menu-buffer-file)
 162 (make-variable-buffer-local 'howm-menu-buffer-file-place)
 163 (make-variable-buffer-local 'howm-menu-mode-local-map)
 164
 165 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 166 ;; mode
 167
 168 (defun howm-menu-mode ()
 169   "howm menu
 170 key     binding
 171 ---     -------
 172 \\[action-lock-magic-return]    Follow link
 173 \\[action-lock-goto-next-link]  Next link
 174 \\[action-lock-goto-previous-link]      Prev link
 175 \\[describe-mode]       This help
 176 \\[bury-buffer] Quit
 177 "
 178   (interactive)
 179   (setq major-mode 'howm-menu-mode
 180         mode-name "HM")
 181   (setq howm-menu-mode-local-map (copy-keymap howm-menu-mode-map))
 182   (use-local-map howm-menu-mode-local-map)
 183   )
 184
 185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 186 ;; main
 187
 188 (defun howm-menu (&optional force-refresh last-chance)
 189   (interactive)
 190   (when (and (eq (howm-folder-type howm-directory) ':dir)
 191              (not (file-exists-p howm-directory)))
 192     (make-directory howm-directory t))
 193   (let ((*howm-menu-force-refresh* force-refresh)
 194         ;; force to use the original howm-directory
 195         (*howm-independent-directories* nil))
 196     (if (and howm-menu-keyword-regexp (null howm-menu-file))
 197         (let ((m (howm-keyword-search howm-menu-top)))
 198           (when (and (cdr (assoc 'menu-p m))
 199                      (not (cdr (assoc 'keyword-matched m))))
 200             (howm-menu-initialize-skel last-chance)))
 201       (howm-menu-open howm-menu-file))))
 202
 203 (defun howm-menu-open (file &optional place name)
 204   (setq name (or name (howm-menu-name file)))
 205   (let ((f (if (file-name-absolute-p file)
 206                file
 207              (expand-file-name file howm-directory))))
 208     (if (file-exists-p f)
 209         (howm-menu-open-sub f place name)
 210       (progn
 211         (find-file f)
 212         (howm-mode)))))
 213
 214 (defun howm-menu-open-sub (f place name)
 215   (let* ((pb (current-buffer))
 216          (pm major-mode)
 217          (b (get-buffer name))
 218          (mtime (nth 5 (file-attributes f))))
 219     (if (or *howm-menu-force-refresh*
 220             (null b)
 221             (progn
 222               (set-buffer b)
 223               (or (howm-time< howm-menu-last-time mtime)
 224                   (howm-time< howm-menu-next-expiry-time
 225                               (current-time)))))
 226         (howm-menu-refresh f place name)
 227       (switch-to-buffer b))
 228     (let ((cm major-mode))
 229       (save-excursion
 230         (while (eq pm cm)
 231           (set-buffer pb)
 232           (setq pb howm-menu-previous-buffer)
 233           (set-buffer pb)
 234           (setq pm major-mode)))
 235       (setq howm-menu-previous-buffer pb))))
 236
 237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 238 ;; refresh
 239
 240 (howm-defvar-risky howm-menu-shortcut-assoc nil)
 241 (make-variable-buffer-local 'howm-menu-shortcut-assoc)
 242 (howm-defvar-risky howm-menu-invisible t
 243   "*Non nil if 'invisible' property should be used in menu.
 244 This must be t at now.
 245 When this is nil, delete-region is used instead, and bug appears.")
 246
 247 (defun howm-menu-refresh (&optional file place name)
 248   (interactive)
 249   ;; preprocess
 250   (when name
 251     (switch-to-buffer (get-buffer-create name)))
 252   (howm-menu-mode)
 253   (setq howm-menu-buffer-file (or file howm-menu-buffer-file))
 254   (setq howm-menu-buffer-file-place (or place
 255                                         howm-menu-buffer-file-place
 256                                         1))
 257   (setq howm-menu-shortcut-assoc nil)
 258   ;; main
 259   (howm-rewrite-read-only-buffer
 260     (howm-menu-insert-paragraph howm-menu-buffer-file
 261                                 howm-menu-buffer-file-place)
 262     (howm-menu-dynamic-setup) ;; shotcut & dynamic contents
 263     (howm-menu-set-face))
 264   ;; postprocess
 265   (goto-char (point-min))
 266   (setq howm-menu-last-time (current-time))
 267   (setq howm-menu-next-expiry-time
 268         (howm-days-after (current-time) 0
 269                          howm-menu-expiry-hours))
 270   (howm-menu-shortcut-warn)
 271   (run-hooks 'howm-menu-hook))
 272
 273 (defun howm-menu-insert-paragraph (file place)
 274   (insert-file-contents (expand-file-name file
 275                                           howm-directory))
 276   (howm-view-set-place place)
 277   (let* ((r (howm-view-paragraph-region))
 278          (b (car r))
 279          (e (cadr r)))
 280     (delete-region e (point-max))
 281     (delete-region (point-min) b))
 282   (goto-char (point-max))
 283   (insert (howm-menu-footer)))
 284
 285 ;; (defun howm-menu-dynamic-setup ()
 286 ;;   (let* ((action-lock-default-rules (howm-menu-action-lock-rules)))
 287 ;;     (if howm-mode
 288 ;;         (howm-initialize-buffer)
 289 ;;       (howm-mode 1)))
 290 ;;   (howm-menu-shortcut-initialize)
 291 ;;   (howm-menu-replace howm-menu-display-rules))
 292
 293 (defun howm-menu-dynamic-setup ()
 294   (howm-menu-shortcut-initialize)
 295   (howm-menu-replace howm-menu-display-rules)
 296   (let* ((action-lock-default-rules (howm-menu-action-lock-rules)))
 297     (if howm-mode
 298         (howm-initialize-buffer)
 299       (howm-mode 1))))
 300
 301 (defun howm-menu-set-face ()
 302   (set (make-local-variable 'font-lock-keywords-only) t)
 303   (howm-menu-add-font-lock)
 304   (font-lock-fontify-buffer)
 305   (when howm-menu-toggle-invisible
 306     (howm-menu-make-invisible)))
 307
 308 (defun howm-menu-footer ()
 309   (or howm-menu-footer
 310       (let* ((r (howm-menu-command-table-raw))
 311              (buttons (mapcar (lambda (f)
 312                                 (cdr (assoc f
 313                                             (mapcar (lambda (z)
 314                                                       (cons (cadr z)
 315                                                             (car z)))
 316                                                     r))))
 317                               '(howm-menu-refresh howm-menu-edit)))
 318              (footer (apply #'concat `("\n-- \n" ,@buttons))))
 319         (setq howm-menu-footer footer)
 320         footer)))
 321
 322 (defun howm-menu-refresh-background ()
 323   ;; save-current-buffer doesn't work on GNU Emacs 21.4.1
 324   (let ((b (current-buffer)))
 325     (howm-menu t)
 326     (switch-to-buffer b)))
 327
 328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 329 ;; action-lock
 330
 331 (defun howm-menu-invoke (arg)
 332   (interactive "P")
 333   (cond ((save-excursion
 334            (beginning-of-line)
 335            (looking-at howm-menu-list-regexp))
 336          (beginning-of-line)
 337          (action-lock-invoke arg))
 338         ((howm-menu-list-get-item)
 339          (howm-view-open-item (howm-menu-list-get-item)))
 340         (t
 341          (error "Not on spell string."))))
 342
 343 (defun howm-menu-action-lock-rules ()
 344   (let* ((d action-lock-default-rules)
 345          (f (howm-action-lock-reminder-forward-rules))
 346          (j (howm-menu-list-rules))
 347          (m (mapcar (lambda (pair)
 348                       (let* ((h (car pair))
 349                              (r (if (listp h) (car h) h))
 350                              (n (if (listp h) (cadr h) nil))
 351                              (args (if n
 352                                        `(list (match-string-no-properties ,n))
 353                                      nil))
 354                              (functab (cdr pair))
 355                              (c (howm-menu-action functab args)))
 356                         (list r c)))
 357                     (howm-menu-command-table))))
 358     (append m d j f)))
 359
 360 ;; Elisp is not Scheme. Lambda is not closure. Don't forget dynamic binding.
 361 ;; Check
 362 ;;   (pp (car (howm-menu-action-lock-rules)))
 363 ;; for debug. [2003/09/25]
 364 (defun howm-menu-action (function-table args)
 365   (let* ((func (car function-table))
 366          (onbuf (cadr function-table))
 367          (switch-p (eq onbuf 'previous)))
 368     (let* ((s-buf (if (eq onbuf 'current) 'cur 'prev))
 369            (s-switch `(switch-to-buffer ,s-buf))
 370            (s-apply `(apply #',func ,(if args 'a nil))))
 371 ;;            (s-apply `(apply #',func ,(if args '(list a) nil))))
 372       (let* ((s-body (if switch-p
 373                          `(progn ,s-switch ,s-apply)
 374                        `(with-current-buffer ,s-buf ,s-apply))))
 375         `(lambda (&optional ,howm-menu-action-arg)
 376            (let ((a ,args)
 377                  (cur (current-buffer))
 378                  (prev (if (howm-buffer-alive-p howm-menu-previous-buffer)
 379                            howm-menu-previous-buffer
 380                          (current-buffer))))
 381              ,s-body))))))
 382
 383 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 384 ;; shortcut
 385
 386 (defun howm-menu-shortcut-get-marker ()
 387   (let ((m (make-marker)))
 388     (set-marker m (point))
 389     (add-to-list '*howm-menu-shortcut-markers* m)
 390     m))
 391
 392 (defun howm-menu-shortcut-clear-markers ()
 393   (mapc (lambda (m) (set-marker m nil))
 394         *howm-menu-shortcut-markers*)
 395   (setq *howm-menu-shortcut-markers* nil))
 396
 397 (defun howm-menu-shortcut-initialize ()
 398   (setq *howm-menu-shortcut-keys* nil)
 399   (setq *howm-menu-shortcut-multidef-keys* nil)
 400   (howm-menu-shortcut-clear-markers))
 401
 402 (defun howm-menu-shortcut-sort (keys)
 403   (mapconcat #'identity
 404              (sort (copy-sequence keys) #'string<)
 405              ""))
 406
 407 (defun howm-menu-shortcut-warn ()
 408   (when *howm-menu-shortcut-multidef-keys*
 409     (beep)
 410     (message "Multiple definitions for key(s): \"%s\" in \"%s\""
 411              (howm-menu-shortcut-sort *howm-menu-shortcut-multidef-keys*)
 412              (howm-menu-shortcut-sort *howm-menu-shortcut-keys*))))
 413
 414 ;; Check howm-menu-mode-local-map if you want to debug howm-menu-shortcut.
 415 (defun howm-menu-shortcut ()
 416   (let* ((beg (match-beginning 0))
 417          (end (match-end 0))
 418          (wbeg (match-beginning howm-menu-key-regexp-word-pos))
 419          (wend (match-end  howm-menu-key-regexp-word-pos))
 420          (key (match-string-no-properties howm-menu-key-regexp-key-pos))
 421          (move-only (match-beginning howm-menu-key-regexp-moveonly-pos)))
 422     ;; 'end' must be first.
 423     ;; howm-menu-invisible-region can be delete-region indeed,
 424     ;; and points after the region can be slided.
 425     (howm-menu-invisible-region wend end)
 426     (howm-menu-invisible-region beg wbeg)
 427     (let ((p (howm-menu-shortcut-get-marker)))
 428       (setq howm-menu-shortcut-assoc
 429             (cons (cons key p) howm-menu-shortcut-assoc))
 430       (define-key howm-menu-mode-local-map key
 431         (howm-menu-shortcut-func key p move-only)))
 432     (when (member key *howm-menu-shortcut-keys*)
 433       (setq *howm-menu-shortcut-multidef-keys*
 434             (cons key *howm-menu-shortcut-multidef-keys*)))
 435     (setq *howm-menu-shortcut-keys*
 436           (cons key *howm-menu-shortcut-keys*))))
 437
 438 (defun howm-menu-shortcut-func (key p move-only)
 439   (if howm-menu-invisible
 440       (howm-menu-shortcut-func1 p move-only)
 441     (howm-menu-shortcut-func2 key p move-only)))
 442
 443 ;; old code. it works.
 444 (defun howm-menu-shortcut-func1 (p move-only)
 445   `(lambda (arg)
 446      (interactive "P")
 447      (let ((pos ,p))
 448        (if ,move-only
 449            (goto-char pos)
 450          (save-excursion
 451            (goto-char pos)
 452            (let ((case-fold-search nil)) ;; temporaly
 453              (when (null (action-lock-get-action))
 454                (action-lock-goto-next-link))
 455              (action-lock-invoke arg)))))))
 456
 457 ;; new code. broken.
 458 ;; It doesn't work because action can be
 459 ;; (let ((s (match-string-no-properties 0))) (howm-keyword-search s nil nil)).
 460 (defun howm-menu-shortcut-func2 (key p move-only)
 461   (if move-only
 462       `(lambda (arg) (interactive "P") (goto-char ,p))
 463     (save-excursion
 464       (goto-char p)
 465       (let ((case-fold-search nil)) ;; temporaly
 466         (when (null (action-lock-get-action))
 467           (action-lock-goto-next-link))
 468         (let ((action (action-lock-get-action)))
 469           (if (null action)
 470               (lambda (arg) (interactive "P") nil)
 471             (progn
 472               (rplacd (assoc key howm-menu-shortcut-assoc)
 473                       action)
 474               `(lambda (arg)
 475                  (interactive "P")
 476                  (funcall (cdr (assoc ,key howm-menu-shortcut-assoc))
 477                           arg)))))))))
 478
 479 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 480 ;; action
 481
 482 (defun howm-menu-edit ()
 483   (interactive)
 484   (let ((place howm-menu-buffer-file-place))
 485     (find-file (expand-file-name howm-menu-buffer-file howm-directory))
 486     (howm-mode t)
 487     (when place
 488       (howm-view-set-place place)
 489       (recenter 0))))
 490
 491 (defun howm-menu-eval (s)
 492   (let ((expr (read s)))
 493     (eval expr)))
 494
 495 (defun howm-menu-call (s)
 496   (let ((expr (read s)))
 497     (call-interactively expr)))
 498
 499 (defun howm-open-today ()
 500   (interactive)
 501   (and (howm-create-file t)
 502        (howm-insert-template ""))
 503   (howm-set-mode))
 504
 505 (defun howm-open-past (&optional days-before)
 506   (interactive "p")
 507   (setq days-before (or days-before 1))
 508   (if (= days-before 0)
 509       (howm-open-today)
 510     (howm-open-past-sub days-before)))
 511
 512 (defun howm-open-past-sub (days-before)
 513   (let ((f (expand-file-name (howm-file-name (howm-days-after (current-time)
 514                                                               (- days-before)))
 515                              howm-directory)))
 516     (if (file-exists-p f)
 517         (find-file f)
 518       (error "No such file: %s" f)))
 519   (howm-set-mode))
 520
 521 (defun howm-find-past (&optional days-before)
 522   (interactive "p")
 523   (cond ((howm-one-file-one-day-p) (howm-open-past days-before))
 524         (t (howm-search-past days-before))))
 525
 526 (defun howm-find-today (&optional days-before)
 527   (interactive "P")
 528   (howm-find-past (or days-before 0)))
 529
 530 (defun howm-find-yesterday (&optional days-before)
 531   (interactive)
 532   (howm-find-past (or days-before 1)))
 533
 534 (defun howm-one-file-one-day-p ()
 535   (let* ((now (decode-time))
 536          (d (nth 3 now))
 537          (m (nth 4 now))
 538          (y (nth 5 now))
 539          (beginning-of-day (encode-time 0 0 0 d m y))
 540          (end-of-day (encode-time 59 59 23 d m y)))
 541     (string= (howm-file-name beginning-of-day)
 542              (howm-file-name end-of-day))))
 543
 544 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 545 ;; face
 546
 547 (defun howm-menu-make-invisible ()
 548   (save-excursion
 549     (goto-char (point-min))
 550     (let (visible-p
 551           invisible-beg)
 552       (while (not (= (point) (point-max)))
 553         (setq visible-p t)
 554         (while (re-search-forward howm-menu-toggle-invisible
 555                                   (line-end-position) t)
 556           (if visible-p
 557               (setq invisible-beg (match-beginning 0))
 558             (howm-menu-invisible-region invisible-beg (match-end 0)))
 559           (setq visible-p (not visible-p)))
 560         (when (not visible-p)
 561           (howm-menu-invisible-region invisible-beg
 562                                       (save-excursion (forward-line) (point))))
 563         (forward-line)))))
 564
 565 (defun howm-menu-font-lock-rules ()
 566   `((,howm-menu-key-regexp
 567      (,howm-menu-key-regexp-key-pos howm-menu-key-face t))
 568     ;; In menu-list form "> FILE-NAME | ",
 569     ;; I want to hide annoying long underlines drawn by action-lock.
 570     (,howm-menu-list-regexp
 571      (,howm-menu-list-regexp-face-pos howm-menu-list-face t))
 572     ;; But some users may want to highlight today's YYYY-MM-DD even if
 573     ;; it is a part of a FILE-NAME.
 574     ;; The next code makes duplicated entries; they are already put into
 575     ;; font-lock-keywords by howm-reminder-add-font-lock
 576     ;; in howm-initialize-buffer because menu is howm-mode.
 577     ;; They are hidden by the above rule in FILE-NAME columns,
 578     ;; and I need to put them again now. Sigh...
 579     ;; Clean me!
 580     ,@(howm-reminder-today-font-lock-keywords)))
 581 (defun howm-menu-add-font-lock ()
 582   (cheat-font-lock-append-keywords (howm-menu-font-lock-rules)))
 583
 584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 585 ;; dynamic contents
 586
 587 (defun howm-menu-replace (rules)
 588   (mapc (lambda (pair)
 589           (let* ((reg (car pair))
 590                  (to (cdr pair)))
 591             (goto-char (point-min))
 592             (while (re-search-forward reg nil t)
 593               (cond ((stringp to) (replace-match to))
 594                     ((functionp to) (funcall to))
 595                     (t (error "Invalid to-part: %s." to))))))
 596         rules))
 597
 598 ;; (defun howm-menu-func ()
 599 ;;   (let ((b (match-beginning 0))
 600 ;;         (e (match-end 0))
 601 ;;         (f (read (match-string-no-properties 1))))
 602 ;;     (if (or (eq howm-menu-allow t)
 603 ;;             (member f howm-menu-allow))
 604 ;;         (howm-replace-region b e (funcall f))
 605 ;;       (message "%s is not allowed." f))))
 606
 607 ;; (defun howm-menu-var ()
 608 ;;   (let ((b (match-beginning 0))
 609 ;;         (e (match-end 0))
 610 ;;         (f (read (match-string-no-properties 1))))
 611 ;;     (howm-replace-region b e (eval f))))
 612
 613 (defun howm-menu-here ()
 614   (let* ((beg (match-beginning 0))
 615          (expr-beg (match-end 0))
 616          (expr-end (progn (forward-sexp) (point)))
 617          (expr (read (buffer-substring-no-properties expr-beg expr-end))))
 618     (cond ((symbolp expr) (howm-menu-here-var expr beg expr-end))
 619           ((listp expr) (howm-menu-here-func (car expr) (cdr expr)
 620                                               beg expr-end))
 621           (t (message "Unknown expr: %s" expr)))))
 622
 623 (defun howm-menu-here-var (expr beg end)
 624   (if (boundp expr)
 625       (howm-replace-region beg end (symbol-value expr))
 626     (message "Unknown symbol: %s" expr)))
 627
 628 (defun howm-menu-here-func (func args beg end)
 629 ;;   (let ((allowed (or (eq howm-menu-allow t) (member func howm-menu-allow))))
 630   (let ((allowed (member func howm-menu-allow)))
 631     (cond ((not allowed) (message "Not allowed: %s" func))
 632           ((not (fboundp func)) (message "Unknown function: %s" func))
 633           (t (howm-replace-region beg end (apply func args))))))
 634
 635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 636 ;; schedule, todo, recent, random
 637
 638 ;;; command
 639
 640 (defun howm-menu-schedule ()
 641   (howm-menu-general "schedule" 'schedule
 642                      (howm-schedule-menu howm-menu-schedule-days
 643                                          howm-menu-schedule-days-before)))
 644
 645 (defvar howm-menu-todo-show-day-of-week t)
 646 (defun howm-menu-todo ()
 647   (howm-menu-general "todo" 'todo
 648                      (howm-todo-menu howm-menu-todo-num
 649                                      howm-menu-todo-priority
 650                                      howm-menu-reminder-separators)))
 651 (defun howm-menu-reminder ()
 652   (howm-menu-general "reminder" 'todo
 653                      (howm-reminder-menu howm-menu-todo-num
 654                                          howm-menu-todo-priority
 655                                          howm-menu-reminder-separators)))
 656
 657 (defun howm-menu-recent (&optional evaluator label)
 658   (howm-menu-general (or label "recent")
 659                      nil
 660                      (howm-recent-menu howm-menu-recent-num evaluator)))
 661
 662 (defun howm-menu-random () (howm-menu-recent t "random"))
 663
 664 (defun howm-menu-general (label formatter item-list)
 665   "Generate output string for items in howm menu.
 666 LABEL is only used for message.
 667 FORMATTER is a function which receives an item and returns an output string
 668  (without newline).
 669 FORMATTER can be nil for standard style, 'todo for todo style,
 670 'schedule for schedule style, or 'full for full note.
 671 ITEM-LIST is list of items which should be shown."
 672   (let ((f (cond ((null formatter) #'howm-menu-format-item)
 673                  ((eq 'todo formatter) #'howm-menu-format-todo)
 674                  ((eq 'schedule formatter) #'howm-menu-format-reminder)
 675                  ((eq 'full formatter) #'howm-menu-format-full)
 676                  (t formatter))))
 677     (let* ((msg "scanning %s...")
 678            (msg-done (concat msg "done")))
 679       (message msg label)
 680       ;;     (delete-region (match-beginning 0) (match-end 0))
 681       (prog1
 682           (mapconcat f item-list "\n")
 683         (message msg-done label)))))
 684
 685 ;;; schedule/todo
 686
 687 (defun howm-menu-format-todo (item)
 688   ;; item can be a separator.
 689   (if (eq (howm-page-type (howm-item-page item)) ':nil)
 690       (howm-item-summary item)
 691     (let ((dow-str (cond (howm-menu-todo-show-day-of-week nil)
 692                          (t "  "))))
 693       (howm-menu-format-reminder item dow-str t))))
 694
 695 (defun howm-menu-format-reminder (item &optional day-of-week-str show-priority)
 696   (let* ((p (howm-todo-parse item))
 697          (late (floor (car p)))
 698          (dow (cl-cadddr p))
 699          (dow-str (or day-of-week-str
 700                       (howm-day-of-week-string dow)))
 701          (priority (if (and howm-menu-todo-priority-format
 702                             show-priority)
 703                        (format howm-menu-todo-priority-format
 704                                (howm-todo-priority item))
 705                      ""))
 706          (h (format "%s%3s%s" dow-str late priority)))
 707     (howm-menu-list-format h (howm-view-item-summary item) item
 708                            howm-menu-reminder-format)))
 709
 710 (defun howm-day-of-week-string (&optional day-of-week)
 711   ;; 0 = Sunday
 712   (let ((dow (or day-of-week (nth 6 (decode-time))))
 713         (names (howm-day-of-week)))
 714     (cond ((stringp names) (substring names dow (1+ dow))) ;; backward compatibility
 715           ((listp names) (nth dow names))
 716           (t "  "))))
 717
 718 (defun howm-menu-format-full (item)
 719   (let ((text (format "%s %s\n%s"
 720                       howm-ref-header
 721                       (howm-item-name item)
 722                       (with-temp-buffer
 723                         (howm-page-insert (howm-item-page item))
 724                         (howm-view-set-place (howm-view-item-place item))
 725                         (apply 'buffer-substring-no-properties
 726                                (howm-view-paragraph-region))))))
 727     (howm-menu-list-put-item text item)
 728     text))
 729
 730 ;;; recent/random
 731
 732 (defun howm-recent-menu (num &optional evaluator)
 733   ;; Bug: (length howm-recent-menu) can be smaller than NUM
 734   ;; when empty files exist.
 735   (let* ((randomp (eq evaluator t))
 736          (summarizer #'(lambda (file line content) content))
 737          ;; Unique name is needed for dynamic binding. Sigh...
 738          (h-r-m-evaluator (if randomp
 739                               (lambda (f) (number-to-string (random)))
 740                             (or evaluator #'howm-view-mtime)))
 741          (sorted (howm-sort (lambda (f) (funcall h-r-m-evaluator f))
 742                             #'howm-view-string>
 743                             (mapcar #'howm-item-name
 744                                     (howm-folder-items howm-directory t))))
 745          (files (howm-first-n sorted num)))
 746     (let ((r (howm-menu-recent-regexp)))
 747       (if randomp
 748           (cl-mapcan (lambda (f)
 749                             (let ((is (howm-view-search-items r (list f)
 750                                                               summarizer)))
 751                               (and is (list (nth (random (length is))
 752                                                  is)))))
 753                           files)
 754         (howm-first-n (howm-view-search-items r files summarizer) num)))))
 755
 756 (defun howm-menu-recent-regexp ()
 757   (or howm-menu-recent-regexp (howm-view-title-regexp-grep)))
 758
 759 ;;; common
 760
 761 (defun howm-menu-list-put-item (text item)
 762   ;; put it to whole text, because I don't assume "> ..." format here.
 763   (put-text-property 0 (length text) 'howm-menu-list-item item text))
 764 (defun howm-menu-list-get-item (&optional text)
 765   (get-text-property (if text 0 (point)) 'howm-menu-list-item text))
 766 (defun howm-menu-list-getput-item (from-text to-text)
 767   (howm-menu-list-put-item to-text
 768                            (howm-menu-list-get-item from-text)))
 769
 770 (defun howm-menu-list-action (&optional keyword)
 771   (let ((item (howm-menu-list-get-item keyword)))
 772     (cond (item (howm-view-open-item item)) ;; schedule, todo, etc.
 773           (keyword (howm-keyword-search keyword)) ;; history
 774           (t (error "Target is not specified."))))) ;; can't happen
 775
 776 (defun howm-menu-format-item (item &optional list-format)
 777   (let* ((info (file-name-sans-extension (howm-view-item-basename item)))
 778          (line (howm-view-item-summary item)))
 779     (howm-menu-list-format info line item list-format)))
 780
 781 (defun howm-menu-list-format (info line item &optional list-format)
 782   (let ((s (format (or list-format howm-menu-list-format) info line)))
 783     (howm-menu-list-put-item s item)
 784     s))
 785
 786 (defun howm-menu-list-rules ()
 787   (list (action-lock-general #'howm-menu-list-action
 788                              howm-menu-list-regexp
 789                              howm-menu-list-regexp-key-pos
 790                              howm-menu-list-regexp-action-pos)))
 791
 792 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 793 ;; embed search result
 794
 795 (defun howm-menu-search (key &optional formatter regexp-p)
 796   "Embed search result of KEY into menu.
 797 See `howm-menu-general' for FORMATTER.
 798 KEY is a regular expression if REGEXP-P is not nil.
 799
 800 Bugs: If you write %here%(howm-menu-search \"foo\" full) in your menu,
 801 - menu file itself is also searched.
 802 Write %here%(howm-menu-search \"[f]oo\" full t) insteadly.
 803 - same note is shown twice if \"foo\" is hit twice in it."
 804   (let ((fixed-p (not regexp-p)))
 805     (howm-menu-general "menu-search"
 806                        formatter
 807                        (howm-view-search-folder-items key (howm-folder)
 808                                                       nil fixed-p))))
 809
 810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 811 ;; categorized todo-list
 812
 813 ;; Experimental [2006-01-16]
 814
 815 (defun howm-menu-classified-reminder (classifier &optional comparer
 816                                                  title-format)
 817   "Generate string of classified reminder-list.
 818 CLASSIFIER is a function which receives an item and answers its class.
 819 Class can be an arbitrary lisp object.
 820 When class is nil, corresponding item is not shown in this list.
 821 COMPARER is a function which receives two keys and answer t or nil.
 822 It is used for sorting of keys.
 823 TITLE-FORMAT is a format string for class title."
 824   (let* ((a (howm-classify classifier
 825                            (howm-reminder-menu nil
 826                                                howm-menu-todo-priority
 827                                                nil)))
 828          ;; key 'nil' is skipped.
 829          (keys (remove nil (mapcar #'car a)))
 830          (tform (concat (or title-format "--%s--") "\n")))
 831     (when comparer
 832       (setq keys (sort keys comparer)))
 833     (mapconcat (lambda (k)
 834                  (let* ((item-list (howm-first-n (cdr (assoc k a))
 835                                                  howm-menu-todo-num))
 836                         (is (howm-with-reminder-setting
 837                               (howm-todo-insert-separators
 838                                item-list
 839                                howm-menu-reminder-separators
 840                                t))))
 841                    (concat (format tform k)
 842                            (howm-menu-general (format "reminder(%s)" k) 'todo
 843                                               is))))
 844                keys "\n")))
 845
 846 (defun howm-menu-categorized-reminder (categories &optional title-format
 847                                                   erase-p omit-misc-p)
 848   "Generate string of categorized reminder-list.
 849
 850 Write %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\"))
 851 to show categorized list in menu. (You don't need quote(')
 852 before the above list; arguments are not evaluated in %here%
 853 because I don't have enough courage to call eval.)
 854
 855 If you like to erase category label from summary string, try
 856 %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\") nil t)
 857 instead.
 858
 859 If you don't like misc. category, try
 860 %here%(howm-menu-categorized-reminder (\"foo\" \"bar\" \"baz\") nil nil t)."
 861   ;; Using categories, matcher, etc. in lambda is bad indeed
 862   ;; because of dynamic binding.
 863   (let* ((matcher (lambda (cat str item)
 864                     (and (string-match (regexp-quote cat) str)
 865                          (progn
 866                            (when erase-p
 867                              (howm-item-set-summary item
 868                                                     (replace-match "" nil nil
 869                                                                    str)))
 870                            t))))
 871          (classifier (lambda (item)
 872                        (let ((s (howm-item-summary item)))
 873                          (or (cl-find-if (lambda (c)
 874                                                 (funcall matcher c s item))
 875                                               categories)
 876                              (if omit-misc-p nil "misc.")))))
 877          (pos (lambda (c) (or (cl-position c categories) howm-infinity)))
 878          (comparer (lambda (a b) (< (funcall pos a) (funcall pos b)))))
 879     (howm-menu-classified-reminder classifier comparer title-format)))
 880
 881 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 882 ;; generate initial menu
 883
 884 (defun howm-menu-initialize-skel (&optional dummy)
 885   (let ((menu-name (howm-get-symbol nil "howm-menu-" howm-menu-lang)))
 886     (require menu-name)
 887     (howm-menu-copy-skel (symbol-value menu-name))
 888     (howm-view-kill-buffer)
 889     (howm-menu nil t)))
 890
 891 (defun howm-menu-copy-skel (contents)
 892   (let ((menu-file (or howm-menu-file
 893                        (expand-file-name "0000-00-00-000000.txt"
 894                                          howm-directory)))
 895         (r "^="))
 896     (if (file-exists-p menu-file)
 897         ;; I have no courage to erase existing file.
 898         (progn
 899           (setq howm-menu-file menu-file)
 900           (message "Assume %s as menu file." menu-file))
 901       (progn
 902         (find-file menu-file)
 903         (insert contents)
 904         (goto-char (point-min))
 905         (while (re-search-forward r nil t)
 906           (replace-match howm-view-title-header nil nil))
 907         (howm-mode 1)
 908         (save-buffer)))))
 909
 910 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 911 ;; switch language
 912
 913 (defun howm-require-lang (&optional lang)
 914   (require (howm-get-symbol nil "howm-lang-" (or lang howm-menu-lang))))
 915
 916 (defun howm-lang-ref (var)
 917   (let ((lang howm-menu-lang))
 918     (howm-require-lang lang)
 919     ;; For backward compatibility, I use howm-day-of-week-en
 920     ;; rather than howm-day-of-week:en.
 921     (symbol-value (howm-get-symbol t var "-" lang))))
 922
 923 (defun howm-menu-command-table-raw ()
 924   (howm-lang-ref "howm-menu-command-table"))
 925
 926 (defun howm-menu-command-table ()
 927   (append howm-menu-command-table-common
 928           (mapcar (lambda (pair) (cons (regexp-quote (car pair)) (cdr pair)))
 929                   (howm-menu-command-table-raw))))
 930
 931 (defun howm-day-of-week ()
 932   (howm-lang-ref "howm-day-of-week"))
 933
 934 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 935 ;; misc.
 936
 937 (defun howm-menu-p ()
 938   (string= major-mode "howm-menu-mode"))
 939
 940 (defun howm-menu-name (file)
 941   (format howm-menu-name-format file))
 942
 943 (defun howm-buffer-alive-p (buf)
 944   (and buf (buffer-name buf)))
 945
 946 (defun howm-menu-keyword-p (keyword)
 947   (and howm-menu-keyword-regexp
 948        (stringp keyword) ;; perhaps unnecessary
 949        (string-match howm-menu-keyword-regexp keyword)))
 950
 951 (defun howm-time< (t1 t2)
 952   (or (< (car t1) (car t2))
 953       (and (= (car t1) (car t2))
 954            (< (cadr t1) (cadr t2)))))
 955
 956 (defun howm-menu-invisible-region (beg end)
 957   (if howm-menu-invisible
 958       (put-text-property beg end 'invisible t)
 959     (delete-region beg end))
 960 ;;   (put-text-property beg end 'intangible t)
 961   )
 962
 963 ;;; howm-menu.el ends here