howm-menu.el

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