1 ;;; howm-mode.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2022
3 ;;; HIRAOKA Kazuyuki <khi@users.osdn.me>
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)
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.
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,
19 ;;;--------------------------------------------------------------------
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
22 ;; Backward compatibility
24 ;; (require 'howm-mode) in .emacs is obsolete. Use (require 'howm) instead.
26 ;; This must be earlier than (require 'howm-common), because
27 ;; howm-common needs cl, and (require 'cl) should be written in howm.el.
28 (when (not (featurep 'howm))
29 (message "Warning: Requiring howm-mode is obsolete. Require howm instead.")
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45 ;; You can easily modify them.
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")
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]
64 (defvar howm-default-key-table
66 ;; ("key" func list-mode-p global-p)
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)
79 ("e" howm-remember 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)
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)
95 ("P" howm-previous-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)
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."
110 (howm-defvar-risky howm-migemo-client nil
111 "Command name of migemo-client.
113 (setq howm-migemo-client '((type . cmigemo) (command . \"cmigemo\")))
114 Example of migemo-client (obsolete):
115 (setq howm-migemo-client \"migemo-client\")
116 See also `howm-migemo-client-option`")
117 (howm-defvar-risky howm-migemo-client-option nil
118 "List of option for migemo-client.
120 (setq howm-migemo-client-option
121 '(\"-q\" \"-d\" \"/usr/share/cmigemo/utf-8/migemo-dict\"))
122 Example of migemo-client (obsolete):
123 (setq howm-migemo-client-option '(\"-H\" \"::1\")
124 See also `howm-migemo-client`")
128 ;; Be careful to keep consistency.
130 (howm-defvar-risky howm-keyword/ref-regexp-format
131 "\\(%s\\)[ \t]*\\([^ \t\r\n].*\\)")
132 (howm-defvar-risky howm-keyword-format
133 (format "%s %%s" howm-keyword-header)
134 "Format for declaration of keyword. See `format'.")
135 (howm-defvar-risky howm-keyword-regexp
136 (format howm-keyword/ref-regexp-format (regexp-quote howm-keyword-header)))
137 (howm-defvar-risky howm-keyword-regexp-hilit-pos 1)
138 (howm-defvar-risky howm-keyword-regexp-pos 2)
139 (howm-defvar-risky howm-ref-regexp
140 (format howm-keyword/ref-regexp-format (regexp-quote howm-ref-header))
141 "Regexp for explicit link.")
142 (howm-defvar-risky howm-ref-regexp-hilit-pos 0
143 "Position of search string in `howm-ref-regexp'")
144 (howm-defvar-risky howm-ref-regexp-pos 2
145 "Position of search string in `howm-ref-regexp'")
146 (howm-defvar-risky howm-wiki-regexp "\\[\\[\\([^]\r\n]+\\)\\]\\]"
147 "Regexp for explicit link.")
148 (howm-defvar-risky howm-wiki-regexp-hilit-pos 1
149 "Position of hilight in `howm-wiki-regexp'")
150 (howm-defvar-risky howm-wiki-regexp-pos 1
151 "Position of search string in `howm-wiki-regexp'")
152 (howm-defvar-risky howm-wiki-format "[[%s]]"
153 "Format for declaration of wiki word. See `format'.")
155 (howm-defvar-risky howm-template-rules
156 '(("%title" . howm-template-title)
157 ("%date" . howm-template-date)
158 ("%file" . howm-template-previous-file)
159 ("%cursor" . howm-template-cursor))) ;; Cursor must be the last rule.
160 (defvar howm-template-date-format howm-dtime-format
161 "%date is replaced with `howm-template-date-format'
162 in `howm-template'. See `format-time-string'")
163 (defvar howm-template-file-format (concat howm-ref-header " %s")
164 "%file is replaced with `homw-template-file-format'
165 in `howm-template'. %s is replaced with name of last file. See `format'.")
171 (defun howm-action-lock-general (command regexp pos
175 `(lambda (&optional dummy)
176 (let ((s (match-string-no-properties ,pos)))
177 ;; (when howm-keyword-case-fold-search
178 ;; (setq s (downcase s)))
179 (,command s ,@options)))
183 (defun howm-action-lock-search (regexp
185 &optional hilit-pos create-p open-unique-p)
186 (howm-action-lock-general 'howm-keyword-search
187 regexp pos hilit-pos create-p open-unique-p))
188 (defun howm-action-lock-related (regexp pos hilit-pos)
189 (howm-action-lock-general 'howm-list-related regexp pos hilit-pos))
191 (defun howm-action-lock-date-rule ()
192 (action-lock-general 'howm-action-lock-date howm-date-regexp 0 0))
194 (defun howm-action-lock-quote-keyword (keyword)
195 (let ((q (regexp-quote keyword)))
196 ;; when a regexp is specified, leave unmatched keywords.
197 (if (and (stringp howm-check-word-break)
198 (not (string-match howm-check-word-break keyword)))
200 ;; add word break checks
201 (concat "\\b" q "\\b"))))
203 (defun howm-action-lock-setup ()
204 (setq action-lock-case-fold-search howm-keyword-case-fold-search)
206 (let* ((date-al (action-lock-date "{_}" howm-dtime-format)))
207 ;; override the rule in action-lock.el
208 (action-lock-add-rules (list date-al) t))
209 (let* ((ks (howm-keyword-for-goto))
210 (r (mapconcat (if howm-check-word-break
211 #'howm-action-lock-quote-keyword
214 ;; The following optimization causes an error
215 ;; "Variable binding depth exceeds max-specpdl-size".
216 ;; (r (cond ((stringp howm-check-word-break)
217 ;; (mapconcat #'howm-action-lock-quote-keyword ks "\\|"))
219 ;; (regexp-opt ks (and howm-check-word-break 'word)))))
220 (wiki (howm-action-lock-search howm-wiki-regexp
222 howm-wiki-regexp-hilit-pos
224 (explicit (howm-action-lock-search howm-ref-regexp
226 howm-ref-regexp-hilit-pos))
227 (implicit (howm-action-lock-search r 0))
228 (rev (howm-action-lock-related howm-keyword-regexp
229 howm-keyword-regexp-pos
230 howm-keyword-regexp-hilit-pos))
231 (date (howm-action-lock-date-rule))
232 (done (howm-action-lock-reminder-done-rule))
236 ,@(if ks (list implicit) nil)
238 ,@(if (howm-menu-p) nil (list date done))
241 ;; don't override the rule in action-lock.el
242 ;; esp. http://xxx should call browser even if "<<< http" exists
243 (action-lock-add-rules all)))
245 (defun howm-file-name (&optional time)
246 (format-time-string howm-file-name-format
247 (or time (current-time))))
249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
252 (define-minor-mode howm-mode
253 "With no argument, this command toggles the mode.
254 Non-null prefix argument turns on the mode.
255 Null prefix argument turns off the mode.
257 When the mode is enabled, underlines are drawn on texts which match
258 to titles of other files. Typing \\[action-lock-magic-return] there,
259 you can jump to the corresponding file.
263 \\[action-lock-magic-return] Follow link
264 \\[howm-refresh] Refresh buffer
265 \\[howm-list-all] List all files
266 \\[howm-list-grep] Search (grep)
267 \\[howm-create] Create new file
268 \\[howm-dup] Duplicate current file
269 \\[howm-insert-keyword] Insert keyword
270 \\[howm-insert-date] Insert date
271 \\[howm-insert-dtime] Insert date with time
272 \\[howm-keyword-to-kill-ring] Copy current keyword to kill ring
273 \\[action-lock-goto-next-link] Go to next link
274 \\[action-lock-goto-previous-link] Go to previous link
275 \\[howm-next-memo] Go to next entry in current buffer
276 \\[howm-previous-memo] Go to previous entry in current buffer
277 \\[howm-first-memo] Go to first entry in current buffer
278 \\[howm-last-memo] Go to last entry in current buffer
279 \\[howm-create-here] Add new entry to current buffer
280 \\[howm-create-interactively] Create new file interactively (not recommended)
281 \\[howm-random-walk] Browse random entries automtically
283 :init-value nil ;; default = off
284 :lighter howm-lighter ;; mode-line
285 :keymap (mapcar (lambda (entry)
286 (let ((k (car entry))
288 (cons (concat howm-prefix k) f)))
289 howm-default-key-table)
291 (howm-initialize-buffer)
292 (howm-restore-buffer)))
294 (defun howm-set-keymap ()
295 (mapc (lambda (entry)
296 (let* ((k (car entry))
298 (list-mode-p (cl-caddr entry))
299 (global-p (cl-cadddr entry))
300 (pk (concat howm-prefix k)))
301 (define-key howm-mode-map pk f)
306 (list howm-view-summary-mode-map
307 howm-view-contents-mode-map)))
309 (define-key global-map pk f))))
310 howm-default-key-table)
311 (define-key howm-mode-map "\C-x\C-s" 'howm-save-buffer))
314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317 (defun howm-refresh ()
321 (howm-initialize-buffer)))
323 (defun howm-initialize-buffer ()
325 (when (not howm-mode)
326 (error "Not howm-mode"))
327 (howm-message-time "init-buf"
330 (howm-set-configuration-for-major-mode major-mode)
331 (howm-action-lock-setup)
332 (howm-mode-add-font-lock)
333 (howm-reminder-add-font-lock)
334 (cheat-font-lock-fontify)
335 ;; make-local-hook is obsolete for emacs >= 21.1.
336 (howm-funcall-if-defined (make-local-hook 'after-save-hook))
337 (add-hook 'after-save-hook 'howm-after-save t t))))
339 (defun howm-after-save ()
341 (howm-keyword-add-current-buffer)
342 (when howm-refresh-after-save
343 (howm-initialize-buffer))
344 (when (and howm-menu-refresh-after-save
345 (> howm-menu-expiry-hours 0))
346 (howm-menu-refresh-background))
347 (run-hooks 'howm-after-save-hook)))
349 (defun howm-restore-buffer ()
350 (action-lock-mode 0))
352 (defun howm-list-all ()
354 (howm-set-command 'howm-list-all)
355 (howm-normalize-show "" (howm-all-items))
356 ;; for backward compatibility
357 (cond ((howm-list-title-p) t) ;; already done in howm-normalize-show
358 (howm-list-all-title (howm-list-title-internal))))
360 (defun howm-all-items ()
361 "Returns list of all items in the first search path."
362 (howm-folder-items (car (howm-search-path)) t))
364 (defun howm-list-recent (&optional days)
366 (howm-set-command 'howm-list-recent)
367 (let* ((d (or days howm-list-recent-days))
369 (from (howm-days-before now d))
370 (item-list (howm-folder-items howm-directory t)))
371 (howm-normalize-show "" (howm-filter-items-by-mtime item-list from now))
372 ;; clean me [2003-11-30]
373 (cond ((howm-list-title-p) t) ;; already done in howm-normalize-show
374 (howm-list-recent-title (howm-list-title-internal))
375 ((not days) (howm-view-summary-to-contents)))))
377 ;; clean me: direct access to howm-view-* is undesirable.
379 (defvar howm-list-title-previous nil
381 (make-variable-buffer-local 'howm-list-title-previous)
382 (defun howm-list-title-put-previous (&optional item-list)
383 (when howm-list-title-undo
384 (setq howm-list-title-previous (or item-list (howm-view-item-list)))))
385 (defun howm-list-title-clear-previous ()
386 (setq howm-list-title-previous nil))
387 (defun howm-list-title-get-previous ()
388 (if howm-list-title-undo
389 (let ((prev howm-list-title-previous))
390 (setq howm-list-title-previous nil)
391 (howm-view-summary-rebuild prev))
392 (error "Undo is not enabled.")))
393 (defun howm-list-title-regexp ()
394 (or howm-list-title-regexp (howm-view-title-regexp-grep)))
395 (defalias 'howm-list-title 'howm-list-toggle-title) ;; backward compatibility
396 (defun howm-list-toggle-title (&optional undo)
398 (if (or undo howm-list-title-previous)
399 (howm-list-title-get-previous)
400 (howm-list-title-internal)))
401 (defun howm-list-title-internal ()
402 (let ((b (current-buffer)))
403 (howm-list-title-put-previous)
404 (howm-view-list-title (howm-list-title-regexp))
405 ;; (howm-view-filter-by-contents (howm-list-title-regexp))
406 (let ((c (current-buffer)))
409 (howm-view-kill-buffer)
411 (howm-view-summary-check t)))))
413 (defun howm-list-title-p ()
414 (let ((a (howm-get-value howm-list-title)))
415 (cond ((null a) nil) ;; I know this is redundant.
416 ((listp a) (member (howm-command) a))
419 (defun howm-days-after (ti days &optional hours)
420 (let* ((ne (howm-decode-time ti))
423 (nh (nth hour-pos ne))
424 (nd (nth day-pos ne)))
425 (setf (nth hour-pos ne) (+ nh (or hours 0)))
426 (setf (nth day-pos ne) (+ nd days))
427 (apply #'encode-time ne)))
429 (defun howm-days-before (ti days)
430 (howm-days-after ti (- days)))
432 (defun howm-list-grep (&optional completion-p)
434 (howm-set-command 'howm-list-grep)
435 (howm-list-grep-general completion-p))
437 (defun howm-list-grep-fixed ()
439 (howm-set-command 'howm-list-grep-fixed)
440 (howm-list-grep-general t))
442 (defun howm-list-grep-general (&optional completion-p)
443 (let* ((action (lambda (pattern) (howm-search pattern completion-p)))
444 (regexp (howm-iigrep completion-p action)))
445 (when completion-p ;; Goto link works only for fixed string at now.
446 (howm-write-history regexp))
447 (funcall action regexp)))
449 (defun howm-search (regexp fixed-p &optional emacs-regexp filter bufname)
450 (if (string= regexp "")
452 (howm-message-time "search"
453 (let* ((trio (howm-call-view-search-internal regexp fixed-p emacs-regexp))
455 (name (or bufname (cadr trio)))
456 (items (cl-caddr trio)))
458 (setq items (funcall filter items)))
459 (howm-normalize-show name items (or emacs-regexp regexp) nil nil kw)
460 (howm-record-view-window-configuration)))))
462 (defun howm-iigrep (completion-p action)
463 (howm-with-iigrep (howm-iigrep-command-for-pattern completion-p)
464 howm-iigrep-show-what action
466 (howm-completing-read-keyword)
467 (read-from-minibuffer "Search all (grep): "))))
469 (defmacro howm-with-iigrep (command-for-pattern show-what action &rest body)
471 `(let ((*iigrep-post-sentinel* (howm-iigrep-post-sentinel ,action))
472 (howm-view-summary-name "*howmS(preview)*")
473 (howm-view-contents-name "*howmC(preview)*")
474 (howm-history-limit 0)
475 (*howm-show-item-filename* nil)
476 (howm-message-time nil))
478 (iigrep-with-grep ,command-for-pattern ,show-what
480 (mapc (lambda (b) (and (get-buffer b) (kill-buffer b)))
481 (list howm-view-summary-name howm-view-contents-name)))))
483 (defmacro howm-iigrep-command-for-pattern (&optional fixed-p converter)
484 ;; use macro due to dynamic binding. Sigh...
485 `(and howm-view-use-grep
487 (let* ((pattern (funcall (or ,converter #'identity) str))
488 (trio (howm-real-grep-single-command
489 pattern (list howm-directory) ,fixed-p))
491 (args (cl-second trio))
492 (fs (cl-third trio)))
493 (append (list com) (cons "-I" args) fs)))))
495 (defmacro howm-iigrep-post-sentinel (action)
496 ;; use macro due to dynamic binding. Sigh...
497 `(lambda (hits pattern)
498 (when (<= hits howm-iigrep-preview-items)
499 (save-selected-window
500 (funcall ,action pattern)))))
502 (defvar *howm-view-window-configuration* nil
504 (defun howm-view-window-configuration ()
505 *howm-view-window-configuration*)
506 (defun howm-set-view-window-configuration (conf)
507 (setq *howm-view-window-configuration* conf))
508 (defun howm-record-view-window-configuration ()
509 (howm-set-view-window-configuration (current-window-configuration)))
510 (defun howm-restore-view-window-configuration ()
511 (set-window-configuration (howm-view-window-configuration)))
512 (defun howm-return-to-list ()
514 (howm-restore-view-window-configuration))
516 (defun howm-call-view-search-internal (regexp fixed-p &optional emacs-regexp)
517 (let ((hilit (if emacs-regexp
518 `((,emacs-regexp . howm-view-hilit-face))
520 (howm-view-search-folder-internal regexp (howm-search-path-folder)
521 nil nil fixed-p hilit)))
523 (defun howm-list-migemo (&optional completion-p)
525 (howm-set-command 'howm-list-migemo)
528 (howm-list-migemo-action (howm-iigrep-migemo))))
530 (defun howm-list-migemo-action (roma)
531 (let* ((e-reg (howm-migemo-get-pattern roma "emacs"))
532 (g-reg (if howm-view-use-grep
533 (howm-migemo-get-pattern roma "egrep")
535 (if (and e-reg g-reg)
536 (howm-search g-reg nil e-reg nil roma)
537 (message "No response from migemo-client."))))
539 (defun howm-iigrep-migemo ()
540 (let* ((converter (lambda (yomi) (howm-migemo-get-pattern yomi "egrep")))
541 (command-for-pattern (howm-iigrep-command-for-pattern nil converter))
542 (show-what (if (eq howm-iigrep-migemo-show-what 'inherit)
543 howm-iigrep-show-what
544 howm-iigrep-migemo-show-what)))
545 (howm-with-iigrep command-for-pattern show-what
546 #'howm-list-migemo-action
547 (read-from-minibuffer "Search all (migemo): "))))
549 (defun howm-migemo-get-pattern (roma type)
550 (when (and (null howm-migemo-client) (not howm-view-use-grep))
552 (cl-labels ((ref (key) (cdr (assoc key howm-migemo-client))))
553 (cond ((and (featurep 'migemo) (string= type "emacs"))
554 (howm-funcall-if-defined (migemo-get-pattern roma)))
555 ((or (null howm-migemo-client) (stringp howm-migemo-client))
556 (car (howm-call-process (or howm-migemo-client "migemo-client")
557 `(,@howm-migemo-client-option "-t" ,type ,roma)
559 ((eq (ref 'type) 'cmigemo)
560 (car (howm-call-process (ref 'command)
561 `(,@howm-migemo-client-option
562 ,@(and (string= type "emacs") '("-e"))
564 (t (error "Invalid howm-migemo-client: %s" howm-migemo-client)))))
566 (defun howm-normalize-oldp ()
567 howm-list-normalizer)
569 ;; ;; generate conv in howm-normalizer-pair
570 ;; (let ((methods '("random" "name" "numerical-name" "date" "reverse-date"
571 ;; "summary" "reminder" "mtime" "reverse")))
572 ;; (mapcar (lambda (m)
574 ;; (howm-get-symbol nil "howm-view-sort-by-" m))
576 ;; (howm-get-symbol nil "howm-sort-items-by-" m)))
577 ;; (cons command internal)))
580 (defun howm-normalizer-pair ()
581 (let* ((old howm-list-normalizer)
582 (new howm-normalizer)
583 (conv '((howm-view-sort-by-random . howm-sort-items-by-random)
584 (howm-view-sort-by-name . howm-sort-items-by-name)
585 (howm-view-sort-by-numerical-name
586 . howm-sort-items-by-numerical-name)
587 (howm-view-sort-by-date . howm-sort-items-by-date)
588 (howm-view-sort-by-reverse-date
589 . howm-sort-items-by-reverse-date)
590 (howm-view-sort-by-summary . howm-sort-items-by-summary)
591 (howm-view-sort-by-reminder . howm-sort-items-by-reminder)
592 (howm-view-sort-by-mtime . howm-sort-items-by-mtime)
593 (howm-view-sort-by-reverse . howm-sort-items-by-reverse)))
595 (q (assoc new conv)))
597 (message "Warning: %s is wrong for howm-normalizer. Use %s." (car q) (cdr q))
599 (cond ((null old) (cons old new))
600 (p (cons nil (cdr p)))
601 (t (cons old #'identity)))))
603 (defmacro howm-with-normalizer (&rest body)
605 (let ((g (cl-gensym)))
607 (when (howm-normalize-oldp)
609 "Warning: howm-list-normalizer is obsolete. Use howm-normalizer."))
610 (let* ((,g (howm-normalizer-pair))
611 (howm-list-normalizer (car ,g))
612 (howm-normalizer (cdr ,g)))
615 (defun howm-normalize-show (name item-list
616 &optional keyword comefrom-regexp no-list-title
618 ;; comefrom-regexp and no-list-title are never used now. [2009-07-23]
619 (howm-with-normalizer
620 (if (howm-normalize-oldp)
621 ;; for backward compatibility.
623 (howm-view-summary name item-list fl-keywords)
624 (howm-list-normalize-old keyword comefrom-regexp no-list-title))
625 (let* ((r (howm-normalize item-list keyword
626 comefrom-regexp no-list-title)))
627 (howm-call-view-summary name (cdr r) fl-keywords)
630 (defun howm-call-view-summary (name item-list-pair fl-keywords)
631 (let ((orig (car item-list-pair))
632 (entitled (cdr item-list-pair)))
633 (howm-view-summary name (or entitled orig) fl-keywords)
636 (howm-list-title-put-previous orig)
637 (howm-list-title-clear-previous))))
639 (defun howm-normalize (item-list
640 &optional keyword comefrom-regexp no-list-title)
641 ;; no-list-title is never used now. [2009-07-23]
642 "Sort ITEM-LIST in the standard order."
644 (entitled-item-list nil))
645 (setq item-list (funcall howm-normalizer item-list))
647 (let ((key-reg (or comefrom-regexp
648 (howm-make-keyword-regexp1 keyword)))
649 (word-reg (format "\\<%s\\>"
650 (if (stringp keyword)
651 (regexp-quote keyword)
652 (regexp-opt keyword t))))
653 (wiki-reg (regexp-quote (howm-make-wiki-string keyword)))
657 (regexp-quote (expand-file-name keyword)))))
658 (case-fold-search howm-keyword-case-fold-search))
659 (cl-labels ((check (tag flag reg &optional tag-when-multi-hits)
661 (let ((r (howm-normalize-check item-list tag reg
662 tag-when-multi-hits)))
663 (setq matched (append (car r) matched))
664 (setq item-list (cdr r))))))
665 ;; not efficient. should I do them at once?
666 (check 'word howm-list-prefer-word word-reg)
667 (check 'wiki howm-list-prefer-wiki wiki-reg)
668 (check 'related-keyword t howm-keyword-regexp)
669 (check 'keyword t key-reg 'keyword-multi-hits)
670 (check 'file file-reg file-reg))))
671 (when (and (howm-list-title-p)
673 (not (and (member 'file matched)
674 howm-inhibit-title-file-match)))
675 (setq entitled-item-list
676 (howm-entitle-items (howm-list-title-regexp) item-list)))
677 (cons matched (cons item-list entitled-item-list))))
679 (defun howm-normalize-check (item-list tag reg tag-when-multi-hits)
680 (let* ((r (if (eq tag 'file)
681 (howm-view-lift-by-path-internal item-list reg)
682 (howm-view-lift-by-summary-internal item-list reg)))
685 (matched (cond ((and tag-when-multi-hits (eq m 'multi))
686 (list tag-when-multi-hits tag))
689 (cons matched item-list)))
691 (defun howm-list-normalize-old (&optional keyword comefrom-regexp no-list-title)
692 "Sort displayed items in the standard order.
693 This function is obsolete. Use `howm-normalize' insteadly.
694 --- Sorry, below documentation is incomplete. ---
695 When KEYWORD is given, matched items are placed on the top.
696 KEYWORD can be a string or a list of strings.
699 (howm-view-in-background
700 (howm-list-normalize-subr keyword comefrom-regexp no-list-title))
701 (howm-view-summary)))
703 (defun howm-list-normalize-subr (keyword comefrom-regexp no-list-title)
704 "Obsolete. Do not use this any more."
706 (funcall howm-list-normalizer)
708 (let ((key-reg (or comefrom-regexp
709 (howm-make-keyword-regexp1 keyword)))
710 (word-reg (format "\\<%s\\>"
711 (if (stringp keyword)
712 (regexp-quote keyword)
713 (regexp-opt keyword t))))
714 (wiki-reg (regexp-quote (howm-make-wiki-string keyword)))
718 (regexp-quote (expand-file-name keyword)))))
719 (case-fold-search howm-keyword-case-fold-search))
721 (let ((check (lambda (tag flag reg &optional tag-when-multi-hits)
723 (let ((m (if (eq tag 'file)
724 (howm-view-lift-by-name nil reg t)
725 (howm-view-lift-by-summary nil reg))))
727 (setq matched (cons tag matched)))
728 (when (and tag-when-multi-hits (eq m 'multi))
730 (cons tag-when-multi-hits matched))))))))
731 (funcall check 'word howm-list-prefer-word word-reg)
732 (funcall check 'wiki howm-list-prefer-wiki wiki-reg)
733 (funcall check 'related-keyword t howm-keyword-regexp)
734 (funcall check 'keyword t key-reg 'keyword-multi-hits)
735 (funcall check 'file file-reg file-reg))))
736 (when (and (howm-list-title-p)
738 (not (and (member 'file matched)
739 howm-inhibit-title-file-match)))
740 (howm-list-title-internal))
743 (defun howm-make-keyword-string (keyword)
744 (format howm-keyword-format keyword))
745 (defun howm-make-wiki-string (keyword)
746 (format howm-wiki-format keyword))
749 (defvar howm-keyword-regexp-format "%s$"
750 "Format to make entire-match regexp from keyword string.
751 Default is \"%s$\" because we want to make regexp \"<<< foo$\"
752 from keyword string \"<<< foo\",
753 so that we can accept \"<<< foo\" and reject \"<<< foobar\".
754 We need entire-match in order to
755 (1) place \"<<< foo\" on the top when \"foo\" is searched, and
756 (2) judge existence of \"<<< foo\" when [[foo]] is hit.")
757 (defun howm-make-keyword-regexp1 (keyword)
758 (howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp1-sub))
759 (defun howm-make-keyword-regexp2 (keyword)
760 (howm-make-keyword-regexp-general keyword #'howm-make-keyword-regexp2-sub))
761 (defun howm-make-keyword-regexp1-sub (keyword)
762 (format howm-keyword-regexp-format
763 (regexp-quote (howm-make-keyword-string keyword))))
764 (defun howm-make-keyword-regexp2-sub (keyword)
765 (format howm-keyword-regexp-format
766 (howm-make-keyword-string (regexp-quote keyword))))
767 (defun howm-make-keyword-regexp-general (keyword regexp-generator)
768 (cond ((stringp keyword)
769 (funcall regexp-generator keyword))
771 (mapconcat (lambda (s)
773 (funcall regexp-generator s)
777 (t (error "Wrong type: %s" keyword))))
779 (defun howm-list-related (str)
780 (howm-set-command 'howm-list-related)
781 (let* ((keys (mapcar (lambda (k)
782 (if howm-keyword-case-fold-search
785 (howm-subkeyword str)))
786 (filter `(lambda (items)
787 (howm-filter-items-by-summary items ,(regexp-opt keys)))))
788 ;; Note that regexp-opt returns a regexp for emacs (not for grep).
789 (howm-search (howm-make-keyword-string ".*") nil nil filter)))
791 (defun howm-subkeyword (str)
794 (howm-keyword-for-goto)))
796 (defun howm-list-around ()
798 (howm-set-command 'howm-list-around)
799 (let ((f (buffer-file-name))
800 (item-list (howm-view-sort-by-reverse-date-internal
802 (let ((howm-normalizer #'identity))
803 (howm-normalize-show "" item-list))
804 (let ((pos (cl-position-if (lambda (item)
805 (string= (howm-item-name item) f))
806 (howm-view-item-list))))
807 (goto-char (point-min))
810 (howm-view-summary-check t)))
812 (defun howm-history ()
814 (unless (file-exists-p howm-history-file)
815 (error "No history."))
816 ;; disable expansion of %schedule etc.
817 (let ((howm-menu-display-rules nil)) ;; dirty
818 (howm-menu-open howm-history-file)))
820 ;; (defvar howm-history-exclude
821 ;; (let ((strings '("[0-9][0-9][0-9][0-9]" "^[*=] [^ ]")))
823 ;; ,(mapconcat 'regexp-quote strings "\\|"))))
824 ;; (defun howm-history ()
826 ;; (howm-menu-open howm-history-file)
827 ;; (howm-edit-read-only-buffer
828 ;; (mapc #'flush-lines
829 ;; howm-history-exclude)))
831 (defvar *howm-command* nil
833 (defun howm-set-command (com)
834 (setq *howm-command* com))
835 (defun howm-command ()
838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
841 (defun howm-create (&optional which-template here)
843 (let* ((t-c (howm-create-default-title-content))
846 (howm-create-file-with-title title which-template nil here content)))
848 (howm-dont-warn-free-variable transient-mark-mode)
849 (howm-dont-warn-free-variable mark-active)
850 (defun howm-create-default-title-content ()
852 (m (or (mark t) -777))
855 (search-str (howm-view-name)))
856 (let* ((transient-mark-p (and (boundp 'transient-mark-mode)
857 transient-mark-mode))
858 (mark-active-p (and (boundp 'mark-active) mark-active))
859 (active-p (if transient-mark-p
862 (strictly-active-p (and transient-mark-p mark-active-p))
863 (title-p (let* ((b (line-beginning-position))
864 (e (line-end-position)))
866 (< 0 beg) (<= b beg) (<= end e) (not (= beg end)))))
867 (content-p (and strictly-active-p
868 howm-content-from-region))
869 (search-p (and howm-title-from-search
870 (stringp search-str)))
871 (s (cond ((or title-p content-p) (buffer-substring-no-properties beg
873 (search-p search-str))))
874 (cond ((null s) (cons "" ""))
875 ((eq content-p t) (cons "" s))
876 ((or title-p search-p) (cons s ""))
877 (content-p (cons "" s))
880 (defun howm-create-here (&optional which-template)
882 (howm-create which-template t))
884 (defun howm-create-file-with-title (title &optional
885 which-template not-use-file here content)
886 (let ((b (current-buffer)))
889 (cond ((howm-buffer-empty-p) nil)
890 ((and here howm-create-here-just) (beginning-of-line))
891 (t (howm-create-newline)))
893 (insert-f (lambda (switch)
894 (howm-insert-template (if switch title "")
895 b which-template (not switch))))
896 (use-file (not not-use-file)))
897 ;; second candidate which appears when undo is called
898 (let ((end (funcall insert-f not-use-file)))
901 (insert (or content "")))
903 (delete-region p end))
904 (funcall insert-f use-file))
905 (howm-create-finish)))
907 (defun howm-create-finish ()
909 (run-hooks 'howm-create-hook))
911 (defun howm-create-newline ()
914 (howm-create-newline-prepend)
915 (howm-create-newline-append)))
916 (defun howm-create-newline-prepend ()
917 (goto-char (point-min)))
918 (defun howm-create-newline-append ()
919 (goto-char (point-max))
921 (when (not (= (line-beginning-position) (point))) ;; not empty line
925 (defun howm-insert-template (title &optional
926 previous-buffer which-template not-use-file)
928 (f (buffer-file-name previous-buffer))
929 (af (and f (howm-abbreviate-file-name f))))
930 (insert (howm-template-string which-template previous-buffer))
931 (let* ((date (format-time-string howm-template-date-format))
932 (use-file (not not-use-file))
933 (file (cond ((not use-file) "")
935 ((string= f (buffer-file-name)) "")
936 (t (format howm-template-file-format af)))))
937 (let ((arg `((title . ,title) (date . ,date) (file . ,file)))
938 (end (point-marker)))
939 (howm-replace howm-template-rules arg beg end)
942 (defvar howm-template-receive-buffer t
943 "Non nil if howm-template should receive previous-buffer
944 when howm-template is a function.
945 Set this option to nil if backward compatibility with howm-1.2.4 or earlier
948 (defun howm-template-string (which-template previous-buffer)
949 ;; which-template should be 1, 2, 3, ...
950 (setq which-template (or which-template 1))
951 (cond ((stringp howm-template) howm-template)
952 ((functionp howm-template) (let ((args (if howm-template-receive-buffer
955 (list which-template))))
956 (apply howm-template args)))
957 ((listp howm-template) (nth (- which-template 1) howm-template))))
959 (defun howm-replace (rules arg &optional beg end)
961 (let ((spell (car pair))
963 (goto-char (or beg (point-min)))
964 (while (re-search-forward spell end t)
965 (delete-region (match-beginning 0) (match-end 0))
966 (funcall disp-f arg))))
969 (defun howm-template-title (arg)
970 (insert (cdr (assoc 'title arg))))
971 (defun howm-template-date (arg)
972 (insert (cdr (assoc 'date arg))))
973 (defun howm-template-previous-file (arg)
974 (insert (cdr (assoc 'file arg))))
975 (defun howm-template-cursor (arg)) ;; do nothing
979 (let* ((r (howm-view-paragraph-region))
980 (s (buffer-substring-no-properties (car r) (cadr r))))
985 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
988 (defun howm-completing-read-keyword ()
989 (message "Scanning...")
990 (let* ((kl (howm-keyword-list))
991 (table (mapcar #'list kl))
992 (completion-ignore-case howm-keyword-case-fold-search))
993 (completing-read "Keyword: " table)))
995 (defun howm-insert-keyword ()
997 (insert (howm-completing-read-keyword)))
999 (defun howm-keyword-to-kill-ring (&optional filename-p)
1001 (let ((title (howm-title-at-current-point filename-p)))
1003 (howm-string-to-kill-ring title)
1004 (error "No keyword."))))
1006 (defun howm-title-at-current-point (&optional filename-p
1007 title-regexp title-regexp-pos)
1008 (let ((reg (or title-regexp howm-view-title-regexp))
1009 (pos (or title-regexp-pos howm-view-title-regexp-pos)))
1012 (cond ((and (not filename-p)
1013 (re-search-backward reg nil t))
1014 (match-string-no-properties pos))
1016 (howm-abbreviate-file-name (buffer-file-name)))
1019 (defun howm-string-to-kill-ring (str)
1026 (defun howm-keyword-for-comefrom ()
1028 (goto-char (point-min))
1029 (let ((keyword-list nil))
1030 (while (re-search-forward howm-keyword-regexp nil t)
1032 (cons (match-string-no-properties howm-keyword-regexp-pos)
1034 (reverse keyword-list))))
1036 (defun howm-keyword-list ()
1037 (let ((sep (format "[\n%s]" (or howm-keyword-list-alias-sep ""))))
1038 (with-current-buffer (howm-keyword-buffer)
1040 (split-string (buffer-substring (point-min) (point-max)) sep)))))
1042 (defun howm-keyword-add (keyword-list)
1043 (interactive "sKeyword: ")
1044 (setq keyword-list (if (stringp keyword-list)
1047 (with-current-buffer (howm-keyword-buffer)
1049 (goto-char (point-max))
1051 (when (howm-keyword-new-p k)
1054 (when (buffer-file-name)
1055 (howm-basic-save-buffer)))))
1057 (defun howm-keyword-new-p (str)
1059 (let ((r (format "^%s$" (regexp-quote str)))
1060 (case-fold-search howm-keyword-case-fold-search))
1061 (goto-char (point-min))
1062 (not (re-search-forward r nil t)))))
1064 (defun howm-support-aliases-p ()
1065 howm-keyword-list-alias-sep)
1066 (defun howm-aliases ()
1067 (if (howm-support-aliases-p)
1070 (defun howm-read-aliases ()
1071 (with-current-buffer (howm-keyword-buffer)
1074 (goto-char (point-min))
1075 (while (search-forward howm-keyword-list-alias-sep nil t)
1076 (let* ((line (buffer-substring-no-properties (line-beginning-position)
1077 (line-end-position)))
1078 (keys (split-string line howm-keyword-list-alias-sep))
1079 (ks (if howm-keyword-case-fold-search
1080 (mapcar #'downcase keys)
1082 (setq ans (cons ks ans))
1086 (defun howm-expand-aliases-recursively (keyword aliases)
1087 (let ((keys (list keyword))
1089 (cl-labels ((expand (keys)
1090 (sort (cl-remove-duplicates
1091 (cl-mapcan (lambda (k)
1093 (lambda (a) (if (member k a)
1097 keys) :test #'string=)
1099 (while (not (equal prev keys))
1101 (setq keys (expand keys))))
1103 (cl-assert (equal (howm-expand-aliases-recursively "a"
1104 '(("d" "e" "f") ("a" "b" "c")))
1106 (cl-assert (equal (howm-expand-aliases-recursively "a"
1107 '(("d" "e" "b") ("a" "b" "c")))
1108 '("a" "b" "c" "d" "e")))
1110 (defun howm-keyword-aliases (keyword)
1111 "List of strings which are equivalent to KEYWORD.
1112 KEYWORD itself is always at the head of the returneded list.
1114 ;; Return the original keyword (not downcased) for backward compatibility.
1115 ;; I'm not sure whether this behavior is really needed.
1116 (let* ((key (if howm-keyword-case-fold-search
1119 (aliases (howm-aliases))
1120 (equiv (if howm-keyword-aliases-recursive
1121 (howm-expand-aliases-recursively key aliases)
1122 (cl-remove-duplicates
1124 (cl-remove-if-not (lambda (a) (member key a))
1128 (cons keyword (remove key equiv)))))
1130 (defun howm-keyword-search (keyword &optional create-p open-unique-p)
1131 (howm-message-time "key-search"
1132 (howm-set-command 'howm-keyword-search)
1133 (howm-with-normalizer
1134 (howm-keyword-search-subr keyword create-p open-unique-p))))
1136 (defun howm-keyword-search-subr (keyword create-p open-unique-p)
1137 (let* ((aliases (if (howm-support-aliases-p)
1138 (howm-keyword-aliases keyword)
1140 (menu-p (howm-menu-keyword-p keyword))
1141 (comefrom-regexp (if menu-p ;; clean me
1143 (howm-make-keyword-regexp2 aliases)))
1144 (trio (let ((howm-search-other-dir (if menu-p ;; clean me
1146 howm-search-other-dir))
1147 (*howm-view-force-case-fold-search*
1148 howm-keyword-case-fold-search)) ;; dirty!
1149 (howm-call-view-search-internal aliases t)))
1150 ;; code for <http://pc8.2ch.net/test/read.cgi/unix/1077881095/823>.
1151 ;; but this change is canceled; I'll try more fundamental fix. [2005-11-04]
1152 ;; (if open-unique-p
1153 ;; (let ((r (concat "^" (regexp-quote keyword) "$")))
1154 ;; (howm-call-view-search r nil))
1155 ;; (howm-call-view-search aliases t))))
1158 (items (cl-caddr trio))
1160 (found (if items t nil)) ;; want to forget items as soon as possible
1162 (let* ((howm-keyword-format
1163 (if menu-p ;; clean me
1164 (default-value 'howm-keyword-format)
1165 howm-keyword-format))
1166 (r (howm-normalize items aliases
1168 (setq items-pair (cdr r))
1170 (keyword-matched (member 'keyword matched))
1171 (keyword-matched-multi (member 'keyword-multi-hits matched))
1172 (file-matched (member 'file matched))
1173 (title (howm-make-keyword-string keyword)))
1174 ;; main processing (clean me!) [2003-12-01]
1177 ((and menu-p keyword-matched)
1178 (howm-keyword-search-open-menu keyword (car items-pair)
1179 keyword-matched-multi))
1181 ((and create-p (not keyword-matched))
1182 (howm-keyword-search-create title))
1183 ;; open if unique match
1184 ((and open-unique-p (howm-single-element-p items))
1185 (howm-keyword-search-open-unique items))
1187 (howm-call-view-summary name items-pair kw)
1188 (when (howm-normalize-oldp)
1189 ;; sorry for redundancy & inefficiency
1190 (howm-list-normalize-old aliases comefrom-regexp t))))
1193 (howm-write-history keyword))
1194 ;; return information
1195 `((menu-p . ,menu-p)
1197 (matched . ,matched)
1198 (keyword-matched . ,keyword-matched)
1199 (create-p . ,create-p))
1202 (defun howm-keyword-search-open-menu (keyword item-list multi-hits-p)
1203 "Open KEYWORD as menu."
1204 ;; dirty. peeking howm-view.el
1205 (let* ((item (car item-list))
1206 (fname (howm-view-item-filename item))
1207 (place (howm-view-item-place item)))
1208 (let ((howm-search-other-dir nil))
1209 (howm-menu-open fname place (howm-menu-name keyword))))
1211 (message "Warning: found two or more %s." keyword)))
1213 (defun howm-keyword-search-create (title)
1214 "create new memo <<< TITLE."
1215 (howm-create-file-with-title title)
1216 (message "New keyword."))
1218 (defun howm-keyword-search-open-unique (items)
1219 "Open unique match."
1220 (howm-view-open-item (car items)))
1222 ;; (defvar *howm-keyword-buffer* nil) ;; for internal use
1223 (defun howm-keyword-for-goto (&optional keyword-list)
1225 (let ((case-fold-search howm-keyword-case-fold-search))
1226 (sort (cl-mapcan (lambda (k)
1227 (goto-char (point-min))
1228 ;; when howm-check-word-break is non-nil,
1229 ;; checking word breaks is desired for efficiency.
1230 ;; it is not implemented yet.
1231 (if (search-forward k nil 'noerr)
1234 (or keyword-list (howm-keyword-list)))
1236 (> (length x) (length y)))))))
1238 (defun howm-keyword-add-current-buffer ()
1240 (goto-char (point-min))
1241 (let ((m (current-message))
1243 (while (re-search-forward howm-keyword-regexp nil t)
1244 (let ((key-str (if howm-keyword-list-alias-sep
1245 (mapconcat #'identity
1247 howm-keyword-list-alias-sep)
1248 (match-string-no-properties howm-keyword-regexp-pos))))
1249 (setq keyword-list (cons key-str keyword-list))))
1250 (howm-keyword-add keyword-list)
1252 (defun howm-keyword-add-items (items)
1253 (let ((files (mapcar #'howm-view-item-filename items)))
1257 (insert-file-contents f)
1258 (howm-set-configuration-for-file-name f)
1259 (howm-keyword-add-current-buffer))
1262 (defun howm-keyword-read ()
1264 (beg (line-beginning-position)))
1266 (skip-chars-backward " ")
1267 (while (re-search-backward howm-keyword-regexp beg t)
1268 (setq ks (cons (match-string-no-properties howm-keyword-regexp-pos) ks))
1269 (skip-chars-backward " "))
1273 ;;; howm-mode.el ends here