OSDN Git Service

set version as 1.4.4-snapshot
[howm/howm.git] / howm-view.el
1 ;;; howm-view.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016
3 ;;;   HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
4 ;;; $Id: howm-view.el,v 1.251 2012-12-29 08:57:18 hira Exp $
5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 1, or (at your option)
9 ;;; any later version.
10 ;;;
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; The GNU General Public License is available by anonymouse ftp from
17 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
18 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
19 ;;; USA.
20 ;;--------------------------------------------------------------------
21
22 (provide 'howm-view)
23 (require 'howm)
24
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;; variables
27
28 ;; customize
29 (defvar howm-view-summary-sep "|")
30 (defvar howm-view-summary-format
31   (let* ((path (format-time-string howm-file-name-format))
32          (width (length (file-name-nondirectory path))))
33     (concat "%-" (format "%s" (1+ width)) "s" howm-view-summary-sep " ")))
34 (defvar howm-view-header-format
35   "\n==========================>>> %s\n"
36   "Format string of header for howm-view-contents.
37 %s is replaced with file name. See `format'.")
38 (defvar howm-view-header-regexp "^==========================>>> .*$")
39 (defvar howm-view-open-recenter howm-view-search-recenter)
40 (defvar howm-view-title-header "=")
41 ;; howm-view-title-regexp is assumed to have a form "^xxxxxxx$"
42 (defvar howm-view-title-regexp (format "^%s\\( +\\(.*\\)\\|\\)$"
43                                      (regexp-quote howm-view-title-header)))
44 (defvar howm-view-title-regexp-pos 2)
45 (defvar howm-view-title-regexp-grep (format "^%s +"
46                                      (regexp-quote howm-view-title-header)))
47 (defun howm-view-title-regexp-grep ()
48   (if howm-view-use-grep
49       howm-view-title-regexp-grep
50     howm-view-title-regexp))
51
52 (howm-defvar-risky howm-view-sort-methods
53   '(("random" . howm-view-sort-by-random)
54     ("name" . howm-view-sort-by-name)
55     ("name-match" . howm-view-lift-by-name)
56     ("numerical-name" . howm-view-sort-by-numerical-name)
57     ("summary" . howm-view-sort-by-summary)
58     ("summary-match" . howm-view-lift-by-summary)
59     ("summary-match-string" . howm-view-lift-by-summary-substring)
60 ;     ("atime" . howm-view-sort-by-atime) ;; nonsense
61 ;     ("ctime" . howm-view-sort-by-ctime) ;; needless
62     ("mtime" . howm-view-sort-by-mtime)
63     ("date" . howm-view-sort-by-reverse-date)
64     ("reminder" . howm-view-sort-by-reminder)
65     ("reverse" . howm-view-sort-reverse)))
66
67 (howm-defvar-risky howm-view-filter-methods
68   '(("name" . howm-view-filter-by-name)
69     ("summary" . howm-view-filter-by-summary)
70     ("mtime" . howm-view-filter-by-mtime)
71 ;     ("ctime" . howm-view-filter-by-ctime) ;; needless
72     ("date" . howm-view-filter-by-date)
73     ("reminder" . howm-view-filter-by-reminder)
74     ("contents" . howm-view-filter-by-contents)
75     ("Region" . howm-view-filter-by-region)
76     ("Around" . howm-view-filter-by-around)
77 ;     ("uniq" . howm-view-filter-uniq))
78   ))
79
80 ;; referred only when howm-view-use-grep is nil
81 (defvar howm-view-watch-modified-buffer t)
82
83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84 ;;; item
85
86 (defun howm-view-item-basename (item &optional nonempty)
87   (let* ((f (howm-item-name item))
88          (b (file-name-nondirectory f)))
89     (if (and (string= b "") nonempty)
90         f
91       b)))
92
93 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 ;;; riffle
95
96 (defalias 'riffle-home:howm              'howm-view-item-home)
97 (defalias 'riffle-summary-item:howm      'howm-view-summary-item)
98 (defalias 'riffle-contents-item:howm     'howm-view-contents-item)
99 (defalias 'riffle-summary-set-mode:howm  'howm-view-summary-mode)
100 (defalias 'riffle-contents-set-mode:howm 'howm-view-contents-mode)
101
102 (defun riffle-summary-name-format:howm ()
103   howm-view-summary-name)
104 (defun riffle-contents-name-format:howm ()
105   howm-view-contents-name)
106 (defun riffle-post-update:howm (item)
107   (howm-message-nolog "View: %s" (howm-view-item-filename item)))
108
109 ;;; aliases
110
111 ;; Only howm-view.el should call riffle-xxx.
112 ;; Define alias if it is used in howm-xxx besides howm-view.el.
113 (defalias 'howm-view-name          #'riffle-name)          
114 (defalias 'howm-view-item-list     #'riffle-item-list)     
115 (defalias 'howm-view-line-number   #'riffle-line-number)   
116 (defalias 'howm-view-summary-check #'riffle-summary-check) 
117 (defalias 'howm-view-persistent-p  #'riffle-persistent-p)  
118 (defalias 'howm-view-kill-buffer   #'riffle-kill-buffer)   
119 (defalias 'howm-view-set-place     #'riffle-set-place)     
120 (defalias 'howm-view-get-place     #'riffle-get-place)     
121 (defalias 'howm-view-summary-current-item  #'riffle-summary-current-item)
122 (defalias 'howm-view-contents-current-item #'riffle-contents-current-item)
123 (defalias 'howm-view-summary-to-contents   #'riffle-summary-to-contents)
124 (defalias 'howm-view-restore-window-configuration #'riffle-restore-window-configuration)
125
126 ;; for howmoney.el
127 ;; http://howm.sourceforge.jp/cgi-bin/hiki/hiki.cgi?howmoney
128 (defun howm-view-get-buffer (name-format &optional name new)
129   (let ((riffle-type ':howm)) ;; cheat
130     (riffle-get-buffer name-format name new)))
131 (defun howm-view-summary-buffer (&optional new)
132   (let ((riffle-type ':howm)) ;; cheat
133     (riffle-summary-buffer new)))
134 (defalias 'howm-view-summary-show 'riffle-summary-show)
135 (defalias 'howm-view-set-item-list 'riffle-set-item-list)
136
137 ;; for howmz
138 ;; http://noir.s7.xrea.com/archives/000136.html
139 ;; http://noir.s7.xrea.com/pub/zaurus/howmz.el
140 (defalias 'howm-view-sort-items 'howm-sort)
141
142 ;;; variables
143
144 (defvar howm-view-font-lock-silent t
145   "Inhibit font-lock-verbose if non-nil.")
146 (howm-defvar-risky howm-view-summary-font-lock-keywords
147   `((,(concat "\\(^[^ \t\r\n].*?\\)" (regexp-quote howm-view-summary-sep))
148      1 howm-view-name-face)
149     ("^ +" . howm-view-empty-face)))
150 (howm-defvar-risky howm-view-contents-font-lock-keywords nil)
151
152 (howm-defvar-risky *howm-view-font-lock-keywords* nil
153   "For internal use. Don't set this variable.
154 This is a shameful global variable and should be clearned in future.")
155 (howm-defvar-risky howm-view-font-lock-keywords nil
156   "For internal use.")
157 (defvar howm-view-font-lock-first-time t
158   "For internal use.")
159 (make-variable-buffer-local 'howm-view-font-lock-keywords)
160 (make-variable-buffer-local 'howm-view-font-lock-first-time)
161
162 ;;; modes
163
164 (riffle-define-derived-mode howm-view-summary-mode riffle-summary-mode "HowmS"
165   "memo viewer (summary mode)
166 key     binding
167 ---     -------
168 \\[howm-view-summary-open]      Open file
169 \\[next-line]   Next item
170 \\[previous-line]       Previous item
171 \\[riffle-pop-or-scroll-other-window]   Pop and scroll contents
172 \\[scroll-other-window-down]    Scroll contents
173 \\[riffle-scroll-other-window]  Scroll contents one line
174 \\[riffle-scroll-other-window-down]     Scroll contents one line
175 \\[riffle-summary-to-contents]  Concatenate all contents
176 \\[howm-view-filter-uniq]       Remove duplication of same file
177 \\[howm-view-summary-shell-command]     Execute command in inferior shell
178
179 \\[delete-other-windows]        Delete contents window
180 \\[riffle-pop-window]   Pop contents window
181 \\[riffle-toggle-window]        Toggle contents window
182 \\[howm-list-toggle-title]      Show/Hide Title
183
184 \\[howm-view-filter]    Filter (by date, contents, etc.)
185 \\[howm-view-filter-by-contents]        Search (= filter by contents)
186 \\[howm-view-sort]      Sort (by date, summary line, etc.)
187 \\[howm-view-sort-reverse]      Reverse order
188 \\[howm-view-dired]     Invoke Dired-X
189 \\[describe-mode]       This help
190 \\[riffle-kill-buffer]  Quit
191 "
192   (make-local-variable 'font-lock-keywords)
193   (cheat-font-lock-mode howm-view-font-lock-silent)
194   (when howm-view-font-lock-first-time
195     (setq howm-view-font-lock-first-time nil)
196     (cheat-font-lock-merge-keywords howm-user-font-lock-keywords
197                                     howm-view-summary-font-lock-keywords
198                                     ;; dirty! Clean dependency between files.
199                                     (howm-reminder-today-font-lock-keywords)))
200   (when *howm-view-font-lock-keywords*
201     (setq howm-view-font-lock-keywords *howm-view-font-lock-keywords*))
202   (when howm-view-font-lock-keywords
203     (cheat-font-lock-merge-keywords howm-view-font-lock-keywords
204                                     howm-user-font-lock-keywords
205                                     howm-view-summary-font-lock-keywords))
206   ;; font-lock-set-defaults removes these local variables after 2008-02-24
207   (set (make-local-variable 'font-lock-keywords-only) t)
208   (set (make-local-variable 'font-lock-keywords-case-fold-search) t)
209   ;;     (setq font-lock-keywords-case-fold-search
210   ;;           howm-view-grep-ignore-case-option)
211   (cheat-font-lock-fontify)
212   )
213
214 (riffle-define-derived-mode howm-view-contents-mode riffle-contents-mode "HowmC"
215   "memo viewer (contents mode)
216 key     binding
217 ---     -------
218 \\[howm-view-contents-open]     Open file
219 \\[next-line]   Next line
220 \\[previous-line]       Previous line
221 \\[scroll-up]   Scroll up
222 \\[scroll-down] Scroll down
223 \\[riffle-scroll-up]    Scroll one line up
224 \\[riffle-scroll-down]  Scroll one line down
225 \\[riffle-contents-to-summary]  Summary
226 \\[riffle-contents-goto-next-item]      Next item
227 \\[riffle-contents-goto-previous-item]  Previous item
228
229 \\[howm-view-filter]    Filter (by date, contents, etc.)
230 \\[howm-view-filter-by-contents]        Search (= filter by contents)
231 \\[howm-view-sort]      Sort
232 \\[howm-view-sort-reverse]      Reverse order
233 \\[howm-view-dired]     Invoke Dired-X
234 \\[describe-mode]       This help
235 \\[riffle-kill-buffer]  Quit
236 "
237 ;   (kill-all-local-variables)
238   (make-local-variable 'font-lock-keywords)
239   (cheat-font-lock-mode howm-view-font-lock-silent)
240   (let ((ck `((,howm-view-header-regexp (0 howm-view-hilit-face))))
241         (sk (or (howm-view-font-lock-keywords)
242                 *howm-view-font-lock-keywords*)))
243 ;;         ;; extremely dirty!! [2003/10/06 21:08]
244 ;;         (sk (or (with-current-buffer (riffle-summary-buffer)
245 ;;                   font-lock-keywords)
246 ;;                 *howm-view-font-lock-keywords*)))
247     (cheat-font-lock-merge-keywords sk ck
248                                     howm-user-font-lock-keywords
249                                     howm-view-contents-font-lock-keywords)
250     ;; font-lock-set-defaults removes these local variables after 2008-02-24
251     (set (make-local-variable 'font-lock-keywords-only) t)
252     (set (make-local-variable 'font-lock-keywords-case-fold-search)
253          howm-view-grep-ignore-case-option)
254     (cheat-font-lock-fontify)
255     ))
256
257 (defun howm-view-font-lock-keywords ()
258   (with-current-buffer (riffle-summary-buffer)
259     howm-view-font-lock-keywords))
260
261 ;;; keymaps
262
263 ;; (defvar howm-view-summary-mode-map nil)
264 ;; (defvar howm-view-contents-mode-map nil)
265
266 (defun howm-view-define-common-key (keymap)
267   (let ((m keymap))
268 ;;     (define-key m "?" 'howm-view-help)
269     (define-key m "f" 'howm-view-filter)
270     (define-key m "G" 'howm-view-filter-by-contents)
271     (define-key m "S" 'howm-view-sort)
272     (define-key m "R" 'howm-view-sort-reverse)
273     (define-key m "q" 'howm-view-kill-buffer)
274     (define-key m "X" 'howm-view-dired)
275     ))
276
277 (let ((m howm-view-summary-mode-map))
278   (define-key m "\C-m" 'howm-view-summary-open)
279   (define-key m "\C-j" 'howm-view-summary-open)
280   (define-key m "u" 'howm-view-filter-uniq)
281   (define-key m "!" 'howm-view-summary-shell-command)
282   (define-key m "T" 'howm-list-toggle-title) ;; defined in other file. dirty!
283   ;;     (define-key m howm-reminder-quick-check-key 'howm-reminder-quick-check)
284   ;;     (define-key m ";" 'howm-view-invoke-action-lock)
285   (define-key m "\C-i" 'howm-view-summary-next-section)
286   (define-key m "\M-\C-i" 'howm-view-summary-previous-section)
287   (define-key m [tab] 'howm-view-summary-next-section)
288   (define-key m [(meta tab)] 'howm-view-summary-previous-section)
289   (howm-view-define-common-key m))
290
291 (let ((m howm-view-contents-mode-map))
292   (define-key m "\C-m" 'howm-view-contents-open)
293   (define-key m "\C-j" 'howm-view-contents-open)
294   (howm-view-define-common-key m))
295
296 ;;; summary
297
298 (defun howm-view-summary (&optional name item-list fl-keywords)
299   (let* ((*howm-view-font-lock-keywords* fl-keywords) ;; ok? [2008-07-11]
300          (r (riffle-summary name item-list ':howm
301                            (howm-view-in-background-p))))
302     (if (null r)
303         (message "No match")
304       ;; We want to entry font-lock keywords even when background-p.
305       (when *howm-view-font-lock-keywords*
306         (setq howm-view-font-lock-keywords *howm-view-font-lock-keywords*)))
307     r))
308
309 ;; (defun howm-view-summary (&optional name item-list)
310 ;;   (let ((*howm-view-font-lock-keywords* t))
311 ;;     (riffle-summary name item-list ':howm)))
312
313 (defun howm-view-summary-open (&optional reverse-delete-p)
314   (interactive "P")
315   (when (not (and howm-view-summary-keep-cursor
316                   (get-buffer-window (riffle-contents-buffer))))
317     (riffle-summary-check t))
318   (let* ((p (riffle-persistent-p howm-view-summary-persistent))
319          (persistent (if reverse-delete-p
320                          (not p)
321                        p)))
322     (howm-record-view-window-configuration)
323     (howm-view-summary-open-sub (not persistent))))
324
325 (defun howm-view-summary-open-sub (&optional kill)
326   (interactive "P")
327   (let ((b (riffle-contents-buffer))
328         (looking-at-str (buffer-substring-no-properties (point)
329                                                         (line-end-position))))
330     (riffle-pop-to-buffer b howm-view-summary-window-size)
331     (let ((howm-view-open-hook nil)) ;; Don't execute it in contents-open.
332       (howm-view-contents-open-sub kill))
333     (end-of-line)
334     (or (search-backward looking-at-str (line-beginning-position) t)
335         (beginning-of-line))
336     (run-hooks 'howm-view-open-hook)))
337
338 (defvar howm-view-summary-item-previous-name nil
339   "for internal use")
340 (defun howm-view-summary-item (item)
341   ;; Clean me. This depends on implementation of `riffle-summary-show'
342   ;; severely.
343   (when (eq (point) (point-min))
344     (setq howm-view-summary-item-previous-name ""))
345   (let* ((f (howm-item-name item))
346          (name (if (and howm-view-summary-omit-same-name
347                         (string= f howm-view-summary-item-previous-name))
348                    ""
349                  (progn
350                    (setq howm-view-summary-item-previous-name f)
351                    (howm-view-item-basename item t))))
352          (h (format howm-view-summary-format name)))
353     (concat h (howm-view-item-summary item))))
354
355 (defun howm-view-summary-next-section (&optional n)
356   (interactive "P")
357   (setq n (or n 1))
358   (let ((i (abs n))
359         (step (if (>= n 0) 1 -1)))
360     (while (and (> i 0)
361                 (howm-view-summary-next-section-sub step))
362       (setq i (1- i)))))
363 (defun howm-view-summary-previous-section (&optional n)
364   (interactive "P")
365   (setq n (or n 1))
366   (howm-view-summary-next-section (- n)))
367 (defun howm-view-summary-next-section-sub (step)
368   ;; inefficient. so what?
369   (let* ((f (lambda ()
370               (howm-view-item-filename (riffle-summary-current-item))))
371 ;;               (riffle-controller 'section (riffle-summary-current-item))))
372          (cont-p (lambda ()
373                    (save-excursion
374                      (let ((a (funcall f)))
375                        (forward-line -1)
376                        (string= a (funcall f)))))))
377     (while (and (= (forward-line step) 0)
378                 (funcall cont-p))
379       ;; no body
380       )))
381
382 ;;; contents
383
384 (defun howm-view-contents-open (&optional reverse-delete-p)
385   (interactive "P")
386   (let* ((p (riffle-persistent-p howm-view-contents-persistent))
387          (persistent (if reverse-delete-p
388                          (not p)
389                        p)))
390     (howm-record-view-window-configuration)
391     (howm-view-contents-open-sub (not persistent))))
392
393 (defvar *howm-view-item-privilege* nil) ;; dirty
394
395 (defun howm-view-contents-open-sub (&optional kill)
396   (let* ((item (riffle-contents-current-item))
397          (page (howm-item-page item))
398          (offset (howm-view-item-offset item))
399          (pos (- (point) offset))
400          (viewer (howm-view-external-viewer page)))
401     (when kill
402       (riffle-kill-buffer))
403     (when (howm-view-item-privilege item)
404       (riffle-restore-window-configuration)) ;; force without mode check
405     (setq *howm-view-item-privilege* (howm-view-item-privilege item)) ;; dirty
406     (run-hooks 'howm-view-before-open-hook)
407     (if viewer
408         (howm-view-call-external-viewer viewer page)
409       (howm-view-open-item item
410                            (lambda ()
411                              (when (or (< pos (point-min)) (<= (point-max) pos))
412                                (widen))
413                              (goto-char pos))
414                            t))
415     (run-hooks 'howm-view-open-hook)))
416
417 (defun howm-view-open-item (item &optional position-setter merely)
418   (howm-page-open (howm-item-page item))
419   (howm-view-set-mark-command)
420   (if position-setter
421       (funcall position-setter)
422     (howm-view-set-place (howm-item-place item)))
423   (recenter howm-view-open-recenter)
424   (when (not merely)
425     (howm-view-open-postprocess)))
426 (defun howm-view-open-postprocess ()
427   (run-hooks 'howm-view-open-hook))
428
429 (defvar howm-view-previous-section-page nil "For internal use")
430 (defvar howm-view-previous-section-beg nil "For internal use")
431 (defvar howm-view-previous-section-end nil "For internal use")
432
433 (defun howm-view-contents-item (item)
434   (when (howm-buffer-empty-p)
435     (setq howm-view-previous-section-page ""
436           howm-view-previous-section-beg nil
437           howm-view-previous-section-end nil))
438   (let* ((page (howm-item-page item))
439          (place (howm-view-item-place item))
440          (peq (howm-page= page howm-view-previous-section-page)) ;; dirty!
441          (done-p (if place
442                      (and peq
443                           (<= howm-view-previous-section-beg place)
444                           (<= place howm-view-previous-section-end))
445                    peq)))
446     (if done-p
447         ""
448       (let* ((header (if (null (cdr (howm-view-item-list))) ;; dirty!
449                          ""
450                        (format howm-view-header-format
451                                (howm-page-abbreviate-name page))))
452              (header-length (howm-view-string-point-count header))
453              (viewer (howm-view-external-viewer page)))
454         (concat header
455                 (howm-view-contents-item-sub item page place header viewer
456                                              (+ (point) header-length)))))))
457
458 (defvar howm-view-string-point-count-strict nil)
459 (defun howm-view-string-point-count (str)
460   "Count points of string STR.
461 Namely, it is the difference between start position and end position
462 of STR if STR is inserted to a buffer.
463 It looks to be simply equal to (length STR) on emacs-21.1.1.
464 But I'm not sure for multi-byte characters on other versions of emacsen."
465   (if howm-view-string-point-count-strict
466       (with-temp-buffer
467         (insert str)
468         (- (point) (point-min)))
469     ;; I assume (length (buffer-substring-no-properties START END))
470     ;; is equal to (abs (- START END))). Is it correct?
471     ;; (cf.) snap://Info-mode/elisp#Positions
472     (length str)))
473
474 (defun howm-view-contents-item-sub (item page place header viewer c)
475   (with-temp-buffer
476     (let (b e h)
477       (if viewer
478           (howm-view-contents-indicator viewer page)
479         (howm-page-insert page))
480       (if place
481           (progn
482             (riffle-set-place place)
483             (setq h (point))
484             (let ((r (howm-view-contents-region page)))
485               (setq b (car r)
486                     e (cadr r))))
487         (setq b (point-min)
488               e (point-max)
489               h b))
490       (howm-view-item-set-offset item (- c b))
491       (howm-view-item-set-home item (+ c (- b) h))
492       (setq howm-view-previous-section-page page ;; dirty!
493             howm-view-previous-section-beg (riffle-get-place b)
494             howm-view-previous-section-end (riffle-get-place e))
495       (buffer-substring-no-properties b e))))
496
497 (defvar howm-view-preview-narrow t)
498 (defun howm-view-contents-region (filename)
499   (when filename
500     (howm-page-set-configuration filename))
501   (if (or howm-view-preview-narrow
502           (not (riffle-preview-p)))
503       (howm-view-paragraph-region)
504     (list (point-min) (point-max))))
505
506 (defun howm-view-contents-indicator (viewer fname)
507   (insert (howm-viewer-indicator viewer fname)))
508
509 (defun howm-view-paragraph-region (&optional include-following-blank-p)
510   (let ((b (save-excursion
511              (end-of-line)
512              (re-search-backward howm-view-title-regexp
513                                  nil 'to-limit)
514              (line-beginning-position)))
515         (e (save-excursion
516              (end-of-line)
517              (let ((found (re-search-forward howm-view-title-regexp
518                                              nil 'to-limit)))
519                (if include-following-blank-p
520                    (if found (match-beginning 0) (point-max))
521                  (progn
522                    (if found
523                        (forward-line -1)
524                      (goto-char (point-max)))
525 ;                   (end-of-line)
526                    (while (and (looking-at "^$")
527                                (= (forward-line -1) 0)) ;; successful
528                      nil) ;; dummy
529                    (end-of-line)
530                    (point)))))))
531     (list b e)))
532
533 (defun howm-view-set-mark-command ()
534   (set-mark-command nil)
535   (howm-deactivate-mark))
536
537 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
538 ;;; misc.
539
540 (defun howm-view-file-list (&optional item-list)
541   (howm-cl-remove-duplicates* (mapcar #'howm-view-item-filename
542                                       (or item-list (howm-view-item-list)))
543                               :test #'howm-page=))
544
545 (defun howm-view-mtime (file)
546   (howm-view-time-to-string (howm-page-mtime file)))
547
548 ;; (defun howm-view-xtime (file x)
549 ;;   (let* ((a (file-attributes file))
550 ;;          (n (cdr (assoc x '((a . 4) (m . 5) (c . 6)))))
551 ;;          (ti (nth n a)))
552 ;;     (howm-view-time-to-string ti)))
553
554 (defun howm-view-time-to-string (ti)
555   (format-time-string "%Y%m%d-%H%M%S" ti))
556
557 (defun howm-view-string> (a b)
558   (string< b a))
559
560 (defun howm-view-string<= (a b)
561   (not (string< b a)))
562
563 (defun howm-view-string< (a b)
564   (string< a b))
565
566 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
567 ;;; dir
568
569 (defun howm-view-directory (dir &optional recursive-p)
570   (howm-view-summary "" (howm-folder-items dir recursive-p)))
571
572 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
573 ;;; filter
574
575 (defun howm-view-filter (&optional remove-p)
576   (interactive "P")
577   (let* ((table howm-view-filter-methods)
578          (command (completing-read (if remove-p
579                                        "(Reject) filter by: "
580                                      "filter by: ")
581                                    table nil t)))
582     (call-interactively (cdr (assoc command table)))))
583
584 (defun howm-view-filter-uniq ()
585   (interactive)
586   (howm-view-filter-doit #'howm-filter-items-uniq))
587
588 (defun howm-view-filter-by-name (&optional remove-p regexp)
589   (interactive "P")
590   (howm-view-filter-by-name/summary #'howm-filter-items-by-name
591                                     regexp remove-p))
592
593 (defun howm-view-filter-by-summary (&optional remove-p regexp)
594   (interactive "P")
595   (howm-view-filter-by-name/summary #'howm-filter-items-by-summary
596                                     regexp remove-p))
597
598 (defun howm-view-filter-by-name/summary (filter regexp remove-p)
599   (let* ((r (or regexp (howm-view-filter-read-from-minibuffer "Regexp: "
600                                                               remove-p)))
601          (f `(lambda (item-list rmv-p)
602                (funcall #',filter item-list ,r rmv-p))))
603     (howm-view-filter-doit f remove-p)))
604
605 (defun howm-view-filter-by-date (&optional remove-p)
606   (interactive "P")
607   (howm-view-filter-by-time-range #'howm-filter-items-by-date
608                                   remove-p))
609
610 (defun howm-view-filter-by-reminder (&optional remove-p)
611   (interactive "P")
612   (howm-view-filter-by-time-range #'howm-filter-items-by-reminder remove-p))
613
614 (defun howm-view-filter-by-mtime (&optional remove-p range)
615   (interactive "P")
616   (howm-view-filter-by-time-range #'howm-filter-items-by-mtime remove-p range))
617
618 (defun howm-view-filter-by-time-range (filter &optional remove-p range)
619   (let* ((r (or range (howm-view-ask-time-range remove-p)))
620          (from (car r))
621          (to (cadr r))
622          (f `(lambda (item-list rmv-p)
623                (funcall #',filter item-list ',from ',to rmv-p))))
624     (howm-view-filter-doit f remove-p)))
625
626 (defun howm-view-filter-by-region (beg end)
627   (interactive "r")
628   (let ((r (mapcar #'howm-view-line-number (list beg end))))
629     (howm-view-filter-by-line-range (car r) (cadr r))))
630
631 (defvar howm-view-filter-by-around-default 10)
632 (defun howm-view-filter-by-around (&optional distance)
633   (interactive "P")
634   (let* ((d (or distance howm-view-filter-by-around-default))
635          (c (howm-view-line-number)))
636     (howm-view-filter-by-line-range (- c d) (+ c d))))
637
638 (defun howm-view-filter-by-line-range (beg end)
639   (let ((f `(lambda (item-list remove-p)
640               (when remove-p
641                 (error "Not supported."))
642               ;; beg and end are counted as 1,2,3,...
643               (cl-subseq item-list
644                               (max (1- ,beg) 0)
645                               ;; end is included.
646                               (min ,end (length item-list))))))
647     (howm-view-filter-doit f)))
648
649 (defun howm-view-filter-by-contents (&optional remove-p regexp)
650   (interactive "P")
651   (let ((r (or regexp (howm-view-filter-read-from-minibuffer
652                        "Search in result (grep): "
653                        remove-p))))
654     (if remove-p
655         (howm-view-remove-by-contents r)
656       (howm-view-search-in-result r))))
657
658 (howm-if-ver1dot3 nil
659   (defcustom howm-view-search-in-result-correctly t
660     "*Non nil if search-in-result should be aware of paragraph."
661     :type 'boolean
662     :group 'howm-search))
663
664 (defun howm-view-search-in-result (regexp)
665 ;;   (interactive "sSearch in result (grep): ")
666   (let* ((orig (howm-view-name))
667          (name (if (string= orig "")
668                    regexp
669                  (format "%s&%s" orig regexp)))
670          (orig-item-list (howm-view-item-list))
671          (folder (howm-make-folder-from-items orig-item-list)))
672     (howm-write-history regexp)
673     (howm-view-search-folder regexp folder name)
674     (when howm-view-search-in-result-correctly
675       (howm-view-summary-rebuild (howm-item-list-filter (howm-view-item-list)
676                                                         orig-item-list)))))
677
678 (defun howm-view-remove-by-contents (regexp)
679 ;;   (interactive "s(Reject) Search in result (grep): ")
680   (let ((howm-v-r-b-c-regexp regexp))
681     (howm-view-sort/filter-doit
682      (lambda (item-list switch)
683        (howm-filter-items-by-contents item-list howm-v-r-b-c-regexp t)))))
684
685 (defun howm-view-sort/filter-doit (proc &optional switch)
686   (let ((kw font-lock-keywords))
687     (prog1
688         ;; return item-list for
689         ;; http://howm.sourceforge.jp/cgi-bin/hiki/hiki.cgi?HidePrivateReminder
690         (howm-view-summary-rebuild (funcall proc (howm-view-item-list) switch))
691       (setq font-lock-keywords kw))))
692
693 (defalias 'howm-view-filter-doit 'howm-view-sort/filter-doit)
694
695 ;; For backward compatibility with howmoney. Don't use this.
696 (defun howm-view-filter-general (pred)
697   (howm-view-filter-doit (lambda (item-list dummy)
698                            (cl-remove-if-not pred item-list))))
699 ;; (defun howm-view-filter-general (pred &optional remove-p with-index)
700 ;;   (let* ((item-list (howm-view-item-list))
701 ;;          (s (if with-index
702 ;;                 (howm-map-with-index #'list item-list)
703 ;;               item-list))
704 ;;          (r (if remove-p
705 ;;                 (cl-remove-if pred s)
706 ;;               (cl-remove-if-not pred s)))
707 ;;          (filtered (if with-index
708 ;;                        (mapcar #'car r)
709 ;;                      r)))
710 ;;     (howm-view-summary-rebuild filtered)))
711
712 (defmacro howm-filter-items (pred lis &optional remove-p)
713   `(if ,remove-p
714        (cl-remove-if ,pred ,lis)
715      (cl-remove-if-not ,pred ,lis)))
716
717 (defun howm-filter-items-uniq (item-list &optional remove-p)
718   (when remove-p
719     (error "Not supported."))
720   (let* ((howm-view-filter-uniq-prev (if howm-view-search-in-result-correctly
721                                          (cons "" nil)
722                                        ""))
723          (pred (if howm-view-search-in-result-correctly
724                    (lambda (item)
725                      (let ((page (howm-item-page item))
726                            (place (howm-item-place item))
727                            (range (howm-item-range item))
728                            (p-page  (car howm-view-filter-uniq-prev))
729                            (p-range (cdr howm-view-filter-uniq-prev)))
730                        (prog1
731                            (not (and (howm-page= page p-page)
732                                      (and place p-range
733                                           (<= (car p-range) place)
734                                           (<= place (cadr p-range)))))
735                          (setq howm-view-filter-uniq-prev (cons page range)))))
736                  ;; old code
737                  (lambda (item)
738                    (let ((f (howm-view-item-filename item)))
739                      (prog1
740                          (not (howm-page= f howm-view-filter-uniq-prev))
741                        (setq howm-view-filter-uniq-prev f)))))))
742     (cl-remove-if-not pred item-list)))
743
744 (defun howm-filter-items-by-name (item-list regexp &optional remove-p)
745   (howm-filter-items-by-name/summary #'howm-view-item-basename
746                                      item-list regexp remove-p))
747
748 (defun howm-filter-items-by-summary (item-list regexp &optional remove-p)
749   (howm-filter-items-by-name/summary #'howm-view-item-summary
750                                      item-list regexp remove-p))
751
752 (defun howm-filter-items-by-name/summary (accessor item-list regexp remove-p)
753   (howm-filter-items (lambda (item)
754                        (string-match regexp (funcall accessor item)))
755                      item-list remove-p))
756
757 (defun howm-filter-items-by-date (item-list from to &optional remove-p)
758   (let* ((form (howm-view-file-name-format))
759          (fts (mapcar (lambda (x)
760                         (file-name-nondirectory (format-time-string form x)))
761                       (list from to)))
762          (fs (car fts))
763          (ts (cadr fts)))
764     (howm-filter-items (lambda (item)
765                          (let ((cs (howm-view-item-basename item)))
766                            (and (howm-view-string<= fs cs)
767                                 (howm-view-string< cs ts))))
768                        item-list remove-p)))
769
770 (defun howm-filter-items-by-reminder (item-list from to &optional remove-p)
771   (let* ((from-str (format-time-string howm-date-format from))
772          (to-str (format-time-string howm-date-format to))
773          (reg (howm-reminder-regexp howm-reminder-types)))
774     (howm-filter-items
775      (lambda (item)
776        (let ((s (howm-view-item-summary item)))
777          (and (string-match reg s)
778               (let* ((x (match-string-no-properties 0 s)) ;; [2004-02-07]@
779                      (d (and (string-match howm-date-regexp x)
780                              (match-string-no-properties 0 x)))) ;; [2004-02-07]
781                 (and (howm-view-string<= from-str d)
782                      (howm-view-string< d to-str))))))
783      item-list remove-p)))
784
785 (defun howm-filter-items-by-mtime (item-list from to &optional remove-p)
786   (let ((fs (howm-view-time-to-string from))
787         (ts (howm-view-time-to-string to)))
788     (howm-filter-items
789      (lambda (item)
790        (let ((cs (howm-view-mtime (howm-view-item-filename item))))
791          (and (howm-view-string<= fs cs)
792               (howm-view-string< cs ts))))
793      item-list remove-p)))
794
795 (defun howm-filter-items-by-contents (item-list regexp &optional remove-p)
796   (let* ((match (howm-view-search-folder-items-fi regexp item-list)))
797     (if howm-view-search-in-result-correctly
798         (howm-item-list-filter item-list match remove-p)
799       ;; old behavior
800       (let ((match-names (howm-cl-remove-duplicates*
801                           (mapcar #'howm-item-name match))))
802         (howm-filter-items (lambda (item)
803                              (member (howm-item-name item) match-names))
804                            item-list remove-p)))))
805
806 (defun howm-view-file-name-format ()
807   howm-file-name-format) ;; defined in howm-common.el
808
809 (defun howm-view-ask-time-range (&optional remove-p)
810   (let* ((now (current-time))
811          (from (howm-view-ask-time "From" now t remove-p))
812          (to (howm-view-ask-time "To" from nil remove-p)))
813     (list from to)))
814
815 (defvar howm-view-min-year 1950)
816 (defvar howm-view-max-year 2030)
817 (defun howm-view-ask-time (prompt default &optional from-p remove-p)
818   (let* ((z (decode-time default))
819          (yd (nth 5 z))
820          (md (nth 4 z))
821          (dd (nth 3 z)))
822     (let (y0 m0 d0 hour0 min0 sec0)
823       (if from-p
824           (setq y0 howm-view-min-year m0 1 d0 1
825                 hour0 0 min0 0 sec0 0)
826         (setq y0 howm-view-max-year m0 12 d0 'last-day-of-month
827               hour0 24 min0 0 sec0 0))
828       (let ((y (howm-ask-time-sub prompt "year" yd remove-p)))
829         (if (null y)
830             (howm-view-encode-time sec0 min0 hour0 d0 m0 y0)
831           (let ((m (howm-ask-time-sub prompt "month" md remove-p)))
832             (if (null m)
833                 (howm-view-encode-time sec0 min0 hour0 d0 m0 y)
834               (let ((d (or (howm-ask-time-sub prompt "date" dd remove-p) d0)))
835                 (howm-view-encode-time sec0 min0 hour0 d m y)))))))))
836
837 (defun howm-ask-time-sub (prompt ymd default remove-p)
838   (let* ((message (format "%s %s (* = no limit) [%d]: " prompt ymd  default))
839          (raw (howm-view-filter-read-from-minibuffer message remove-p))
840          (n (if (string= raw "")
841                 default
842               (string-to-number raw))))
843     (if (= n 0)
844         nil
845       n)))
846
847 (defun howm-view-encode-time (sec min hour d m y)
848   (when (eq d 'last-day-of-month)
849     (setq m (+ m 1))
850     (setq d -1))
851   (encode-time sec min hour d m y))
852
853 (defun howm-view-filter-read-from-minibuffer (message &optional remove-p)
854   (read-from-minibuffer (if remove-p
855                             (concat "(Reject) " message)
856                           message)))
857
858 (defun howm-view-summary-rebuild (item-list &optional fl-keywords)
859   (howm-view-summary (howm-view-name) item-list fl-keywords))
860
861 (let* ((h (regexp-quote howm-view-title-header))
862        (t1 (format "Skip \"%s \"" howm-view-title-header))
863        (r1 (format "^\\(%s\\)? *$" h))
864        (t2 (format "Skip \"%s \" and \"[xxxx-xx-xx xx:xx]\""
865                    howm-view-title-header))
866        (r2 (format "\\(%s\\)\\|\\(^\\[[-: 0-9]+\\]\\)" r1)))
867   (howm-if-ver1dot3 nil
868     (defcustom howm-view-title-skip-regexp r2
869       "*Regular expression for lines which should not be titles.
870 If the original title matches this regexp, the first non-matched line
871 is shown as title instead.
872 Nil disables this feature.
873
874 This feature does not work when `howm-view-search-in-result-correctly' is nil."
875       :type `(radio (const :tag "Off" nil)
876                     (const :tag ,t1 ,r1)
877                     (const :tag ,t2 ,r2)
878                     regexp)
879       :group 'howm-title
880       :group 'howm-efficiency)))
881
882 (defcustom howm-view-list-title-type 1
883   "*Type of showing title in summary buffer.
884 Value 1 means \"show title instead of summary\".
885 Value 2 means \"show title before summary\".
886 You may want to set `howm-view-summary-format' to be \"\" if you never need
887 to see file names."
888   :type '(radio (const :tag "title instead of summary"
889                        1)
890                 (const :tag "title before summary"
891                        2))
892   :group 'howm-experimental)
893
894 (defun howm-view-list-title (title-regexp)
895   (howm-view-summary-rebuild (howm-entitle-items
896                               title-regexp (howm-view-item-list))))
897
898 (defun howm-entitle-items (title-regexp item-list)
899   (if (= howm-view-list-title-type 1)
900       (howm-entitle-items-style1 title-regexp item-list)
901     (howm-entitle-items-style2 title-regexp item-list)))
902
903 (defun howm-entitle-items-style1 (title-regexp item-list)
904   "Put title instead of summary."
905   (let ((items (howm-view-search-folder-items-fi title-regexp item-list)))
906     (if howm-view-search-in-result-correctly
907         (let* ((r (howm-item-list-filter items item-list 'with-rest))
908                (hit-items (car r))
909                (nohit-items (cdr r))
910                ;; should I use (howm-classify #'howm-item-place nohit-items) ?
911                (noplace-nohit-items
912                 (cl-remove-if #'howm-item-place nohit-items))
913                (rest-items
914                 (howm-item-list-filter (cl-remove-if-not #'howm-item-place
915                                                               nohit-items)
916                                        items t))
917                (all-items (append hit-items noplace-nohit-items rest-items)))
918           (when howm-view-title-skip-regexp
919             (mapc #'howm-view-change-title all-items))
920           all-items)
921       (let* ((pages (howm-cl-remove-duplicates* (mapcar #'howm-item-page
922                                                         item-list)))
923              (hit-pages (mapcar #'howm-item-page items))
924              (nohit-pages (cl-remove-if
925                            (lambda (p) (cl-member p hit-pages
926                                                         :test #'howm-page=))
927                            pages))
928              (nohit-items (mapcar #'howm-make-item nohit-pages))
929              (all-items (if (null nohit-items)
930                             items
931                           (append items nohit-items))))
932         all-items))))
933
934 (defvar howm-entitle-items-style2-max-length 20)
935 (defvar howm-entitle-items-style2-format "%-13s | %s") ;; for title and summary
936 (defvar howm-entitle-items-style2-title-line nil) ;; independent title line?
937 (defun howm-entitle-items-style2 (title-regexp item-list)
938   "Put title before summary."
939   ;; fix me: howm-item-place is not set for howm-list-all
940   (let ((last-title ""))
941     (cl-mapcan
942      (lambda (item)
943        (let ((orig (howm-item-summary item))
944              (titles (howm-item-titles item)))
945          (cl-mapcan
946           (lambda (s)
947             (if (string= s last-title)
948                 (setq s "")
949               (setq last-title s))
950             (when (> (length s) howm-entitle-items-style2-max-length)
951               (setq s (substring s 0 howm-entitle-items-style2-max-length)))
952             (mapcar (lambda (x)
953                       (let ((i (howm-item-dup item)))
954                         (howm-item-set-summary i x)
955                         i))
956                     (if (and howm-entitle-items-style2-title-line
957                              (not (string= s "")))
958                         (list (format howm-entitle-items-style2-format
959                                       s "")
960                               (format howm-entitle-items-style2-format
961                                       "" orig))
962                       (list (format howm-entitle-items-style2-format
963                                     s orig)))))
964           (or titles (list "")))))
965      item-list)))
966
967 ;;; detect items in same paragraph (= entry = memo. sorry for inconsistent terminology)
968
969 (defun howm-item-with-temp-buffer (item proc)
970   (with-temp-buffer
971     (howm-page-insert (howm-item-page item))
972     (let* ((p (howm-item-place item))
973            (r (if (null p)
974                   (list (point-min) (point-max))
975                 (progn
976                   (riffle-set-place p)
977                   (howm-view-paragraph-region)))))
978       (narrow-to-region (car r) (cadr r))
979       (funcall proc item))))
980
981 (defun howm-item-titles (item)
982   "List of titles of ITEM.
983 When place (see `howm-item-place') is specified, ITEM has at most one title.
984 Otherwise, ITEM can have two or more titles."
985   (howm-item-with-temp-buffer
986    item
987    (lambda (i)
988      (let ((titles nil))
989        (goto-char (point-min))
990        (while (re-search-forward (howm-list-title-regexp) nil t)
991          (setq titles
992                (cons (buffer-substring-no-properties (match-beginning 0)
993                                                      (line-end-position))
994                      titles)))
995        (mapcar (lambda (x)
996                  (if (string-match howm-view-title-regexp x)
997                      (match-string-no-properties howm-view-title-regexp-pos x)
998                    x))
999                (reverse titles))))))
1000
1001 (defun howm-item-range (item)
1002   "List of beginning-place and end-place of paragraph to which ITEM belongs."
1003   (howm-item-with-temp-buffer
1004    item
1005    (lambda (i)
1006      (let ((r (list (point-min) (point-max))))
1007        (widen)
1008        (list (progn
1009                (goto-char (car r))
1010                (riffle-get-place))
1011              (progn
1012                (goto-char (cadr r))
1013                (riffle-get-place)))))))
1014 ;;   (with-temp-buffer
1015 ;;     (howm-page-insert (howm-item-page item))
1016 ;;     (let* ((p (howm-item-place item))
1017 ;;            (r (if (null p)
1018 ;;                   (list (point-min) (point-max))
1019 ;;                 (progn
1020 ;;                   (riffle-set-place p)
1021 ;;                   (howm-view-paragraph-region)))))
1022 ;;       (list (progn
1023 ;;               (goto-char (car r))
1024 ;;               (riffle-get-place))
1025 ;;             (progn
1026 ;;               (goto-char (cadr r))
1027 ;;               (riffle-get-place))))))
1028
1029 (defun howm-item-list-rangeset (item-list)
1030   "Make assoc list of page to rangeset.
1031 ITEM-LIST is list of items.
1032 Return value is assoc list; each element of it is a cons pair of page
1033 and rangeset which indicates ranges of places of paragraphs to which items
1034 in ITEM-LIST belongs."
1035   (let ((alist nil))  ;; key = page, value = rangeset of place
1036     (cl-labels ((add-to-alist (page rs)
1037                            (setq alist (cons (cons page rs) alist))))
1038       (mapc (lambda (item)
1039               (let* ((page (howm-item-page item))
1040                      (place (howm-item-place item))
1041                      (rs (cdr (assoc page alist))))
1042                 (cond ((null place)
1043                        (add-to-alist page (howm-make-rangeset)))
1044                       ((null rs)
1045                        (add-to-alist page (howm-make-rangeset
1046                                            (howm-item-range item))))
1047                       ((howm-rangeset-belong-p place rs)
1048                        nil) ;; do nothing
1049                       (t
1050                        (howm-rangeset-add! rs (howm-item-range item))))))
1051             item-list)
1052       alist)))
1053
1054 (defun howm-item-list-filter (item-list reference-item-list
1055                                         &optional remove-match)
1056   "Select items in ITEM-LIST according to REFERENCE-ITEM-LIST.
1057 When REMOVE-MATCH is nil, return value is list of items i in ITEM-LIST
1058 which satisfy the condition \"there exists i' in REFERENCE-ITEM-LIST
1059 such that i and i' belong to same paragraph\" (case 1).
1060 When REMOVE-MATCH is non-nil and not the symbol 'with-rest',
1061 return value is complement of the above list;
1062 list of items in ITEM-LIST which do not satisfy the above condition (case 2).
1063 When REMOVE-MATCH is the symbol 'with-rest',
1064 return value is (A . B), where A is the return value of case 1 and
1065 B is items in REFERENCE-ITEM-LIST that do not match in case 1."
1066   ;; 
1067   ;; split no-place items:
1068   ;; Though implementation 1 calls grep many times,
1069   ;; implementation 2 is slower in construction of folder from items.
1070   ;; [2012-12-28]
1071   ;; 
1072   ;; implementation 1 (call grep many times)
1073   (setq item-list
1074         (cl-mapcan (lambda (item)
1075                           (if (howm-item-place item)
1076                               (list item)
1077                             (or (howm-view-search-folder-items-fi
1078                                  (howm-view-title-regexp-grep) (list item))
1079                                 (list item))))
1080                         item-list))
1081   ;; 
1082   ;; ;; implementation 2 (making items-folder is slow)
1083   ;; (let* ((place-items (cl-remove-if-not #'howm-item-place item-list))
1084   ;;        (no-place-items (cl-remove-if #'howm-item-place item-list))
1085   ;;        (split-items (howm-view-search-folder-items-fi
1086   ;;                      (howm-view-title-regexp-grep) no-place-items))
1087   ;;        ;;; !!!!!!!!! use CL !!!!!!!!!!!!!!!!!!!!!!!!!!!!
1088   ;;        (no-title-items (set-difference no-place-items split-items
1089   ;;                                        :key #'howm-item-page)))
1090   ;;   (setq item-list (append place-items split-items no-title-items)))
1091   ;;
1092   (let* ((alist (howm-item-list-rangeset reference-item-list))
1093          (matcher (lambda (item)
1094                     (let* ((page (howm-item-page item))
1095                            (place (howm-item-place item))
1096                            (rs (cdr (assoc page alist))))
1097                       (cond ((null rs) nil)
1098                             ((howm-rangeset-belong-p place rs) rs)
1099                             (t nil))))))
1100     (cond ((eq remove-match 'with-rest)
1101            (let ((match (cl-remove-if-not
1102                          (lambda (item)
1103                            (let ((rs (funcall matcher item)))
1104                              (and rs (howm-rangeset-hit! rs))))
1105                          item-list)))
1106              (cons match
1107                    (cl-mapcan
1108                     (lambda (a) (and (not (howm-rangeset-hit-p (cdr a)))
1109                                      (list (howm-make-item (car a)))))
1110                     alist))))
1111           (remove-match (cl-remove-if matcher item-list))
1112           (t (cl-remove-if-not matcher item-list)))))
1113
1114 ;;; rangeset
1115 ;;; ex.
1116 ;;; (*rangeset* (1 . 4) (5 . 6) (8 . 14))
1117 ;;; (*rangeset*) ==> "almighty"
1118 ;;; (*rangeset-hit* (1 . 4) (5 . 6) (8 . 14)) ==> "hit" is recorded
1119
1120 (defun howm-make-rangeset (&optional beg-end)
1121   (if (null beg-end)
1122       (cons '*rangeset* nil)
1123     (let ((rs (howm-make-rangeset)))
1124       (howm-rangeset-add! rs beg-end))))
1125
1126 (defun howm-rangeset-belong-p (point rs)
1127   (or (null (cdr rs))
1128       (cl-member-if (lambda (pair)
1129                            (and (<= (car pair) point) (<= point (cdr pair))))
1130                          (cdr rs))))
1131
1132 (defun howm-rangeset-add! (rs beg-end)
1133   ;; "almighty" is ignored here. sorry for confusion...
1134   ;; c = cursor (pointing its cdr)
1135   ;; p = pair
1136   (let ((c rs)
1137         (beg (car beg-end))
1138         (end (cadr beg-end)))
1139     (while (and (cdr c) beg)
1140       (let ((p (cadr c)))
1141         (cond ((< end (car p)) ;; insert [beg, end] here
1142                (rplacd c (cons (cons beg end) (cdr c)))
1143                (setq beg nil))
1144               ((< (cdr p) beg) ;; skip this
1145                (setq c (cdr c)))
1146               (t ;; merge into [beg, end]
1147                (setq beg (min beg (car p))
1148                      end (max end (cdr p)))
1149                (rplacd c (cddr c))))))
1150     (when beg
1151       (rplacd c (list (cons beg end)))))
1152   rs)
1153
1154 (defvar howm-rangeset-hit-indicator '*rangeset-hit*)
1155
1156 (defun howm-rangeset-hit! (rs)
1157   (setcar rs howm-rangeset-hit-indicator))
1158
1159 (defun howm-rangeset-hit-p (rs)
1160   (eq (car rs) howm-rangeset-hit-indicator))
1161
1162 ;; check
1163
1164 (let ((tests '(
1165                (()
1166                 ())
1167                (((3 . 5))
1168                 ((3 . 5)))
1169                (((3 . 5) (0 . 1))
1170                 ((0 . 1) (3 . 5)))
1171                (((3 . 5) (6 . 8))
1172                 ((3 . 5) (6 . 8)))
1173                (((3 . 5) (1 . 4))
1174                 ((1 . 5)))
1175                (((3 . 5) (4 . 7))
1176                 ((3 . 7)))
1177                (((3 . 5) (1 . 9))
1178                 ((1 . 9)))
1179                (((3 . 1) (4 . 1) (5 . 9))
1180                 ((1 . 4) (5 . 9)))
1181                (((3 . 1) (4 . 1) (5 . 9) (2 . 6) (5 . 3))
1182                 ((1 . 9)))
1183                ))
1184        ;; inhibit 'reference to free variable' warning in byte-compilation
1185       (check nil))
1186   (cl-labels ((check (ans result)
1187                   (cond ((null ans) (null result))
1188                         ((not (equal (car ans) (car result))) nil)
1189                         (t (funcall check (cdr ans) (cdr result))))))
1190     (mapc (lambda (z)
1191             (apply (lambda (prob ans)
1192                      (let* ((rs (howm-make-rangeset)))
1193                        (mapc (lambda (pair)
1194                                (let ((a (car pair))
1195                                      (b (cdr pair)))
1196                                  (howm-rangeset-add! rs
1197                                                      (list (min a b)
1198                                                            (max a b)))))
1199                              prob)
1200                        (when (not (equal (cdr rs) ans))
1201                          (error "howm-rangeset-add: %s ==> %s" prob rs))))
1202                    z))
1203           tests)))
1204
1205 (let ((rs '(*rangeset* (1 . 4) (5 . 6) (8 . 14))))
1206   (if (and (howm-rangeset-belong-p 1 rs)
1207            (howm-rangeset-belong-p 3 rs)
1208            (howm-rangeset-belong-p 4 rs)
1209            (howm-rangeset-belong-p 5 rs)
1210            (not (howm-rangeset-belong-p 0 rs))
1211            (not (howm-rangeset-belong-p 4.5 rs))
1212            (not (howm-rangeset-belong-p 7 rs))
1213            (not (howm-rangeset-belong-p 15 rs)))
1214       t
1215     (error "howm-rangeset-belong-p: wrong result")))
1216
1217 (defun howm-view-change-title (item)
1218   (when (string-match howm-view-title-skip-regexp (howm-item-summary item))
1219     (let ((title-line (with-temp-buffer
1220                         (howm-page-insert (howm-item-page item))
1221                         (howm-view-set-place (or (howm-item-place item)
1222                                                  (howm-view-get-place
1223                                                   (point-min))))
1224                         (howm-view-get-title-line))))
1225       (howm-item-set-summary item title-line))))
1226
1227 (defun howm-view-get-title-line ()
1228   (while (and (looking-at howm-view-title-skip-regexp)
1229               (= (forward-line 1) 0))
1230     ;; do nothine
1231     )
1232   (buffer-substring-no-properties (line-beginning-position)
1233                                   (line-end-position)))
1234
1235 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1236 ;;; search
1237
1238 (defun howm-view-search (str file-list &optional
1239                              name summarizer fixed-p hilit-keywords)
1240   "This function is not used in howm any more."
1241   (howm-view-search-folder str (howm-make-folder:files file-list)
1242                            name summarizer fixed-p hilit-keywords))
1243
1244 (defun howm-view-search-items (str file-list &optional summarizer fixed-p)
1245   (howm-view-search-folder-items str (howm-make-folder:files file-list)
1246                                  summarizer fixed-p))
1247
1248 (defun howm-view-search-folder (&rest args)
1249   (howm-view-search-folder-doit (apply #'howm-view-search-folder-internal
1250                                        args)))
1251
1252 (defun howm-view-search-folder-internal (str folder
1253                                              &optional name summarizer
1254                                              fixed-p hilit-keywords)
1255   ;; clean me. str-orig can be string or list of strings.
1256   (let* ((str-orig str)
1257          (str-list (if (listp str-orig) str-orig (list str-orig)))
1258          (str-principal (if (listp str-orig) (car str-orig) str-orig)))
1259     ;; rename str
1260     (setq str str-principal)
1261     (setq name (or name str))
1262     (when howm-view-update-search-ring
1263       (isearch-update-ring str (not fixed-p)))
1264     (let* ((items (howm-view-search-folder-items str-orig
1265                                                  folder summarizer fixed-p))
1266            (kw (or hilit-keywords
1267                    (let ((r (if fixed-p
1268                                 (regexp-opt str-list)
1269                               (mapconcat (lambda (x) (concat "\\(" x "\\)"))
1270                                          str-list
1271                                          "\\|"))))
1272                      `((,r . howm-view-hilit-face))))))
1273       (let* ((f (expand-file-name str)))
1274         (when (file-exists-p f)
1275           (let ((fi (howm-view-make-item f)))
1276             (howm-view-item-set-privilege fi t)
1277             (setq items (cons fi items)))))
1278       (list kw name items))))
1279
1280 (defun howm-view-search-folder-doit (p)
1281   (howm-view-summary (cadr p) (cl-caddr p) (car p)))
1282
1283 (defun howm-view-search-folder-items (str folder &optional summarizer fixed-p)
1284   (let ((found (howm-folder-grep folder str fixed-p))
1285         (summarizer (or summarizer
1286                         (lambda (file place content)
1287                           (string-match "^ *\\(.*\\)" content)
1288                           (match-string-no-properties 1 content)))))
1289     (mapc (lambda (i)
1290             (let ((file (howm-page-name (howm-item-page i)))
1291                   (place (howm-item-place i))
1292                   (content (howm-item-summary i)))
1293               (howm-item-set-summary i (funcall summarizer
1294                                                 file place content))))
1295           found)
1296     found))
1297
1298 ;; sorry for confusing functions...
1299
1300 (defun howm-view-search-folder-items-fi (regexp item-list &rest args)
1301   (apply #'howm-view-search-folder-items
1302          regexp (howm-make-folder-from-items item-list) args))
1303
1304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1305 ;;; sort
1306
1307 (defun howm-view-sort ()
1308   (interactive)
1309   (let* ((table howm-view-sort-methods)
1310          (command (completing-read "sort by: " table nil t)))
1311     (call-interactively (cdr (assoc command table)))))
1312
1313 (defmacro howm-view-defun-sort-by (name)
1314   "Define an interactive command howm-view-sort-by-NAME,
1315 which simply calls howm-sort-items-by-NAME."
1316   (let ((command (howm-get-symbol nil "howm-view-sort-by-" name))
1317         (internal (howm-get-symbol nil "howm-sort-items-by-" name)))
1318     `(defun ,command (&optional reverse-p)
1319        (interactive "P")
1320        (howm-view-sort-doit #',internal reverse-p))))
1321 (howm-view-defun-sort-by "random")
1322 (howm-view-defun-sort-by "name")
1323 (howm-view-defun-sort-by "numerical-name")
1324 (howm-view-defun-sort-by "date")
1325 (howm-view-defun-sort-by "reverse-date")
1326 (howm-view-defun-sort-by "summary")
1327 (howm-view-defun-sort-by "reminder")
1328 (howm-view-defun-sort-by "mtime")
1329 (howm-view-defun-sort-by "reverse")
1330
1331 (defalias 'howm-view-sort-reverse 'howm-view-sort-by-reverse)
1332
1333 (defalias 'howm-view-sort-doit 'howm-view-sort/filter-doit)
1334
1335 (defmacro howm-sort-items (evaluator comparer item-list
1336                                              &optional reverse-p)
1337   `(let* ((howm-view-s-i-comparer ,comparer)
1338           (cmp (if reverse-p
1339                    (lambda (a b) (funcall howm-view-s-i-comparer b a))
1340                  howm-view-s-i-comparer)))
1341      (howm-sort ,evaluator cmp item-list)))
1342
1343 ;; ;; generate the below aliases for howm-test080714
1344 ;; (let ((methods '("random" "name" "numerical-name" "date" "reverse-date"
1345 ;;                  "summary" "reminder" "mtime" "reverse")))
1346 ;;   (mapcar (lambda (m)
1347 ;;             (let* ((command
1348 ;;                     (howm-get-symbol nil "howm-view-sort-by-" m))
1349 ;;                    (internal
1350 ;;                     (howm-get-symbol nil "howm-sort-items-by-" m))
1351 ;;                    (obsolete
1352 ;;                     (howm-get-symbol nil command "-internal")))
1353 ;;               `(defalias ',obsolete ',internal)))
1354 ;;           methods))
1355
1356 ;; for backward compatibility with howm-test080714 only
1357 (defalias 'howm-view-sort-by-random-internal 'howm-sort-items-by-random)
1358 (defalias 'howm-view-sort-by-name-internal 'howm-sort-items-by-name)
1359 (defalias 'howm-view-sort-by-numerical-name-internal
1360   'howm-sort-items-by-numerical-name)
1361 (defalias 'howm-view-sort-by-date-internal 'howm-sort-items-by-date)
1362 (defalias 'howm-view-sort-by-reverse-date-internal
1363   'howm-sort-items-by-reverse-date)
1364 (defalias 'howm-view-sort-by-summary-internal 'howm-sort-items-by-summary)
1365 (defalias 'howm-view-sort-by-reminder-internal 'howm-sort-items-by-reminder)
1366 (defalias 'howm-view-sort-by-mtime-internal 'howm-sort-items-by-mtime)
1367 (defalias 'howm-view-sort-by-reverse-internal 'howm-sort-items-by-reverse)
1368
1369 (defun howm-sort-items-by-random (item-list &optional reverse-p)
1370   (howm-sort-items #'(lambda (dummy) (random)) #'< item-list reverse-p))
1371
1372 (defun howm-sort-items-by-name (item-list &optional reverse-p)
1373   (howm-sort-items #'howm-view-item-basename #'string< reverse-p))
1374
1375 (defun howm-sort-items-by-numerical-name (item-list &optional reverse-p)
1376   (howm-sort-items (lambda (i)
1377                              (let ((b (howm-view-item-basename i)))
1378                                (if (string-match "^[0-9]+$" b)
1379                                    (string-to-number b)
1380                                  howm-infinity)))
1381                            #'< reverse-p))
1382
1383 (defvar howm-view-sort-by-date-ignore-regexp "^[a-zA-Z]")
1384 (defun howm-sort-items-by-date (item-list &optional reverse-p)
1385   (let ((sorted (howm-sort-items #'howm-view-item-basename #'string<
1386                                          item-list reverse-p)))
1387     (cdr (howm-view-lift-internal #'howm-view-item-basename
1388                                   sorted
1389                                   howm-view-sort-by-date-ignore-regexp
1390                                   t))))
1391
1392 (defun howm-sort-items-by-reverse-date (item-list &optional reverse-p)
1393   (howm-sort-items-by-date item-list (not reverse-p)))
1394
1395 (defun howm-sort-items-by-summary (item-list &optional reverse-p)
1396   (howm-sort-items #'howm-view-item-summary #'string<
1397                            item-list reverse-p))
1398
1399 (defun howm-sort-items-by-reminder (item-list &optional reverse-p)
1400   (let* ((howm-view-s-b-r-i-regexp (howm-reminder-regexp howm-reminder-types))
1401          (howm-view-s-b-r-i-max (format-time-string
1402                                  howm-reminder-today-format
1403                                  (encode-time 59 59 23 31 12
1404                                               howm-view-max-year)))
1405          (evaluator (lambda (item)
1406                       (let ((s (howm-view-item-summary item)))
1407                         (if (string-match howm-view-s-b-r-i-regexp s)
1408                             (match-string-no-properties 0 s)
1409                           howm-view-s-b-r-i-max)))))
1410     (howm-sort-items evaluator #'string< item-list reverse-p)))
1411
1412 (defun howm-sort-items-by-mtime (item-list &optional reverse-p)
1413   (howm-sort-items (lambda (item)
1414                      (howm-view-mtime (howm-view-item-filename item)))
1415                    #'howm-view-string>
1416                    item-list reverse-p))
1417
1418 (defun howm-sort-items-by-reverse (item-list &optional dummy)
1419   (reverse item-list))
1420
1421 ;;; lift (move matched items to the top)
1422
1423 (defun howm-view-lift-by-name (&optional reverse-p regexp path-p)
1424   (interactive "P")
1425   (howm-view-lift-doit (if path-p
1426                            #'howm-view-lift-by-path-internal
1427                          #'howm-view-lift-by-name-internal)
1428                        reverse-p regexp))
1429
1430 (defun howm-view-lift-by-summary (&optional reverse-p regexp)
1431   (interactive "P")
1432   (howm-view-lift-doit #'howm-view-lift-by-summary-internal
1433                        reverse-p regexp))
1434
1435 (defun howm-view-lift-by-summary-substring (&optional reverse-p regexp
1436                                                       regexp-pos)
1437   (interactive "P")
1438   (howm-view-lift-doit #'howm-view-lift-by-summary-substring-internal
1439                        reverse-p regexp regexp-pos))
1440
1441 (defun howm-view-lift-doit (sorter &optional reverse-p regexp
1442                                             regexp-pos)
1443   (let* ((howm-view-s-b-m-d-regexp (or regexp
1444                                        (read-from-minibuffer "Regexp: ")))
1445          (howm-view-s-b-m-d-regexp-pos regexp-pos)
1446          (howm-view-s-b-m-d-sorter sorter)
1447          (howm-view-s-b-m-d-matched nil))
1448     (howm-view-sort-doit (lambda (item-list rvs-p)
1449                            (let ((p (apply howm-view-s-b-m-d-sorter
1450                                            item-list
1451                                            howm-view-s-b-m-d-regexp
1452                                            rvs-p
1453                                            howm-view-s-b-m-d-regexp-pos)))
1454                              (setq howm-view-s-b-m-d-matched (car p))
1455                              (cdr p)))
1456                          reverse-p)
1457     howm-view-s-b-m-d-matched))
1458
1459 (defun howm-view-lift-internal (picker item-list regexp
1460                                        &optional reverse-p regexp-pos)
1461   "Sort items and return (matched . sorted-list).
1462 matched can be nil, single, or multi."
1463   (let* ((howm-view-l-i-matched nil)
1464          (evaluator (lambda (item)
1465                       (let ((str (funcall picker item)))
1466                         (if (string-match regexp str)
1467                             (progn
1468                               (setq howm-view-l-i-matched
1469                                     (if howm-view-l-i-matched 'multi 'single))
1470                               (if regexp-pos
1471                                   (match-string-no-properties regexp-pos str)
1472                                 1))
1473                           0))))
1474          (comparer (if regexp-pos
1475                        (lambda (x y)
1476                          (cond ((eq x 0) nil)
1477                                ((eq y 0) t)
1478                                (t (string< x y))))
1479                      #'>)))
1480     (let ((sorted-list (howm-sort-items evaluator comparer item-list
1481                                         reverse-p)))
1482       (cons howm-view-l-i-matched sorted-list))))
1483
1484 (defun howm-view-lift-by-name-internal (item-list regexp &optional reverse-p)
1485   (howm-view-lift-internal #'howm-view-item-basename
1486                            item-list regexp reverse-p))
1487
1488 (defun howm-view-lift-by-path-internal (item-list regexp &optional reverse-p)
1489   (howm-view-lift-internal #'howm-item-name item-list regexp reverse-p))
1490
1491 (defun howm-view-lift-by-summary-internal (item-list regexp &optional reverse-p)
1492   (howm-view-lift-internal #'howm-view-item-summary item-list regexp reverse-p))
1493
1494 (defun howm-view-lift-by-summary-substring-internal (item-list regexp
1495                                                                &optional
1496                                                                reverse-p
1497                                                                regexp-pos)
1498   (howm-view-lift-internal #'howm-view-item-summary item-list regexp reverse-p
1499                            (or regexp-pos 0)))
1500
1501 ;; backward compatibility
1502 (defalias 'howm-view-sort-by-name-match 'howm-view-lift-by-name)
1503 (defalias 'howm-view-sort-by-summary-match 'howm-view-lift-by-summary)
1504 (defalias 'howm-view-sort-by-summary-match-string
1505   'howm-view-lift-by-summary-substring)
1506
1507 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1508 ;;; Dired-X
1509
1510 (defvar howm-view-dired-buffer-name "*howm-dired*")
1511 (howm-defvar-risky howm-view-dired-ls-command "ls")
1512 (howm-defvar-risky howm-view-dired-ls-options '("-l"))
1513
1514 (defun dired-virtual (dir)
1515   (howm-inhibit-warning-in-compilation))
1516
1517 (defun howm-view-dired ()
1518   (interactive)
1519   (require (if (howm-xemacsp) 'dired-vir 'dired-x))
1520   (when (not (member major-mode
1521                      '(howm-view-summary-mode howm-view-contents-mode)))
1522     (error "Invalid mode for this command."))
1523 ;;   ;; bug in emacs-21.3.50?
1524 ;;   (when (not (fboundp 'dired-insert-headerline))
1525 ;;     (defun dired-insert-headerline (dir);; also used by dired-insert-subdir
1526 ;;       ;; Insert DIR's headerline with no trailing slash, exactly like ls
1527 ;;       ;; would, and put cursor where dired-build-subdir-alist puts subdir
1528 ;;       ;; boundaries.
1529 ;;       (save-excursion (insert "  " (directory-file-name dir) ":\n"))))
1530   (let* ((i2f (lambda (item)
1531                 (file-relative-name (howm-view-item-filename item))))
1532          (current-file (funcall i2f (riffle-summary-current-item)))
1533          (files (howm-cl-remove-duplicates* (mapcar i2f (howm-view-item-list))
1534                                             :test #'equal))
1535 ;;          (pos (cl-position f files :test #'string=))
1536          (args (append howm-view-dired-ls-options files))
1537          (a `((howm-view-summary-mode . ,howm-view-summary-persistent)
1538               (howm-view-contents-mode . ,howm-view-contents-persistent)))
1539          (p (howm-view-persistent-p (cdr (assoc major-mode a)))))
1540     (if p
1541         (howm-view-restore-window-configuration)
1542       (howm-view-kill-buffer))
1543     (switch-to-buffer (get-buffer-create howm-view-dired-buffer-name))
1544     (setq buffer-read-only nil)
1545     (erase-buffer)
1546     (howm-call-process-here howm-view-dired-ls-command args)
1547     (set-buffer-modified-p nil)
1548     (dired-virtual default-directory)
1549     (howm-view-dired-goto current-file)))
1550
1551 (defun howm-view-dired-goto (rname)
1552 "In dired buffer, search file name RNAME and move cursor to corresponding line.
1553 RNAME must be relative name."
1554   (goto-char (point-min))
1555   ;; Raw call of `dired-get-filename' and `dired-next-line' causes
1556   ;; warnings in compilation.
1557   (while (let ((c (howm-funcall-if-defined (dired-get-filename 'no-dir t))))
1558            (not (and c (equal (file-relative-name c) rname))))
1559     (howm-funcall-if-defined (dired-next-line 1))))
1560
1561 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1562 ;;; shell
1563
1564 (howm-defvar-risky howm-view-summary-shell-hist '("ls -l FILE" "FILE"))
1565 (howm-defvar-risky howm-view-summary-shell-last-file "FILE")
1566 (defun howm-view-summary-shell-command ()
1567   (interactive)
1568   (when (not (member major-mode
1569                      '(howm-view-summary-mode)))
1570     (error "Invalid mode for this command."))
1571   (let* ((n (howm-view-line-number))
1572          (item (nth (1- n) (howm-view-item-list)))
1573          (file (howm-page-abbreviate-name (howm-view-item-filename item)))
1574          (last-reg (regexp-quote howm-view-summary-shell-last-file)))
1575     (setq howm-view-summary-shell-hist
1576           (mapcar (lambda (h)
1577                     (replace-regexp-in-string last-reg file h t))
1578                   howm-view-summary-shell-hist))
1579     (setq howm-view-summary-shell-last-file file)
1580     (let* ((default (car howm-view-summary-shell-hist))
1581            (c (read-string "command: "
1582                            (cons default 0)
1583                            '(howm-view-summary-shell-hist . 1))))
1584       (shell-command c))
1585     (let ((item-list (cl-remove-if (lambda (item)
1586                                           (not (file-exists-p
1587                                                 (howm-view-item-filename item))))
1588                                         (howm-view-item-list))))
1589       (setq *riffle-summary-check* nil) ;; dirty
1590       (howm-view-summary (howm-view-name) item-list)
1591       (howm-goto-line n)
1592       (save-selected-window
1593         (let ((b (get-buffer "*Shell Command Output*")))
1594           (cond ((not (howm-buffer-empty-p b))
1595                  (switch-to-buffer-other-window b))
1596                 ((eq item (riffle-summary-current-item))
1597                  nil)
1598                 (t (progn
1599                      (setq *riffle-summary-check* t) ;; dirty
1600                      (howm-view-summary-check t))))))
1601       )))
1602
1603 ;;; howm-view.el ends here