OSDN Git Service

469522dc5387583c1556d5cf82a076208fdd65a1
[howm/howm.git] / howm-mode.el
1 ;;; howm-mode.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2018
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 (easy-mmode-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   nil ;; default = off
284   howm-lighter ;; mode-line
285   (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   )
291
292 ;; emacs20's easy-mmode-define-minor-mode can't have body. sigh...
293 (add-hook 'howm-mode-on-hook 'howm-initialize-buffer)
294 (add-hook 'howm-mode-off-hook 'howm-restore-buffer)
295
296 (defun howm-set-keymap ()
297   (mapc (lambda (entry)
298           (let* ((k (car entry))
299                  (f (cadr entry))
300                  (list-mode-p (cl-caddr entry))
301                  (global-p (cl-cadddr entry))
302                  (pk (concat howm-prefix k)))
303             (define-key howm-mode-map pk f)
304             (when list-mode-p
305               (mapc (lambda (m)
306                       (define-key m k f)
307                       (define-key m pk f))
308                     (list howm-view-summary-mode-map
309                           howm-view-contents-mode-map)))
310             (when global-p
311               (define-key global-map pk f))))
312         howm-default-key-table)
313   (define-key howm-mode-map "\C-x\C-s" 'howm-save-buffer))
314 (howm-set-keymap)
315
316 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317 ;; Main functions
318
319 (defun howm-refresh ()
320   (interactive)
321   (if (howm-menu-p)
322       (howm-menu-refresh)
323     (howm-initialize-buffer)))
324
325 (defun howm-initialize-buffer ()
326   (interactive)
327   (when (not howm-mode)
328     (error "Not howm-mode"))
329   (howm-message-time "init-buf"
330     (save-restriction
331       (widen)
332       (howm-set-configuration-for-major-mode major-mode)
333       (howm-action-lock-setup)
334       (howm-mode-add-font-lock)
335       (howm-reminder-add-font-lock)
336       (cheat-font-lock-fontify)
337       ;; make-local-hook is obsolete for emacs >= 21.1.
338       (howm-funcall-if-defined (make-local-hook 'after-save-hook))
339       (add-hook 'after-save-hook 'howm-after-save t t))))
340
341 (defun howm-after-save ()
342   (when howm-mode
343     (howm-keyword-add-current-buffer)
344     (when howm-refresh-after-save
345       (howm-initialize-buffer))
346     (when (and howm-menu-refresh-after-save
347                (> howm-menu-expiry-hours 0))
348       (howm-menu-refresh-background))
349     (run-hooks 'howm-after-save-hook)))
350
351 (defun howm-restore-buffer ()
352   (action-lock-mode 0))
353
354 (defun howm-list-all ()
355   (interactive)
356   (howm-set-command 'howm-list-all)
357   (howm-normalize-show "" (howm-all-items))
358   ;; for backward compatibility
359   (cond ((howm-list-title-p) t)  ;; already done in howm-normalize-show
360         (howm-list-all-title (howm-list-title-internal))))
361
362 (defun howm-all-items ()
363   "Returns list of all items in the first search path."
364   (howm-folder-items (car (howm-search-path)) t))
365
366 (defun howm-list-recent (&optional days)
367   (interactive "P")
368   (howm-set-command 'howm-list-recent)
369   (let* ((d (or days howm-list-recent-days))
370          (now (current-time))
371          (from (howm-days-before now d))
372          (item-list (howm-folder-items howm-directory t)))
373     (howm-normalize-show "" (howm-filter-items-by-mtime item-list from now))
374     ;; clean me [2003-11-30]
375     (cond ((howm-list-title-p) t)  ;; already done in howm-normalize-show
376           (howm-list-recent-title (howm-list-title-internal))
377           ((not days) (howm-view-summary-to-contents)))))
378
379 ;; clean me: direct access to howm-view-* is undesirable.
380
381 (defvar howm-list-title-previous nil
382   "For internal use")
383 (make-variable-buffer-local 'howm-list-title-previous)
384 (defun howm-list-title-put-previous (&optional item-list)
385   (when howm-list-title-undo
386     (setq howm-list-title-previous (or item-list (howm-view-item-list)))))
387 (defun howm-list-title-clear-previous ()
388   (setq howm-list-title-previous nil))
389 (defun howm-list-title-get-previous ()
390   (if howm-list-title-undo
391       (let ((prev howm-list-title-previous))
392         (setq howm-list-title-previous nil)
393         (howm-view-summary-rebuild prev))
394     (error "Undo is not enabled.")))
395 (defun howm-list-title-regexp ()
396   (or howm-list-title-regexp (howm-view-title-regexp-grep)))
397 (defalias 'howm-list-title 'howm-list-toggle-title) ;; backward compatibility
398 (defun howm-list-toggle-title (&optional undo)
399   (interactive "P")
400   (if (or undo howm-list-title-previous)
401       (howm-list-title-get-previous)
402     (howm-list-title-internal)))
403 (defun howm-list-title-internal ()
404   (let ((b (current-buffer)))
405     (howm-list-title-put-previous)
406     (howm-view-list-title (howm-list-title-regexp))
407     ;;       (howm-view-filter-by-contents (howm-list-title-regexp))
408     (let ((c (current-buffer)))
409       (when (not (eq b c))
410         (set-buffer b)
411         (howm-view-kill-buffer)
412         (switch-to-buffer c)
413         (howm-view-summary-check t)))))
414
415 (defun howm-list-title-p ()
416   (let ((a (howm-get-value howm-list-title)))
417     (cond ((null a) nil) ;; I know this is redundant.
418           ((listp a) (member (howm-command) a))
419           (t a))))
420
421 (defun howm-days-after (ti days &optional hours)
422   (let* ((ne (howm-decode-time ti))
423          (hour-pos 2)
424          (day-pos 3)
425          (nh (nth hour-pos ne))
426          (nd (nth day-pos ne)))
427     (setf (nth hour-pos ne) (+ nh (or hours 0)))
428     (setf (nth day-pos ne) (+ nd days))
429     (apply #'encode-time ne)))
430
431 (defun howm-days-before (ti days)
432   (howm-days-after ti (- days)))
433
434 (defun howm-list-grep (&optional completion-p)
435   (interactive "P")
436   (howm-set-command 'howm-list-grep)
437   (howm-list-grep-general completion-p))
438
439 (defun howm-list-grep-fixed ()
440   (interactive)
441   (howm-set-command 'howm-list-grep-fixed)
442   (howm-list-grep-general t))
443
444 (defun howm-list-grep-general (&optional completion-p)
445   (let* ((regexp (if completion-p
446                      (howm-completing-read-keyword)
447                    (read-from-minibuffer "Search all (grep): "))))
448     (when completion-p  ;; Goto link works only for fixed string at now.
449       (howm-write-history regexp))
450     (howm-search regexp completion-p)))
451
452 (defun howm-search (regexp fixed-p &optional emacs-regexp filter)
453   (if (string= regexp "")
454       (howm-list-all)
455     (howm-message-time "search"
456       (let* ((trio (howm-call-view-search-internal regexp fixed-p emacs-regexp))
457              (kw (car trio))
458              (name (cadr trio))
459              (items (cl-caddr trio)))
460         (when filter
461           (setq items (funcall filter items)))
462         (howm-normalize-show name items (or emacs-regexp regexp) nil nil kw)
463         (howm-record-view-window-configuration)))))
464
465 (defvar *howm-view-window-configuration* nil
466   "For internal use")
467 (defun howm-view-window-configuration ()
468   *howm-view-window-configuration*)
469 (defun howm-set-view-window-configuration (conf)
470   (setq *howm-view-window-configuration* conf))
471 (defun howm-record-view-window-configuration ()
472   (howm-set-view-window-configuration (current-window-configuration)))
473 (defun howm-restore-view-window-configuration ()
474   (set-window-configuration (howm-view-window-configuration)))
475 (defun howm-return-to-list ()
476   (interactive)
477   (howm-restore-view-window-configuration))
478
479 (defun howm-call-view-search-internal (regexp fixed-p &optional emacs-regexp)
480   (let ((hilit (if emacs-regexp
481                    `((,emacs-regexp . howm-view-hilit-face))
482                  nil)))
483     (howm-view-search-folder-internal regexp (howm-search-path-folder)
484                                       nil nil fixed-p hilit)))
485
486 (defun howm-list-migemo (&optional completion-p)
487   (interactive "P")
488   (howm-set-command 'howm-list-migemo)
489   (if completion-p
490       (howm-list-grep t)
491     (let* ((roma (read-from-minibuffer "Search all (migemo): "))
492            (e-reg (howm-migemo-get-pattern roma "emacs"))
493            (g-reg (if howm-view-use-grep
494                       (howm-migemo-get-pattern roma "egrep")
495                     e-reg)))
496       (if (and e-reg g-reg)
497           (howm-search g-reg nil e-reg)
498         (message "No response from migemo-client.")))))
499
500 (defun howm-migemo-get-pattern (roma type)
501   (when (and (null howm-migemo-client) (not howm-view-use-grep))
502     (require 'migemo))
503   (cl-labels ((ref (key) (cdr (assoc key howm-migemo-client))))
504     (cond ((and (featurep 'migemo) (string= type "emacs"))
505            (howm-funcall-if-defined (migemo-get-pattern roma)))
506           ((or (null howm-migemo-client) (stringp howm-migemo-client))
507            (car (howm-call-process (or howm-migemo-client "migemo-client")
508                                    `(,@howm-migemo-client-option "-t" ,type ,roma)
509                                    0)))
510           ((eq (ref 'type) 'cmigemo)
511            (car (howm-call-process (ref 'command)
512                                    `(,@howm-migemo-client-option
513                                      ,@(and (string= type "emacs") '("-e"))
514                                      "-w" ,roma))))
515           (t (error "Invalid howm-migemo-client: %s" howm-migemo-client)))))
516
517 (defun howm-normalize-oldp ()
518   howm-list-normalizer)
519
520 ;; ;; generate conv in howm-normalizer-pair
521 ;; (let ((methods '("random" "name" "numerical-name" "date" "reverse-date"
522 ;;                  "summary" "reminder" "mtime" "reverse")))
523 ;;   (mapcar (lambda (m)
524 ;;             (let ((command
525 ;;                    (howm-get-symbol nil "howm-view-sort-by-" m))
526 ;;                   (internal
527 ;;                    (howm-get-symbol nil "howm-sort-items-by-" m)))
528 ;;               (cons command internal)))
529 ;;           methods))
530
531 (defun howm-normalizer-pair ()
532   (let* ((old howm-list-normalizer)
533          (new howm-normalizer)
534          (conv '((howm-view-sort-by-random . howm-sort-items-by-random)
535                  (howm-view-sort-by-name . howm-sort-items-by-name)
536                  (howm-view-sort-by-numerical-name
537                   . howm-sort-items-by-numerical-name)
538                  (howm-view-sort-by-date . howm-sort-items-by-date)
539                  (howm-view-sort-by-reverse-date
540                   . howm-sort-items-by-reverse-date)
541                  (howm-view-sort-by-summary . howm-sort-items-by-summary)
542                  (howm-view-sort-by-reminder . howm-sort-items-by-reminder)
543                  (howm-view-sort-by-mtime . howm-sort-items-by-mtime)
544                  (howm-view-sort-by-reverse . howm-sort-items-by-reverse)))
545          (p (assoc old conv))
546          (q (assoc new conv)))
547     (when q
548       (message "Warning: %s is wrong for howm-normalizer. Use %s." (car q) (cdr q))
549       (setq new (cdr q)))
550     (cond ((null old) (cons old new))
551           (p (cons nil (cdr p)))
552           (t (cons old #'identity)))))
553
554 (defmacro howm-with-normalizer (&rest body)
555   (declare (indent 0))
556   (let ((g (cl-gensym)))
557     `(progn
558        (when (howm-normalize-oldp)
559          (message
560           "Warning: howm-list-normalizer is obsolete. Use howm-normalizer."))
561        (let* ((,g (howm-normalizer-pair))
562               (howm-list-normalizer (car ,g))
563               (howm-normalizer (cdr ,g)))
564          ,@body))))
565
566 (defun howm-normalize-show (name item-list
567                                  &optional keyword comefrom-regexp no-list-title
568                                  fl-keywords)
569   ;; comefrom-regexp and no-list-title are never used now. [2009-07-23]
570   (howm-with-normalizer
571     (if (howm-normalize-oldp)
572         ;; for backward compatibility.
573         (progn
574           (howm-view-summary name item-list fl-keywords)
575           (howm-list-normalize-old keyword comefrom-regexp no-list-title))
576       (let* ((r (howm-normalize item-list keyword
577                                 comefrom-regexp no-list-title)))
578         (howm-call-view-summary name (cdr r) fl-keywords)
579         (car r)))))
580
581 (defun howm-call-view-summary (name item-list-pair fl-keywords)
582   (let ((orig (car item-list-pair))
583         (entitled (cdr item-list-pair)))
584     (howm-view-summary name (or entitled orig) fl-keywords)
585     ;; side effect
586     (if entitled
587         (howm-list-title-put-previous orig)
588       (howm-list-title-clear-previous))))
589
590 (defun howm-normalize (item-list
591                        &optional keyword comefrom-regexp no-list-title)
592   ;; no-list-title is never used now. [2009-07-23]
593   "Sort ITEM-LIST in the standard order."
594   (let ((matched nil)
595         (entitled-item-list nil))
596     (setq item-list (funcall howm-normalizer item-list))
597     (when keyword
598       (let ((key-reg (or comefrom-regexp
599                          (howm-make-keyword-regexp1 keyword)))
600             (word-reg (format "\\<%s\\>"
601                               (if (stringp keyword)
602                                   (regexp-quote keyword)
603                                 (regexp-opt keyword t))))
604             (wiki-reg (regexp-quote (howm-make-wiki-string keyword)))
605             (file-reg (and
606                        (stringp keyword)
607                        (format "^%s$"
608                                (regexp-quote (expand-file-name keyword)))))
609             (case-fold-search howm-keyword-case-fold-search))
610         (cl-labels ((check (tag flag reg &optional tag-when-multi-hits)
611                         (when flag
612                           (let ((r (howm-normalize-check item-list tag reg
613                                                          tag-when-multi-hits)))
614                             (setq matched (append (car r) matched))
615                             (setq item-list (cdr r))))))
616           ;; not efficient. should I do them at once?
617           (check 'word            howm-list-prefer-word word-reg)
618           (check 'wiki            howm-list-prefer-wiki wiki-reg)
619           (check 'related-keyword t howm-keyword-regexp)
620           (check 'keyword         t key-reg 'keyword-multi-hits)
621           (check 'file            file-reg file-reg))))
622     (when (and (howm-list-title-p)
623                (not no-list-title)
624                (not (and (member 'file matched)
625                          howm-inhibit-title-file-match)))
626       (setq entitled-item-list
627             (howm-entitle-items (howm-list-title-regexp) item-list)))
628     (cons matched (cons item-list entitled-item-list))))
629
630 (defun howm-normalize-check (item-list tag reg tag-when-multi-hits)
631   (let* ((r (if (eq tag 'file)
632                 (howm-view-lift-by-path-internal item-list reg)
633               (howm-view-lift-by-summary-internal item-list reg)))
634          (m (car r))
635          (item-list (cdr r))
636          (matched (cond ((and tag-when-multi-hits (eq m 'multi))
637                          (list tag-when-multi-hits tag))
638                         (m (list tag))
639                         (t nil))))
640     (cons matched item-list)))
641
642 (defun howm-list-normalize-old (&optional keyword comefrom-regexp no-list-title)
643   "Sort displayed items in the standard order.
644 This function is obsolete. Use `howm-normalize' insteadly.
645 --- Sorry, below documentation is incomplete. ---
646 When KEYWORD is given, matched items are placed on the top.
647 KEYWORD can be a string or a list of strings.
648 "
649   (prog1
650       (howm-view-in-background
651         (howm-list-normalize-subr keyword comefrom-regexp no-list-title))
652     (howm-view-summary)))
653
654 (defun howm-list-normalize-subr (keyword comefrom-regexp no-list-title)
655   "Obsolete. Do not use this any more."
656   (let ((matched nil))
657     (funcall howm-list-normalizer)
658     (when keyword
659       (let ((key-reg (or comefrom-regexp
660                          (howm-make-keyword-regexp1 keyword)))
661             (word-reg (format "\\<%s\\>"
662                               (if (stringp keyword)
663                                   (regexp-quote keyword)
664                                 (regexp-opt keyword t))))
665             (wiki-reg (regexp-quote (howm-make-wiki-string keyword)))
666             (file-reg (and
667                        (stringp keyword)
668                        (format "^%s$"
669                                (regexp-quote (expand-file-name keyword)))))
670             (case-fold-search howm-keyword-case-fold-search))
671         ;; clean me.
672         (let ((check (lambda (tag flag reg &optional tag-when-multi-hits)
673                        (when flag
674                          (let ((m (if (eq tag 'file)
675                                       (howm-view-lift-by-name nil reg t)
676                                     (howm-view-lift-by-summary nil reg))))
677                            (when m
678                              (setq matched (cons tag matched)))
679                            (when (and tag-when-multi-hits (eq m 'multi))
680                              (setq matched
681                                    (cons tag-when-multi-hits matched))))))))
682           (funcall check 'word            howm-list-prefer-word word-reg)
683           (funcall check 'wiki            howm-list-prefer-wiki wiki-reg)
684           (funcall check 'related-keyword t howm-keyword-regexp)
685           (funcall check 'keyword         t key-reg 'keyword-multi-hits)
686           (funcall check 'file            file-reg file-reg))))
687     (when (and (howm-list-title-p)
688                (not no-list-title)
689                (not (and (member 'file matched)
690                          howm-inhibit-title-file-match)))
691       (howm-list-title-internal))
692     matched))
693
694 (defun howm-make-keyword-string (keyword)
695   (format howm-keyword-format keyword))
696 (defun howm-make-wiki-string (keyword)
697   (format howm-wiki-format keyword))
698
699 ;; clean me
700 (defvar howm-keyword-regexp-format "%s$"
701   "Format to make entire-match regexp from keyword string.
702 Default is \"%s$\" because we want to make regexp \"<<< foo$\"
703 from keyword string \"<<< foo\",
704 so that we can accept \"<<< foo\" and reject \"<<< foobar\".
705 We need entire-match in order to
706 (1) place \"<<< foo\" on the top when \"foo\" is searched, and
707 (2) judge existence of \"<<< foo\" when [[foo]] is hit.")
708 (defun howm-make-keyword-regexp1 (keyword)
709   (howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp1-sub))
710 (defun howm-make-keyword-regexp2 (keyword)
711   (howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp2-sub))
712 (defun howm-make-keyword-regexp1-sub (keyword)
713   (format howm-keyword-regexp-format
714           (regexp-quote (howm-make-keyword-string keyword))))
715 (defun howm-make-keyword-regexp2-sub (keyword)
716   (format howm-keyword-regexp-format
717           (howm-make-keyword-string (regexp-quote keyword))))
718 (defun howm-make-keyword-regexp-general (keyword regexp-generator)
719   (cond ((stringp keyword)
720          (funcall regexp-generator keyword))
721         ((listp keyword)
722          (mapconcat (lambda (s)
723                       (concat "\\("
724                               (funcall regexp-generator s)
725                               "\\)"))
726                     keyword
727                     "\\|"))
728         (t (error "Wrong type: %s" keyword))))
729
730 (defun howm-list-related (str)
731   (howm-set-command 'howm-list-related)
732   (let* ((keys (mapcar (lambda (k)
733                          (if howm-keyword-case-fold-search
734                              (downcase k)
735                            k))
736                        (howm-subkeyword str)))
737          (filter `(lambda (items)
738                     (howm-filter-items-by-summary items ,(regexp-opt keys)))))
739     ;; Note that regexp-opt returns a regexp for emacs (not for grep).
740     (howm-search (howm-make-keyword-string ".*") nil nil filter)))
741
742 (defun howm-subkeyword (str)
743   (with-temp-buffer
744     (insert str)
745     (howm-keyword-for-goto)))
746
747 (defun howm-list-around ()
748   (interactive)
749   (howm-set-command 'howm-list-around)
750   (let ((f (buffer-file-name))
751         (item-list (howm-view-sort-by-reverse-date-internal
752                     (howm-all-items))))
753     (let ((howm-normalizer #'identity))
754       (howm-normalize-show "" item-list))
755     (let ((pos (cl-position-if (lambda (item)
756                                       (string= (howm-item-name item) f))
757                                     (howm-view-item-list))))
758       (goto-char (point-min))
759       (when pos
760         (forward-line pos)))
761     (howm-view-summary-check t)))
762
763 (defun howm-history ()
764   (interactive)
765   (unless (file-exists-p howm-history-file)
766     (error "No history."))
767   ;; disable expansion of %schedule etc.
768   (let ((howm-menu-display-rules nil)) ;; dirty
769     (howm-menu-open howm-history-file)))
770
771 ;; (defvar howm-history-exclude
772 ;;   (let ((strings '("[0-9][0-9][0-9][0-9]" "^[*=] [^ ]")))
773 ;;     `("| %.*%$"
774 ;;       ,(mapconcat 'regexp-quote strings "\\|"))))
775 ;; (defun howm-history ()
776 ;;   (interactive)
777 ;;   (howm-menu-open howm-history-file)
778 ;;   (howm-edit-read-only-buffer
779 ;;     (mapc #'flush-lines
780 ;;           howm-history-exclude)))
781
782 (defvar *howm-command* nil
783   "For internal use")
784 (defun howm-set-command (com)
785   (setq *howm-command* com))
786 (defun howm-command ()
787   *howm-command*)
788
789 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
790 ;; Create
791
792 (defun howm-create (&optional which-template here)
793   (interactive "p")
794   (let* ((t-c (howm-create-default-title-content))
795          (title (car t-c))
796          (content (cdr t-c)))
797     (howm-create-file-with-title title which-template nil here content)))
798
799 (howm-dont-warn-free-variable transient-mark-mode)
800 (howm-dont-warn-free-variable mark-active)
801 (defun howm-create-default-title-content ()
802   (let* ((p (point))
803          (m (or (mark t) -777))
804          (beg (min p m))
805          (end (max p m))
806          (search-str (howm-view-name)))
807     (let* ((transient-mark-p (and (boundp 'transient-mark-mode)
808                                   transient-mark-mode))
809            (mark-active-p (and (boundp 'mark-active) mark-active))
810            (active-p (if transient-mark-p
811                          mark-active-p
812                        t))
813            (strictly-active-p (and transient-mark-p mark-active-p))
814            (title-p (let* ((b (line-beginning-position))
815                            (e (line-end-position)))
816                       (and active-p
817                            (< 0 beg) (<= b beg) (<= end e) (not (= beg end)))))
818            (content-p (and strictly-active-p
819                            howm-content-from-region))
820            (search-p (and howm-title-from-search
821                           (stringp search-str)))
822            (s (cond ((or title-p content-p) (buffer-substring-no-properties beg
823                                                                             end))
824                     (search-p search-str))))
825       (cond ((null s) (cons "" ""))
826             ((eq content-p t) (cons "" s))
827             ((or title-p search-p) (cons s ""))
828             (content-p (cons "" s))
829             (t (cons "" ""))))))
830
831 (defun howm-create-here (&optional which-template)
832   (interactive "p")
833   (howm-create which-template t))
834
835 (defun howm-create-file-with-title (title &optional
836                                     which-template not-use-file here content)
837   (let ((b (current-buffer)))
838     (when (not here)
839       (howm-create-file))
840     (cond ((howm-buffer-empty-p) nil)
841           ((and here howm-create-here-just) (beginning-of-line))
842           (t (howm-create-newline)))
843     (let ((p (point))
844           (insert-f (lambda (switch)
845                       (howm-insert-template (if switch title "")
846                                             b which-template (not switch))))
847           (use-file (not not-use-file)))
848       ;; second candidate which appears when undo is called
849       (let ((end (funcall insert-f not-use-file)))
850         (save-excursion
851           (goto-char end)
852           (insert (or content "")))
853         (undo-boundary)
854         (delete-region p end))
855       (funcall insert-f use-file))
856     (howm-create-finish)))
857
858 (defun howm-create-finish ()
859   (howm-set-mode)
860   (run-hooks 'howm-create-hook))
861
862 (defun howm-create-newline ()
863   (widen)
864   (if howm-prepend
865       (howm-create-newline-prepend)
866     (howm-create-newline-append)))
867 (defun howm-create-newline-prepend ()
868   (goto-char (point-min)))
869 (defun howm-create-newline-append ()
870   (goto-char (point-max))
871   (delete-blank-lines)
872   (when (not (= (line-beginning-position) (point))) ;; not empty line
873     (insert "\n"))
874   (insert "\n"))
875
876 (defun howm-insert-template (title &optional
877                                    previous-buffer which-template not-use-file)
878   (let* ((beg (point))
879          (f (buffer-file-name previous-buffer))
880          (af (and f (howm-abbreviate-file-name f))))
881     (insert (howm-template-string which-template previous-buffer))
882     (let* ((date (format-time-string howm-template-date-format))
883            (use-file (not not-use-file))
884            (file (cond ((not use-file) "")
885                        ((null f) "")
886                        ((string= f (buffer-file-name)) "")
887                        (t (format howm-template-file-format af)))))
888       (let ((arg `((title . ,title) (date . ,date) (file . ,file)))
889             (end (point-marker)))
890         (howm-replace howm-template-rules arg beg end)
891         end))))
892
893 (defvar howm-template-receive-buffer t
894   "Non nil if howm-template should receive previous-buffer
895 when howm-template is a function.
896 Set this option to nil if backward compatibility with howm-1.2.4 or earlier
897 is necessary.")
898
899 (defun howm-template-string (which-template previous-buffer)
900   ;; which-template should be 1, 2, 3, ...
901   (setq which-template (or which-template 1))
902   (cond ((stringp howm-template) howm-template)
903         ((functionp howm-template) (let ((args (if howm-template-receive-buffer
904                                                    (list which-template
905                                                          previous-buffer)
906                                                  (list which-template))))
907                                      (apply howm-template args)))
908         ((listp howm-template) (nth (- which-template 1) howm-template))))
909
910 (defun howm-replace (rules arg &optional beg end)
911   (mapc (lambda (pair)
912           (let ((spell (car pair))
913                 (disp-f (cdr pair)))
914             (goto-char (or beg (point-min)))
915             (while (re-search-forward spell end t)
916               (delete-region (match-beginning 0) (match-end 0))
917               (funcall disp-f arg))))
918         rules))
919
920 ;; Use dynamic bindings dirtily!
921 (defun howm-template-title (arg)
922   (insert (cdr (assoc 'title arg))))
923 (defun howm-template-date (arg)
924   (insert (cdr (assoc 'date arg))))
925 (defun howm-template-previous-file (arg)
926   (insert (cdr (assoc 'file arg))))
927 (defun howm-template-cursor (arg)) ;; do nothing
928
929 (defun howm-dup ()
930   (interactive)
931   (let* ((r (howm-view-paragraph-region))
932          (s (buffer-substring-no-properties (car r) (cadr r))))
933     (howm-create-file)
934     (howm-set-mode)
935     (insert "\n" s)))
936
937 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
938 ;; Keyword
939
940 (defun howm-completing-read-keyword ()
941   (message "Scanning...")
942   (let* ((kl (howm-keyword-list))
943          (table (mapcar #'list kl))
944          (completion-ignore-case howm-keyword-case-fold-search))
945     (completing-read "Keyword: " table)))
946
947 (defun howm-insert-keyword ()
948   (interactive)
949   (insert (howm-completing-read-keyword)))
950
951 (defun howm-keyword-to-kill-ring (&optional filename-p)
952   (interactive "P")
953   (let ((title (howm-title-at-current-point filename-p)))
954     (if title
955         (howm-string-to-kill-ring title)
956       (error "No keyword."))))
957
958 (defun howm-title-at-current-point (&optional filename-p
959                                               title-regexp title-regexp-pos)
960   (let ((reg (or title-regexp howm-view-title-regexp))
961         (pos (or title-regexp-pos howm-view-title-regexp-pos)))
962     (save-excursion
963       (end-of-line)
964       (cond ((and (not filename-p)
965                   (re-search-backward reg nil t))
966              (match-string-no-properties pos))
967             ((buffer-file-name)
968              (howm-abbreviate-file-name (buffer-file-name)))
969             (t nil)))))
970
971 (defun howm-string-to-kill-ring (str)
972   (if str
973       (progn
974         (kill-new str)
975         (message "%s" str))
976     (error "Empty.")))
977
978 (defun howm-keyword-for-comefrom ()
979   (save-excursion
980     (goto-char (point-min))
981     (let ((keyword-list nil))
982       (while (re-search-forward howm-keyword-regexp nil t)
983         (setq keyword-list
984               (cons (match-string-no-properties howm-keyword-regexp-pos)
985                     keyword-list)))
986       (reverse keyword-list))))
987
988 (defun howm-keyword-list ()
989   (let ((sep (format "[\n%s]" (or howm-keyword-list-alias-sep ""))))
990     (with-current-buffer (howm-keyword-buffer)
991       (delete ""
992               (split-string (buffer-substring (point-min) (point-max)) sep)))))
993
994 (defun howm-keyword-add (keyword-list)
995   (interactive "sKeyword: ")
996   (setq keyword-list (if (stringp keyword-list)
997                          (list keyword-list)
998                        keyword-list))
999   (with-current-buffer (howm-keyword-buffer)
1000     (save-excursion
1001       (goto-char (point-max))
1002       (mapc (lambda (k)
1003               (when (howm-keyword-new-p k)
1004                 (insert k "\n")))
1005             keyword-list)
1006       (when (buffer-file-name)
1007         (howm-basic-save-buffer)))))
1008
1009 (defun howm-keyword-new-p (str)
1010   (save-excursion
1011     (let ((r (format "^%s$" (regexp-quote str)))
1012           (case-fold-search howm-keyword-case-fold-search))
1013       (goto-char (point-min))
1014       (not (re-search-forward r nil t)))))
1015
1016 (defun howm-support-aliases-p ()
1017   howm-keyword-list-alias-sep)
1018 (defun howm-aliases ()
1019   (if (howm-support-aliases-p)
1020       (howm-read-aliases)
1021     nil))
1022 (defun howm-read-aliases ()
1023   (with-current-buffer (howm-keyword-buffer)
1024     (save-excursion
1025       (let ((ans nil))
1026         (goto-char (point-min))
1027         (while (search-forward howm-keyword-list-alias-sep nil t)
1028           (let* ((line (buffer-substring-no-properties (line-beginning-position)
1029                                                        (line-end-position)))
1030                  (keys (split-string line howm-keyword-list-alias-sep))
1031                  (ks (if howm-keyword-case-fold-search
1032                          (mapcar #'downcase keys)
1033                        keys)))
1034             (setq ans (cons ks ans))
1035             (end-of-line)))
1036         ans))))
1037
1038 (defun howm-expand-aliases-recursively (keyword aliases)
1039   (let ((keys (list keyword))
1040         (prev nil))
1041     (cl-labels ((expand (keys)
1042                      (sort (cl-remove-duplicates
1043                             (cl-mapcan (lambda (k)
1044                                               (cl-mapcan
1045                                                (lambda (a) (if (member k a)
1046                                                                (copy-sequence a)
1047                                                              nil))
1048                                                aliases))
1049                                             keys) :test #'string=)
1050                            #'string<)))
1051       (while (not (equal prev keys))
1052         (setq prev keys)
1053         (setq keys (expand keys))))
1054     keys))
1055 (cl-assert (equal (howm-expand-aliases-recursively "a"
1056                                                 '(("d" "e" "f") ("a" "b" "c")))
1057                '("a" "b" "c")))
1058 (cl-assert (equal (howm-expand-aliases-recursively "a"
1059                                                 '(("d" "e" "b") ("a" "b" "c")))
1060                '("a" "b" "c" "d" "e")))
1061
1062 (defun howm-keyword-aliases (keyword)
1063   "List of strings which are equivalent to KEYWORD.
1064 KEYWORD itself is always at the head of the returneded list.
1065 "
1066   ;; Return the original keyword (not downcased) for backward compatibility.
1067   ;; I'm not sure whether this behavior is really needed.
1068   (let* ((key (if howm-keyword-case-fold-search
1069                   (downcase keyword)
1070                 keyword))
1071          (aliases (howm-aliases))
1072          (equiv (if howm-keyword-aliases-recursive
1073                     (howm-expand-aliases-recursively key aliases)
1074                   (cl-remove-duplicates
1075                    (apply #'append
1076                           (cl-remove-if-not (lambda (a) (member key a))
1077                                                  aliases))))))
1078     (if (null equiv)
1079         keyword
1080       (cons keyword (remove key equiv)))))
1081
1082 (defun howm-keyword-search (keyword &optional create-p open-unique-p)
1083   (howm-message-time "key-search"
1084     (howm-set-command 'howm-keyword-search)
1085     (howm-with-normalizer
1086       (howm-keyword-search-subr keyword create-p open-unique-p))))
1087
1088 (defun howm-keyword-search-subr (keyword create-p open-unique-p)
1089   (let* ((aliases (if (howm-support-aliases-p)
1090                       (howm-keyword-aliases keyword)
1091                     keyword))
1092          (menu-p (howm-menu-keyword-p keyword))
1093          (comefrom-regexp (if menu-p ;; clean me
1094                               nil
1095                             (howm-make-keyword-regexp2 aliases)))
1096          (trio (let ((howm-search-other-dir (if menu-p ;; clean me
1097                                                  nil
1098                                                howm-search-other-dir))
1099                       (*howm-view-force-case-fold-search*
1100                        howm-keyword-case-fold-search)) ;; dirty!
1101                  (howm-call-view-search-internal aliases t)))
1102 ;; code for <http://pc8.2ch.net/test/read.cgi/unix/1077881095/823>.
1103 ;; but this change is canceled; I'll try more fundamental fix. [2005-11-04]
1104 ;;                   (if open-unique-p
1105 ;;                       (let ((r (concat "^" (regexp-quote keyword) "$")))
1106 ;;                         (howm-call-view-search r nil))
1107 ;;                     (howm-call-view-search aliases t))))
1108          (kw (car trio))
1109          (name (cadr trio))
1110          (items (cl-caddr trio))
1111          (items-pair nil)
1112          (found (if items t nil)) ;; want to forget items as soon as possible
1113          (matched (and found
1114                        (let* ((howm-keyword-format
1115                                (if menu-p ;; clean me
1116                                    (default-value 'howm-keyword-format)
1117                                  howm-keyword-format))
1118                               (r (howm-normalize items aliases
1119                                                  comefrom-regexp)))
1120                          (setq items-pair (cdr r))
1121                          (car r))))
1122          (keyword-matched (member 'keyword matched))
1123          (keyword-matched-multi (member 'keyword-multi-hits matched))
1124          (file-matched (member 'file matched))
1125          (title (howm-make-keyword-string keyword)))
1126     ;; main processing (clean me!) [2003-12-01]
1127     (cond
1128      ;; for %foo%
1129      ((and menu-p keyword-matched)
1130       (howm-keyword-search-open-menu keyword (car items-pair)
1131                                      keyword-matched-multi))
1132      ;; for [[foo]]
1133      ((and create-p (not keyword-matched))
1134       (howm-keyword-search-create title))
1135      ;; open if unique match
1136      ((and open-unique-p (howm-single-element-p items))
1137       (howm-keyword-search-open-unique items))
1138      (t
1139       (howm-call-view-summary name items-pair kw)
1140       (when (howm-normalize-oldp)
1141         ;; sorry for redundancy & inefficiency
1142         (howm-list-normalize-old aliases comefrom-regexp t))))
1143     ;; record history
1144     (when (not menu-p)
1145       (howm-write-history keyword))
1146     ;; return information
1147     `((menu-p . ,menu-p)
1148       (found . ,found)
1149       (matched . ,matched)
1150       (keyword-matched . ,keyword-matched)
1151       (create-p . ,create-p))
1152     ))
1153
1154 (defun howm-keyword-search-open-menu (keyword item-list multi-hits-p)
1155   "Open KEYWORD as menu."
1156   ;; dirty. peeking howm-view.el
1157   (let* ((item (car item-list))
1158          (fname (howm-view-item-filename item))
1159          (place (howm-view-item-place item)))
1160     (let ((howm-search-other-dir nil))
1161       (howm-menu-open fname place (howm-menu-name keyword))))
1162   (when multi-hits-p
1163     (message "Warning: found two or more %s." keyword)))
1164
1165 (defun howm-keyword-search-create (title)
1166   "create new memo <<< TITLE."
1167   (howm-create-file-with-title title)
1168   (message "New keyword."))
1169
1170 (defun howm-keyword-search-open-unique (items)
1171   "Open unique match."
1172   (howm-view-open-item (car items)))
1173
1174 ;; (defvar *howm-keyword-buffer* nil) ;; for internal use
1175 (defun howm-keyword-for-goto (&optional keyword-list)
1176   (save-excursion
1177     (let ((case-fold-search howm-keyword-case-fold-search))
1178       (sort (cl-mapcan (lambda (k)
1179                               (goto-char (point-min))
1180                               ;; when howm-check-word-break is non-nil,
1181                               ;; checking word breaks is desired for efficiency.
1182                               ;; it is not implemented yet.
1183                               (if (search-forward k nil 'noerr)
1184                                   (list k)
1185                                 nil))
1186                             (or keyword-list (howm-keyword-list)))
1187             (lambda (x y)
1188               (> (length x) (length y)))))))
1189
1190 (defun howm-keyword-add-current-buffer ()
1191   (save-excursion
1192     (goto-char (point-min))
1193     (let ((m (current-message))
1194           (keyword-list nil))
1195       (while (re-search-forward howm-keyword-regexp nil t)
1196         (let ((key-str (if howm-keyword-list-alias-sep
1197                            (mapconcat #'identity
1198                                       (howm-keyword-read)
1199                                       howm-keyword-list-alias-sep)
1200                          (match-string-no-properties howm-keyword-regexp-pos))))
1201           (setq keyword-list (cons key-str keyword-list))))
1202       (howm-keyword-add keyword-list)
1203       (message "%s" m))))
1204 (defun howm-keyword-add-items (items)
1205   (let ((files (mapcar #'howm-view-item-filename items)))
1206     (with-temp-buffer
1207       (mapc (lambda (f)
1208               (erase-buffer)
1209               (insert-file-contents f)
1210               (howm-set-configuration-for-file-name f)
1211               (howm-keyword-add-current-buffer))
1212             files))))
1213
1214 (defun howm-keyword-read ()
1215   (let ((ks nil)
1216         (beg (line-beginning-position)))
1217     (end-of-line)
1218     (skip-chars-backward " ")
1219     (while (re-search-backward howm-keyword-regexp beg t)
1220       (setq ks (cons (match-string-no-properties howm-keyword-regexp-pos) ks))
1221       (skip-chars-backward " "))
1222     (end-of-line)
1223     ks))
1224
1225 ;;; howm-mode.el ends here