howm-backend.el

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