howm-misc.el

   1 ;;; howm-misc.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-misc.el,v 1.96 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 (provide 'howm-misc)
  23 (require 'howm)
  24
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;; Misc.
  27
  28 (defun howm-version ()
  29   (interactive)
  30   (message "howm-%s" howm-version))
  31
  32 (defun howm-keyword-file ()
  33   ;; create .howm-keys
  34   (when (not (file-exists-p howm-keyword-file))
  35     (save-excursion
  36       (find-file howm-keyword-file)
  37       (when howm-menu-top
  38         (goto-char (point-min))
  39         (insert howm-menu-top "\n"))
  40       (set-buffer-modified-p t)
  41       (save-buffer)
  42       (kill-buffer nil)
  43       (message "Generating %s ..." howm-keyword-file)
  44       (howm-keyword-add-items (howm-all-items))
  45       (message "Done.")))
  46   howm-keyword-file)
  47
  48 (add-hook 'howm-view-open-hook 'howm-set-mode)
  49 (defun howm-set-mode ()
  50   (when (howm-set-mode-p)
  51     (howm-set-configuration-for-major-mode major-mode)
  52     (howm-mode 1)))
  53
  54 (defun howm-set-mode-p (&optional buf)
  55   (with-current-buffer (or buf (current-buffer))
  56     (let ((hdir (car (howm-search-path))))
  57       (and (buffer-file-name)
  58            (howm-folder-territory-p hdir (buffer-file-name))))))
  59
  60 (defvar howm-configuration-for-major-mode nil)
  61 ;; ;; sample
  62 ;; (setq howm-configuration-for-major-mode
  63 ;;   '(
  64 ;;     ;; fix me
  65 ;;     (emacs-lisp-mode
  66 ;;      . (
  67 ;;         (howm-keyword-format . "(def[a-z*]+ +%s[ \t\r\n]")
  68 ;;         (howm-keyword-regexp-format . "%s")
  69 ;;         (howm-keyword-regexp . "(\\(def[a-z]+\\) +'?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)") ;; ' for (defalias 'xxx ...)
  70 ;;         (howm-keyword-regexp-hilit-pos . 1)
  71 ;;         (howm-keyword-regexp-pos . 2)
  72 ;;         (howm-view-title-regexp . "^(.*$")
  73 ;; ;;         (howm-view-title-regexp . "^[^; \t\r\n].*$")
  74 ;;         (howm-view-title-regexp-pos . 0)
  75 ;;         (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
  76 ;;         (howm-mode-title-face . nil)
  77 ;;         (howm-keyword-list-alias-sep . nil)
  78 ;;         (howm-view-preview-narrow . nil)
  79 ;;         ))
  80 ;;     (scheme-mode
  81 ;;      . (
  82 ;;         (howm-keyword-format . "(def[a-z]+ +[(]?%s[) \t\r\n]")
  83 ;;         (howm-keyword-regexp-format . "%s")
  84 ;;         (howm-keyword-regexp . "(\\(def[a-z]+\\) +[(]?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
  85 ;;         (howm-keyword-regexp-hilit-pos . 1)
  86 ;;         (howm-keyword-regexp-pos . 2)
  87 ;;         (howm-view-title-regexp . "^[^; \t\r\n].*$")
  88 ;;         (howm-view-title-regexp-pos . 0)
  89 ;;         (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
  90 ;;         (howm-mode-title-face . nil)
  91 ;;         (howm-keyword-list-alias-sep . nil)
  92 ;;         (howm-view-preview-narrow . nil)
  93 ;;         ))
  94 ;;     (ruby-mode
  95 ;;      . (
  96 ;;         (howm-keyword-format . "\\(def\\|class\\) +%s\\b")
  97 ;;         (howm-keyword-regexp-format . "%s")
  98 ;;         (howm-keyword-regexp . "\\(def\\|class\\) +\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
  99 ;;         (howm-keyword-regexp-hilit-pos . 1)
 100 ;;         (howm-keyword-regexp-pos . 2)
 101 ;;         (howm-view-title-regexp . "^[^# \t\r\n].*$")
 102 ;;         (howm-view-title-regexp-pos . 0)
 103 ;;         (howm-view-title-regexp-grep . "^[^# \t\r\n].*$")
 104 ;;         (howm-mode-title-face . nil)
 105 ;;         (howm-keyword-list-alias-sep . nil)
 106 ;;         (howm-view-preview-narrow . nil)
 107 ;;         ))
 108 ;;     (yatex-mode
 109 ;;      . (
 110 ;;         (howm-keyword-format . "\\\\label%s")
 111 ;;         (howm-keyword-regexp-format . "%s")
 112 ;;         (howm-keyword-regexp . "\\(\\\\label\\)\\({[^}\r\n]+}\\)")
 113 ;;         (howm-keyword-regexp-hilit-pos . 1)
 114 ;;         (howm-keyword-regexp-pos . 2)
 115 ;;         (howm-view-title-regexp . "\\\\\\(\\(sub\\)*section\\|chapter\\|part\\|begin\\)")
 116 ;;         (howm-view-title-regexp-pos . 0)
 117 ;;         (howm-view-title-regexp-grep . "\\\\((sub)*section|chapter|part|begin)")
 118 ;;         (howm-mode-title-face . nil)
 119 ;;         (howm-keyword-list-alias-sep . nil)
 120 ;;         (howm-view-preview-narrow . nil)
 121 ;;         ))
 122 ;;     ))
 123
 124 (defun howm-set-configuration-for-file-name (f)
 125   (let ((mode (howm-auto-mode f)))
 126     (howm-set-configuration-for-major-mode mode)))
 127
 128 (defun howm-set-configuration-for-major-mode (mode)
 129   (let ((a (cdr (assoc mode howm-configuration-for-major-mode))))
 130     (when a  ;; I know this is redundant.
 131       (mapc (lambda (sv)
 132               (let ((symbol (car sv))
 133                     (value (cdr sv)))
 134                 (set (make-local-variable symbol) value)))
 135             a))))
 136
 137 (defmacro howm-if-unbound (var &rest alt-body)
 138   `(if (boundp ',var) ,var ,@alt-body))
 139
 140 ;; copied and modified from set-auto-mode in /usr/share/emacs/21.2/lisp/files.el
 141 ;; (I don't want to set the mode actually. Sigh...)
 142 (howm-dont-warn-free-variable auto-mode-interpreter-regexp)
 143 (defvar howm-auto-mode-interpreter-regexp
 144   (howm-if-unbound auto-mode-interpreter-regexp
 145                    ;; xemacs doesn't have it.
 146                    "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
 147 (defun howm-auto-mode (&optional file-name)
 148   "Major mode appropriate for current buffer.
 149 This checks for a -*- mode tag in the buffer's text,
 150 compares the filename against the entries in `auto-mode-alist',
 151 or checks the interpreter that runs this file against
 152 `interpreter-mode-alist'.
 153
 154 It does not check for the `mode:' local variable in the
 155 Local Variables section of the file; for that, use `hack-local-variables'.
 156
 157 If `enable-local-variables' is nil, this function does not check for a
 158 -*- mode tag.
 159
 160 This function merely returns the mode; it does not set the mode.
 161 "
 162   ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
 163   (let (beg end done modes ans)
 164     (save-excursion
 165       (goto-char (point-min))
 166       (skip-chars-forward " \t\n")
 167       (and enable-local-variables
 168            ;; Don't look for -*- if this file name matches any
 169            ;; of the regexps in inhibit-first-line-modes-regexps.
 170            (let ((temp (howm-if-unbound inhibit-first-line-modes-regexps
 171                                         inhibit-local-variables-regexps))
 172                  (name (file-name-sans-versions (or file-name ""))))
 173              (while (let ((sufs (howm-if-unbound inhibit-first-line-modes-suffixes
 174                                                  inhibit-local-variables-suffixes)))
 175                       (while (and sufs (not (string-match (car sufs) name)))
 176                         (setq sufs (cdr sufs)))
 177                       sufs)
 178                (setq name (substring name 0 (match-beginning 0))))
 179              (while (and temp
 180                          (not (string-match (car temp) name)))
 181                (setq temp (cdr temp)))
 182              (not temp))
 183            (search-forward "-*-" (save-excursion
 184                                    ;; If the file begins with "#!"
 185                                    ;; (exec interpreter magic), look
 186                                    ;; for mode frobs in the first two
 187                                    ;; lines.  You cannot necessarily
 188                                    ;; put them in the first line of
 189                                    ;; such a file without screwing up
 190                                    ;; the interpreter invocation.
 191                                    (end-of-line (and (looking-at "^#!") 2))
 192                                    (point)) t)
 193            (progn
 194              (skip-chars-forward " \t")
 195              (setq beg (point))
 196              (search-forward "-*-"
 197                              (save-excursion (end-of-line) (point))
 198                              t))
 199            (progn
 200              (forward-char -3)
 201              (skip-chars-backward " \t")
 202              (setq end (point))
 203              (goto-char beg)
 204              (if (save-excursion (search-forward ":" end t))
 205                  ;; Find all specifications for the `mode:' variable
 206                  ;; and execute them left to right.
 207                  (while (let ((case-fold-search t))
 208                           (or (and (looking-at "mode:")
 209                                    (goto-char (match-end 0)))
 210                               (re-search-forward "[ \t;]mode:" end t)))
 211                    (skip-chars-forward " \t")
 212                    (setq beg (point))
 213                    (if (search-forward ";" end t)
 214                        (forward-char -1)
 215                      (goto-char end))
 216                    (skip-chars-backward " \t")
 217                    (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
 218                          modes))
 219                ;; Simple -*-MODE-*- case.
 220                (push (intern (concat (downcase (buffer-substring beg end))
 221                                      "-mode"))
 222                      modes)))))
 223     ;; If we found modes to use, set done.
 224     (dolist (mode (nreverse modes))
 225       (when (functionp mode)
 226         (setq ans mode)
 227         (setq done t)))
 228     ;; If we didn't find a mode from a -*- line, try using the file name.
 229     (if (and (not done) file-name)
 230         (let ((name file-name)
 231               (keep-going t))
 232           ;; Remove backup-suffixes from file name.
 233           (setq name (file-name-sans-versions name))
 234           (while keep-going
 235             (setq keep-going nil)
 236             (let ((alist auto-mode-alist)
 237                   (mode nil))
 238               ;; Find first matching alist entry.
 239               (let ((case-fold-search
 240                      (memq system-type '(vax-vms windows-nt))))
 241                 (while (and (not mode) alist)
 242                   (if (string-match (car (car alist)) name)
 243                       (if (and (consp (cdr (car alist)))
 244                                (nth 2 (car alist)))
 245                           (setq mode (car (cdr (car alist)))
 246                                 name (substring name 0 (match-beginning 0))
 247                                 keep-going t)
 248                         (setq mode (cdr (car alist))
 249                               keep-going nil)))
 250                   (setq alist (cdr alist))))
 251               (if mode
 252                   (setq ans mode)
 253                 ;; If we can't deduce a mode from the file name,
 254                 ;; look for an interpreter specified in the first line.
 255                 ;; As a special case, allow for things like "#!/bin/env perl",
 256                 ;; which finds the interpreter anywhere in $PATH.
 257                 (let ((interpreter
 258                        (save-excursion
 259                          (goto-char (point-min))
 260                          (if (looking-at howm-auto-mode-interpreter-regexp)
 261                              (match-string 2)
 262                            "")))
 263                       elt)
 264                   ;; Map interpreter name to a mode.
 265                   (setq elt (assoc (file-name-nondirectory interpreter)
 266                                    interpreter-mode-alist))
 267                   (if elt
 268                       (setq ans (cdr elt)))))))))
 269     ans
 270     ))
 271
 272 ;; copied from /usr/share/emacs/21.2/lisp/subr.el
 273 ;; for emacs20 and xemacs
 274 (when (not (fboundp 'replace-regexp-in-string))
 275   (defun replace-regexp-in-string (regexp rep string &optional
 276                                           fixedcase literal subexp start)
 277     "Replace all matches for REGEXP with REP in STRING.
 278
 279 Return a new string containing the replacements.
 280
 281 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
 282 arguments with the same names of function `replace-match'.  If START
 283 is non-nil, start replacements at that index in STRING.
 284
 285 REP is either a string used as the NEWTEXT arg of `replace-match' or a
 286 function.  If it is a function it is applied to each match to generate
 287 the replacement passed to `replace-match'; the match-data at this
 288 point are such that match 0 is the function's argument.
 289
 290 To replace only the first match (if any), make REGEXP match up to \\'
 291 and replace a sub-expression, e.g.
 292   (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
 293     => \" bar foo\"
 294 "
 295
 296     ;; To avoid excessive consing from multiple matches in long strings,
 297     ;; don't just call `replace-match' continually.  Walk down the
 298     ;; string looking for matches of REGEXP and building up a (reversed)
 299     ;; list MATCHES.  This comprises segments of STRING which weren't
 300     ;; matched interspersed with replacements for segments that were.
 301     ;; [For a `large' number of replacments it's more efficient to
 302     ;; operate in a temporary buffer; we can't tell from the function's
 303     ;; args whether to choose the buffer-based implementation, though it
 304     ;; might be reasonable to do so for long enough STRING.]
 305     (let ((l (length string))
 306           (start (or start 0))
 307           matches str mb me)
 308       (save-match-data
 309         (while (and (< start l) (string-match regexp string start))
 310           (setq mb (match-beginning 0)
 311                 me (match-end 0))
 312           ;; If we matched the empty string, make sure we advance by one char
 313           (when (= me mb) (setq me (min l (1+ mb))))
 314           ;; Generate a replacement for the matched substring.
 315           ;; Operate only on the substring to minimize string consing.
 316           ;; Set up match data for the substring for replacement;
 317           ;; presumably this is likely to be faster than munging the
 318           ;; match data directly in Lisp.
 319           (string-match regexp (setq str (substring string mb me)))
 320           (setq matches
 321                 (cons (replace-match (if (stringp rep)
 322                                          rep
 323                                        (funcall rep (match-string 0 str)))
 324                                      fixedcase literal str subexp)
 325                       (cons (substring string start mb) ; unmatched prefix
 326                             matches)))
 327           (setq start me))
 328         ;; Reconstruct a string from the pieces.
 329         (setq matches (cons (substring string start l) matches)) ; leftover
 330         (apply #'concat (nreverse matches)))))
 331   )
 332
 333 (howm-defvar-risky howm-kill-all-enable-force nil)
 334 (defun howm-kill-all (&optional force-p)
 335   "Kill all buffers which is howm-mode and unmodified."
 336   (interactive "P")
 337   (let ((anyway (and force-p howm-kill-all-enable-force)))
 338     (when (if anyway
 339               (yes-or-no-p "Discard all unsaved changes on howm-mode buffers? ")
 340             (y-or-n-p "Kill all howm-mode buffers? "))
 341       (when (eq major-mode 'howm-view-summary-mode)
 342         (howm-view-restore-window-configuration))
 343       (mapc (lambda (b)
 344               (when (howm-buffer-p b)
 345                 (when anyway
 346                   (switch-to-buffer b)
 347                   (set-buffer-modified-p nil))  ;; dangerous!
 348                 (when (not (buffer-modified-p b))
 349                   (kill-buffer b))))
 350             (buffer-list))
 351       (message "Done."))))
 352
 353 (defun howm-toggle-buffer ()
 354   (interactive)
 355   (if (howm-buffer-p)
 356       (howm-switch-to-nonhowm-buffer)
 357     (howm-switch-to-howm-buffer)))
 358 (defun howm-switch-to-howm-buffer ()
 359   (interactive)
 360   (let ((b (howm-find-buffer #'howm-buffer-p)))
 361     (if b
 362         (switch-to-buffer b)
 363       (howm-menu))))
 364 (defun howm-switch-to-nonhowm-buffer ()
 365   (interactive)
 366   (switch-to-buffer (or (howm-find-buffer #'(lambda (b)
 367                                               (not (howm-buffer-p b))))
 368                         (error "No nonhowm buffer"))))
 369
 370 (defun howm-find-buffer (pred)
 371   (catch :found
 372     (mapc (lambda (b)
 373             (cond ((howm-internal-buffer-p b) nil) ;; skip
 374                   ((funcall pred b) (throw :found b))
 375                   (t t)))
 376           (buffer-list))
 377     nil))
 378
 379 (defun howm-internal-buffer-p (buf)
 380   (string= (substring (buffer-name buf) 0 1) " "))
 381
 382 (defun howm-buffer-p (&optional buf)
 383   (let* ((indep-dirs (cons nil *howm-independent-directories*))
 384          (keyword-bufs (mapcar
 385                         (lambda (d)
 386                           (let ((default-directory (or d default-directory)))
 387                             (howm-keyword-buffer)))
 388                         indep-dirs)))
 389     (with-current-buffer (or buf (current-buffer))
 390       (or howm-mode
 391           (member major-mode
 392                   '(howm-view-summary-mode
 393                     howm-view-contents-mode))
 394           (member buf keyword-bufs)))))
 395
 396 (defun howm-mode-add-font-lock ()
 397   (cheat-font-lock-append-keywords (howm-mode-add-font-lock-internal)))
 398
 399 (defun howm-mode-add-font-lock-internal ()
 400   (when howm-use-color
 401     `(,@howm-user-font-lock-keywords
 402       (,howm-view-title-regexp
 403        (0 howm-mode-title-face prepend))
 404       (,howm-keyword-regexp
 405        (,howm-keyword-regexp-hilit-pos howm-mode-keyword-face prepend))
 406       (,howm-ref-regexp
 407        (,howm-ref-regexp-hilit-pos howm-mode-ref-face prepend))
 408       (,howm-wiki-regexp
 409        (,howm-wiki-regexp-pos howm-mode-wiki-face prepend))
 410       )))
 411
 412 ;;; unofficial. may be removed if no one needs them.
 413
 414 (defun howm-show-buffer-as-howm ()
 415   (interactive)
 416   (let* ((name (buffer-name))
 417          (pos (point))
 418          (s (buffer-substring-no-properties (point-min) (point-max)))
 419          (b (get-buffer-create (format "*howm[%s]*" name))))
 420     (set-buffer b)
 421     (howm-rewrite-read-only-buffer
 422       (insert s)
 423       (howm-mode 1)
 424       (howm-initialize-buffer))
 425     (goto-char pos)
 426     (switch-to-buffer b)))
 427
 428 ;;; narrowing
 429
 430 (defun howm-narrow-to-memo ()
 431   (interactive)
 432   (apply #'narrow-to-region (howm-view-paragraph-region t)))
 433
 434 (defun howm-toggle-narrow ()
 435   (interactive)
 436   (if (howm-narrow-p)
 437       (widen)
 438     (howm-narrow-to-memo)))
 439
 440 (put 'howm-narrow-to-memo 'disabled t)
 441 (put 'howm-toggle-narrow 'disabled t)
 442
 443 (defun howm-narrow-p ()
 444   (let ((b (point-min))
 445         (e (point-max)))
 446     (save-restriction
 447       (widen)
 448       (not (and (equal b (point-min))
 449                 (equal e (point-max)))))))
 450
 451 (defun howm-auto-narrow ()
 452   (when (cond (*howm-view-item-privilege* nil)
 453               ((eq howm-auto-narrow t) t)
 454               (t (member (howm-command) howm-auto-narrow)))
 455     (howm-narrow-to-memo)))
 456 ;;   (when (and (member (howm-command) howm-auto-narrow)
 457 ;;              (not *howm-view-item-privilege*))
 458
 459 ;;; select file for new memo by hand
 460
 461 (defun howm-create-interactively (&optional use-current-directory)
 462   (interactive "P")
 463   (find-file (read-file-name "Memo file: "
 464                              (if use-current-directory
 465                                  nil
 466                                howm-directory)))
 467   (goto-char (point-max))
 468   (howm-create-here))
 469
 470 ;;; next/previous memo
 471
 472 (defmacro howm-save-narrowing (&rest body)
 473   (declare (indent 0))
 474   `(let ((narrowp (howm-narrow-p)))
 475      (when narrowp
 476        (widen))
 477      (unwind-protect
 478          (progn
 479            ,@body)
 480        (when narrowp
 481          (howm-narrow-to-memo)))))
 482
 483 (defun howm-next-memo (n)
 484   (interactive "p")
 485   (howm-save-narrowing
 486     (when (looking-at howm-view-title-regexp)
 487       (setq n (+ n 1)))
 488     (re-search-forward howm-view-title-regexp nil nil n)))
 489
 490 (defun howm-previous-memo (n)
 491   (interactive "p")
 492   (howm-save-narrowing
 493     (when (not (looking-at howm-view-title-regexp))
 494       (setq n (+ n 1)))
 495     (re-search-backward howm-view-title-regexp nil nil n)))
 496
 497 (defun howm-first-memo ()
 498   (interactive)
 499   (howm-save-narrowing
 500     (goto-char (point-min))))
 501
 502 (defun howm-last-memo ()
 503   (interactive)
 504   (howm-save-narrowing
 505     (goto-char (point-max)))
 506   (re-search-backward howm-view-title-regexp))
 507
 508 ;;; random walk
 509
 510 (defvar howm-random-walk-buf nil "for internal use")
 511 (defvar howm-random-walk-ro t "for internal use")
 512
 513 (defun howm-random-walk ()
 514   (interactive)
 515   (let ((orig-bufs (buffer-list))
 516         (howm-history-file nil))
 517     (while (let ((v (frame-visible-p (selected-frame))))
 518              (and v (not (eq v 'icon))
 519                   (not (input-pending-p))))
 520       (unwind-protect
 521           (cond ((eq major-mode 'howm-view-summary-mode)
 522                  (howm-random-walk-summary))
 523                 (howm-mode
 524                  (howm-random-walk-text))
 525                 (t
 526                  (howm-list-all)
 527                  (howm-random-walk-summary)))
 528         (mapc (lambda (b)
 529                 (when (and (not (member b orig-bufs))
 530                            (null (get-buffer-window b)))
 531                   (kill-buffer b)))
 532               (buffer-list)))
 533       (sit-for howm-random-walk-wait))))
 534
 535 (defun howm-random-walk-summary ()
 536   (let ((n (length (riffle-item-list))))
 537     (goto-char (point-min))
 538     (forward-line (random n))
 539     (howm-view-summary-check)
 540     (sit-for howm-random-walk-wait)
 541     (howm-view-summary-open)))
 542
 543 (defun howm-random-walk-text ()
 544   (let* ((ks (howm-keyword-for-goto))
 545          (k (nth (random (length ks)) ks))
 546          (d (- (point-max) (point-min))))
 547     (goto-char (+ (point-min) (random d)))
 548     (if (search-forward k nil t)
 549         (goto-char (match-beginning 0))
 550       (search-backward k nil t))
 551     (sit-for howm-random-walk-wait)
 552     (howm-keyword-search k)))
 553
 554 ;; named note
 555
 556 (defun howm-open-named-file ()
 557   "Ask a file name and open it as howm note if it is under howm directory."
 558   (interactive)
 559   (let* ((item-dir (lambda (item) (file-name-directory (howm-item-name item))))
 560          (dir (cond ((eq major-mode 'howm-view-summary-mode)
 561                      (funcall item-dir (howm-view-summary-current-item)))
 562                     ((eq major-mode 'howm-view-contents-mode)
 563                      (funcall item-dir (howm-view-contents-current-item)))
 564                     (t
 565                      howm-directory)))
 566          (fname (read-file-name "Howm file name: " dir)))
 567     (find-file fname)
 568     (if (file-exists-p fname)
 569         (howm-set-mode)
 570       (progn
 571         (howm-insert-template "")
 572         (howm-create-finish)))))
 573
 574 ;; imitation of remember.el
 575 ;; http://www.emacswiki.org/cgi-bin/emacs-en/RememberMode
 576
 577 ;; shamelessly copied from http://newartisans.com/johnw/Emacs/remember.el
 578 ;; (I cannot browse http://sacha.free.net.ph/notebook/emacs/dev today.)
 579
 580 (defvar howm-remember-wconf nil
 581   "for internal use")
 582 (defvar howm-remember-buffer-name "*howm-remember*")
 583 (defvar howm-remember-mode-hook nil)
 584 (let ((m (make-sparse-keymap)))
 585   (define-key m "\C-c\C-c" 'howm-remember-submit)
 586   (define-key m "\C-c\C-k" 'howm-remember-discard)
 587   (howm-defvar-risky howm-remember-mode-map m))
 588
 589 (defun howm-remember ()
 590   "Add text to new note in howm."
 591   (interactive)
 592   (setq howm-remember-wconf (current-window-configuration))
 593   (switch-to-buffer-other-window (get-buffer-create howm-remember-buffer-name))
 594   (howm-remember-mode)
 595   (apply #'message
 596          `("Remember (%s) or discard (%s)."
 597            ,@(mapcar (lambda (f)
 598                        (key-description
 599                         (where-is-internal f howm-remember-mode-map t)))
 600                      '(howm-remember-submit howm-remember-discard)))))
 601
 602 (defun howm-remember-mode ()
 603   "Major mode for `howm-remember'.
 604
 605 \\{howm-remember-mode-map}"
 606   (interactive)
 607   (kill-all-local-variables)
 608   (text-mode)
 609   (use-local-map howm-remember-mode-map)
 610   (setq major-mode 'howm-remember-mode
 611         mode-name "HowmRemember")
 612   (run-hooks 'howm-remember-mode-hook))
 613
 614 (defun howm-remember-submit ()
 615   (interactive)
 616   (save-excursion
 617     (let* ((title (howm-remember-get-title)) ;; has side effect
 618            (s (buffer-substring-no-properties (point-min) (point-max))))
 619       (set-window-configuration howm-remember-wconf)
 620       (howm-create-file-with-title title)
 621       (insert s "\n")
 622       (save-buffer)
 623       (kill-buffer (current-buffer))))
 624   (howm-remember-discard))
 625
 626 (defun howm-remember-get-title ()
 627   (if (not howm-remember-first-line-to-title)
 628       ""
 629     (progn
 630       (goto-char (point-min))
 631       (prog1
 632           (buffer-substring-no-properties (point-min)
 633                                           (line-end-position))
 634         (forward-line 1)
 635         (delete-region (point-min) (point))))))
 636
 637 (defun howm-remember-discard ()
 638   (interactive)
 639   (kill-buffer (current-buffer))
 640   (set-window-configuration howm-remember-wconf))
 641
 642 ;; Rename buffer
 643 ;;
 644 ;; You can rename howm buffers based on their titles.
 645 ;; Only buffer names in emacs are changed; file names are kept unchanged.
 646 ;;
 647 ;; Add the next lines to your .emacs if you like this feature.
 648 ;; (add-hook 'howm-mode-hook 'howm-mode-set-buffer-name)
 649 ;; (add-hook 'after-save-hook 'howm-mode-set-buffer-name)
 650 ;;
 651 ;; The original idea and code are given by Mielke-san (peter at exegenix.com).
 652 ;; http://lists.sourceforge.jp/mailman/archives/howm-eng/2006/000020.html
 653 ;; thx!
 654
 655 (defvar howm-buffer-name-limit 20)
 656 (defvar howm-buffer-name-total-limit howm-buffer-name-limit)
 657 (defvar howm-buffer-name-format "%s"
 658   "Buffer name format for `howm-mode-set-buffer-name'.
 659 For example, buffer name is _ABC_ if title is ABC and the value of
 660 this variable is \"_%s_\".")
 661
 662 (defun howm-truncate-string (string limit &optional dots-str)
 663   "Truncate STRING if it is longer than LIMIT.
 664 For example, \"1234567...\" is returned if string is \"123456789012\"
 665 and limit is 10.
 666 When DOTS-STR is non-nil, it is used instead of \"...\"."
 667   (let ((dots (or dots-str "...")))
 668     (when (> (length dots) limit)
 669       (setq dots (substring dots 0 limit)))
 670     (if (> (length string) limit)
 671         (concat (substring string 0 (- limit (length dots)))
 672                 dots)
 673       string)))
 674
 675 (defun howm-set-buffer-name-from-title (checker title-regexp title-regexp-pos)
 676   "Set the buffer name to the title(s) of the file."
 677   (when (funcall checker)
 678     (save-excursion
 679       (goto-char 0)
 680       (let ((titles nil))
 681         (while (re-search-forward title-regexp nil t)
 682           (setq titles
 683                 (cons (match-string-no-properties title-regexp-pos)
 684                       titles)))
 685         (let ((name0 (mapconcat
 686                       (lambda (s)
 687                         (howm-truncate-string s howm-buffer-name-limit))
 688                       (reverse (cl-remove-if (lambda (s) (string= s ""))
 689                                                   titles))
 690                       "/")))
 691           (when (not (string= name0 "")) ;; exclude "no title" case
 692             (let ((name (format howm-buffer-name-format
 693                                 (howm-truncate-string
 694                                  name0
 695                                  howm-buffer-name-total-limit))))
 696               (rename-buffer name t))))))))
 697
 698 (defun howm-mode-set-buffer-name ()
 699   (howm-set-buffer-name-from-title (lambda ()
 700                                      (and howm-mode (buffer-file-name)))
 701                                    howm-view-title-regexp
 702                                    howm-view-title-regexp-pos))
 703
 704 ;; memoize: used in howm-bayesian-set
 705
 706 (defun howm-memoize-put (fname value)
 707   (put fname 'howm-memoize value))
 708 (defun howm-memoize-get (fname)
 709   (get fname 'howm-memoize))
 710
 711 (defun howm-memoize-call (fname func args)
 712   (let* ((p (assoc args (howm-memoize-get fname))))
 713     (if p
 714         (progn
 715 ;;           (message "hit %s" p)
 716           (cdr p))
 717       (let ((r (apply func args)))
 718         ;; We need to get it again because func can change memory.
 719         (howm-memoize-put fname `((,args . ,r) ,@(howm-memoize-get fname)))
 720         r))))
 721
 722 (defun howm-memoize-reset (fname)
 723   (howm-memoize-put fname nil))
 724
 725 (defmacro howm-defun-memoize (fname args &rest body)
 726   (declare (indent 2))
 727   `(progn
 728      (howm-memoize-reset ',fname)
 729      (defun ,fname ,args
 730        "Function generated by `howm-defun-memoize'"
 731        (howm-memoize-call ',fname (lambda ,args ,@body) (list ,@args)))))
 732
 733 ;; ;; test
 734 ;; (howm-memoize-reset 'fib)
 735 ;; (howm-defun-memoize fib (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))
 736 ;; (fib 5)
 737 ;; (howm-memoize-get 'fib)
 738
 739 ;; Bayesian set
 740 ;;
 741 ;; "M-x howm-bayesian-set RET lisp scheme haskell RET" to estimate
 742 ;; related keywords with lisp, scheme, and haskell.
 743 ;; If you are lucky, you may find ruby, elisp, gauche, etc.
 744 ;; in estimated candidates.
 745 ;;
 746 ;; (ref.)
 747 ;; Zoubin Ghahramani and Katherine Heller: "Bayesian Sets",
 748 ;; Advances in Neural Information Processing Systems,
 749 ;; Vol. 18, pp. 435-442, MIT Press, 2006.
 750 ;; http://books.nips.cc/nips18.html
 751 ;; http://books.nips.cc/papers/files/nips18/NIPS2005_0712.pdf
 752
 753 (defun howm-bset-nodup (f &rest args)
 754   (cl-remove-duplicates (apply f args) :test #'equal))
 755 (defun howm-bset-mapcar (func lis)
 756   (howm-bset-nodup #'mapcar func lis))
 757 (defun howm-bset-mapcan (func lis)
 758   (howm-bset-nodup (lambda (f z) (apply #'append (mapcar f z)))
 759                    func lis))
 760
 761 (defun howm-bset-message (&rest args)
 762   (let (message-log-max) ;; prevent it from being logged
 763     (apply #'message args)))
 764
 765 (defun howm-bset-matched-files (query)
 766 ;;   (howm-bset-message "Finding files for query (%s)..." query)
 767   (howm-bset-mapcar #'howm-item-name
 768                     (howm-view-search-folder-items query (howm-folder)
 769                                                    nil t)))
 770
 771 (howm-defun-memoize howm-bset-keywords-in-file* (file keyword-list)
 772 ;;   (howm-bset-message "Finding keywords in file (%s)..." file)
 773   (with-temp-buffer
 774     (insert-file-contents file)
 775     (howm-keyword-for-goto keyword-list)))
 776
 777 (defun howm-bset-keywords-in-file (file)
 778   (howm-bset-keywords-in-file* file nil))
 779
 780 (defun howm-bset-candidate-keywords (query-list)
 781 ;;   (howm-bset-message "Collecting keywords...")
 782   (let ((files (howm-bset-mapcan #'howm-bset-matched-files
 783                                  query-list)))
 784     (howm-bset-mapcan (lambda (f)
 785                         (howm-bset-message "Collecting keywords in file (%s)..."
 786                                            f)
 787                         (howm-bset-keywords-in-file f))
 788                       files)))
 789
 790 (howm-defun-memoize howm-bset-file-score (file query-list
 791                                                coef number-of-all-keywords)
 792 ;;   (howm-bset-message "Scoring file (%s)..." file)
 793   (let* ((m (/ (length (howm-bset-keywords-in-file file))
 794                (float number-of-all-keywords)))
 795          (a (* coef m))
 796          (b (* coef (- 1 m)))
 797          (s (length (howm-bset-keywords-in-file* file query-list)))
 798          (a2 (+ a s))
 799          (b2 (+ b (- (length query-list) s))))
 800     ;; log{(a2/a) * (b/b2)}
 801     (- (- (log a2) (log a)) (- (log b2) (log b)))))
 802
 803 (howm-defun-memoize howm-bset-keyword-score (keyword query-list
 804                                                      coef
 805                                                      number-of-all-keywords)
 806   (howm-bset-message "Scoring keyword (%s)..." keyword)
 807   (apply #'+
 808          (mapcar (lambda (file)
 809                    (howm-bset-file-score file query-list coef
 810                                          number-of-all-keywords))
 811                  (howm-bset-matched-files keyword))))
 812
 813 (defun howm-bset-reset ()
 814   (mapc #'howm-memoize-reset '(howm-bset-file-score
 815                                howm-bset-keyword-score
 816                                howm-bset-keywords-in-file*)))
 817
 818 (defun howm-bset (query-list)
 819   (howm-bset-reset)
 820   (unwind-protect
 821       (let ((n (length (howm-keyword-list)))
 822             (c 2.0)) ;; heuristic value
 823         (sort (copy-sequence (howm-bset-candidate-keywords query-list))
 824               (lambda (k1 k2)
 825                 (apply #'>
 826                        (mapcar (lambda (k)
 827                                  (howm-bset-keyword-score k query-list c n))
 828                                (list k1 k2))))))
 829     (howm-bset-reset)))
 830
 831 (defun howm-bayesian-set (query-str)
 832   (interactive "sQueries: ")
 833   (switch-to-buffer (get-buffer-create "*howm-bayesian-set*"))
 834   (howm-rewrite-read-only-buffer
 835     (insert (mapconcat #'identity
 836                        (howm-bset (split-string query-str))
 837                        "\n"))
 838     (howm-mode 1))
 839   (goto-char (point-min))
 840   (howm-bset-message "Done."))
 841
 842 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 843 ;; Fellowship
 844
 845 ;; xemacs: add-to-list doesn't have APPEND
 846 ;; (add-to-list 'auto-mode-alist '("\\.howm$" . text-mode) t)
 847 (setq auto-mode-alist (append auto-mode-alist
 848                               (list '("\\.howm$" . text-mode))))
 849
 850 ;; xyzzy doesn't have eval-after-load.
 851 ;; It will be useless anyway.
 852 (when (not (fboundp 'eval-after-load))
 853   (defun eval-after-load (file form)
 854     nil))
 855
 856 ;; xemacs canna doesn't use minor-mode. [2004-01-30]
 857 (defvar action-lock-mode-before-canna nil)
 858 (make-variable-buffer-local 'action-lock-mode-before-canna)
 859 (defadvice canna:enter-canna-mode (around action-lock-fix activate)
 860   (setq action-lock-mode-before-canna action-lock-mode)
 861   (setq action-lock-mode nil)
 862   ad-do-it)
 863 (defadvice canna:quit-canna-mode (around action-lock-fix activate)
 864   (setq action-lock-mode action-lock-mode-before-canna)
 865   ad-do-it)
 866
 867 ;; for mcomplete.el [2003-12-17]
 868 ;; http://homepage1.nifty.com/bmonkey/emacs/elisp/mcomplete.el
 869 ;; error when this-command is (lambda () (interactive) ...)
 870 (defadvice mcomplete-p (around symbol-check activate)
 871   (and (symbolp this-command)
 872        ad-do-it))
 873
 874 ;; for auto-save-buffers.el [2004-01-10]
 875 ;; http://www.namazu.org/~satoru/auto-save/
 876 ;; http://homepage3.nifty.com/oatu/emacs/misc.html
 877 ;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=auto%20save
 878 (defvar howm-auto-save-buffers-disposed nil)
 879 (howm-dont-warn-free-variable auto-save-buffers-regexp)
 880 (howm-dont-warn-free-variable auto-save-reject-buffers-regexp)
 881 (defun howm-auto-save-buffers-p ()
 882   (let ((f (howm-file-name)))
 883     (and (if (boundp 'auto-save-buffers-regexp)
 884              (string-match auto-save-buffers-regexp f)
 885            nil)
 886          (if (boundp 'auto-save-reject-buffers-regexp)
 887              (not (string-match auto-save-reject-buffers-regexp f))
 888            t))))
 889 (defun howm-auto-save-buffers-dispose ()
 890   (setq howm-menu-refresh-after-save nil)
 891   (setq howm-refresh-after-save nil)
 892   (setq howm-auto-save-buffers-disposed t)
 893   (message "howm: Automatic refresh is disabled when auto-save-buffers is called."))
 894 (defadvice auto-save-buffers (around howm-dispose activate)
 895   (if (or howm-auto-save-buffers-disposed
 896           (not (howm-auto-save-buffers-p)))
 897       ad-do-it
 898     (howm-auto-save-buffers-dispose)))
 899
 900 ;; howm on ChangeLog Memo
 901 (defun howm-setup-change-log ()
 902   (setq howm-keyword-format "\t* %s")
 903   (setq howm-keyword-regexp "^\t\\(\\*\\)[ \t]+\\([^:\r\n]+\\)")
 904   (setq howm-keyword-regexp-hilit-pos 1) ;; ¡Ö´ØÏ¢¥¡¼¥ï¡¼¥É¡×ÍÑ
 905   (setq howm-keyword-regexp-pos 2)
 906   (setq howm-view-title-regexp "^$")
 907   (setq howm-view-title-regexp-pos 0)
 908   (setq howm-view-title-regexp-grep 'sorry-not-yet)
 909   (setq howm-use-color nil)
 910   (setq howm-menu-top nil)
 911   (defadvice howm-exclude-p (around change-log (filename) activate)
 912     (setq ad-return-value
 913           (not (find-if (lambda (dir)
 914                           (string= (howm-file-name)
 915                                    (file-relative-name filename dir)))
 916                         (howm-search-path)))))
 917   (defadvice howm-create-file-with-title (around change-log (title) activate)
 918     (howm-create-file)
 919     (when (string-match howm-keyword-regexp title)
 920       (setq title (match-string-no-properties howm-keyword-regexp-pos
 921                                               title)))
 922     (insert title))
 923   (defadvice howm-create-file (around change-log
 924                                       (&optional keep-cursor-p) activate)
 925     (let* ((default (howm-file-name))
 926            (file (expand-file-name default howm-directory))
 927            (dir (file-name-directory file))
 928            (buffer-file-name file)) ;; don't insert file name
 929       (make-directory dir t)
 930       (add-change-log-entry nil file)))
 931   (add-hook 'change-log-mode-hook 'howm-mode)
 932   )
 933
 934 ;; howm with ChangeLog Memo
 935 (defvar howm-change-log-file-name "ChangeLog")
 936 (defun howm-to-change-log ()
 937   (interactive)
 938   (let* ((title (howm-title-at-current-point))
 939          (file (expand-file-name howm-change-log-file-name howm-directory))
 940          ;; cheat add-change-log-entry
 941          (buffer-file-name title)
 942          (default-directory howm-directory))
 943     (add-change-log-entry nil file)))
 944 (defun howm-from-change-log ()
 945   (interactive)
 946   (let* ((title-regexp "^\t[*][ \t]*\\(.*\\)$")
 947          (title-regexp-pos 1)
 948          (title (howm-title-at-current-point nil
 949                                              title-regexp title-regexp-pos)))
 950     (howm-create-file-with-title title)))
 951
 952 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 953 ;; Bug Report
 954
 955 ;; Japanese is assumed at now.
 956
 957 (defun howm-test ()
 958   "Show bug report template for howm."
 959   (howm-set-lang)
 960   (howm-bug-report))
 961
 962 (defun howm-set-lang ()
 963   (set-language-environment "Japanese")
 964   (set-default-coding-systems 'euc-jp)
 965   (set-buffer-file-coding-system 'euc-jp-unix)
 966   (set-terminal-coding-system 'euc-jp)
 967   (set-keyboard-coding-system 'euc-jp)
 968   )
 969
 970 (defun howm-compiled-p ()
 971   (byte-code-function-p (symbol-function 'howm-compiled-p)))
 972 (defun howm-make-file-p ()
 973   (eval-when-compile
 974     (getenv "HOWM_MAKE")))
 975 (defun howm-test-p ()
 976   (getenv "HOWM_TEST"))
 977
 978 (defun howm-bug-report (&optional show-sym)
 979   (interactive "P")
 980   (let ((report-buf (format-time-string "howm-bug-report-%Y%m%d-%H%M%S"))
 981         (template "sample/bug-report.txt"))
 982     (switch-to-buffer report-buf)
 983     (when (not (howm-buffer-empty-p))
 984       (error "Buffer %s exists (and not empty)." report-buf))
 985     (if (file-exists-p template)
 986         (insert-file-contents template)
 987       (insert "Please copy the following text to your bug report.\n\n"))
 988     (goto-char (point-max))
 989     (mapc (lambda (sv)
 990             (insert (format "%s: %s\n" (car sv) (cdr sv))))
 991           `(
 992             ("howm" . ,(howm-version-long))
 993             ,@(honest-report-version-assoc)
 994             ))
 995     (when (eq howm-view-use-grep t)
 996       (insert
 997        (format "grep: %s - %s\n"
 998                (cl-mapcan (lambda (d)
 999                                  (let ((f (expand-file-name
1000                                            howm-view-grep-command d)))
1001                                    (and (file-executable-p f)
1002                                         (list f))))
1003                                exec-path)
1004                (car (howm-call-process "grep" '("--version"))))))
1005     (when show-sym
1006       (goto-char (point-max))
1007       (insert "\n(List of variables)\n")
1008       (insert (howm-symbols-desc)))
1009     (goto-char (point-min))))
1010
1011 (defun howm-version-long ()
1012   (format "%s (compile: %s, make: %s, test: %s)"
1013           howm-version
1014           (howm-compiled-p)
1015           (howm-make-file-p)
1016           (howm-test-p)))
1017
1018 (defun howm-symbols-desc (&optional max-desc-len)
1019   (when (null max-desc-len)
1020     (setq max-desc-len 50))
1021   (apply #'concat
1022          (mapcar (lambda (sym)
1023                    (when (boundp sym)
1024                      (let ((v (format "%S" (symbol-value sym))))
1025                        (when (and (numberp max-desc-len)
1026                                   (< max-desc-len (length v)))
1027                          (setq v
1028                                (let* ((tl (/ max-desc-len 4))
1029                                       (hd (- max-desc-len tl)))
1030                                  (concat (substring v 0 hd)
1031                                          " ... "
1032                                          (substring v (- tl))))))
1033                        (format "%s: %s\n" (symbol-name sym) v))))
1034                  (sort (howm-symbols)
1035                        (lambda (x y)
1036                          (string< (symbol-name x) (symbol-name y)))))))
1037
1038 (defvar howm-required-features '(
1039                                 cheat-font-lock
1040                                 action-lock
1041                                 riffle
1042                                 gfunc
1043                                 illusion
1044                                 honest-report
1045                                 )
1046   "List of features which are required for, and distributed with, howm itself.")
1047
1048 (defun howm-prefix-names ()
1049   (mapcar #'symbol-name (cons 'howm howm-required-features)))
1050
1051 (defun howm-symbols ()
1052   (let* ((reg (format "^%s" (regexp-opt (howm-prefix-names) t)))
1053          (a nil))
1054     (mapatoms (lambda (s)
1055                 (when (string-match reg (symbol-name s))
1056                   (setq a (cons s a)))))
1057     a))
1058
1059 (defun howm-elp ()
1060   (interactive)
1061   (mapcar #'elp-instrument-package
1062           (howm-prefix-names)))
1063
1064 (defvar howm-sample-directory (expand-file-name "sample/")
1065   "for internal use")
1066 (defun howm-bug-shot ()
1067   (interactive)
1068   (let* ((version (concat "[howm] " (howm-version-long)))
1069          (init (and (howm-test-p)
1070                     (let ((f (expand-file-name "dot.emacs"
1071                                                howm-sample-directory)))
1072                       (and (file-readable-p f)
1073                            (with-temp-buffer
1074                              (insert-file-contents f)
1075                              (buffer-substring-no-properties (point-min)
1076                                                              (point-max)))))))
1077          (header (if init
1078                      (concat version "\n\n[init]\n" init)
1079                    version))
1080          (footer "--- your comment ---"))
1081     (honest-report header footer)
1082     (message "Please copy this buffer to your report.")))
1083
1084 ;;; howm-misc.el ends here