howm-mode.el

   1 ;;; howm-mode.el --- Wiki-like note-taking tool
   2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2022
   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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;; Backward compatibility
  23
  24 ;; (require 'howm-mode) in .emacs is obsolete. Use (require 'howm) instead.
  25
  26 ;; This must be earlier than (require 'howm-common), because
  27 ;; howm-common needs cl, and (require 'cl) should be written in howm.el.
  28 (when (not (featurep 'howm))
  29   (message "Warning: Requiring howm-mode is obsolete. Require howm instead.")
  30 ;;   (beep)
  31 ;;   (sit-for 1)
  32   (require 'howm))
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 ;; Require
  36
  37 (provide 'howm-mode)
  38 (require 'howm)
  39
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41 ;; Customize
  42
  43 ;;; --- level 1 ---
  44
  45 ;; You can easily modify them.
  46
  47 (howm-defvar-risky howm-template
  48   (concat howm-view-title-header " %title%cursor\n%date %file\n\n")
  49   "Contents of new file. %xxx are replaced with specified items.
  50 If it is a list, <n>-th one is used when you type C-u <n> M-x howm-create.
  51 If it is a function, it is called to get template string with the argument <n>.")
  52 (defvar howm-keyword-header "<<<"
  53   "Header string for declaration of keyword (implicit link).")
  54 (defvar howm-ref-header ">>>"
  55   "Header string for explicit link.")
  56 (defvar howm-lighter " howm"
  57   "Mode line for howm-mode")
  58
  59 (defvar howm-inhibit-title-file-match t
  60   "If non-nil, inhibit howm-list-title when search string matches file name")
  61 (defvar howm-list-all-title nil) ;; obsolete [2003-11-30]
  62 (defvar howm-list-recent-title nil) ;; obsolete [2003-11-30]
  63
  64 (defvar howm-default-key-table
  65   '(
  66     ;; ("key" func list-mode-p global-p)
  67     ("r" howm-refresh)
  68     ("l" howm-list-recent t t)
  69     ("a" howm-list-all t t)
  70     ("g" howm-list-grep t t)
  71     ("s" howm-list-grep-fixed t t)
  72     ("m" howm-list-migemo t t)
  73     ("t" howm-list-todo t t)
  74     ("y" howm-list-schedule t t)
  75     ("b" howm-list-buffers t t)
  76     ("x" howm-list-mark-ring t t)
  77     ("o" howm-occur t t)
  78     ("c" howm-create t t)
  79     ("e" howm-remember t t)
  80     ("," howm-menu t t)
  81     ("." howm-find-today nil t)
  82     (":" howm-find-yesterday nil t)
  83     ("A" howm-list-around)
  84     ("h" howm-history nil t)
  85     ("D" howm-dup)
  86     ("i" howm-insert-keyword nil t)
  87     ("d" howm-insert-date nil t)
  88     ("T" howm-insert-dtime nil t)
  89     ("K" howm-keyword-to-kill-ring t t)
  90     ("n" action-lock-goto-next-link)
  91     ("p" action-lock-goto-previous-link)
  92     ("Q" howm-kill-all t t)
  93     (" " howm-toggle-buffer nil t)
  94     ("N" howm-next-memo)
  95     ("P" howm-previous-memo)
  96     ("H" howm-first-memo)
  97     ("L" howm-last-memo)
  98     ("C" howm-create-here nil t)
  99     ("I" howm-create-interactively nil t)
 100     ("w" howm-random-walk nil t)
 101     ("M" howm-open-named-file t t)
 102     )
 103   "List of (key function list-mode-p global-p).
 104 `howm-prefix' + this key is real stroke.
 105 If optional argument list-mode-p is non-nil,
 106 same key is also available in view mode.
 107 It is further registered globally if global-p is non-nil."
 108   )
 109
 110 (howm-defvar-risky howm-migemo-client nil
 111   "Command name of migemo-client.
 112 Example of cmigemo:
 113   (setq howm-migemo-client '((type . cmigemo) (command . \"cmigemo\")))
 114 Example of migemo-client (obsolete):
 115   (setq howm-migemo-client \"migemo-client\")
 116 See also `howm-migemo-client-option`")
 117 (howm-defvar-risky howm-migemo-client-option nil
 118   "List of option for migemo-client.
 119 Example of cmigemo:
 120   (setq howm-migemo-client-option
 121         '(\"-q\" \"-d\" \"/usr/share/cmigemo/utf-8/migemo-dict\"))
 122 Example of migemo-client (obsolete):
 123   (setq howm-migemo-client-option '(\"-H\" \"::1\")
 124 See also `howm-migemo-client`")
 125
 126 ;;; --- level 2 ---
 127
 128 ;; Be careful to keep consistency.
 129
 130 (howm-defvar-risky howm-keyword/ref-regexp-format
 131   "\\(%s\\)[ \t]*\\([^ \t\r\n].*\\)")
 132 (howm-defvar-risky howm-keyword-format
 133   (format "%s %%s" howm-keyword-header)
 134   "Format for declaration of keyword. See `format'.")
 135 (howm-defvar-risky howm-keyword-regexp
 136   (format howm-keyword/ref-regexp-format (regexp-quote howm-keyword-header)))
 137 (howm-defvar-risky howm-keyword-regexp-hilit-pos 1)
 138 (howm-defvar-risky howm-keyword-regexp-pos 2)
 139 (howm-defvar-risky howm-ref-regexp
 140   (format howm-keyword/ref-regexp-format (regexp-quote howm-ref-header))
 141   "Regexp for explicit link.")
 142 (howm-defvar-risky howm-ref-regexp-hilit-pos 0
 143   "Position of search string in `howm-ref-regexp'")
 144 (howm-defvar-risky howm-ref-regexp-pos 2
 145   "Position of search string in `howm-ref-regexp'")
 146 (howm-defvar-risky howm-wiki-regexp "\\[\\[\\([^]\r\n]+\\)\\]\\]"
 147   "Regexp for explicit link.")
 148 (howm-defvar-risky howm-wiki-regexp-hilit-pos 1
 149   "Position of hilight in `howm-wiki-regexp'")
 150 (howm-defvar-risky howm-wiki-regexp-pos 1
 151   "Position of search string in `howm-wiki-regexp'")
 152 (howm-defvar-risky howm-wiki-format "[[%s]]"
 153   "Format for declaration of wiki word. See `format'.")
 154
 155 (howm-defvar-risky howm-template-rules
 156   '(("%title" . howm-template-title)
 157     ("%date" . howm-template-date)
 158     ("%file" . howm-template-previous-file)
 159     ("%cursor" . howm-template-cursor))) ;; Cursor must be the last rule.
 160 (defvar howm-template-date-format howm-dtime-format
 161   "%date is replaced with `howm-template-date-format'
 162 in `howm-template'. See `format-time-string'")
 163 (defvar howm-template-file-format (concat howm-ref-header " %s")
 164   "%file is replaced with `homw-template-file-format'
 165 in `howm-template'. %s is replaced with name of last file. See `format'.")
 166
 167 ;;; --- level 3 ---
 168
 169 ;; As you like.
 170
 171 (defun howm-action-lock-general (command regexp pos
 172                                          &optional hilit-pos
 173                                          &rest options)
 174   (list regexp
 175         `(lambda (&optional dummy)
 176            (let ((s (match-string-no-properties ,pos)))
 177 ;;             (when howm-keyword-case-fold-search
 178 ;;               (setq s (downcase s)))
 179              (,command s ,@options)))
 180         (or hilit-pos 0)
 181         t))
 182
 183 (defun howm-action-lock-search (regexp
 184                                 pos
 185                                 &optional hilit-pos create-p open-unique-p)
 186   (howm-action-lock-general 'howm-keyword-search
 187                             regexp pos hilit-pos create-p open-unique-p))
 188 (defun howm-action-lock-related (regexp pos hilit-pos)
 189   (howm-action-lock-general 'howm-list-related regexp pos hilit-pos))
 190
 191 (defun howm-action-lock-date-rule ()
 192   (action-lock-general 'howm-action-lock-date howm-date-regexp 0 0))
 193
 194 (defun howm-action-lock-quote-keyword (keyword)
 195   (let ((q (regexp-quote keyword)))
 196     ;; when a regexp is specified, leave unmatched keywords.
 197     (if (and (stringp howm-check-word-break)
 198              (not (string-match howm-check-word-break keyword)))
 199         q
 200       ;; add word break checks
 201       (concat "\\b" q "\\b"))))
 202
 203 (defun howm-action-lock-setup ()
 204   (setq action-lock-case-fold-search howm-keyword-case-fold-search)
 205   (action-lock-mode t)
 206   (let* ((date-al (action-lock-date "{_}" howm-dtime-format)))
 207     ;; override the rule in action-lock.el
 208     (action-lock-add-rules (list date-al) t))
 209   (let* ((ks (howm-keyword-for-goto))
 210          (r (mapconcat (if howm-check-word-break
 211                            #'howm-action-lock-quote-keyword
 212                          #'regexp-quote)
 213                        ks "\\|"))
 214          ;; The following optimization causes an error
 215          ;; "Variable binding depth exceeds max-specpdl-size".
 216          ;; (r (cond ((stringp howm-check-word-break)
 217          ;;           (mapconcat #'howm-action-lock-quote-keyword ks "\\|"))
 218          ;;          (t
 219          ;;           (regexp-opt ks (and howm-check-word-break 'word)))))
 220          (wiki (howm-action-lock-search howm-wiki-regexp
 221                                         howm-wiki-regexp-pos
 222                                         howm-wiki-regexp-hilit-pos
 223                                         t))
 224          (explicit (howm-action-lock-search howm-ref-regexp
 225                                             howm-ref-regexp-pos
 226                                             howm-ref-regexp-hilit-pos))
 227          (implicit (howm-action-lock-search r 0))
 228          (rev (howm-action-lock-related howm-keyword-regexp
 229                                         howm-keyword-regexp-pos
 230                                         howm-keyword-regexp-hilit-pos))
 231          (date (howm-action-lock-date-rule))
 232          (done (howm-action-lock-reminder-done-rule))
 233          (all `(
 234                 ,explicit
 235                 ,rev
 236                 ,@(if ks (list implicit) nil)
 237                 ,wiki
 238                 ,@(if (howm-menu-p) nil (list date done))
 239                 ))
 240          )
 241     ;; don't override the rule in action-lock.el
 242     ;; esp. http://xxx should call browser even if "<<< http" exists
 243     (action-lock-add-rules all)))
 244
 245 (defun howm-file-name (&optional time)
 246   (format-time-string howm-file-name-format
 247                       (or time (current-time))))
 248
 249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 250 ;; Definitions
 251
 252 (define-minor-mode howm-mode
 253   "With no argument, this command toggles the mode.
 254 Non-null prefix argument turns on the mode.
 255 Null prefix argument turns off the mode.
 256
 257 When the mode is enabled, underlines are drawn on texts which match
 258 to titles of other files. Typing \\[action-lock-magic-return] there,
 259 you can jump to the corresponding file.
 260
 261 key     binding
 262 ---     -------
 263 \\[action-lock-magic-return]    Follow link
 264 \\[howm-refresh]        Refresh buffer
 265 \\[howm-list-all]       List all files
 266 \\[howm-list-grep]      Search (grep)
 267 \\[howm-create] Create new file
 268 \\[howm-dup]    Duplicate current file
 269 \\[howm-insert-keyword] Insert keyword
 270 \\[howm-insert-date]    Insert date
 271 \\[howm-insert-dtime]   Insert date with time
 272 \\[howm-keyword-to-kill-ring]   Copy current keyword to kill ring
 273 \\[action-lock-goto-next-link]  Go to next link
 274 \\[action-lock-goto-previous-link]      Go to previous link
 275 \\[howm-next-memo]      Go to next entry in current buffer
 276 \\[howm-previous-memo]  Go to previous entry in current buffer
 277 \\[howm-first-memo]     Go to first entry in current buffer
 278 \\[howm-last-memo]      Go to last entry in current buffer
 279 \\[howm-create-here]    Add new entry to current buffer
 280 \\[howm-create-interactively]   Create new file interactively (not recommended)
 281 \\[howm-random-walk]    Browse random entries automtically
 282 "
 283   :init-value nil ;; default = off
 284   :lighter howm-lighter ;; mode-line
 285   :keymap (mapcar (lambda (entry)
 286                     (let ((k (car entry))
 287                           (f (cadr entry)))
 288                       (cons (concat howm-prefix k) f)))
 289                   howm-default-key-table)
 290   (if howm-mode
 291       (howm-initialize-buffer)
 292     (howm-restore-buffer)))
 293
 294 (defun howm-set-keymap ()
 295   (mapc (lambda (entry)
 296           (let* ((k (car entry))
 297                  (f (cadr entry))
 298                  (list-mode-p (cl-caddr entry))
 299                  (global-p (cl-cadddr entry))
 300                  (pk (concat howm-prefix k)))
 301             (define-key howm-mode-map pk f)
 302             (when list-mode-p
 303               (mapc (lambda (m)
 304                       (define-key m k f)
 305                       (define-key m pk f))
 306                     (list howm-view-summary-mode-map
 307                           howm-view-contents-mode-map)))
 308             (when global-p
 309               (define-key global-map pk f))))
 310         howm-default-key-table)
 311   (define-key howm-mode-map "\C-x\C-s" 'howm-save-buffer))
 312 (howm-set-keymap)
 313
 314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 315 ;; Main functions
 316
 317 (defun howm-refresh ()
 318   (interactive)
 319   (if (howm-menu-p)
 320       (howm-menu-refresh)
 321     (howm-initialize-buffer)))
 322
 323 (defun howm-initialize-buffer ()
 324   (interactive)
 325   (when (not howm-mode)
 326     (error "Not howm-mode"))
 327   (howm-message-time "init-buf"
 328     (save-restriction
 329       (widen)
 330       (howm-set-configuration-for-major-mode major-mode)
 331       (howm-action-lock-setup)
 332       (howm-mode-add-font-lock)
 333       (howm-reminder-add-font-lock)
 334       (cheat-font-lock-fontify)
 335       ;; make-local-hook is obsolete for emacs >= 21.1.
 336       (howm-funcall-if-defined (make-local-hook 'after-save-hook))
 337       (add-hook 'after-save-hook 'howm-after-save t t))))
 338
 339 (defun howm-after-save ()
 340   (when howm-mode
 341     (howm-keyword-add-current-buffer)
 342     (when howm-refresh-after-save
 343       (howm-initialize-buffer))
 344     (when (and howm-menu-refresh-after-save
 345                (> howm-menu-expiry-hours 0))
 346       (howm-menu-refresh-background))
 347     (run-hooks 'howm-after-save-hook)))
 348
 349 (defun howm-restore-buffer ()
 350   (action-lock-mode 0))
 351
 352 (defun howm-list-all ()
 353   (interactive)
 354   (howm-set-command 'howm-list-all)
 355   (howm-normalize-show "" (howm-all-items))
 356   ;; for backward compatibility
 357   (cond ((howm-list-title-p) t)  ;; already done in howm-normalize-show
 358         (howm-list-all-title (howm-list-title-internal))))
 359
 360 (defun howm-all-items ()
 361   "Returns list of all items in the first search path."
 362   (howm-folder-items (car (howm-search-path)) t))
 363
 364 (defun howm-list-recent (&optional days)
 365   (interactive "P")
 366   (howm-set-command 'howm-list-recent)
 367   (let* ((d (or days howm-list-recent-days))
 368          (now (current-time))
 369          (from (howm-days-before now d))
 370          (item-list (howm-folder-items howm-directory t)))
 371     (howm-normalize-show "" (howm-filter-items-by-mtime item-list from now))
 372     ;; clean me [2003-11-30]
 373     (cond ((howm-list-title-p) t)  ;; already done in howm-normalize-show
 374           (howm-list-recent-title (howm-list-title-internal))
 375           ((not days) (howm-view-summary-to-contents)))))
 376
 377 ;; clean me: direct access to howm-view-* is undesirable.
 378
 379 (defvar howm-list-title-previous nil
 380   "For internal use")
 381 (make-variable-buffer-local 'howm-list-title-previous)
 382 (defun howm-list-title-put-previous (&optional item-list)
 383   (when howm-list-title-undo
 384     (setq howm-list-title-previous (or item-list (howm-view-item-list)))))
 385 (defun howm-list-title-clear-previous ()
 386   (setq howm-list-title-previous nil))
 387 (defun howm-list-title-get-previous ()
 388   (if howm-list-title-undo
 389       (let ((prev howm-list-title-previous))
 390         (setq howm-list-title-previous nil)
 391         (howm-view-summary-rebuild prev))
 392     (error "Undo is not enabled.")))
 393 (defun howm-list-title-regexp ()
 394   (or howm-list-title-regexp (howm-view-title-regexp-grep)))
 395 (defalias 'howm-list-title 'howm-list-toggle-title) ;; backward compatibility
 396 (defun howm-list-toggle-title (&optional undo)
 397   (interactive "P")
 398   (if (or undo howm-list-title-previous)
 399       (howm-list-title-get-previous)
 400     (howm-list-title-internal)))
 401 (defun howm-list-title-internal ()
 402   (let ((b (current-buffer)))
 403     (howm-list-title-put-previous)
 404     (howm-view-list-title (howm-list-title-regexp))
 405     ;;       (howm-view-filter-by-contents (howm-list-title-regexp))
 406     (let ((c (current-buffer)))
 407       (when (not (eq b c))
 408         (set-buffer b)
 409         (howm-view-kill-buffer)
 410         (switch-to-buffer c)
 411         (howm-view-summary-check t)))))
 412
 413 (defun howm-list-title-p ()
 414   (let ((a (howm-get-value howm-list-title)))
 415     (cond ((null a) nil) ;; I know this is redundant.
 416           ((listp a) (member (howm-command) a))
 417           (t a))))
 418
 419 (defun howm-days-after (ti days &optional hours)
 420   (let* ((ne (howm-decode-time ti))
 421          (hour-pos 2)
 422          (day-pos 3)
 423          (nh (nth hour-pos ne))
 424          (nd (nth day-pos ne)))
 425     (setf (nth hour-pos ne) (+ nh (or hours 0)))
 426     (setf (nth day-pos ne) (+ nd days))
 427     (apply #'encode-time ne)))
 428
 429 (defun howm-days-before (ti days)
 430   (howm-days-after ti (- days)))
 431
 432 (defun howm-list-grep (&optional completion-p)
 433   (interactive "P")
 434   (howm-set-command 'howm-list-grep)
 435   (howm-list-grep-general completion-p))
 436
 437 (defun howm-list-grep-fixed ()
 438   (interactive)
 439   (howm-set-command 'howm-list-grep-fixed)
 440   (howm-list-grep-general t))
 441
 442 (defun howm-list-grep-general (&optional completion-p)
 443   (let* ((action (lambda (pattern) (howm-search pattern completion-p)))
 444          (regexp (howm-iigrep completion-p action)))
 445     (when completion-p  ;; Goto link works only for fixed string at now.
 446       (howm-write-history regexp))
 447     (funcall action regexp)))
 448
 449 (defun howm-search (regexp fixed-p &optional emacs-regexp filter bufname)
 450   (if (string= regexp "")
 451       (howm-list-all)
 452     (howm-message-time "search"
 453       (let* ((trio (howm-call-view-search-internal regexp fixed-p emacs-regexp))
 454              (kw (car trio))
 455              (name (or bufname (cadr trio)))
 456              (items (cl-caddr trio)))
 457         (when filter
 458           (setq items (funcall filter items)))
 459         (howm-normalize-show name items (or emacs-regexp regexp) nil nil kw)
 460         (howm-record-view-window-configuration)))))
 461
 462 (defun howm-iigrep (completion-p action)
 463   (howm-with-iigrep (howm-iigrep-command-for-pattern completion-p)
 464       howm-iigrep-show-what action
 465     (if completion-p
 466         (howm-completing-read-keyword)
 467       (read-from-minibuffer "Search all (grep): "))))
 468
 469 (defmacro howm-with-iigrep (command-for-pattern show-what action &rest body)
 470   (declare (indent 3))
 471   `(let ((*iigrep-post-sentinel* (howm-iigrep-post-sentinel ,action))
 472          (howm-view-summary-name "*howmS(preview)*")
 473          (howm-view-contents-name "*howmC(preview)*")
 474          (howm-history-limit 0)
 475          (*howm-show-item-filename* nil)
 476          (howm-message-time nil))
 477      (unwind-protect
 478          (iigrep-with-grep ,command-for-pattern ,show-what
 479            ,@body)
 480        (mapc (lambda (b) (and (get-buffer b) (kill-buffer b)))
 481              (list howm-view-summary-name howm-view-contents-name)))))
 482
 483 (defmacro howm-iigrep-command-for-pattern (&optional fixed-p converter)
 484   ;; use macro due to dynamic binding. Sigh...
 485   `(and howm-view-use-grep
 486         (lambda (str)
 487           (let* ((pattern (funcall (or ,converter #'identity) str))
 488                  (trio (howm-real-grep-single-command
 489                         pattern (list howm-directory) ,fixed-p))
 490                  (com (car trio))
 491                  (args (cl-second trio))
 492                  (fs (cl-third trio)))
 493             (append (list com) (cons "-I" args) fs)))))
 494
 495 (defmacro howm-iigrep-post-sentinel (action)
 496   ;; use macro due to dynamic binding. Sigh...
 497   `(lambda (hits pattern)
 498      (when (<= hits howm-iigrep-preview-items)
 499        (save-selected-window
 500          (funcall ,action pattern)))))
 501
 502 (defvar *howm-view-window-configuration* nil
 503   "For internal use")
 504 (defun howm-view-window-configuration ()
 505   *howm-view-window-configuration*)
 506 (defun howm-set-view-window-configuration (conf)
 507   (setq *howm-view-window-configuration* conf))
 508 (defun howm-record-view-window-configuration ()
 509   (howm-set-view-window-configuration (current-window-configuration)))
 510 (defun howm-restore-view-window-configuration ()
 511   (set-window-configuration (howm-view-window-configuration)))
 512 (defun howm-return-to-list ()
 513   (interactive)
 514   (howm-restore-view-window-configuration))
 515
 516 (defun howm-call-view-search-internal (regexp fixed-p &optional emacs-regexp)
 517   (let ((hilit (if emacs-regexp
 518                    `((,emacs-regexp . howm-view-hilit-face))
 519                  nil)))
 520     (howm-view-search-folder-internal regexp (howm-search-path-folder)
 521                                       nil nil fixed-p hilit)))
 522
 523 (defun howm-list-migemo (&optional completion-p)
 524   (interactive "P")
 525   (howm-set-command 'howm-list-migemo)
 526   (if completion-p
 527       (howm-list-grep t)
 528     (howm-list-migemo-action (howm-iigrep-migemo))))
 529
 530 (defun howm-list-migemo-action (roma)
 531   (let* ((e-reg (howm-migemo-get-pattern roma "emacs"))
 532          (g-reg (if howm-view-use-grep
 533                     (howm-migemo-get-pattern roma "egrep")
 534                   e-reg)))
 535     (if (and e-reg g-reg)
 536         (howm-search g-reg nil e-reg nil roma)
 537       (message "No response from migemo-client."))))
 538
 539 (defun howm-iigrep-migemo ()
 540   (let* ((converter (lambda (yomi) (howm-migemo-get-pattern yomi "egrep")))
 541          (command-for-pattern (howm-iigrep-command-for-pattern nil converter))
 542          (show-what (if (eq howm-iigrep-migemo-show-what 'inherit)
 543                         howm-iigrep-show-what
 544                       howm-iigrep-migemo-show-what)))
 545     (howm-with-iigrep command-for-pattern show-what
 546                       #'howm-list-migemo-action
 547       (read-from-minibuffer "Search all (migemo): "))))
 548
 549 (defun howm-migemo-get-pattern (roma type)
 550   (when (and (null howm-migemo-client) (not howm-view-use-grep))
 551     (require 'migemo))
 552   (cl-labels ((ref (key) (cdr (assoc key howm-migemo-client))))
 553     (cond ((and (featurep 'migemo) (string= type "emacs"))
 554            (howm-funcall-if-defined (migemo-get-pattern roma)))
 555           ((or (null howm-migemo-client) (stringp howm-migemo-client))
 556            (car (howm-call-process (or howm-migemo-client "migemo-client")
 557                                    `(,@howm-migemo-client-option "-t" ,type ,roma)
 558                                    0)))
 559           ((eq (ref 'type) 'cmigemo)
 560            (car (howm-call-process (ref 'command)
 561                                    `(,@howm-migemo-client-option
 562                                      ,@(and (string= type "emacs") '("-e"))
 563                                      "-w" ,roma))))
 564           (t (error "Invalid howm-migemo-client: %s" howm-migemo-client)))))
 565
 566 (defun howm-normalize-oldp ()
 567   howm-list-normalizer)
 568
 569 ;; ;; generate conv in howm-normalizer-pair
 570 ;; (let ((methods '("random" "name" "numerical-name" "date" "reverse-date"
 571 ;;                  "summary" "reminder" "mtime" "reverse")))
 572 ;;   (mapcar (lambda (m)
 573 ;;             (let ((command
 574 ;;                    (howm-get-symbol nil "howm-view-sort-by-" m))
 575 ;;                   (internal
 576 ;;                    (howm-get-symbol nil "howm-sort-items-by-" m)))
 577 ;;               (cons command internal)))
 578 ;;           methods))
 579
 580 (defun howm-normalizer-pair ()
 581   (let* ((old howm-list-normalizer)
 582          (new howm-normalizer)
 583          (conv '((howm-view-sort-by-random . howm-sort-items-by-random)
 584                  (howm-view-sort-by-name . howm-sort-items-by-name)
 585                  (howm-view-sort-by-numerical-name
 586                   . howm-sort-items-by-numerical-name)
 587                  (howm-view-sort-by-date . howm-sort-items-by-date)
 588                  (howm-view-sort-by-reverse-date
 589                   . howm-sort-items-by-reverse-date)
 590                  (howm-view-sort-by-summary . howm-sort-items-by-summary)
 591                  (howm-view-sort-by-reminder . howm-sort-items-by-reminder)
 592                  (howm-view-sort-by-mtime . howm-sort-items-by-mtime)
 593                  (howm-view-sort-by-reverse . howm-sort-items-by-reverse)))
 594          (p (assoc old conv))
 595          (q (assoc new conv)))
 596     (when q
 597       (message "Warning: %s is wrong for howm-normalizer. Use %s." (car q) (cdr q))
 598       (setq new (cdr q)))
 599     (cond ((null old) (cons old new))
 600           (p (cons nil (cdr p)))
 601           (t (cons old #'identity)))))
 602
 603 (defmacro howm-with-normalizer (&rest body)
 604   (declare (indent 0))
 605   (let ((g (cl-gensym)))
 606     `(progn
 607        (when (howm-normalize-oldp)
 608          (message
 609           "Warning: howm-list-normalizer is obsolete. Use howm-normalizer."))
 610        (let* ((,g (howm-normalizer-pair))
 611               (howm-list-normalizer (car ,g))
 612               (howm-normalizer (cdr ,g)))
 613          ,@body))))
 614
 615 (defun howm-normalize-show (name item-list
 616                                  &optional keyword comefrom-regexp no-list-title
 617                                  fl-keywords)
 618   ;; comefrom-regexp and no-list-title are never used now. [2009-07-23]
 619   (howm-with-normalizer
 620     (if (howm-normalize-oldp)
 621         ;; for backward compatibility.
 622         (progn
 623           (howm-view-summary name item-list fl-keywords)
 624           (howm-list-normalize-old keyword comefrom-regexp no-list-title))
 625       (let* ((r (howm-normalize item-list keyword
 626                                 comefrom-regexp no-list-title)))
 627         (howm-call-view-summary name (cdr r) fl-keywords)
 628         (car r)))))
 629
 630 (defun howm-call-view-summary (name item-list-pair fl-keywords)
 631   (let ((orig (car item-list-pair))
 632         (entitled (cdr item-list-pair)))
 633     (howm-view-summary name (or entitled orig) fl-keywords)
 634     ;; side effect
 635     (if entitled
 636         (howm-list-title-put-previous orig)
 637       (howm-list-title-clear-previous))))
 638
 639 (defun howm-normalize (item-list
 640                        &optional keyword comefrom-regexp no-list-title)
 641   ;; no-list-title is never used now. [2009-07-23]
 642   "Sort ITEM-LIST in the standard order."
 643   (let ((matched nil)
 644         (entitled-item-list nil))
 645     (setq item-list (funcall howm-normalizer item-list))
 646     (when keyword
 647       (let ((key-reg (or comefrom-regexp
 648                          (howm-make-keyword-regexp1 keyword)))
 649             (word-reg (format "\\<%s\\>"
 650                               (if (stringp keyword)
 651                                   (regexp-quote keyword)
 652                                 (regexp-opt keyword t))))
 653             (wiki-reg (regexp-quote (howm-make-wiki-string keyword)))
 654             (file-reg (and
 655                        (stringp keyword)
 656                        (format "^%s$"
 657                                (regexp-quote (expand-file-name keyword)))))
 658             (case-fold-search howm-keyword-case-fold-search))
 659         (cl-labels ((check (tag flag reg &optional tag-when-multi-hits)
 660                         (when flag
 661                           (let ((r (howm-normalize-check item-list tag reg
 662                                                          tag-when-multi-hits)))
 663                             (setq matched (append (car r) matched))
 664                             (setq item-list (cdr r))))))
 665           ;; not efficient. should I do them at once?
 666           (check 'word            howm-list-prefer-word word-reg)
 667           (check 'wiki            howm-list-prefer-wiki wiki-reg)
 668           (check 'related-keyword t howm-keyword-regexp)
 669           (check 'keyword         t key-reg 'keyword-multi-hits)
 670           (check 'file            file-reg file-reg))))
 671     (when (and (howm-list-title-p)
 672                (not no-list-title)
 673                (not (and (member 'file matched)
 674                          howm-inhibit-title-file-match)))
 675       (setq entitled-item-list
 676             (howm-entitle-items (howm-list-title-regexp) item-list)))
 677     (cons matched (cons item-list entitled-item-list))))
 678
 679 (defun howm-normalize-check (item-list tag reg tag-when-multi-hits)
 680   (let* ((r (if (eq tag 'file)
 681                 (howm-view-lift-by-path-internal item-list reg)
 682               (howm-view-lift-by-summary-internal item-list reg)))
 683          (m (car r))
 684          (item-list (cdr r))
 685          (matched (cond ((and tag-when-multi-hits (eq m 'multi))
 686                          (list tag-when-multi-hits tag))
 687                         (m (list tag))
 688                         (t nil))))
 689     (cons matched item-list)))
 690
 691 (defun howm-list-normalize-old (&optional keyword comefrom-regexp no-list-title)
 692   "Sort displayed items in the standard order.
 693 This function is obsolete. Use `howm-normalize' insteadly.
 694 --- Sorry, below documentation is incomplete. ---
 695 When KEYWORD is given, matched items are placed on the top.
 696 KEYWORD can be a string or a list of strings.
 697 "
 698   (prog1
 699       (howm-view-in-background
 700         (howm-list-normalize-subr keyword comefrom-regexp no-list-title))
 701     (howm-view-summary)))
 702
 703 (defun howm-list-normalize-subr (keyword comefrom-regexp no-list-title)
 704   "Obsolete. Do not use this any more."
 705   (let ((matched nil))
 706     (funcall howm-list-normalizer)
 707     (when keyword
 708       (let ((key-reg (or comefrom-regexp
 709                          (howm-make-keyword-regexp1 keyword)))
 710             (word-reg (format "\\<%s\\>"
 711                               (if (stringp keyword)
 712                                   (regexp-quote keyword)
 713                                 (regexp-opt keyword t))))
 714             (wiki-reg (regexp-quote (howm-make-wiki-string keyword)))
 715             (file-reg (and
 716                        (stringp keyword)
 717                        (format "^%s$"
 718                                (regexp-quote (expand-file-name keyword)))))
 719             (case-fold-search howm-keyword-case-fold-search))
 720         ;; clean me.
 721         (let ((check (lambda (tag flag reg &optional tag-when-multi-hits)
 722                        (when flag
 723                          (let ((m (if (eq tag 'file)
 724                                       (howm-view-lift-by-name nil reg t)
 725                                     (howm-view-lift-by-summary nil reg))))
 726                            (when m
 727                              (setq matched (cons tag matched)))
 728                            (when (and tag-when-multi-hits (eq m 'multi))
 729                              (setq matched
 730                                    (cons tag-when-multi-hits matched))))))))
 731           (funcall check 'word            howm-list-prefer-word word-reg)
 732           (funcall check 'wiki            howm-list-prefer-wiki wiki-reg)
 733           (funcall check 'related-keyword t howm-keyword-regexp)
 734           (funcall check 'keyword         t key-reg 'keyword-multi-hits)
 735           (funcall check 'file            file-reg file-reg))))
 736     (when (and (howm-list-title-p)
 737                (not no-list-title)
 738                (not (and (member 'file matched)
 739                          howm-inhibit-title-file-match)))
 740       (howm-list-title-internal))
 741     matched))
 742
 743 (defun howm-make-keyword-string (keyword)
 744   (format howm-keyword-format keyword))
 745 (defun howm-make-wiki-string (keyword)
 746   (format howm-wiki-format keyword))
 747
 748 ;; clean me
 749 (defvar howm-keyword-regexp-format "%s$"
 750   "Format to make entire-match regexp from keyword string.
 751 Default is \"%s$\" because we want to make regexp \"<<< foo$\"
 752 from keyword string \"<<< foo\",
 753 so that we can accept \"<<< foo\" and reject \"<<< foobar\".
 754 We need entire-match in order to
 755 (1) place \"<<< foo\" on the top when \"foo\" is searched, and
 756 (2) judge existence of \"<<< foo\" when [[foo]] is hit.")
 757 (defun howm-make-keyword-regexp1 (keyword)
 758   (howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp1-sub))
 759 (defun howm-make-keyword-regexp2 (keyword)
 760   (howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp2-sub))
 761 (defun howm-make-keyword-regexp1-sub (keyword)
 762   (format howm-keyword-regexp-format
 763           (regexp-quote (howm-make-keyword-string keyword))))
 764 (defun howm-make-keyword-regexp2-sub (keyword)
 765   (format howm-keyword-regexp-format
 766           (howm-make-keyword-string (regexp-quote keyword))))
 767 (defun howm-make-keyword-regexp-general (keyword regexp-generator)
 768   (cond ((stringp keyword)
 769          (funcall regexp-generator keyword))
 770         ((listp keyword)
 771          (mapconcat (lambda (s)
 772                       (concat "\\("
 773                               (funcall regexp-generator s)
 774                               "\\)"))
 775                     keyword
 776                     "\\|"))
 777         (t (error "Wrong type: %s" keyword))))
 778
 779 (defun howm-list-related (str)
 780   (howm-set-command 'howm-list-related)
 781   (let* ((keys (mapcar (lambda (k)
 782                          (if howm-keyword-case-fold-search
 783                              (downcase k)
 784                            k))
 785                        (howm-subkeyword str)))
 786          (filter `(lambda (items)
 787                     (howm-filter-items-by-summary items ,(regexp-opt keys)))))
 788     ;; Note that regexp-opt returns a regexp for emacs (not for grep).
 789     (howm-search (howm-make-keyword-string ".*") nil nil filter)))
 790
 791 (defun howm-subkeyword (str)
 792   (with-temp-buffer
 793     (insert str)
 794     (howm-keyword-for-goto)))
 795
 796 (defun howm-list-around ()
 797   (interactive)
 798   (howm-set-command 'howm-list-around)
 799   (let ((f (buffer-file-name))
 800         (item-list (howm-view-sort-by-reverse-date-internal
 801                     (howm-all-items))))
 802     (let ((howm-normalizer #'identity))
 803       (howm-normalize-show "" item-list))
 804     (let ((pos (cl-position-if (lambda (item)
 805                                       (string= (howm-item-name item) f))
 806                                     (howm-view-item-list))))
 807       (goto-char (point-min))
 808       (when pos
 809         (forward-line pos)))
 810     (howm-view-summary-check t)))
 811
 812 (defun howm-history ()
 813   (interactive)
 814   (unless (file-exists-p howm-history-file)
 815     (error "No history."))
 816   ;; disable expansion of %schedule etc.
 817   (let ((howm-menu-display-rules nil)) ;; dirty
 818     (howm-menu-open howm-history-file)))
 819
 820 ;; (defvar howm-history-exclude
 821 ;;   (let ((strings '("[0-9][0-9][0-9][0-9]" "^[*=] [^ ]")))
 822 ;;     `("| %.*%$"
 823 ;;       ,(mapconcat 'regexp-quote strings "\\|"))))
 824 ;; (defun howm-history ()
 825 ;;   (interactive)
 826 ;;   (howm-menu-open howm-history-file)
 827 ;;   (howm-edit-read-only-buffer
 828 ;;     (mapc #'flush-lines
 829 ;;           howm-history-exclude)))
 830
 831 (defvar *howm-command* nil
 832   "For internal use")
 833 (defun howm-set-command (com)
 834   (setq *howm-command* com))
 835 (defun howm-command ()
 836   *howm-command*)
 837
 838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 839 ;; Create
 840
 841 (defun howm-create (&optional which-template here)
 842   (interactive "p")
 843   (let* ((t-c (howm-create-default-title-content))
 844          (title (car t-c))
 845          (content (cdr t-c)))
 846     (howm-create-file-with-title title which-template nil here content)))
 847
 848 (howm-dont-warn-free-variable transient-mark-mode)
 849 (howm-dont-warn-free-variable mark-active)
 850 (defun howm-create-default-title-content ()
 851   (let* ((p (point))
 852          (m (or (mark t) -777))
 853          (beg (min p m))
 854          (end (max p m))
 855          (search-str (howm-view-name)))
 856     (let* ((transient-mark-p (and (boundp 'transient-mark-mode)
 857                                   transient-mark-mode))
 858            (mark-active-p (and (boundp 'mark-active) mark-active))
 859            (active-p (if transient-mark-p
 860                          mark-active-p
 861                        t))
 862            (strictly-active-p (and transient-mark-p mark-active-p))
 863            (title-p (let* ((b (line-beginning-position))
 864                            (e (line-end-position)))
 865                       (and active-p
 866                            (< 0 beg) (<= b beg) (<= end e) (not (= beg end)))))
 867            (content-p (and strictly-active-p
 868                            howm-content-from-region))
 869            (search-p (and howm-title-from-search
 870                           (stringp search-str)))
 871            (s (cond ((or title-p content-p) (buffer-substring-no-properties beg
 872                                                                             end))
 873                     (search-p search-str))))
 874       (cond ((null s) (cons "" ""))
 875             ((eq content-p t) (cons "" s))
 876             ((or title-p search-p) (cons s ""))
 877             (content-p (cons "" s))
 878             (t (cons "" ""))))))
 879
 880 (defun howm-create-here (&optional which-template)
 881   (interactive "p")
 882   (howm-create which-template t))
 883
 884 (defun howm-create-file-with-title (title &optional
 885                                     which-template not-use-file here content)
 886   (let ((b (current-buffer)))
 887     (when (not here)
 888       (howm-create-file))
 889     (cond ((howm-buffer-empty-p) nil)
 890           ((and here howm-create-here-just) (beginning-of-line))
 891           (t (howm-create-newline)))
 892     (let ((p (point))
 893           (insert-f (lambda (switch)
 894                       (howm-insert-template (if switch title "")
 895                                             b which-template (not switch))))
 896           (use-file (not not-use-file)))
 897       ;; second candidate which appears when undo is called
 898       (let ((end (funcall insert-f not-use-file)))
 899         (save-excursion
 900           (goto-char end)
 901           (insert (or content "")))
 902         (undo-boundary)
 903         (delete-region p end))
 904       (funcall insert-f use-file))
 905     (howm-create-finish)))
 906
 907 (defun howm-create-finish ()
 908   (howm-set-mode)
 909   (run-hooks 'howm-create-hook))
 910
 911 (defun howm-create-newline ()
 912   (widen)
 913   (if howm-prepend
 914       (howm-create-newline-prepend)
 915     (howm-create-newline-append)))
 916 (defun howm-create-newline-prepend ()
 917   (goto-char (point-min)))
 918 (defun howm-create-newline-append ()
 919   (goto-char (point-max))
 920   (delete-blank-lines)
 921   (when (not (= (line-beginning-position) (point))) ;; not empty line
 922     (insert "\n"))
 923   (insert "\n"))
 924
 925 (defun howm-insert-template (title &optional
 926                                    previous-buffer which-template not-use-file)
 927   (let* ((beg (point))
 928          (f (buffer-file-name previous-buffer))
 929          (af (and f (howm-abbreviate-file-name f))))
 930     (insert (howm-template-string which-template previous-buffer))
 931     (let* ((date (format-time-string howm-template-date-format))
 932            (use-file (not not-use-file))
 933            (file (cond ((not use-file) "")
 934                        ((null f) "")
 935                        ((string= f (buffer-file-name)) "")
 936                        (t (format howm-template-file-format af)))))
 937       (let ((arg `((title . ,title) (date . ,date) (file . ,file)))
 938             (end (point-marker)))
 939         (howm-replace howm-template-rules arg beg end)
 940         end))))
 941
 942 (defvar howm-template-receive-buffer t
 943   "Non nil if howm-template should receive previous-buffer
 944 when howm-template is a function.
 945 Set this option to nil if backward compatibility with howm-1.2.4 or earlier
 946 is necessary.")
 947
 948 (defun howm-template-string (which-template previous-buffer)
 949   ;; which-template should be 1, 2, 3, ...
 950   (setq which-template (or which-template 1))
 951   (cond ((stringp howm-template) howm-template)
 952         ((functionp howm-template) (let ((args (if howm-template-receive-buffer
 953                                                    (list which-template
 954                                                          previous-buffer)
 955                                                  (list which-template))))
 956                                      (apply howm-template args)))
 957         ((listp howm-template) (nth (- which-template 1) howm-template))))
 958
 959 (defun howm-replace (rules arg &optional beg end)
 960   (mapc (lambda (pair)
 961           (let ((spell (car pair))
 962                 (disp-f (cdr pair)))
 963             (goto-char (or beg (point-min)))
 964             (while (re-search-forward spell end t)
 965               (delete-region (match-beginning 0) (match-end 0))
 966               (funcall disp-f arg))))
 967         rules))
 968
 969 (defun howm-template-title (arg)
 970   (insert (cdr (assoc 'title arg))))
 971 (defun howm-template-date (arg)
 972   (insert (cdr (assoc 'date arg))))
 973 (defun howm-template-previous-file (arg)
 974   (insert (cdr (assoc 'file arg))))
 975 (defun howm-template-cursor (arg)) ;; do nothing
 976
 977 (defun howm-dup ()
 978   (interactive)
 979   (let* ((r (howm-view-paragraph-region))
 980          (s (buffer-substring-no-properties (car r) (cadr r))))
 981     (howm-create-file)
 982     (howm-set-mode)
 983     (insert "\n" s)))
 984
 985 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 986 ;; Keyword
 987
 988 (defun howm-completing-read-keyword ()
 989   (message "Scanning...")
 990   (let* ((kl (howm-keyword-list))
 991          (table (mapcar #'list kl))
 992          (completion-ignore-case howm-keyword-case-fold-search))
 993     (completing-read "Keyword: " table)))
 994
 995 (defun howm-insert-keyword ()
 996   (interactive)
 997   (insert (howm-completing-read-keyword)))
 998
 999 (defun howm-keyword-to-kill-ring (&optional filename-p)
1000   (interactive "P")
1001   (let ((title (howm-title-at-current-point filename-p)))
1002     (if title
1003         (howm-string-to-kill-ring title)
1004       (error "No keyword."))))
1005
1006 (defun howm-title-at-current-point (&optional filename-p
1007                                               title-regexp title-regexp-pos)
1008   (let ((reg (or title-regexp howm-view-title-regexp))
1009         (pos (or title-regexp-pos howm-view-title-regexp-pos)))
1010     (save-excursion
1011       (end-of-line)
1012       (cond ((and (not filename-p)
1013                   (re-search-backward reg nil t))
1014              (match-string-no-properties pos))
1015             ((buffer-file-name)
1016              (howm-abbreviate-file-name (buffer-file-name)))
1017             (t nil)))))
1018
1019 (defun howm-string-to-kill-ring (str)
1020   (if str
1021       (progn
1022         (kill-new str)
1023         (message "%s" str))
1024     (error "Empty.")))
1025
1026 (defun howm-keyword-for-comefrom ()
1027   (save-excursion
1028     (goto-char (point-min))
1029     (let ((keyword-list nil))
1030       (while (re-search-forward howm-keyword-regexp nil t)
1031         (setq keyword-list
1032               (cons (match-string-no-properties howm-keyword-regexp-pos)
1033                     keyword-list)))
1034       (reverse keyword-list))))
1035
1036 (defun howm-keyword-list ()
1037   (let ((sep (format "[\n%s]" (or howm-keyword-list-alias-sep ""))))
1038     (with-current-buffer (howm-keyword-buffer)
1039       (delete ""
1040               (split-string (buffer-substring (point-min) (point-max)) sep)))))
1041
1042 (defun howm-keyword-add (keyword-list)
1043   (interactive "sKeyword: ")
1044   (setq keyword-list (if (stringp keyword-list)
1045                          (list keyword-list)
1046                        keyword-list))
1047   (with-current-buffer (howm-keyword-buffer)
1048     (save-excursion
1049       (goto-char (point-max))
1050       (mapc (lambda (k)
1051               (when (howm-keyword-new-p k)
1052                 (insert k "\n")))
1053             keyword-list)
1054       (when (buffer-file-name)
1055         (howm-basic-save-buffer)))))
1056
1057 (defun howm-keyword-new-p (str)
1058   (save-excursion
1059     (let ((r (format "^%s$" (regexp-quote str)))
1060           (case-fold-search howm-keyword-case-fold-search))
1061       (goto-char (point-min))
1062       (not (re-search-forward r nil t)))))
1063
1064 (defun howm-support-aliases-p ()
1065   howm-keyword-list-alias-sep)
1066 (defun howm-aliases ()
1067   (if (howm-support-aliases-p)
1068       (howm-read-aliases)
1069     nil))
1070 (defun howm-read-aliases ()
1071   (with-current-buffer (howm-keyword-buffer)
1072     (save-excursion
1073       (let ((ans nil))
1074         (goto-char (point-min))
1075         (while (search-forward howm-keyword-list-alias-sep nil t)
1076           (let* ((line (buffer-substring-no-properties (line-beginning-position)
1077                                                        (line-end-position)))
1078                  (keys (split-string line howm-keyword-list-alias-sep))
1079                  (ks (if howm-keyword-case-fold-search
1080                          (mapcar #'downcase keys)
1081                        keys)))
1082             (setq ans (cons ks ans))
1083             (end-of-line)))
1084         ans))))
1085
1086 (defun howm-expand-aliases-recursively (keyword aliases)
1087   (let ((keys (list keyword))
1088         (prev nil))
1089     (cl-labels ((expand (keys)
1090                      (sort (cl-remove-duplicates
1091                             (cl-mapcan (lambda (k)
1092                                               (cl-mapcan
1093                                                (lambda (a) (if (member k a)
1094                                                                (copy-sequence a)
1095                                                              nil))
1096                                                aliases))
1097                                             keys) :test #'string=)
1098                            #'string<)))
1099       (while (not (equal prev keys))
1100         (setq prev keys)
1101         (setq keys (expand keys))))
1102     keys))
1103 (cl-assert (equal (howm-expand-aliases-recursively "a"
1104                                                 '(("d" "e" "f") ("a" "b" "c")))
1105                '("a" "b" "c")))
1106 (cl-assert (equal (howm-expand-aliases-recursively "a"
1107                                                 '(("d" "e" "b") ("a" "b" "c")))
1108                '("a" "b" "c" "d" "e")))
1109
1110 (defun howm-keyword-aliases (keyword)
1111   "List of strings which are equivalent to KEYWORD.
1112 KEYWORD itself is always at the head of the returneded list.
1113 "
1114   ;; Return the original keyword (not downcased) for backward compatibility.
1115   ;; I'm not sure whether this behavior is really needed.
1116   (let* ((key (if howm-keyword-case-fold-search
1117                   (downcase keyword)
1118                 keyword))
1119          (aliases (howm-aliases))
1120          (equiv (if howm-keyword-aliases-recursive
1121                     (howm-expand-aliases-recursively key aliases)
1122                   (cl-remove-duplicates
1123                    (apply #'append
1124                           (cl-remove-if-not (lambda (a) (member key a))
1125                                                  aliases))))))
1126     (if (null equiv)
1127         keyword
1128       (cons keyword (remove key equiv)))))
1129
1130 (defun howm-keyword-search (keyword &optional create-p open-unique-p)
1131   (howm-message-time "key-search"
1132     (howm-set-command 'howm-keyword-search)
1133     (howm-with-normalizer
1134       (howm-keyword-search-subr keyword create-p open-unique-p))))
1135
1136 (defun howm-keyword-search-subr (keyword create-p open-unique-p)
1137   (let* ((aliases (if (howm-support-aliases-p)
1138                       (howm-keyword-aliases keyword)
1139                     keyword))
1140          (menu-p (howm-menu-keyword-p keyword))
1141          (comefrom-regexp (if menu-p ;; clean me
1142                               nil
1143                             (howm-make-keyword-regexp2 aliases)))
1144          (trio (let ((howm-search-other-dir (if menu-p ;; clean me
1145                                                  nil
1146                                                howm-search-other-dir))
1147                       (*howm-view-force-case-fold-search*
1148                        howm-keyword-case-fold-search)) ;; dirty!
1149                  (howm-call-view-search-internal aliases t)))
1150 ;; code for <http://pc8.2ch.net/test/read.cgi/unix/1077881095/823>.
1151 ;; but this change is canceled; I'll try more fundamental fix. [2005-11-04]
1152 ;;                   (if open-unique-p
1153 ;;                       (let ((r (concat "^" (regexp-quote keyword) "$")))
1154 ;;                         (howm-call-view-search r nil))
1155 ;;                     (howm-call-view-search aliases t))))
1156          (kw (car trio))
1157          (name (cadr trio))
1158          (items (cl-caddr trio))
1159          (items-pair nil)
1160          (found (if items t nil)) ;; want to forget items as soon as possible
1161          (matched (and found
1162                        (let* ((howm-keyword-format
1163                                (if menu-p ;; clean me
1164                                    (default-value 'howm-keyword-format)
1165                                  howm-keyword-format))
1166                               (r (howm-normalize items aliases
1167                                                  comefrom-regexp)))
1168                          (setq items-pair (cdr r))
1169                          (car r))))
1170          (keyword-matched (member 'keyword matched))
1171          (keyword-matched-multi (member 'keyword-multi-hits matched))
1172          (file-matched (member 'file matched))
1173          (title (howm-make-keyword-string keyword)))
1174     ;; main processing (clean me!) [2003-12-01]
1175     (cond
1176      ;; for %foo%
1177      ((and menu-p keyword-matched)
1178       (howm-keyword-search-open-menu keyword (car items-pair)
1179                                      keyword-matched-multi))
1180      ;; for [[foo]]
1181      ((and create-p (not keyword-matched))
1182       (howm-keyword-search-create title))
1183      ;; open if unique match
1184      ((and open-unique-p (howm-single-element-p items))
1185       (howm-keyword-search-open-unique items))
1186      (t
1187       (howm-call-view-summary name items-pair kw)
1188       (when (howm-normalize-oldp)
1189         ;; sorry for redundancy & inefficiency
1190         (howm-list-normalize-old aliases comefrom-regexp t))))
1191     ;; record history
1192     (when (not menu-p)
1193       (howm-write-history keyword))
1194     ;; return information
1195     `((menu-p . ,menu-p)
1196       (found . ,found)
1197       (matched . ,matched)
1198       (keyword-matched . ,keyword-matched)
1199       (create-p . ,create-p))
1200     ))
1201
1202 (defun howm-keyword-search-open-menu (keyword item-list multi-hits-p)
1203   "Open KEYWORD as menu."
1204   ;; dirty. peeking howm-view.el
1205   (let* ((item (car item-list))
1206          (fname (howm-view-item-filename item))
1207          (place (howm-view-item-place item)))
1208     (let ((howm-search-other-dir nil))
1209       (howm-menu-open fname place (howm-menu-name keyword))))
1210   (when multi-hits-p
1211     (message "Warning: found two or more %s." keyword)))
1212
1213 (defun howm-keyword-search-create (title)
1214   "create new memo <<< TITLE."
1215   (howm-create-file-with-title title)
1216   (message "New keyword."))
1217
1218 (defun howm-keyword-search-open-unique (items)
1219   "Open unique match."
1220   (howm-view-open-item (car items)))
1221
1222 ;; (defvar *howm-keyword-buffer* nil) ;; for internal use
1223 (defun howm-keyword-for-goto (&optional keyword-list)
1224   (save-excursion
1225     (let ((case-fold-search howm-keyword-case-fold-search))
1226       (sort (cl-mapcan (lambda (k)
1227                               (goto-char (point-min))
1228                               ;; when howm-check-word-break is non-nil,
1229                               ;; checking word breaks is desired for efficiency.
1230                               ;; it is not implemented yet.
1231                               (if (search-forward k nil 'noerr)
1232                                   (list k)
1233                                 nil))
1234                             (or keyword-list (howm-keyword-list)))
1235             (lambda (x y)
1236               (> (length x) (length y)))))))
1237
1238 (defun howm-keyword-add-current-buffer ()
1239   (save-excursion
1240     (goto-char (point-min))
1241     (let ((m (current-message))
1242           (keyword-list nil))
1243       (while (re-search-forward howm-keyword-regexp nil t)
1244         (let ((key-str (if howm-keyword-list-alias-sep
1245                            (mapconcat #'identity
1246                                       (howm-keyword-read)
1247                                       howm-keyword-list-alias-sep)
1248                          (match-string-no-properties howm-keyword-regexp-pos))))
1249           (setq keyword-list (cons key-str keyword-list))))
1250       (howm-keyword-add keyword-list)
1251       (message "%s" m))))
1252 (defun howm-keyword-add-items (items)
1253   (let ((files (mapcar #'howm-view-item-filename items)))
1254     (with-temp-buffer
1255       (mapc (lambda (f)
1256               (erase-buffer)
1257               (insert-file-contents f)
1258               (howm-set-configuration-for-file-name f)
1259               (howm-keyword-add-current-buffer))
1260             files))))
1261
1262 (defun howm-keyword-read ()
1263   (let ((ks nil)
1264         (beg (line-beginning-position)))
1265     (end-of-line)
1266     (skip-chars-backward " ")
1267     (while (re-search-backward howm-keyword-regexp beg t)
1268       (setq ks (cons (match-string-no-properties howm-keyword-regexp-pos) ks))
1269       (skip-chars-backward " "))
1270     (end-of-line)
1271     ks))
1272
1273 ;;; howm-mode.el ends here