1 ;;; howm-view.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2018
3 ;;; HIRAOKA Kazuyuki <khi@users.osdn.me>
4 ;;; $Id: howm-view.el,v 1.251 2012-12-29 08:57:18 hira Exp $
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)
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.
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,
20 ;;--------------------------------------------------------------------
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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))
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)))
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))
80 ;; referred only when howm-view-use-grep is nil
81 (defvar howm-view-watch-modified-buffer t)
83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
93 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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)))
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)
127 ;; https://howm.osdn.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)
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)
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)
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
157 (defvar howm-view-font-lock-first-time t
159 (make-variable-buffer-local 'howm-view-font-lock-keywords)
160 (make-variable-buffer-local 'howm-view-font-lock-first-time)
164 (riffle-define-derived-mode howm-view-summary-mode riffle-summary-mode "HowmS"
165 "memo viewer (summary mode)
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
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
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
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)
214 (riffle-define-derived-mode howm-view-contents-mode riffle-contents-mode "HowmC"
215 "memo viewer (contents mode)
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
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
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)
257 (defun howm-view-font-lock-keywords ()
258 (with-current-buffer (riffle-summary-buffer)
259 howm-view-font-lock-keywords))
263 ;; (defvar howm-view-summary-mode-map nil)
264 ;; (defvar howm-view-contents-mode-map nil)
266 (defun howm-view-define-common-key (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)
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))
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))
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))))
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*)))
309 ;; (defun howm-view-summary (&optional name item-list)
310 ;; (let ((*howm-view-font-lock-keywords* t))
311 ;; (riffle-summary name item-list ':howm)))
313 (defun howm-view-summary-open (&optional reverse-delete-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
322 (howm-record-view-window-configuration)
323 (howm-view-summary-open-sub (not persistent))))
325 (defun howm-view-summary-open-sub (&optional kill)
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))
334 (or (search-backward looking-at-str (line-beginning-position) t)
336 (run-hooks 'howm-view-open-hook)))
338 (defvar howm-view-summary-item-previous-name nil
340 (defun howm-view-summary-item (item)
341 ;; Clean me. This depends on implementation of `riffle-summary-show'
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))
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))))
355 (defun howm-view-summary-next-section (&optional n)
359 (step (if (>= n 0) 1 -1)))
361 (howm-view-summary-next-section-sub step))
363 (defun howm-view-summary-previous-section (&optional n)
366 (howm-view-summary-next-section (- n)))
367 (defun howm-view-summary-next-section-sub (step)
368 ;; inefficient. so what?
370 (howm-view-item-filename (riffle-summary-current-item))))
371 ;; (riffle-controller 'section (riffle-summary-current-item))))
374 (let ((a (funcall f)))
376 (string= a (funcall f)))))))
377 (while (and (= (forward-line step) 0)
384 (defun howm-view-contents-open (&optional reverse-delete-p)
386 (let* ((p (riffle-persistent-p howm-view-contents-persistent))
387 (persistent (if reverse-delete-p
390 (howm-record-view-window-configuration)
391 (howm-view-contents-open-sub (not persistent))))
393 (defvar *howm-view-item-privilege* nil) ;; dirty
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)))
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)
408 (howm-view-call-external-viewer viewer page)
409 (howm-view-open-item item
411 (when (or (< pos (point-min)) (<= (point-max) pos))
415 (run-hooks 'howm-view-open-hook)))
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)
421 (funcall position-setter)
422 (howm-view-set-place (howm-item-place item)))
423 (recenter howm-view-open-recenter)
425 (howm-view-open-postprocess)))
426 (defun howm-view-open-postprocess ()
427 (run-hooks 'howm-view-open-hook))
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")
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!
443 (<= howm-view-previous-section-beg place)
444 (<= place howm-view-previous-section-end))
448 (let* ((header (if (null (cdr (howm-view-item-list))) ;; dirty!
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)))
455 (howm-view-contents-item-sub item page place header viewer
456 (+ (point) header-length)))))))
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
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
474 (defun howm-view-contents-item-sub (item page place header viewer c)
478 (howm-view-contents-indicator viewer page)
479 (howm-page-insert page))
482 (riffle-set-place place)
484 (let ((r (howm-view-contents-region page)))
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))))
497 (defvar howm-view-preview-narrow t)
498 (defun howm-view-contents-region (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))))
506 (defun howm-view-contents-indicator (viewer fname)
507 (insert (howm-viewer-indicator viewer fname)))
509 (defun howm-view-paragraph-region (&optional include-following-blank-p)
510 (let ((b (save-excursion
512 (re-search-backward howm-view-title-regexp
514 (line-beginning-position)))
517 (let ((found (re-search-forward howm-view-title-regexp
519 (if include-following-blank-p
520 (if found (match-beginning 0) (point-max))
524 (goto-char (point-max)))
526 (while (and (looking-at "^$")
527 (= (forward-line -1) 0)) ;; successful
533 (defun howm-view-set-mark-command ()
534 (set-mark-command nil)
535 (howm-deactivate-mark))
537 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)))
545 (defun howm-view-mtime (file)
546 (howm-view-time-to-string (howm-page-mtime file)))
548 ;; (defun howm-view-xtime (file x)
549 ;; (let* ((a (file-attributes file))
550 ;; (n (cdr (assoc x '((a . 4) (m . 5) (c . 6)))))
552 ;; (howm-view-time-to-string ti)))
554 (defun howm-view-time-to-string (ti)
555 (format-time-string "%Y%m%d-%H%M%S" ti))
557 (defun howm-view-string> (a b)
560 (defun howm-view-string<= (a b)
563 (defun howm-view-string< (a b)
566 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
569 (defun howm-view-directory (dir &optional recursive-p)
570 (howm-view-summary "" (howm-folder-items dir recursive-p)))
572 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
575 (defun howm-view-filter (&optional remove-p)
577 (let* ((table howm-view-filter-methods)
578 (command (completing-read (if remove-p
579 "(Reject) filter by: "
582 (call-interactively (cdr (assoc command table)))))
584 (defun howm-view-filter-uniq ()
586 (howm-view-filter-doit #'howm-filter-items-uniq))
588 (defun howm-view-filter-by-name (&optional remove-p regexp)
590 (howm-view-filter-by-name/summary #'howm-filter-items-by-name
593 (defun howm-view-filter-by-summary (&optional remove-p regexp)
595 (howm-view-filter-by-name/summary #'howm-filter-items-by-summary
598 (defun howm-view-filter-by-name/summary (filter regexp remove-p)
599 (let* ((r (or regexp (howm-view-filter-read-from-minibuffer "Regexp: "
601 (f `(lambda (item-list rmv-p)
602 (funcall #',filter item-list ,r rmv-p))))
603 (howm-view-filter-doit f remove-p)))
605 (defun howm-view-filter-by-date (&optional remove-p)
607 (howm-view-filter-by-time-range #'howm-filter-items-by-date
610 (defun howm-view-filter-by-reminder (&optional remove-p)
612 (howm-view-filter-by-time-range #'howm-filter-items-by-reminder remove-p))
614 (defun howm-view-filter-by-mtime (&optional remove-p range)
616 (howm-view-filter-by-time-range #'howm-filter-items-by-mtime remove-p range))
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)))
622 (f `(lambda (item-list rmv-p)
623 (funcall #',filter item-list ',from ',to rmv-p))))
624 (howm-view-filter-doit f remove-p)))
626 (defun howm-view-filter-by-region (beg end)
628 (let ((r (mapcar #'howm-view-line-number (list beg end))))
629 (howm-view-filter-by-line-range (car r) (cadr r))))
631 (defvar howm-view-filter-by-around-default 10)
632 (defun howm-view-filter-by-around (&optional distance)
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))))
638 (defun howm-view-filter-by-line-range (beg end)
639 (let ((f `(lambda (item-list remove-p)
641 (error "Not supported."))
642 ;; beg and end are counted as 1,2,3,...
646 (min ,end (length item-list))))))
647 (howm-view-filter-doit f)))
649 (defun howm-view-filter-by-contents (&optional remove-p regexp)
651 (let ((r (or regexp (howm-view-filter-read-from-minibuffer
652 "Search in result (grep): "
655 (howm-view-remove-by-contents r)
656 (howm-view-search-in-result r))))
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."
662 :group 'howm-search))
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 "")
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)
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)))))
685 (defun howm-view-sort/filter-doit (proc &optional switch)
686 (let ((kw font-lock-keywords))
688 ;; return item-list for
689 ;; https://howm.osdn.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))))
693 (defalias 'howm-view-filter-doit 'howm-view-sort/filter-doit)
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))
702 ;; (howm-map-with-index #'list item-list)
705 ;; (cl-remove-if pred s)
706 ;; (cl-remove-if-not pred s)))
707 ;; (filtered (if with-index
710 ;; (howm-view-summary-rebuild filtered)))
712 (defmacro howm-filter-items (pred lis &optional remove-p)
714 (cl-remove-if ,pred ,lis)
715 (cl-remove-if-not ,pred ,lis)))
717 (defun howm-filter-items-uniq (item-list &optional remove-p)
719 (error "Not supported."))
720 (let* ((howm-view-filter-uniq-prev (if howm-view-search-in-result-correctly
723 (pred (if howm-view-search-in-result-correctly
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)))
731 (not (and (howm-page= page p-page)
733 (<= (car p-range) place)
734 (<= place (cadr p-range)))))
735 (setq howm-view-filter-uniq-prev (cons page range)))))
738 (let ((f (howm-view-item-filename item)))
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)))
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))
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))
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)))
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)))
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)))
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)))
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)))
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)))
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)))
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)
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)))))
806 (defun howm-view-file-name-format ()
807 howm-file-name-format) ;; defined in howm-common.el
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)))
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))
822 (let (y0 m0 d0 hour0 min0 sec0)
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)))
830 (howm-view-encode-time sec0 min0 hour0 d0 m0 y0)
831 (let ((m (howm-ask-time-sub prompt "month" md remove-p)))
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)))))))))
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 "")
842 (string-to-number raw))))
847 (defun howm-view-encode-time (sec min hour d m y)
848 (when (eq d 'last-day-of-month)
851 (encode-time sec min hour d m y))
853 (defun howm-view-filter-read-from-minibuffer (message &optional remove-p)
854 (read-from-minibuffer (if remove-p
855 (concat "(Reject) " message)
858 (defun howm-view-summary-rebuild (item-list &optional fl-keywords)
859 (howm-view-summary (howm-view-name) item-list fl-keywords))
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.
874 This feature does not work when `howm-view-search-in-result-correctly' is nil."
875 :type `(radio (const :tag "Off" nil)
880 :group 'howm-efficiency)))
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
888 :type '(radio (const :tag "title instead of summary"
890 (const :tag "title before summary"
892 :group 'howm-experimental)
894 (defun howm-view-list-title (title-regexp)
895 (howm-view-summary-rebuild (howm-entitle-items
896 title-regexp (howm-view-item-list))))
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)))
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))
909 (nohit-items (cdr r))
910 ;; should I use (howm-classify #'howm-item-place nohit-items) ?
912 (cl-remove-if #'howm-item-place nohit-items))
914 (howm-item-list-filter (cl-remove-if-not #'howm-item-place
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))
921 (let* ((pages (howm-cl-remove-duplicates* (mapcar #'howm-item-page
923 (hit-pages (mapcar #'howm-item-page items))
924 (nohit-pages (cl-remove-if
925 (lambda (p) (cl-member p hit-pages
928 (nohit-items (mapcar #'howm-make-item nohit-pages))
929 (all-items (if (null nohit-items)
931 (append items nohit-items))))
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 ""))
943 (let ((orig (howm-item-summary item))
944 (titles (howm-item-titles item)))
947 (if (string= s last-title)
950 (when (> (length s) howm-entitle-items-style2-max-length)
951 (setq s (substring s 0 howm-entitle-items-style2-max-length)))
953 (let ((i (howm-item-dup item)))
954 (howm-item-set-summary i x)
956 (if (and howm-entitle-items-style2-title-line
957 (not (string= s "")))
958 (list (format howm-entitle-items-style2-format
960 (format howm-entitle-items-style2-format
962 (list (format howm-entitle-items-style2-format
964 (or titles (list "")))))
967 ;;; detect items in same paragraph (= entry = memo. sorry for inconsistent terminology)
969 (defun howm-item-with-temp-buffer (item proc)
971 (howm-page-insert (howm-item-page item))
972 (let* ((p (howm-item-place item))
974 (list (point-min) (point-max))
977 (howm-view-paragraph-region)))))
978 (narrow-to-region (car r) (cadr r))
979 (funcall proc item))))
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
989 (goto-char (point-min))
990 (while (re-search-forward (howm-list-title-regexp) nil t)
992 (cons (buffer-substring-no-properties (match-beginning 0)
996 (if (string-match howm-view-title-regexp x)
997 (match-string-no-properties howm-view-title-regexp-pos x)
999 (reverse titles))))))
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
1006 (let ((r (list (point-min) (point-max))))
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))
1018 ;; (list (point-min) (point-max))
1020 ;; (riffle-set-place p)
1021 ;; (howm-view-paragraph-region)))))
1023 ;; (goto-char (car r))
1024 ;; (riffle-get-place))
1026 ;; (goto-char (cadr r))
1027 ;; (riffle-get-place))))))
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))))
1043 (add-to-alist page (howm-make-rangeset)))
1045 (add-to-alist page (howm-make-rangeset
1046 (howm-item-range item))))
1047 ((howm-rangeset-belong-p place rs)
1050 (howm-rangeset-add! rs (howm-item-range item))))))
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."
1067 ;; split no-place items:
1068 ;; Though implementation 1 calls grep many times,
1069 ;; implementation 2 is slower in construction of folder from items.
1072 ;; implementation 1 (call grep many times)
1074 (cl-mapcan (lambda (item)
1075 (if (howm-item-place item)
1077 (or (howm-view-search-folder-items-fi
1078 (howm-view-title-regexp-grep) (list item))
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)))
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)
1100 (cond ((eq remove-match 'with-rest)
1101 (let ((match (cl-remove-if-not
1103 (let ((rs (funcall matcher item)))
1104 (and rs (howm-rangeset-hit! rs))))
1108 (lambda (a) (and (not (howm-rangeset-hit-p (cdr a)))
1109 (list (howm-make-item (car a)))))
1111 (remove-match (cl-remove-if matcher item-list))
1112 (t (cl-remove-if-not matcher item-list)))))
1116 ;;; (*rangeset* (1 . 4) (5 . 6) (8 . 14))
1117 ;;; (*rangeset*) ==> "almighty"
1118 ;;; (*rangeset-hit* (1 . 4) (5 . 6) (8 . 14)) ==> "hit" is recorded
1120 (defun howm-make-rangeset (&optional beg-end)
1122 (cons '*rangeset* nil)
1123 (let ((rs (howm-make-rangeset)))
1124 (howm-rangeset-add! rs beg-end))))
1126 (defun howm-rangeset-belong-p (point rs)
1128 (cl-member-if (lambda (pair)
1129 (and (<= (car pair) point) (<= point (cdr pair))))
1132 (defun howm-rangeset-add! (rs beg-end)
1133 ;; "almighty" is ignored here. sorry for confusion...
1134 ;; c = cursor (pointing its cdr)
1138 (end (cadr beg-end)))
1139 (while (and (cdr c) beg)
1141 (cond ((< end (car p)) ;; insert [beg, end] here
1142 (rplacd c (cons (cons beg end) (cdr c)))
1144 ((< (cdr p) beg) ;; skip this
1146 (t ;; merge into [beg, end]
1147 (setq beg (min beg (car p))
1148 end (max end (cdr p)))
1149 (rplacd c (cddr c))))))
1151 (rplacd c (list (cons beg end)))))
1154 (defvar howm-rangeset-hit-indicator '*rangeset-hit*)
1156 (defun howm-rangeset-hit! (rs)
1157 (setcar rs howm-rangeset-hit-indicator))
1159 (defun howm-rangeset-hit-p (rs)
1160 (eq (car rs) howm-rangeset-hit-indicator))
1179 (((3 . 1) (4 . 1) (5 . 9))
1181 (((3 . 1) (4 . 1) (5 . 9) (2 . 6) (5 . 3))
1184 ;; inhibit 'reference to free variable' warning in byte-compilation
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))))))
1191 (apply (lambda (prob ans)
1192 (let* ((rs (howm-make-rangeset)))
1193 (mapc (lambda (pair)
1194 (let ((a (car pair))
1196 (howm-rangeset-add! rs
1200 (when (not (equal (cdr rs) ans))
1201 (error "howm-rangeset-add: %s ==> %s" prob rs))))
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)))
1215 (error "howm-rangeset-belong-p: wrong result")))
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
1224 (howm-view-get-title-line))))
1225 (howm-item-set-summary item title-line))))
1227 (defun howm-view-get-title-line ()
1228 (while (and (looking-at howm-view-title-skip-regexp)
1229 (= (forward-line 1) 0))
1232 (buffer-substring-no-properties (line-beginning-position)
1233 (line-end-position)))
1235 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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))
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))
1248 (defun howm-view-search-folder (&rest args)
1249 (howm-view-search-folder-doit (apply #'howm-view-search-folder-internal
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)))
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 "\\)"))
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))))
1280 (defun howm-view-search-folder-doit (p)
1281 (howm-view-summary (cadr p) (cl-caddr p) (car p)))
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)))))
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))))
1298 ;; sorry for confusing functions...
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))
1304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1307 (defun howm-view-sort ()
1309 (let* ((table howm-view-sort-methods)
1310 (command (completing-read "sort by: " table nil t)))
1311 (call-interactively (cdr (assoc command table)))))
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)
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")
1331 (defalias 'howm-view-sort-reverse 'howm-view-sort-by-reverse)
1333 (defalias 'howm-view-sort-doit 'howm-view-sort/filter-doit)
1335 (defmacro howm-sort-items (evaluator comparer item-list
1336 &optional reverse-p)
1337 `(let* ((howm-view-s-i-comparer ,comparer)
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)))
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)
1348 ;; (howm-get-symbol nil "howm-view-sort-by-" m))
1350 ;; (howm-get-symbol nil "howm-sort-items-by-" m))
1352 ;; (howm-get-symbol nil command "-internal")))
1353 ;; `(defalias ',obsolete ',internal)))
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)
1369 (defun howm-sort-items-by-random (item-list &optional reverse-p)
1370 (howm-sort-items #'(lambda (dummy) (random)) #'< item-list reverse-p))
1372 (defun howm-sort-items-by-name (item-list &optional reverse-p)
1373 (howm-sort-items #'howm-view-item-basename #'string< reverse-p))
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)
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
1389 howm-view-sort-by-date-ignore-regexp
1392 (defun howm-sort-items-by-reverse-date (item-list &optional reverse-p)
1393 (howm-sort-items-by-date item-list (not reverse-p)))
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))
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)))
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)))
1416 item-list reverse-p))
1418 (defun howm-sort-items-by-reverse (item-list &optional dummy)
1419 (reverse item-list))
1421 ;;; lift (move matched items to the top)
1423 (defun howm-view-lift-by-name (&optional reverse-p regexp path-p)
1425 (howm-view-lift-doit (if path-p
1426 #'howm-view-lift-by-path-internal
1427 #'howm-view-lift-by-name-internal)
1430 (defun howm-view-lift-by-summary (&optional reverse-p regexp)
1432 (howm-view-lift-doit #'howm-view-lift-by-summary-internal
1435 (defun howm-view-lift-by-summary-substring (&optional reverse-p regexp
1438 (howm-view-lift-doit #'howm-view-lift-by-summary-substring-internal
1439 reverse-p regexp regexp-pos))
1441 (defun howm-view-lift-doit (sorter &optional reverse-p regexp
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
1451 howm-view-s-b-m-d-regexp
1453 howm-view-s-b-m-d-regexp-pos)))
1454 (setq howm-view-s-b-m-d-matched (car p))
1457 howm-view-s-b-m-d-matched))
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)
1468 (setq howm-view-l-i-matched
1469 (if howm-view-l-i-matched 'multi 'single))
1471 (match-string-no-properties regexp-pos str)
1474 (comparer (if regexp-pos
1476 (cond ((eq x 0) nil)
1480 (let ((sorted-list (howm-sort-items evaluator comparer item-list
1482 (cons howm-view-l-i-matched sorted-list))))
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))
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))
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))
1494 (defun howm-view-lift-by-summary-substring-internal (item-list regexp
1498 (howm-view-lift-internal #'howm-view-item-summary item-list regexp reverse-p
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)
1507 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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"))
1514 (defun dired-virtual (dir)
1515 (howm-inhibit-warning-in-compilation))
1517 (defun howm-view-dired ()
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
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))
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)))))
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)
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)))
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))))
1561 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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 ()
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
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: "
1583 '(howm-view-summary-shell-hist . 1))))
1585 (let ((item-list (cl-remove-if (lambda (item)
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)
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))
1599 (setq *riffle-summary-check* t) ;; dirty
1600 (howm-view-summary-check t))))))
1603 ;;; howm-view.el ends here