howm-mode.el

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