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