howm-backend.el

   1 ;;; howm-backend.el --- Wiki-like note-taking tool
   2 ;;; Copyright (C) 2005-2020
   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   (when (listp str)
 459     (if (null (cdr str))
 460         (setq str (car str))
 461       (error "Multiple patterns are not supported: %s" str)))
 462   (let ((grep-command (or (and fixed-p howm-view-fgrep-command)
 463                           howm-view-grep-command))
 464         (opt (split-string howm-view-grep-option))
 465         (eopt (and howm-view-grep-expr-option
 466                    (list howm-view-grep-expr-option)))
 467         (case-fold (or force-case-fold
 468                        (not (let ((case-fold-search nil))
 469                               (string-match "[A-Z]" str))))))
 470     (cl-labels ((add-opt (pred x) (when (and pred x) (setq opt (cons x opt)))))
 471       (add-opt case-fold howm-view-grep-ignore-case-option)
 472       (add-opt fixed-p howm-view-grep-fixed-option)
 473       (add-opt (not fixed-p) howm-view-grep-extended-option))
 474     (with-temp-buffer
 475       (let* ((fs (howm-expand-file-names file-list))
 476              (lines (howm-call-process* grep-command
 477                                         `(,@opt ,@eopt ,str) fs))
 478              (parsed (mapcar 'howm-grep-parse-line lines)))
 479         (remove nil parsed)))))
 480
 481 (defun howm-real-grep-multi (str file-list &optional fixed-p force-case-fold)
 482   (let ((grep-command (or (and fixed-p howm-view-fgrep-command)
 483                           howm-view-grep-command))
 484         (opt (split-string howm-view-grep-option))
 485         (eopt (split-string howm-view-grep-file-stdin-option)))
 486     (let* ((str-list (cond ((stringp str) (list str))
 487                            ((listp str) str)
 488                            (t (error "Wrong type: %s" str))))
 489            (caps-p (cl-member-if (lambda (s) (howm-capital-p s)) str-list))
 490            (case-fold (or force-case-fold (not caps-p))))
 491       (cl-labels ((add-opt (pred x) (when (and pred x) (setq opt (cons x opt)))))
 492         (add-opt case-fold howm-view-grep-ignore-case-option)
 493         (add-opt fixed-p howm-view-grep-fixed-option)
 494         (add-opt (not fixed-p) howm-view-grep-extended-option))
 495       (with-temp-buffer
 496         (let* ((fs (howm-expand-file-names file-list))
 497                (pat (apply #'concat
 498                            (mapcar (lambda (s) (concat s "\n")) str-list)))
 499                (lines (howm-call-process* grep-command
 500                                           `(,@opt ,@eopt) fs
 501                                           nil pat))
 502                (parsed (mapcar 'howm-grep-parse-line lines)))
 503           (remove nil parsed))))))
 504
 505 (defun howm-fake-grep (str file-list &optional fixed-p force-case-fold)
 506   "Search STR in files.
 507 Return a list ((name number str) (name number str) ...), where
 508 name is file name, number is line number, and str is line content.
 509 FILE-LIST is list of file names.
 510 If FIXED-P is non-nil, regexp search is performed.
 511 If FIXED-P is nil, fixed string search is performed.
 512 When STR has no capital letters or FORCE-CASE-FOLD is non-nil,
 513 difference of capital letters and small letters are ignored.
 514
 515 Extended feature:
 516 STR can be list of strings. They are regarded as 'or' pattern of all elements."
 517   (cl-mapcan (lambda (file)
 518                     (howm-fake-grep-file (howm-fake-grep-regexp str fixed-p)
 519                                          file force-case-fold))
 520                   (cl-mapcan #'howm-files-in-directory file-list)))
 521
 522 (defun howm-fake-grep-regexp (str &optional fixed-p)
 523   (let ((str-list (if (stringp str) (list str) str)))
 524     (if fixed-p
 525         (regexp-opt str-list)
 526       (mapconcat (lambda (s) (format "\\(%s\\)" s)) str-list "\\|"))))
 527
 528 (defun howm-fake-grep-file (reg file force-case-fold)
 529   (let ((b (get-file-buffer file)))
 530     (if (and b howm-view-watch-modified-buffer)
 531         (with-current-buffer b
 532           (howm-fake-grep-current-buffer reg file force-case-fold))
 533       (with-temp-buffer
 534         (insert-file-contents file)
 535         (howm-fake-grep-current-buffer reg file force-case-fold)))))
 536
 537 (defun howm-fake-grep-current-buffer (reg file force-case-fold)
 538   (save-excursion
 539     (save-restriction
 540       (widen)
 541       (goto-char (point-max))
 542       (let* ((found nil)
 543              (case-fold-search (or force-case-fold (not (howm-capital-p reg)))))
 544         (while (re-search-backward reg nil t)
 545           (beginning-of-line)
 546           (setq found
 547                 (cons (list file
 548                             (riffle-get-place)
 549                             (buffer-substring-no-properties (point)
 550                                                             (line-end-position)))
 551                       found)))
 552         found))))
 553
 554 (defun howm-grep-parse-line (line)
 555   (if (string-match "^\\(\\([a-zA-Z]:/\\)?[^:]*\\):\\([0-9]*\\):\\(.*\\)$"
 556                     line)
 557       (let ((file (match-string 1 line))
 558             (line (string-to-number (match-string 3 line)))
 559             (content (match-string 4 line)))
 560         (list file line content))
 561     nil))
 562
 563 ;; For backward compatibility. Don't use them any more.
 564 (defalias 'howm-view-grep #'howm-grep)
 565 (defalias 'howm-view-call-process #'howm-call-process)
 566
 567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 568 ;;; class Page
 569
 570 ;; * class Page: abstraction of file
 571
 572 ;; Fix me: confusion between 'page name' and 'file name',
 573 ;; especially for a buffer.
 574
 575 ;; (Wrong comments. Ignore me.)
 576 ;;   * folder
 577 ;;   * name
 578 ;;   * created_time
 579 ;;   * modified_time
 580 ;;   * load
 581 ;;   * save(text)
 582
 583 (defun howm-page-type (page &rest r)
 584   (cond ((stringp page) ':file)
 585         ((bufferp page) ':buf)
 586         ((null page) ':nil)
 587         ((listp page) (car page))))
 588
 589 (howm-defvar-risky howm-page-dispatchers (list #'howm-page-type))
 590
 591 (gfunc-with howm-page-dispatchers
 592   (gfunc-def howm-page-name   (page))
 593   (gfunc-def howm-page-mtime  (page))
 594   (gfunc-def howm-page-open   (page))
 595   (gfunc-def howm-page-insert (page))
 596   (gfunc-def howm-page-viewer (page))
 597   (gfunc-def howm-page-set-configuration (page))
 598   )
 599
 600 (defun howm-page= (x y)
 601   (equal x y))
 602
 603 (defun howm-page-abbreviate-name (page)
 604   (howm-abbreviate-file-name (format "%s" (howm-page-name page))))
 605
 606 (defalias 'howm-save-buffer #'save-buffer)
 607
 608 (defun howm-insert-buffer-contents (buffer)
 609   (insert (with-current-buffer buffer
 610             (save-restriction
 611               (widen)
 612               (let ((limit (point-max)))
 613                 (when howm-view-contents-limit
 614                   (setq limit (min limit howm-view-contents-limit)))
 615                 (buffer-substring-no-properties (point-min) limit))))))
 616
 617 ;; (defun howm-page-insert-range ()
 618 ;;   (let ((limit (point-max)))
 619 ;;     (when howm-view-contents-limit
 620 ;;       (setq limit (min limit howm-view-contents-limit)))
 621 ;;     (list (point-min) limit)))
 622
 623 ;; (defun howm-page-save (&optional args)
 624 ;;   (interactive "p")
 625 ;;   (with-current-buffer (get-file-buffer (howm-page-name howm-buffer-page))
 626 ;;     (apply #'save-buffer args)))
 627
 628 ;; (defun howm-save-buffer (&optional args)
 629 ;;   (interactive "p")
 630 ;;   (prog1
 631 ;;       (save-buffer args)
 632 ;;     (howm-after-save)))
 633
 634 ;;;
 635 ;;; file page: name of file
 636 ;;;
 637
 638 (defun howm-make-page:file (filename)
 639   filename)
 640
 641 (defun howm-page-name:file (page)
 642   page)
 643
 644 (defun howm-page-mtime:file (page)
 645   (nth 5 (file-attributes (howm-page-name page))))
 646
 647 (defun howm-page-open:file (page)
 648   (find-file (howm-page-name page))
 649   ;; widen is desired when corresponding file is already opened and
 650   ;; its buffer is narrowed.
 651   (widen))
 652
 653 (defun howm-page-insert:file (page)
 654   (let ((b (get-file-buffer page)))
 655     (if (and b
 656              howm-view-watch-modified-buffer
 657              (not howm-view-use-grep))
 658         (howm-insert-buffer-contents b)
 659       (howm-insert-file-contents page))))
 660
 661 (defun howm-page-viewer:file (page)
 662   (let* ((ls (lambda (dir)
 663                (with-temp-buffer
 664                  (insert-directory dir "-l")
 665                  (buffer-substring-no-properties (point-min) (point-max)))))
 666          (dir-viewer (and (file-directory-p page)
 667                           (howm-make-viewer:func #'find-file ls)))
 668          (viewer (cdr (cl-assoc-if (lambda (reg) (string-match reg page))
 669                                         howm-view-external-viewer-assoc))))
 670     (or viewer dir-viewer
 671         (and howm-view-use-mailcap
 672              (let* ((ext (if (string-match "\\.[^\\.]+$" page)
 673                              (match-string 0 page)
 674                            ""))
 675                     (type (howm-funcall-if-defined
 676                               (mailcap-extension-to-mime ext)))
 677                     (type-match (lambda (r) (string-match r type))))
 678                (cond ((null type)
 679                       nil)
 680                      ((cl-member-if type-match howm-view-open-by-myself)
 681                       nil)
 682                      (t
 683                       (howm-funcall-if-defined
 684                           (mailcap-mime-info type)))))))))
 685
 686 (defun howm-page-set-configuration:file (page)
 687   (howm-set-configuration-for-file-name page))
 688
 689 ;;;
 690 ;;; buffer page: buffer object
 691 ;;;
 692
 693 (defun howm-make-page:buf (buf)
 694   buf)
 695
 696 (defun howm-page-name:buf (page)
 697   (buffer-name page))
 698
 699 (defconst howm-dummy-mtime (encode-time 0 0 9 1 1 1970)
 700   "Dummy mtime which has no meaning.")
 701
 702 (defun howm-page-mtime:buf (page)
 703   howm-dummy-mtime)
 704
 705 (defun howm-page-open:buf (page)
 706   (switch-to-buffer page))
 707
 708 (defun howm-page-insert:buf (page)
 709   (when (not (howm-buffer-killed-p page))
 710     (howm-insert-buffer-contents page)))
 711
 712 (defun howm-page-viewer:buf (page)
 713   nil)
 714 ;;   (howm-make-viewer:func #'switch-to-buffer))
 715
 716 (defun howm-page-set-configuration:buf (page)
 717   (when (buffer-file-name page)
 718     (howm-set-configuration-for-file-name (buffer-file-name page))))
 719
 720 ;;;
 721 ;;; nil page: dummy page
 722 ;;;
 723
 724 (defun howm-make-page:nil ()
 725   nil)
 726
 727 (defun howm-page-name:nil (page)
 728   "")
 729
 730 (defun howm-page-mtime:nil (page)
 731   howm-dummy-mtime)
 732
 733 (defun howm-page-open:nil (page)
 734   "Do nothing."
 735   nil)
 736
 737 (defun howm-page-insert:nil (page)
 738   "Do nothing."
 739   nil)
 740
 741 (defun howm-page-viewer:nil (page)
 742   nil)
 743
 744 (defun howm-page-set-configuration:nil (page)
 745   "Do nothing."
 746   nil)
 747
 748 ;;;
 749 ;;; rot13file page: almost same as file except that it is rot13ed
 750 ;;;
 751
 752 (defun howm-make-page:rot13file (filename)
 753   (cons ':rot13file filename))
 754
 755 (defun howm-page-name:rot13file (page)
 756   (howm-page-name (cdr page)))
 757
 758 (defun howm-page-mtime:rot13file (page)
 759   (howm-page-mtime:file (cdr page)))
 760
 761 (defun howm-page-open:rot13file (page)
 762   (yarot13-find-file (howm-page-name page))
 763   )
 764
 765 (defun howm-page-insert:rot13file (page)
 766   (yarot13-insert-file-contents (howm-page-name page)))
 767
 768 (defun howm-page-viewer:rot13file (page)
 769   nil)
 770
 771 (defun howm-page-set-configuration:rot13file (page)
 772   (howm-set-configuration-for-file-name (howm-page-name page)))
 773
 774 ;;; Clean me.
 775
 776 ;; (defun howm-file-path (&optional time)
 777 ;;   (expand-file-name (howm-file-name time) howm-directory))
 778
 779 (defun howm-create-file (&optional keep-cursor-p)
 780   (let* ((pc (howm-folder-get-page-create howm-directory (howm-file-name)))
 781          (page (car pc))
 782          (createp (cdr pc)))
 783     (howm-page-open page)
 784     (when (not keep-cursor-p)
 785       (widen)
 786       (goto-char (point-max)))
 787     (when createp
 788       (run-hooks 'howm-create-file-hook))
 789     createp))
 790
 791 ;; (defun howm-create-file (&optional keep-cursor-p)
 792 ;;   (let* ((file (howm-file-path))
 793 ;;          (dir (file-name-directory file))
 794 ;;          (createp (not (file-exists-p file))))
 795 ;;     (make-directory dir t)
 796 ;;     (howm-page-open file)
 797 ;;     (when createp
 798 ;;       (run-hooks 'howm-create-file-hook))
 799 ;;     (when (not keep-cursor-p)
 800 ;;       (widen)
 801 ;;       (goto-char (point-max)))
 802 ;;     createp))
 803
 804 ;;; viewer
 805
 806 ;; Viewer is one of the following.
 807 ;; func    ==> (func) is called after (find-file page).
 808 ;; (func)  ==> (func page) is called.
 809 ;; (func . previewer)
 810 ;;   ==> (func page) and (previewer page) are called for open and preview
 811 ;;   (previewer must return a string).
 812 ;; "str"   ==> (format "str" page) is externally executed on shell.
 813
 814 (defun howm-viewer-type (viewer &rest r)
 815   (cond ((stringp viewer)   ':str)
 816         ((functionp viewer) ':func0)
 817         ((listp viewer)     ':func)))
 818
 819 (howm-defvar-risky howm-viewer-dispatchers (list #'howm-viewer-type))
 820
 821 (gfunc-with howm-viewer-dispatchers
 822   (gfunc-def howm-viewer-call      (viewer page))
 823   (gfunc-def howm-viewer-indicator (viewer page))
 824 )
 825
 826 (defun howm-make-viewer:func (f &optional previewer)
 827   (cons f previewer))
 828
 829 (when howm-view-use-mailcap
 830   (require 'mailcap)
 831   (howm-funcall-if-defined (mailcap-parse-mailcaps))
 832   (howm-funcall-if-defined (mailcap-parse-mimetypes)))
 833
 834 (defun howm-viewer-call:str (viewer page)
 835   (start-process "howm-view-external-viewer" nil
 836                  shell-file-name
 837                  shell-command-switch
 838                  (format viewer (howm-page-name page))))
 839 (defun howm-viewer-call:func0 (viewer page)
 840   (howm-page-open page)
 841   (funcall viewer))
 842 (defun howm-viewer-call:func (viewer page)
 843   (funcall (car viewer) page))
 844
 845 (defvar howm-viewer-indicator-format "%%%%%% %s %%%%%%")
 846 (defun howm-viewer-indicator-gen (fmt &rest args)
 847   (format howm-viewer-indicator-format
 848           (apply #'format (cons fmt args))))
 849 (defun howm-viewer-indicator:str (viewer page)
 850   (howm-viewer-indicator-gen viewer (howm-page-name page)))
 851 (defun howm-viewer-indicator:func0 (viewer page)
 852   (howm-viewer-indicator-gen "%S %S" viewer page))
 853 (defun howm-viewer-indicator:func (viewer page)
 854   (let ((func (car viewer))
 855         (previewer (cdr viewer)))
 856     (if previewer
 857         (funcall previewer page)
 858       (howm-viewer-indicator-gen "(%S %S)" func page))))
 859
 860 (defadvice action-lock-find-file (around external-viewer (f u) activate)
 861   (let ((viewer (howm-page-viewer f)))
 862     (if viewer
 863         (howm-viewer-call viewer (expand-file-name f))
 864       ad-do-it)))
 865
 866 ;; For backward compatibility. Don't use them any more.
 867 (defalias 'howm-view-external-viewer      #'howm-page-viewer)
 868 (defalias 'howm-view-call-external-viewer #'howm-viewer-call)
 869
 870 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 871 ;;; class Item
 872
 873 ;; Fix me: confusion between howm-item-page and howm-item-name
 874
 875 ;; * class Item: abstraction of hit position in file
 876 ;;   * page
 877 ;;   * place
 878 ;;   * and conventional properties
 879
 880 (defun howm-make-item (page &optional summary place offset home privilege)
 881   (list page summary place offset home privilege))
 882 (defun howm-item-page      (item) (nth 0 item)) ;; page can be nil.
 883 (defun howm-item-summary   (item) (howm-item-nth 1 item ""))
 884 (defun howm-item-place     (item) (howm-item-nth 2 item nil))
 885 (defun howm-item-offset    (item) (howm-item-nth 3 item nil))
 886 (defun howm-item-home      (item) (howm-item-nth 4 item nil))
 887 (defun howm-item-privilege (item) (howm-item-nth 5 item nil))
 888 (defun howm-item-nth (n item default)
 889   (or (nth n item) default))
 890 (defun howm-item-set-page (item val)
 891   (setf (nth 0 item) val))
 892 (defun howm-item-set-summary (item val)
 893   (setf (nth 1 item) val))
 894 (defun howm-item-set-offset (item val)
 895   (setf (nth 3 item) val))
 896 (defun howm-item-set-home (item val)
 897   (setf (nth 4 item) val))
 898 (defun howm-item-set-privilege (item val)
 899   (setf (nth 5 item) val))
 900
 901 (defun howm-item-name (item)
 902   (format "%s" (howm-page-name (howm-item-page item))))
 903
 904 (defun howm-item-dup (item) (mapcar #'identity item))
 905
 906 ;; For backward compatibility. Don't use them any more.
 907 ;; ;; item = (filename summary place offset home)
 908 (defun howm-view-make-item (filename &rest r)
 909   (apply #'howm-make-item (cons (howm-make-page:file filename) r)))
 910 (defalias 'howm-view-item-filename      #'howm-item-name)
 911 (defalias 'howm-view-item-summary       #'howm-item-summary)
 912 (defalias 'howm-view-item-place         #'howm-item-place)
 913 (defalias 'howm-view-item-offset        #'howm-item-offset)
 914 (defalias 'howm-view-item-home          #'howm-item-home)
 915 (defalias 'howm-view-item-privilege     #'howm-item-privilege)
 916 (defalias 'howm-view-item-set-summary   #'howm-item-set-summary)
 917 (defalias 'howm-view-item-set-offset    #'howm-item-set-offset)
 918 (defalias 'howm-view-item-set-home      #'howm-item-set-home)
 919 (defalias 'howm-view-item-set-privilege #'howm-item-set-privilege)
 920
 921 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 922 ;;; search path
 923
 924 ;; historical & awkward mechanism
 925
 926 (howm-defvar-risky howm-search-path nil)
 927 (defvar howm-search-other-dir nil)
 928 (defvar *howm-independent-directories* nil) ;; for internal use
 929
 930 (defun howm-independent-search-path ()
 931   (let ((c default-directory))
 932     (and c
 933          (car (cl-member-if (lambda (dir) (howm-subdirectory-p dir c))
 934                                  *howm-independent-directories*)))))
 935
 936 (defun howm-search-path (&optional ignore-independent-search-path)
 937   (let ((d (howm-independent-search-path)))
 938     (cond ((and d (not ignore-independent-search-path)) (list d))
 939           (howm-search-other-dir (howm-search-path-multi))
 940           (t (howm-search-path-single)))))
 941 (defun howm-search-path-single ()
 942   (list howm-directory))
 943 (defun howm-search-path-multi ()
 944   (cons howm-directory howm-search-path))
 945
 946 (defun howm-search-path-folder (&optional ignore-independent-search-path)
 947   (howm-make-folder:nest (howm-search-path ignore-independent-search-path)))
 948
 949 (defun howm-toggle-search-other-dir (&optional arg)
 950   "Change whether `howm-search-path' is searched or not.
 951 With arg, search `howm-search-path' iff arg is positive."
 952   (interactive "P")
 953   (setq howm-search-other-dir
 954         (if arg
 955             (> (prefix-numeric-value arg) 0)
 956           (not howm-search-other-dir)))
 957   (message "howm search-path = %s" (howm-search-path)))
 958
 959 (defun howm-open-directory-independently (dir)
 960   (interactive "DDirectory: ")
 961   (add-to-list '*howm-independent-directories*
 962                (expand-file-name dir))
 963   (let ((default-directory dir))
 964     (howm-normalize-show "" (howm-folder-items dir t))
 965     (howm-keyword-add-items (howm-view-item-list))))
 966
 967 (defvar howm-keyword-buffer-name-format " *howm-keys:%s*")
 968 (defun howm-keyword-buffer ()
 969   (let* ((dir (howm-independent-search-path))
 970          (buffer-name (format howm-keyword-buffer-name-format
 971                               (if dir (expand-file-name dir) ""))))
 972     (if dir
 973         (get-buffer-create buffer-name)
 974       (howm-get-buffer-for-file (howm-keyword-file) buffer-name))))
 975
 976 ;;; exclusion
 977
 978 ;; Fix me on inefficiency.
 979 ;;
 980 ;; [2005-02-18] I can't remember why I checked relative path in old versions.
 981 ;; [2005-04-24] Now I remember the reason.
 982 ;; Some people like ~/.howm/ rather than ~/howm/ as their howm-directory.
 983 ;; It must be included even if it matches to howm-excluded-file-regexp.
 984 ;;
 985 ;; Bug: (howm-exclude-p "~/howm/CVS") != (howm-exclude-p "~/howm/CVS/")
 986 (defun howm-exclude-p (filename)
 987   (not (cl-find-if-not
 988         (lambda (dir) (howm-folder-match-under-p dir
 989                                                  howm-excluded-file-regexp
 990                                                  filename))
 991         (howm-search-path))))
 992
 993 ;;; howm-backend.el ends here