howm-backend.el

   1 ;;; howm-backend.el --- Wiki-like note-taking tool
   2 ;;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016
   3 ;;;   HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
   4 ;;; $Id: howm-backend.el,v 1.50 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-backend)
  23 (require 'howm)
  24
  25 ;; in preparation at now.
  26 ;; many WRONG COMMENTS and TENTATIVE CODES.
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;; class Folder
  30
  31 (defun howm-folder ()
  32   (howm-make-folder:files (howm-search-path)))
  33
  34 ;; * class Folder: abstraction of directory
  35
  36 ;; (Wrong comments. Ignore me.)
  37 ;;   * grep(pattern, fixed, case_insensitive)
  38 ;;     * list of items
  39 ;;   * new_page
  40 ;;   * all_pages
  41 ;;   * all_keys
  42 ;;   * add_keys
  43 ;;   * keys_in(page)
  44 ;;     * This method is optional.
  45
  46 (defun howm-folder-type (folder &rest r)
  47   (cond ((stringp folder) ':dir)
  48         ((eq folder 'buf) ':buf)
  49         ((listp folder) (car folder))))
  50
  51 (howm-defvar-risky howm-folder-dispatchers (list #'howm-folder-type))
  52
  53 (gfunc-with howm-folder-dispatchers
  54   (gfunc-def howm-folder-items (folder &optional recursive-p)
  55     "All pages in FOLDER is returned as list of items.
  56 When RECURSIVE-P is non-nil, pages in subfolders are also listed.")
  57   (gfunc-def howm-folder-grep-internal (folder pattern &optional fixed-p)
  58     "In FOLDER, PATTERN is searched.
  59 Result is returned as list of items. When FIXED-P is nil, PATTERN is
  60 regarded as regular expression.")
  61   ;; need to suppor below for howm-directory
  62   (gfunc-def howm-folder-get-page-create (folder page-name)
  63     "In FOLDER, get page whose name is PAGE-NAME.
  64 If corresponding page does not exist, new page is created.
  65 Return value is a cons pair of page and flag.
  66 Flag is non-nil if new page is created.")
  67   (gfunc-def howm-folder-territory-p (folder name)
  68     "Non nil if FOLDER should own NAME.")
  69   )
  70
  71 ;; (gfunc-def-with howm-folder-dispatchers
  72 ;;   (howm-folder-items (folder &optional recursive-p)
  73 ;;     "All pages in FOLDER is returned as list of items.
  74 ;; When RECURSIVE-P is non-nil, pages in subfolders are also listed.")
  75 ;;   (howm-folder-grep-internal (folder pattern &optional fixed-p)
  76 ;;     "In FOLDER, PATTERN is searched.
  77 ;; Result is returned as list of items. When FIXED-P is nil, PATTERN is
  78 ;; regarded as regular expression.")
  79 ;;   )
  80
  81 (defun howm-folder-match-under-p (dir regexp filename)
  82   (and (eq (howm-folder-type dir) ':dir)
  83        (string-match regexp (file-relative-name filename dir))))
  84
  85 (defun howm-make-folder-from-items (items)
  86   (howm-make-folder:pages (howm-cl-remove-duplicates* (mapcar #'howm-item-page
  87                                                               items)
  88                                                       :test #'howm-page=)))
  89
  90 ;;;
  91 ;;; dir folder: single directory
  92 ;;;
  93
  94 (defun howm-make-folder:dir (dir)
  95   dir)
  96
  97 (defun howm-folder-items:dir (dir &optional recursive-p)
  98   (let ((files (if recursive-p
  99                     (howm-files-in-directory dir)
 100                  (directory-files dir t))))
 101     (howm-folder-items:files (howm-make-folder:files files))))
 102
 103 (defun howm-folder-grep-internal:dir (folder pattern &optional fixed-p)
 104   (howm-grep-items pattern folder fixed-p #'howm-exclude-p))
 105
 106 (defun howm-files-in-directory (path &optional dummy-exclusion-checker)
 107   "List files in PATH recursively, when PATH is a directory.
 108 When PATH is a file, list of it is returned.
 109 Some files and directories are ignored according to `howm-exclude-p'.
 110 DUMMY-EXCLUSION-CHECKER has no effect; it should be removed soon."
 111   (howm-files-in-directory-sub (expand-file-name path)))
 112
 113 (defun howm-files-in-directory-sub (full-path &optional under)
 114   (let* ((top-call-p (null under))
 115          (excluded-p (if top-call-p
 116                          nil
 117                        (or (howm-exclude-p full-path)
 118                            ;; exclude "." & ".."
 119                            (not (howm-subdirectory-p under full-path
 120                                                      'strict))))))
 121     (cond (excluded-p
 122            nil)
 123           ((file-directory-p full-path)
 124            (cl-mapcan (lambda (s)
 125                              (howm-files-in-directory-sub s full-path))
 126                    (directory-files full-path t)))
 127           ((file-exists-p full-path)
 128            (list full-path))
 129           (t
 130            nil))))
 131
 132 ;; ;; list files recursively
 133 ;; (defun howm-files-in-directory (dir &optional exclusion-checker)
 134 ;;   (when (null exclusion-checker)
 135 ;;     (setq exclusion-checker (lambda (x) nil)))
 136 ;;   (cond ((file-directory-p dir) (howm-files-in-directory-sub dir
 137 ;;                                                              exclusion-checker))
 138 ;;         ((file-exists-p dir) (list dir))
 139 ;;         (t nil)))
 140
 141 ;; (defun howm-files-in-directory-sub (dir exclusion-checker)
 142 ;;   (cl-mapcan (lambda (f)
 143 ;;             (cond
 144 ;;              ((funcall exclusion-checker f) nil)
 145 ;;              ((file-directory-p f) (if (howm-subdirectory-p dir f t)
 146 ;;                                        (howm-files-in-directory f exclusion-checker)
 147 ;;                                      nil)) ;; exclude "." & ".."
 148 ;;              ((file-regular-p f) (list f))
 149 ;;              (t nil)))
 150 ;;           (directory-files dir t)))
 151
 152 (defun howm-folder-get-page-create:dir (folder page-name)
 153   (let* ((file (expand-file-name page-name folder))
 154          (dir (file-name-directory file))
 155          (createp (not (file-exists-p file))))
 156     (make-directory dir t)
 157     (cons (howm-make-page:file file) createp)))
 158
 159 (defun howm-folder-territory-p:dir (folder name)
 160   (howm-subdirectory-p folder name))
 161
 162 ;;;
 163 ;;; pages folder: list of 'pages'
 164 ;;;
 165
 166 (defun howm-make-folder:pages (pages)
 167   (cons ':pages pages))
 168
 169 (defun howm-folder-pages:pages (folder)
 170   (cdr folder))
 171
 172 (defun howm-folder-items:pages (folder &optional recursive-p)
 173   (let ((summary ""))
 174     (mapcar (lambda (p) (howm-make-item p summary))
 175             (howm-folder-pages:pages folder))))
 176
 177 ;; should be removed, or renamed at least
 178 (defun howm-folder-files:pages (folder &optional exclusion-checker)
 179   (remove nil (mapcar #'howm-page-name (howm-folder-pages:pages folder))))
 180
 181 (defun howm-folder-grep-internal:pages (folder pattern &optional fixed-p)
 182   (let ((h (howm-classify #'howm-page-type (howm-folder-pages:pages folder) t)))
 183     ;; get result for each type
 184     (apply #'append (mapcar (lambda (p)
 185                               (let ((type (car p))
 186                                     (searcher (cdr p)))
 187                                 (let ((pages (reverse (cdr (assoc type h)))))
 188                                   (funcall searcher pages pattern fixed-p))))
 189                             howm-folder-grep-internal:pages-searcher))))
 190
 191 (howm-defvar-risky howm-folder-grep-internal:pages-searcher
 192   '((:file . howm-folder-grep-internal:pages-files)
 193     (:buf  . howm-folder-grep-internal:pages-buffers)))
 194 (defun howm-folder-grep-internal:pages-files (pages pattern fixed-p)
 195   (let ((files (mapcar #'howm-page-name pages)))
 196     (howm-folder-grep-internal:files (howm-make-folder:files files)
 197                                      pattern fixed-p)))
 198 (defun howm-folder-grep-internal:pages-buffers (pages pattern fixed-p)
 199   (let ((bufs pages)
 200         (r (howm-fake-grep-regexp pattern fixed-p))
 201         (c *howm-view-force-case-fold-search*))
 202     (let ((grep-result (cl-mapcan
 203                         (lambda (b)
 204                           (if (howm-buffer-killed-p b)
 205                               nil
 206                             (with-current-buffer b
 207                               (howm-fake-grep-current-buffer r b c))))
 208                         bufs)))
 209       (mapcar (lambda (g)
 210                 (let ((buf (car g))
 211                       (place (cadr g))
 212                       (content (cl-caddr g)))
 213                   (howm-make-item (howm-make-page:buf buf) content place)))
 214               grep-result))))
 215
 216 (defun howm-list-buffers (&optional all)
 217   "Show buffer list. If ALL is non-nil, hidden buffers are also listed."
 218   (interactive "P")
 219   (let* ((bufs (if all
 220                    (buffer-list)
 221                  (cl-remove-if
 222                   (lambda (b)
 223                     (let ((name (buffer-name b)))
 224                       (or (null name)
 225                           (string-match "^ " name)
 226                           (member name howm-list-buffers-exclude)
 227                           (with-current-buffer b
 228                             (member major-mode
 229                                     '(howm-view-summary-mode
 230                                       howm-view-contents-mode))))))
 231                   (buffer-list))))
 232          (pages (mapcar (lambda (b) (howm-make-page:buf b)) bufs))
 233          (folder (howm-make-folder:pages pages)))
 234     (howm-view-directory folder)))
 235 (defun howm-occur (regexp)
 236   "Show all lines in the current buffer containing a match for REGEXP."
 237   (interactive "sSearch (regexp): ")
 238   (let ((howm-view-use-grep (if howm-occur-force-fake-grep
 239                                 nil
 240                               howm-view-use-grep)))
 241     (howm-view-search-folder regexp
 242                              (howm-make-folder:pages
 243                               (list (howm-make-page:buf (current-buffer)))))))
 244 (defun howm-list-mark-ring ()
 245   "Show all marks in the current buffer."
 246   (interactive)
 247   (let* ((page (howm-make-page:buf (current-buffer)))
 248          (items (mapcar (lambda (m)
 249                           (let ((place (riffle-get-place m))
 250                                 (summary (save-excursion
 251                                            (goto-char m)
 252                                            (let ((b (line-beginning-position))
 253                                                  (e (line-end-position)))
 254                                              (buffer-substring b e)))))
 255                             (howm-make-item page summary place)))
 256                         (howm-cl-remove-duplicates*
 257                          (cons (mark-marker) mark-ring)
 258                          :test #'howm-mark-same-line-p))))
 259     (howm-view-summary "<marks>" items)))
 260 (defun howm-mark-same-line-p (m1 m2)
 261   (apply #'=
 262          (mapcar (lambda (m)
 263                    (save-excursion
 264                      (goto-char m)
 265                      (line-beginning-position)))
 266                  (list m1 m2))))
 267
 268 ;;;
 269 ;;; files folder: list of file names
 270 ;;;
 271
 272 ;;; This folder is treated specially for efficient search.
 273
 274 ;;; Fix me: [2005-02-17]
 275 ;;; Sorry. I can't remember whether 'file' means really 'file' only.
 276 ;;; It may be 'file or directory'.
 277
 278 ;; Try this to check it.
 279 ;; (setq howm-menu-top nil)
 280 ;; (setq howm-menu-file (expand-file-name "sample/0000-00-00-000000.howm"))
 281 ;; (setq howm-directory (howm-make-folder:files (mapcar (lambda (f) (expand-file-name f "sample/")) '("top.txt" "search.txt"))))
 282
 283 (defun howm-make-folder:files (files)
 284   (cons ':files files))
 285
 286 (defun howm-folder-items:files (folder &optional recursive-p)
 287   (let ((summary ""))
 288     (mapcar (lambda (f)
 289               (howm-make-item (howm-make-page:file f) summary))
 290             (howm-folder-files:files folder))))
 291
 292 (defun howm-folder-grep-internal:files (folder pattern &optional fixed-p)
 293   (howm-grep-items pattern (howm-folder-files:files folder) fixed-p))
 294
 295 ;; should be removed, or renamed at least
 296 (defun howm-folder-files:files (folder &optional exclusion-checker)
 297   (cdr folder))
 298
 299 ;;;
 300 ;;; nest folder: list of folders
 301 ;;;
 302
 303 ;; Try this to check it.
 304 ;; (setq howm-menu-top nil)
 305 ;; (setq howm-menu-file (expand-file-name "sample/0000-00-00-000000.howm"))
 306 ;; (setq howm-directory (howm-make-folder:nest (mapcar #'expand-file-name '("sample" "/usr/share/emacs/site-lisp/navi2ch"))))
 307
 308 (defun howm-make-folder:nest (list-of-folders)
 309   (cons ':nest list-of-folders))
 310
 311 (defun howm-folder-subfolders (self)
 312   (cdr self))
 313
 314 (defun howm-folder-items:nest (folder &optional recursive-p)
 315   (cl-mapcan (lambda (f) (howm-folder-items f recursive-p))
 316                   (howm-folder-subfolders folder)))
 317
 318 (defun howm-folder-grep-internal:nest (folder pattern &optional fixed-p)
 319   (cl-mapcan (lambda (f) (howm-folder-grep-internal f pattern fixed-p))
 320                   (howm-folder-subfolders folder)))
 321
 322 ;;;
 323 ;;; namazu folder: namazu index directory
 324 ;;;
 325
 326 ;; (cf.) Namazu: a Full-Text Search Engine http://www.namazu.org/index.html.en
 327
 328 ;; test:
 329 (defun howm-search-namazu (dir pattern)
 330   (interactive "Dindex directory:
 331 ssearch: ")
 332   (let ((folder (howm-make-folder:namazu (expand-file-name dir))))
 333     (howm-view-summary "<namazu>"
 334                        (howm-view-search-folder-items pattern folder))))
 335
 336 (defun howm-make-folder:namazu (index-dir)
 337   (cons ':namazu (expand-file-name index-dir)))
 338
 339 (defun howm-folder-items:namazu (folder &optional recursive-p)
 340   (let ((files (howm-folder-files:namazu folder)))
 341     (howm-folder-items:files (howm-make-folder:files files))))
 342
 343 ;; should be removed, or renamed at least
 344 (defun howm-folder-files:namazu (folder &optional exclusion-checker)
 345   (with-temp-buffer
 346     (insert-file-contents (expand-file-name "NMZ.r"
 347                                             (cdr folder)))
 348     (split-string (buffer-substring-no-properties (point-min)
 349                                                   (point-max))
 350                   "[\n\r\v]+")))
 351
 352 (defun howm-folder-grep-internal:namazu (folder pattern-list &optional fixed-p)
 353   (let* ((index-dir (cdr folder))
 354          (namazu-pattern (mapconcat #'identity pattern-list " or "))
 355          (hits (with-temp-buffer
 356                  (call-process "namazu" nil t nil
 357                                "-l" "-a" namazu-pattern index-dir)
 358                  (split-string (buffer-substring-no-properties (point-min)
 359                                                                (point-max))
 360                                "[\n\r\v]+")))
 361          (files (cl-remove-if (lambda (f) (not (file-exists-p f))) hits)))
 362     ;; grep again
 363     (let ((howm-view-use-grep nil)) ;; Japanese encoding is annoying.
 364       (howm-folder-grep-internal (howm-make-folder:files files)
 365                                  pattern-list fixed-p))))
 366
 367 ;;;
 368 ;;; rot13dir folder: almost same as dir folder except that files are rot13ed.
 369 ;;;
 370
 371 (defun howm-make-folder:rot13dir (dir)
 372   (cons ':rot13dir dir))
 373
 374 (defun howm-folder-items:rot13dir (folder &optional recursive-p)
 375   (let ((files (if recursive-p
 376                    (howm-files-in-directory (cdr folder))
 377                  (directory-files (cdr folder) t))))
 378     (mapcar (lambda (f)
 379               (howm-make-item (howm-make-page:rot13file f)))
 380             files)))
 381
 382 (defun howm-folder-grep-internal:rot13dir (folder pattern-list &optional fixed-p)
 383   (let* ((dir (cdr folder))
 384          (ps (mapcar (lambda (p) (yarot13-rotate-string p)) pattern-list))
 385          (is (howm-folder-grep-internal:dir dir ps fixed-p)))
 386     (mapc (lambda (i)
 387             (let ((file (howm-page-name (howm-item-page i)))
 388                   (summary (howm-item-summary i)))
 389               (howm-item-set-page i (howm-make-page:rot13file file))
 390               (howm-item-set-summary i (yarot13-rotate-string summary))))
 391             is)
 392     is))
 393
 394 ;;; For backward compatibility. Don't use it any more.
 395
 396 (defalias 'howm-view-directory-items  #'howm-folder-items)
 397
 398 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 399 ;;; Grep
 400
 401 ;; Fix me:
 402 ;; Name of arguments are inappropriate.
 403 ;; Pattern and str may be list of strings.
 404 ;; File-list may be a string.
 405
 406 (defun howm-folder-grep (folder pattern &optional fixed-p)
 407   (when (stringp pattern)
 408     (setq pattern (list pattern)))
 409   (howm-folder-grep-internal folder pattern fixed-p))
 410
 411 (defvar *howm-view-force-case-fold-search* nil) ;; dirty!
 412 (howm-defvar-risky howm-view-grep-log-file nil)
 413 (defvar howm-view-grep-log-format "> %s | %s")
 414
 415 (defun howm-grep-items (str file-list &optional fixed-p exclusion-checker)
 416   (let* ((found (howm-grep str file-list fixed-p))
 417          (items (mapcar (lambda (z)
 418                           (let ((file (car z))
 419                                 (place (cadr z))
 420                                 (content (cl-caddr z)))
 421                             (if (and exclusion-checker
 422                                      (funcall exclusion-checker file))
 423                                 nil
 424                               (howm-make-item file content place))))
 425                         found)))
 426     (if exclusion-checker
 427         (remove nil items)
 428       items)))
 429
 430 (defun howm-grep (str file-list &optional fixed-p)
 431   (when howm-view-grep-log-file
 432     (howm-write-log str howm-view-grep-log-format howm-view-grep-log-file))
 433   (when (stringp file-list)
 434     (setq file-list (list file-list)))
 435   (let ((grep-func (cond ((eq howm-view-use-grep t) 'howm-real-grep)
 436                          ((null howm-view-use-grep) 'howm-fake-grep)
 437                          ((functionp howm-view-use-grep) howm-view-use-grep)
 438                          (t (error "No function %s." howm-view-use-grep)))))
 439     (funcall grep-func
 440              str file-list fixed-p *howm-view-force-case-fold-search*)))
 441
 442 (defun howm-real-grep (str file-list &optional fixed-p force-case-fold)
 443   "Call grep and parse its result.
 444 '((file line-number line) (file line-number line) ...)
 445 "
 446   (if (howm-grep-multi-p)
 447       (howm-real-grep-multi str file-list fixed-p force-case-fold)
 448     (howm-real-grep-single str file-list fixed-p force-case-fold)))
 449
 450 (defun howm-grep-multi-p ()
 451   howm-view-grep-file-stdin-option)
 452
 453 ;; obsolete
 454 (defun howm-real-grep-single (str file-list
 455                                   &optional fixed-p force-case-fold)
 456   "Call grep and parse its result.
 457 '((file line-number line) (file line-number line) ...)
 458 "
 459   (when (listp str)
 460     (if (null (cdr str))
 461         (setq str (car str))
 462       (error "Multiple patterns are not supported: %s" str)))
 463   (let ((grep-command (or (and fixed-p howm-view-fgrep-command)
 464                           howm-view-grep-command))
 465         (opt (split-string howm-view-grep-option))
 466         (eopt (and howm-view-grep-expr-option
 467                    (list howm-view-grep-expr-option)))
 468         (case-fold (or force-case-fold
 469                        (not (let ((case-fold-search nil))
 470                               (string-match "[A-Z]" str))))))
 471     (cl-labels ((add-opt (pred x) (when (and pred x) (setq opt (cons x opt)))))
 472       (add-opt case-fold howm-view-grep-ignore-case-option)
 473       (add-opt fixed-p howm-view-grep-fixed-option)
 474       (add-opt (not fixed-p) howm-view-grep-extended-option))
 475     (with-temp-buffer
 476       (let* ((fs (howm-expand-file-names file-list))
 477              (lines (howm-call-process* grep-command
 478                                         `(,@opt ,@eopt ,str) fs))
 479              (parsed (mapcar 'howm-grep-parse-line lines)))
 480         (remove nil parsed)))))
 481
 482 (defun howm-real-grep-multi (str file-list &optional fixed-p force-case-fold)
 483   (let ((grep-command (or (and fixed-p howm-view-fgrep-command)
 484                           howm-view-grep-command))
 485         (opt (split-string howm-view-grep-option))
 486         (eopt (split-string howm-view-grep-file-stdin-option)))
 487     (let* ((str-list (cond ((stringp str) (list str))
 488                            ((listp str) str)
 489                            (t (error "Wrong type: %s" str))))
 490            (caps-p (cl-member-if (lambda (s) (howm-capital-p s)) str-list))
 491            (case-fold (or force-case-fold (not caps-p))))
 492       (cl-labels ((add-opt (pred x) (when (and pred x) (setq opt (cons x opt)))))
 493         (add-opt case-fold howm-view-grep-ignore-case-option)
 494         (add-opt fixed-p howm-view-grep-fixed-option)
 495         (add-opt (not fixed-p) howm-view-grep-extended-option))
 496       (with-temp-buffer
 497         (let* ((fs (howm-expand-file-names file-list))
 498                (pat (apply #'concat
 499                            (mapcar (lambda (s) (concat s "\n")) str-list)))
 500                (lines (howm-call-process* grep-command
 501                                           `(,@opt ,@eopt) fs
 502                                           nil pat))
 503                (parsed (mapcar 'howm-grep-parse-line lines)))
 504           (remove nil parsed))))))
 505
 506 (defun howm-fake-grep (str file-list &optional fixed-p force-case-fold)
 507   "Search STR in files.
 508 Return a list ((name number str) (name number str) ...), where
 509 name is file name, number is line number, and str is line content.
 510 FILE-LIST is list of file names.
 511 If FIXED-P is non-nil, regexp search is performed.
 512 If FIXED-P is nil, fixed string search is performed.
 513 When STR has no capital letters or FORCE-CASE-FOLD is non-nil,
 514 difference of capital letters and small letters are ignored.
 515
 516 Extended feature:
 517 STR can be list of strings. They are regarded as 'or' pattern of all elements."
 518   (cl-mapcan (lambda (file)
 519                     (howm-fake-grep-file (howm-fake-grep-regexp str fixed-p)
 520                                          file force-case-fold))
 521                   (cl-mapcan #'howm-files-in-directory file-list)))
 522
 523 (defun howm-fake-grep-regexp (str &optional fixed-p)
 524   (let ((str-list (if (stringp str) (list str) str)))
 525     (if fixed-p
 526         (regexp-opt str-list)
 527       (mapconcat (lambda (s) (format "\\(%s\\)" s)) str-list "\\|"))))
 528
 529 (defun howm-fake-grep-file (reg file force-case-fold)
 530   (let ((b (get-file-buffer file)))
 531     (if (and b howm-view-watch-modified-buffer)
 532         (with-current-buffer b
 533           (howm-fake-grep-current-buffer reg file force-case-fold))
 534       (with-temp-buffer
 535         (insert-file-contents file)
 536         (howm-fake-grep-current-buffer reg file force-case-fold)))))
 537
 538 (defun howm-fake-grep-current-buffer (reg file force-case-fold)
 539   (save-excursion
 540     (save-restriction
 541       (widen)
 542       (goto-char (point-max))
 543       (let* ((found nil)
 544              (case-fold-search (or force-case-fold (not (howm-capital-p reg)))))
 545         (while (re-search-backward reg nil t)
 546           (beginning-of-line)
 547           (setq found
 548                 (cons (list file
 549                             (riffle-get-place)
 550                             (buffer-substring-no-properties (point)
 551                                                             (line-end-position)))
 552                       found)))
 553         found))))
 554
 555 (defun howm-grep-parse-line (line)
 556   (if (string-match "^\\(\\([a-zA-Z]:/\\)?[^:]*\\):\\([0-9]*\\):\\(.*\\)$"
 557                     line)
 558       (let ((file (match-string 1 line))
 559             (line (string-to-number (match-string 3 line)))
 560             (content (match-string 4 line)))
 561         (list file line content))
 562     nil))
 563
 564 ;; For backward compatibility. Don't use them any more.
 565 (defalias 'howm-view-grep #'howm-grep)
 566 (defalias 'howm-view-call-process #'howm-call-process)
 567
 568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 569 ;;; class Page
 570
 571 ;; * class Page: abstraction of file
 572
 573 ;; Fix me: confusion between 'page name' and 'file name',
 574 ;; especially for a buffer.
 575
 576 ;; (Wrong comments. Ignore me.)
 577 ;;   * folder
 578 ;;   * name
 579 ;;   * created_time
 580 ;;   * modified_time
 581 ;;   * load
 582 ;;   * save(text)
 583
 584 (defun howm-page-type (page &rest r)
 585   (cond ((stringp page) ':file)
 586         ((bufferp page) ':buf)
 587         ((null page) ':nil)
 588         ((listp page) (car page))))
 589
 590 (howm-defvar-risky howm-page-dispatchers (list #'howm-page-type))
 591
 592 (gfunc-with howm-page-dispatchers
 593   (gfunc-def howm-page-name   (page))
 594   (gfunc-def howm-page-mtime  (page))
 595   (gfunc-def howm-page-open   (page))
 596   (gfunc-def howm-page-insert (page))
 597   (gfunc-def howm-page-viewer (page))
 598   (gfunc-def howm-page-set-configuration (page))
 599   )
 600
 601 (defun howm-page= (x y)
 602   (equal x y))
 603
 604 (defun howm-page-abbreviate-name (page)
 605   (howm-abbreviate-file-name (format "%s" (howm-page-name page))))
 606
 607 (defalias 'howm-save-buffer #'save-buffer)
 608
 609 (defun howm-insert-buffer-contents (buffer)
 610   (insert (with-current-buffer buffer
 611             (save-restriction
 612               (widen)
 613               (let ((limit (point-max)))
 614                 (when howm-view-contents-limit
 615                   (setq limit (min limit howm-view-contents-limit)))
 616                 (buffer-substring-no-properties (point-min) limit))))))
 617
 618 ;; (defun howm-page-insert-range ()
 619 ;;   (let ((limit (point-max)))
 620 ;;     (when howm-view-contents-limit
 621 ;;       (setq limit (min limit howm-view-contents-limit)))
 622 ;;     (list (point-min) limit)))
 623
 624 ;; (defun howm-page-save (&optional args)
 625 ;;   (interactive "p")
 626 ;;   (with-current-buffer (get-file-buffer (howm-page-name howm-buffer-page))
 627 ;;     (apply #'save-buffer args)))
 628
 629 ;; (defun howm-save-buffer (&optional args)
 630 ;;   (interactive "p")
 631 ;;   (prog1
 632 ;;       (save-buffer args)
 633 ;;     (howm-after-save)))
 634
 635 ;;;
 636 ;;; file page: name of file
 637 ;;;
 638
 639 (defun howm-make-page:file (filename)
 640   filename)
 641
 642 (defun howm-page-name:file (page)
 643   page)
 644
 645 (defun howm-page-mtime:file (page)
 646   (nth 5 (file-attributes (howm-page-name page))))
 647
 648 (defun howm-page-open:file (page)
 649   (find-file (howm-page-name page))
 650   ;; widen is desired when corresponding file is already opened and
 651   ;; its buffer is narrowed.
 652   (widen))
 653
 654 (defun howm-page-insert:file (page)
 655   (let ((b (get-file-buffer page)))
 656     (if (and b
 657              howm-view-watch-modified-buffer
 658              (not howm-view-use-grep))
 659         (howm-insert-buffer-contents b)
 660       (howm-insert-file-contents page))))
 661
 662 (defun howm-page-viewer:file (page)
 663   (let* ((ls (lambda (dir)
 664                (with-temp-buffer
 665                  (insert-directory dir "-l")
 666                  (buffer-substring-no-properties (point-min) (point-max)))))
 667          (dir-viewer (and (file-directory-p page)
 668                           (howm-make-viewer:func #'find-file ls)))
 669          (viewer (cdr (cl-assoc-if (lambda (reg) (string-match reg page))
 670                                         howm-view-external-viewer-assoc))))
 671     (or viewer dir-viewer
 672         (and howm-view-use-mailcap
 673              (let* ((ext (if (string-match "\\.[^\\.]+$" page)
 674                              (match-string 0 page)
 675                            ""))
 676                     (type (howm-funcall-if-defined
 677                               (mailcap-extension-to-mime ext)))
 678                     (type-match (lambda (r) (string-match r type))))
 679                (cond ((null type)
 680                       nil)
 681                      ((cl-member-if type-match howm-view-open-by-myself)
 682                       nil)
 683                      (t
 684                       (howm-funcall-if-defined
 685                           (mailcap-mime-info type)))))))))
 686
 687 (defun howm-page-set-configuration:file (page)
 688   (howm-set-configuration-for-file-name page))
 689
 690 ;;;
 691 ;;; buffer page: buffer object
 692 ;;;
 693
 694 (defun howm-make-page:buf (buf)
 695   buf)
 696
 697 (defun howm-page-name:buf (page)
 698   (buffer-name page))
 699
 700 (defconst howm-dummy-mtime (encode-time 0 0 9 1 1 1970)
 701   "Dummy mtime which has no meaning.")
 702
 703 (defun howm-page-mtime:buf (page)
 704   howm-dummy-mtime)
 705
 706 (defun howm-page-open:buf (page)
 707   (switch-to-buffer page))
 708
 709 (defun howm-page-insert:buf (page)
 710   (when (not (howm-buffer-killed-p page))
 711     (howm-insert-buffer-contents page)))
 712
 713 (defun howm-page-viewer:buf (page)
 714   nil)
 715 ;;   (howm-make-viewer:func #'switch-to-buffer))
 716
 717 (defun howm-page-set-configuration:buf (page)
 718   (when (buffer-file-name page)
 719     (howm-set-configuration-for-file-name (buffer-file-name page))))
 720
 721 ;;;
 722 ;;; nil page: dummy page
 723 ;;;
 724
 725 (defun howm-make-page:nil ()
 726   nil)
 727
 728 (defun howm-page-name:nil (page)
 729   "")
 730
 731 (defun howm-page-mtime:nil (page)
 732   howm-dummy-mtime)
 733
 734 (defun howm-page-open:nil (page)
 735   "Do nothing."
 736   nil)
 737
 738 (defun howm-page-insert:nil (page)
 739   "Do nothing."
 740   nil)
 741
 742 (defun howm-page-viewer:nil (page)
 743   nil)
 744
 745 (defun howm-page-set-configuration:nil (page)
 746   "Do nothing."
 747   nil)
 748
 749 ;;;
 750 ;;; rot13file page: almost same as file except that it is rot13ed
 751 ;;;
 752
 753 (defun howm-make-page:rot13file (filename)
 754   (cons ':rot13file filename))
 755
 756 (defun howm-page-name:rot13file (page)
 757   (howm-page-name (cdr page)))
 758
 759 (defun howm-page-mtime:rot13file (page)
 760   (howm-page-mtime:file (cdr page)))
 761
 762 (defun howm-page-open:rot13file (page)
 763   (yarot13-find-file (howm-page-name page))
 764   )
 765
 766 (defun howm-page-insert:rot13file (page)
 767   (yarot13-insert-file-contents (howm-page-name page)))
 768
 769 (defun howm-page-viewer:rot13file (page)
 770   nil)
 771
 772 (defun howm-page-set-configuration:rot13file (page)
 773   (howm-set-configuration-for-file-name (howm-page-name page)))
 774
 775 ;;; Clean me.
 776
 777 ;; (defun howm-file-path (&optional time)
 778 ;;   (expand-file-name (howm-file-name time) howm-directory))
 779
 780 (defun howm-create-file (&optional keep-cursor-p)
 781   (let* ((pc (howm-folder-get-page-create howm-directory (howm-file-name)))
 782          (page (car pc))
 783          (createp (cdr pc)))
 784     (howm-page-open page)
 785     (when (not keep-cursor-p)
 786       (widen)
 787       (goto-char (point-max)))
 788     (when createp
 789       (run-hooks 'howm-create-file-hook))
 790     createp))
 791
 792 ;; (defun howm-create-file (&optional keep-cursor-p)
 793 ;;   (let* ((file (howm-file-path))
 794 ;;          (dir (file-name-directory file))
 795 ;;          (createp (not (file-exists-p file))))
 796 ;;     (make-directory dir t)
 797 ;;     (howm-page-open file)
 798 ;;     (when createp
 799 ;;       (run-hooks 'howm-create-file-hook))
 800 ;;     (when (not keep-cursor-p)
 801 ;;       (widen)
 802 ;;       (goto-char (point-max)))
 803 ;;     createp))
 804
 805 ;;; viewer
 806
 807 ;; Viewer is one of the following.
 808 ;; func    ==> (func) is called after (find-file page).
 809 ;; (func)  ==> (func page) is called.
 810 ;; (func . previewer)
 811 ;;   ==> (func page) and (previewer page) are called for open and preview
 812 ;;   (previewer must return a string).
 813 ;; "str"   ==> (format "str" page) is externally executed on shell.
 814
 815 (defun howm-viewer-type (viewer &rest r)
 816   (cond ((stringp viewer)   ':str)
 817         ((functionp viewer) ':func0)
 818         ((listp viewer)     ':func)))
 819
 820 (howm-defvar-risky howm-viewer-dispatchers (list #'howm-viewer-type))
 821
 822 (gfunc-with howm-viewer-dispatchers
 823   (gfunc-def howm-viewer-call      (viewer page))
 824   (gfunc-def howm-viewer-indicator (viewer page))
 825 )
 826
 827 (defun howm-make-viewer:func (f &optional previewer)
 828   (cons f previewer))
 829
 830 (when howm-view-use-mailcap
 831   (require 'mailcap)
 832   (howm-funcall-if-defined (mailcap-parse-mailcaps))
 833   (howm-funcall-if-defined (mailcap-parse-mimetypes)))
 834
 835 (defun howm-viewer-call:str (viewer page)
 836   (start-process "howm-view-external-viewer" nil
 837                  shell-file-name
 838                  shell-command-switch
 839                  (format viewer (howm-page-name page))))
 840 (defun howm-viewer-call:func0 (viewer page)
 841   (howm-page-open page)
 842   (funcall viewer))
 843 (defun howm-viewer-call:func (viewer page)
 844   (funcall (car viewer) page))
 845
 846 (defvar howm-viewer-indicator-format "%%%%%% %s %%%%%%")
 847 (defun howm-viewer-indicator-gen (fmt &rest args)
 848   (format howm-viewer-indicator-format
 849           (apply #'format (cons fmt args))))
 850 (defun howm-viewer-indicator:str (viewer page)
 851   (howm-viewer-indicator-gen viewer (howm-page-name page)))
 852 (defun howm-viewer-indicator:func0 (viewer page)
 853   (howm-viewer-indicator-gen "%S %S" viewer page))
 854 (defun howm-viewer-indicator:func (viewer page)
 855   (let ((func (car viewer))
 856         (previewer (cdr viewer)))
 857     (if previewer
 858         (funcall previewer page)
 859       (howm-viewer-indicator-gen "(%S %S)" func page))))
 860
 861 (defadvice action-lock-find-file (around external-viewer (f u) activate)
 862   (let ((viewer (howm-page-viewer f)))
 863     (if viewer
 864         (howm-viewer-call viewer (expand-file-name f))
 865       ad-do-it)))
 866
 867 ;; For backward compatibility. Don't use them any more.
 868 (defalias 'howm-view-external-viewer      #'howm-page-viewer)
 869 (defalias 'howm-view-call-external-viewer #'howm-viewer-call)
 870
 871 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 872 ;;; class Item
 873
 874 ;; Fix me: confusion between howm-item-page and howm-item-name
 875
 876 ;; * class Item: abstraction of hit position in file
 877 ;;   * page
 878 ;;   * place
 879 ;;   * and conventional properties
 880
 881 (defun howm-make-item (page &optional summary place offset home privilege)
 882   (list page summary place offset home privilege))
 883 (defun howm-item-page      (item) (nth 0 item)) ;; page can be nil.
 884 (defun howm-item-summary   (item) (howm-item-nth 1 item ""))
 885 (defun howm-item-place     (item) (howm-item-nth 2 item nil))
 886 (defun howm-item-offset    (item) (howm-item-nth 3 item nil))
 887 (defun howm-item-home      (item) (howm-item-nth 4 item nil))
 888 (defun howm-item-privilege (item) (howm-item-nth 5 item nil))
 889 (defun howm-item-nth (n item default)
 890   (or (nth n item) default))
 891 (defun howm-item-set-page (item val)
 892   (setf (nth 0 item) val))
 893 (defun howm-item-set-summary (item val)
 894   (setf (nth 1 item) val))
 895 (defun howm-item-set-offset (item val)
 896   (setf (nth 3 item) val))
 897 (defun howm-item-set-home (item val)
 898   (setf (nth 4 item) val))
 899 (defun howm-item-set-privilege (item val)
 900   (setf (nth 5 item) val))
 901
 902 (defun howm-item-name (item)
 903   (format "%s" (howm-page-name (howm-item-page item))))
 904
 905 (defun howm-item-dup (item) (mapcar #'identity item))
 906
 907 ;; For backward compatibility. Don't use them any more.
 908 ;; ;; item = (filename summary place offset home)
 909 (defun howm-view-make-item (filename &rest r)
 910   (apply #'howm-make-item (cons (howm-make-page:file filename) r)))
 911 (defalias 'howm-view-item-filename      #'howm-item-name)
 912 (defalias 'howm-view-item-summary       #'howm-item-summary)
 913 (defalias 'howm-view-item-place         #'howm-item-place)
 914 (defalias 'howm-view-item-offset        #'howm-item-offset)
 915 (defalias 'howm-view-item-home          #'howm-item-home)
 916 (defalias 'howm-view-item-privilege     #'howm-item-privilege)
 917 (defalias 'howm-view-item-set-summary   #'howm-item-set-summary)
 918 (defalias 'howm-view-item-set-offset    #'howm-item-set-offset)
 919 (defalias 'howm-view-item-set-home      #'howm-item-set-home)
 920 (defalias 'howm-view-item-set-privilege #'howm-item-set-privilege)
 921
 922 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 923 ;;; search path
 924
 925 ;; historical & awkward mechanism
 926
 927 (howm-defvar-risky howm-search-path nil)
 928 (defvar howm-search-other-dir nil)
 929 (defvar *howm-independent-directories* nil) ;; for internal use
 930
 931 (defun howm-independent-search-path ()
 932   (let ((c default-directory))
 933     (and c
 934          (car (cl-member-if (lambda (dir) (howm-subdirectory-p dir c))
 935                                  *howm-independent-directories*)))))
 936
 937 (defun howm-search-path (&optional ignore-independent-search-path)
 938   (let ((d (howm-independent-search-path)))
 939     (cond ((and d (not ignore-independent-search-path)) (list d))
 940           (howm-search-other-dir (howm-search-path-multi))
 941           (t (howm-search-path-single)))))
 942 (defun howm-search-path-single ()
 943   (list howm-directory))
 944 (defun howm-search-path-multi ()
 945   (cons howm-directory howm-search-path))
 946
 947 (defun howm-search-path-folder (&optional ignore-independent-search-path)
 948   (howm-make-folder:nest (howm-search-path ignore-independent-search-path)))
 949
 950 (defun howm-toggle-search-other-dir (&optional arg)
 951   "Change whether `howm-search-path' is searched or not.
 952 With arg, search `howm-search-path' iff arg is positive."
 953   (interactive "P")
 954   (setq howm-search-other-dir
 955         (if arg
 956             (> (prefix-numeric-value arg) 0)
 957           (not howm-search-other-dir)))
 958   (message "howm search-path = %s" (howm-search-path)))
 959
 960 (defun howm-open-directory-independently (dir)
 961   (interactive "DDirectory: ")
 962   (add-to-list '*howm-independent-directories*
 963                (expand-file-name dir))
 964   (let ((default-directory dir))
 965     (howm-normalize-show "" (howm-folder-items dir t))
 966     (howm-keyword-add-items (howm-view-item-list))))
 967
 968 (defvar howm-keyword-buffer-name-format " *howm-keys:%s*")
 969 (defun howm-keyword-buffer ()
 970   (let* ((dir (howm-independent-search-path))
 971          (buffer-name (format howm-keyword-buffer-name-format
 972                               (if dir (expand-file-name dir) ""))))
 973     (if dir
 974         (get-buffer-create buffer-name)
 975       (howm-get-buffer-for-file (howm-keyword-file) buffer-name))))
 976
 977 ;;; exclusion
 978
 979 ;; Fix me on inefficiency.
 980 ;;
 981 ;; [2005-02-18] I can't remember why I checked relative path in old versions.
 982 ;; [2005-04-24] Now I remember the reason.
 983 ;; Some people like ~/.howm/ rather than ~/howm/ as their howm-directory.
 984 ;; It must be included even if it matches to howm-excluded-file-regexp.
 985 ;;
 986 ;; Bug: (howm-exclude-p "~/howm/CVS") != (howm-exclude-p "~/howm/CVS/")
 987 (defun howm-exclude-p (filename)
 988   (not (cl-find-if-not
 989         (lambda (dir) (howm-folder-match-under-p dir
 990                                                  howm-excluded-file-regexp
 991                                                  filename))
 992         (howm-search-path))))
 993
 994 ;;; howm-backend.el ends here