OSDN Git Service

set version as 1.4.5-snapshot2
[howm/howm.git] / howm-backend.el
1 ;;; howm-backend.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2005-2018
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