1 ;;; howm-view.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2020
3 ;;; HIRAOKA Kazuyuki <khi@users.osdn.me>
5 ;;; This program is free software; you can redistribute it and/or modify
6 ;;; it under the terms of the GNU General Public License as published by
7 ;;; the Free Software Foundation; either version 1, or (at your option)
10 ;;; This program is distributed in the hope that it will be useful,
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;; GNU General Public License for more details.
15 ;;; The GNU General Public License is available by anonymouse ftp from
16 ;;; prep.ai.mit.edu in pub/gnu/COPYING. Alternately, you can write to
17 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
19 ;;--------------------------------------------------------------------
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 (defvar howm-view-summary-sep "|")
29 (defvar howm-view-summary-format
30 (let* ((path (format-time-string howm-file-name-format))
31 (width (length (file-name-nondirectory path))))
32 (concat "%-" (format "%s" (1+ width)) "s" howm-view-summary-sep " ")))
33 (defvar howm-view-header-format
34 "\n==========================>>> %s\n"
35 "Format string of header for howm-view-contents.
36 %s is replaced with file name. See `format'.")
37 (defvar howm-view-header-regexp "^==========================>>> .*$")
38 (defvar howm-view-open-recenter howm-view-search-recenter)
39 (defvar howm-view-title-header "=")
40 ;; howm-view-title-regexp is assumed to have a form "^xxxxxxx$"
41 (defvar howm-view-title-regexp (format "^%s\\( +\\(.*\\)\\|\\)$"
42 (regexp-quote howm-view-title-header)))
43 (defvar howm-view-title-regexp-pos 2)
44 (defvar howm-view-title-regexp-grep (format "^%s +"
45 (regexp-quote howm-view-title-header)))
46 (defun howm-view-title-regexp-grep ()
47 (if howm-view-use-grep
48 howm-view-title-regexp-grep
49 howm-view-title-regexp))
51 (howm-defvar-risky howm-view-sort-methods
52 '(("random" . howm-view-sort-by-random)
53 ("name" . howm-view-sort-by-name)
54 ("name-match" . howm-view-lift-by-name)
55 ("numerical-name" . howm-view-sort-by-numerical-name)
56 ("summary" . howm-view-sort-by-summary)
57 ("summary-match" . howm-view-lift-by-summary)
58 ("summary-match-string" . howm-view-lift-by-summary-substring)
59 ; ("atime" . howm-view-sort-by-atime) ;; nonsense
60 ; ("ctime" . howm-view-sort-by-ctime) ;; needless
61 ("mtime" . howm-view-sort-by-mtime)
62 ("date" . howm-view-sort-by-reverse-date)
63 ("reminder" . howm-view-sort-by-reminder)
64 ("reverse" . howm-view-sort-reverse)))
66 (howm-defvar-risky howm-view-filter-methods
67 '(("name" . howm-view-filter-by-name)
68 ("summary" . howm-view-filter-by-summary)
69 ("mtime" . howm-view-filter-by-mtime)
70 ; ("ctime" . howm-view-filter-by-ctime) ;; needless
71 ("date" . howm-view-filter-by-date)
72 ("reminder" . howm-view-filter-by-reminder)
73 ("contents" . howm-view-filter-by-contents)
74 ("Region" . howm-view-filter-by-region)
75 ("Around" . howm-view-filter-by-around)
76 ; ("uniq" . howm-view-filter-uniq))
79 ;; referred only when howm-view-use-grep is nil
80 (defvar howm-view-watch-modified-buffer t)
82 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
85 (defun howm-view-item-basename (item &optional nonempty)
86 (let* ((f (howm-item-name item))
87 (b (file-name-nondirectory f)))
88 (if (and (string= b "") nonempty)
92 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
95 (defalias 'riffle-home:howm 'howm-view-item-home)
96 (defalias 'riffle-summary-item:howm 'howm-view-summary-item)
97 (defalias 'riffle-contents-item:howm 'howm-view-contents-item)
98 (defalias 'riffle-summary-set-mode:howm 'howm-view-summary-mode)
99 (defalias 'riffle-contents-set-mode:howm 'howm-view-contents-mode)
101 (defun riffle-summary-name-format:howm ()
102 howm-view-summary-name)
103 (defun riffle-contents-name-format:howm ()
104 howm-view-contents-name)
105 (defun riffle-post-update:howm (item)
106 (howm-message-nolog "View: %s" (howm-view-item-filename item)))
110 ;; Only howm-view.el should call riffle-xxx.
111 ;; Define alias if it is used in howm-xxx besides howm-view.el.
112 (defalias 'howm-view-name #'riffle-name)
113 (defalias 'howm-view-item-list #'riffle-item-list)
114 (defalias 'howm-view-line-number #'riffle-line-number)
115 (defalias 'howm-view-summary-check #'riffle-summary-check)
116 (defalias 'howm-view-persistent-p #'riffle-persistent-p)
117 (defalias 'howm-view-kill-buffer #'riffle-kill-buffer)
118 (defalias 'howm-view-set-place #'riffle-set-place)
119 (defalias 'howm-view-get-place #'riffle-get-place)
120 (defalias 'howm-view-summary-current-item #'riffle-summary-current-item)
121 (defalias 'howm-view-contents-current-item #'riffle-contents-current-item)
122 (defalias 'howm-view-summary-to-contents #'riffle-summary-to-contents)
123 (defalias 'howm-view-restore-window-configuration #'riffle-restore-window-configuration)
126 ;; https://howm.osdn.jp/cgi-bin/hiki/hiki.cgi?howmoney
127 (defun howm-view-get-buffer (name-format &optional name new)
128 (let ((riffle-type ':howm)) ;; cheat
129 (riffle-get-buffer name-format name new)))
130 (defun howm-view-summary-buffer (&optional new)
131 (let ((riffle-type ':howm)) ;; cheat
132 (riffle-summary-buffer new)))
133 (defalias 'howm-view-summary-show 'riffle-summary-show)
134 (defalias 'howm-view-set-item-list 'riffle-set-item-list)
137 ;; http://noir.s7.xrea.com/archives/000136.html
138 ;; http://noir.s7.xrea.com/pub/zaurus/howmz.el
139 (defalias 'howm-view-sort-items 'howm-sort)
143 (defvar howm-view-font-lock-silent t
144 "Inhibit font-lock-verbose if non-nil.")
145 (howm-defvar-risky howm-view-summary-font-lock-keywords
146 `((,(concat "\\(^[^ \t\r\n].*?\\)" (regexp-quote howm-view-summary-sep))
147 1 howm-view-name-face)
148 ("^ +" . howm-view-empty-face)))
149 (howm-defvar-risky howm-view-contents-font-lock-keywords nil)
151 (howm-defvar-risky *howm-view-font-lock-keywords* nil
152 "For internal use. Don't set this variable.
153 This is a shameful global variable and should be clearned in future.")
154 (howm-defvar-risky howm-view-font-lock-keywords nil
156 (defvar howm-view-font-lock-first-time t
158 (make-variable-buffer-local 'howm-view-font-lock-keywords)
159 (make-variable-buffer-local 'howm-view-font-lock-first-time)
163 (riffle-define-derived-mode howm-view-summary-mode riffle-summary-mode "HowmS"
164 "memo viewer (summary mode)
167 \\[howm-view-summary-open] Open file
168 \\[next-line] Next item
169 \\[previous-line] Previous item
170 \\[riffle-pop-or-scroll-other-window] Pop and scroll contents
171 \\[scroll-other-window-down] Scroll contents
172 \\[riffle-scroll-other-window] Scroll contents one line
173 \\[riffle-scroll-other-window-down] Scroll contents one line
174 \\[riffle-summary-to-contents] Concatenate all contents
175 \\[howm-view-summary-next-section] Next file (Skip items in the same file)
176 \\[howm-view-summary-previous-section] Previous file (Skip items in the same file)
177 \\[howm-view-filter-uniq] Remove duplication of same file
178 \\[howm-view-summary-shell-command] Execute command in inferior shell
180 \\[delete-other-windows] Delete contents window
181 \\[riffle-pop-window] Pop contents window
182 \\[riffle-toggle-window] Toggle contents window
183 \\[howm-list-toggle-title] Show/Hide Title
185 \\[howm-view-filter] Filter (by date, contents, etc.)
186 \\[howm-view-filter-by-contents] Search (= filter by contents)
187 \\[howm-view-sort] Sort (by date, summary line, etc.)
188 \\[howm-view-sort-reverse] Reverse order
189 \\[howm-view-dired] Invoke Dired-X
190 \\[describe-mode] This help
191 \\[riffle-kill-buffer] Quit
193 (make-local-variable 'font-lock-keywords)
194 (cheat-font-lock-mode howm-view-font-lock-silent)
195 (when howm-view-font-lock-first-time
196 (setq howm-view-font-lock-first-time nil)
197 (cheat-font-lock-merge-keywords howm-user-font-lock-keywords
198 howm-view-summary-font-lock-keywords
199 ;; dirty! Clean dependency between files.
200 (howm-reminder-today-font-lock-keywords)))
201 (when *howm-view-font-lock-keywords*
202 (setq howm-view-font-lock-keywords *howm-view-font-lock-keywords*))
203 (when howm-view-font-lock-keywords
204 (cheat-font-lock-merge-keywords howm-view-font-lock-keywords
205 howm-user-font-lock-keywords
206 howm-view-summary-font-lock-keywords))
207 ;; font-lock-set-defaults removes these local variables after 2008-02-24
208 (set (make-local-variable 'font-lock-keywords-only) t)
209 (set (make-local-variable 'font-lock-keywords-case-fold-search) t)
210 ;; (setq font-lock-keywords-case-fold-search
211 ;; howm-view-grep-ignore-case-option)
212 (cheat-font-lock-fontify)
215 (riffle-define-derived-mode howm-view-contents-mode riffle-contents-mode "HowmC"
216 "memo viewer (contents mode)
219 \\[howm-view-contents-open] Open file
220 \\[next-line] Next line
221 \\[previous-line] Previous line
222 \\[scroll-up] Scroll up
223 \\[scroll-down] Scroll down
224 \\[riffle-scroll-up] Scroll one line up
225 \\[riffle-scroll-down] Scroll one line down
226 \\[riffle-contents-to-summary] Summary
227 \\[riffle-contents-goto-next-item] Next item
228 \\[riffle-contents-goto-previous-item] Previous item
230 \\[howm-view-filter] Filter (by date, contents, etc.)
231 \\[howm-view-filter-by-contents] Search (= filter by contents)
232 \\[howm-view-sort] Sort
233 \\[howm-view-sort-reverse] Reverse order
234 \\[howm-view-dired] Invoke Dired-X
235 \\[describe-mode] This help
236 \\[riffle-kill-buffer] Quit
238 ; (kill-all-local-variables)
239 (make-local-variable 'font-lock-keywords)
240 (cheat-font-lock-mode howm-view-font-lock-silent)
241 (let ((ck `((,howm-view-header-regexp (0 howm-view-hilit-face))))
242 (sk (or (howm-view-font-lock-keywords)
243 *howm-view-font-lock-keywords*)))
244 ;; ;; extremely dirty!! [2003/10/06 21:08]
245 ;; (sk (or (with-current-buffer (riffle-summary-buffer)
246 ;; font-lock-keywords)
247 ;; *howm-view-font-lock-keywords*)))
248 (cheat-font-lock-merge-keywords sk ck
249 howm-user-font-lock-keywords
250 howm-view-contents-font-lock-keywords)
251 ;; font-lock-set-defaults removes these local variables after 2008-02-24
252 (set (make-local-variable 'font-lock-keywords-only) t)
253 (set (make-local-variable 'font-lock-keywords-case-fold-search)
254 howm-view-grep-ignore-case-option)
255 (cheat-font-lock-fontify)
258 (defun howm-view-font-lock-keywords ()
259 (with-current-buffer (riffle-summary-buffer)
260 howm-view-font-lock-keywords))
264 ;; (defvar howm-view-summary-mode-map nil)
265 ;; (defvar howm-view-contents-mode-map nil)
267 (defun howm-view-define-common-key (keymap)
269 ;; (define-key m "?" 'howm-view-help)
270 (define-key m "f" 'howm-view-filter)
271 (define-key m "G" 'howm-view-filter-by-contents)
272 (define-key m "S" 'howm-view-sort)
273 (define-key m "R" 'howm-view-sort-reverse)
274 (define-key m "q" 'howm-view-kill-buffer)
275 (define-key m "X" 'howm-view-dired)
278 (let ((m howm-view-summary-mode-map))
279 (define-key m "\C-m" 'howm-view-summary-open)
280 (define-key m "\C-j" 'howm-view-summary-open)
281 (define-key m "u" 'howm-view-filter-uniq)
282 (define-key m "!" 'howm-view-summary-shell-command)
283 (define-key m "T" 'howm-list-toggle-title) ;; defined in other file. dirty!
284 ;; (define-key m howm-reminder-quick-check-key 'howm-reminder-quick-check)
285 ;; (define-key m ";" 'howm-view-invoke-action-lock)
286 (define-key m "\C-i" 'howm-view-summary-next-section)
287 (define-key m "\M-\C-i" 'howm-view-summary-previous-section)
288 (define-key m [tab] 'howm-view-summary-next-section)
289 (define-key m [(meta tab)] 'howm-view-summary-previous-section)
290 (howm-view-define-common-key m))
292 (let ((m howm-view-contents-mode-map))
293 (define-key m "\C-m" 'howm-view-contents-open)
294 (define-key m "\C-j" 'howm-view-contents-open)
295 (howm-view-define-common-key m))
299 (defun howm-view-summary (&optional name item-list fl-keywords)
300 (let* ((*howm-view-font-lock-keywords* fl-keywords) ;; ok? [2008-07-11]
301 (r (riffle-summary name item-list ':howm
302 (howm-view-in-background-p))))
305 ;; We want to entry font-lock keywords even when background-p.
306 (when *howm-view-font-lock-keywords*
307 (setq howm-view-font-lock-keywords *howm-view-font-lock-keywords*)))
310 ;; (defun howm-view-summary (&optional name item-list)
311 ;; (let ((*howm-view-font-lock-keywords* t))
312 ;; (riffle-summary name item-list ':howm)))
314 (defun howm-view-summary-open (&optional reverse-delete-p)
316 (when (not (and howm-view-summary-keep-cursor
317 (get-buffer-window (riffle-contents-buffer))))
318 (riffle-summary-check t))
319 (let* ((p (riffle-persistent-p howm-view-summary-persistent))
320 (persistent (if reverse-delete-p
323 (howm-record-view-window-configuration)
324 (howm-view-summary-open-sub (not persistent))))
326 (defun howm-view-summary-open-sub (&optional kill)
328 (let ((b (riffle-contents-buffer))
329 (looking-at-str (buffer-substring-no-properties (point)
330 (line-end-position))))
331 (riffle-pop-to-buffer b howm-view-summary-window-size)
332 (let ((howm-view-open-hook nil)) ;; Don't execute it in contents-open.
333 (howm-view-contents-open-sub kill))
335 (or (search-backward looking-at-str (line-beginning-position) t)
337 (run-hooks 'howm-view-open-hook)))
339 (defvar howm-view-summary-item-previous-name nil
341 (defun howm-view-summary-item (item)
342 ;; Clean me. This depends on implementation of `riffle-summary-show'
344 (when (eq (point) (point-min))
345 (setq howm-view-summary-item-previous-name ""))
346 (let* ((f (howm-item-name item))
347 (name (if (and howm-view-summary-omit-same-name
348 (string= f howm-view-summary-item-previous-name))
351 (setq howm-view-summary-item-previous-name f)
352 (howm-view-item-basename item t))))
353 (h (format howm-view-summary-format name)))
354 (concat h (howm-view-item-summary item))))
356 (defun howm-view-summary-next-section (&optional n)
360 (step (if (>= n 0) 1 -1)))
362 (howm-view-summary-next-section-sub step))
364 (defun howm-view-summary-previous-section (&optional n)
367 (howm-view-summary-next-section (- n)))
368 (defun howm-view-summary-next-section-sub (step)
369 ;; inefficient. so what?
371 (howm-view-item-filename (riffle-summary-current-item))))
372 ;; (riffle-controller 'section (riffle-summary-current-item))))
375 (let ((a (funcall f)))
377 (string= a (funcall f)))))))
378 (while (and (= (forward-line step) 0)
385 (defun howm-view-contents-open (&optional reverse-delete-p)
387 (let* ((p (riffle-persistent-p howm-view-contents-persistent))
388 (persistent (if reverse-delete-p
391 (howm-record-view-window-configuration)
392 (howm-view-contents-open-sub (not persistent))))
394 (defvar *howm-view-item-privilege* nil) ;; dirty
396 (defun howm-view-contents-open-sub (&optional kill)
397 (let* ((item (riffle-contents-current-item))
398 (page (howm-item-page item))
399 (offset (howm-view-item-offset item))
400 (pos (- (point) offset))
401 (viewer (howm-view-external-viewer page)))
403 (riffle-kill-buffer))
404 (when (howm-view-item-privilege item)
405 (riffle-restore-window-configuration)) ;; force without mode check
406 (setq *howm-view-item-privilege* (howm-view-item-privilege item)) ;; dirty
407 (run-hooks 'howm-view-before-open-hook)
409 (howm-view-call-external-viewer viewer page)
410 (howm-view-open-item item
412 (when (or (< pos (point-min)) (<= (point-max) pos))
416 (run-hooks 'howm-view-open-hook)))
418 (defun howm-view-open-item (item &optional position-setter merely)
419 (howm-page-open (howm-item-page item))
420 (howm-view-set-mark-command)
422 (funcall position-setter)
423 (howm-view-set-place (howm-item-place item)))
424 (recenter howm-view-open-recenter)
426 (howm-view-open-postprocess)))
427 (defun howm-view-open-postprocess ()
428 (run-hooks 'howm-view-open-hook))
430 (defvar howm-view-previous-section-page nil "For internal use")
431 (defvar howm-view-previous-section-beg nil "For internal use")
432 (defvar howm-view-previous-section-end nil "For internal use")
434 (defun howm-view-contents-item (item)
435 (when (howm-buffer-empty-p)
436 (setq howm-view-previous-section-page ""
437 howm-view-previous-section-beg nil
438 howm-view-previous-section-end nil))
439 (let* ((page (howm-item-page item))
440 (place (howm-view-item-place item))
441 (peq (howm-page= page howm-view-previous-section-page)) ;; dirty!
444 (<= howm-view-previous-section-beg place)
445 (<= place howm-view-previous-section-end))
449 (let* ((header (if (null (cdr (howm-view-item-list))) ;; dirty!
451 (format howm-view-header-format
452 (howm-page-abbreviate-name page))))
453 (header-length (howm-view-string-point-count header))
454 (viewer (howm-view-external-viewer page)))
456 (howm-view-contents-item-sub item page place header viewer
457 (+ (point) header-length)))))))
459 (defvar howm-view-string-point-count-strict nil)
460 (defun howm-view-string-point-count (str)
461 "Count points of string STR.
462 Namely, it is the difference between start position and end position
463 of STR if STR is inserted to a buffer.
464 It looks to be simply equal to (length STR) on emacs-21.1.1.
465 But I'm not sure for multi-byte characters on other versions of emacsen."
466 (if howm-view-string-point-count-strict
469 (- (point) (point-min)))
470 ;; I assume (length (buffer-substring-no-properties START END))
471 ;; is equal to (abs (- START END))). Is it correct?
472 ;; (cf.) snap://Info-mode/elisp#Positions
475 (defun howm-view-contents-item-sub (item page place header viewer c)
479 (howm-view-contents-indicator viewer page)
480 (howm-page-insert page))
483 (riffle-set-place place)
485 (let ((r (howm-view-contents-region page)))
491 (howm-view-item-set-offset item (- c b))
492 (howm-view-item-set-home item (+ c (- b) h))
493 (setq howm-view-previous-section-page page ;; dirty!
494 howm-view-previous-section-beg (riffle-get-place b)
495 howm-view-previous-section-end (riffle-get-place e))
496 (buffer-substring-no-properties b e))))
498 (defvar howm-view-preview-narrow t)
499 (defun howm-view-contents-region (filename)
501 (howm-page-set-configuration filename))
502 (if (or howm-view-preview-narrow
503 (not (riffle-preview-p)))
504 (howm-view-paragraph-region)
505 (list (point-min) (point-max))))
507 (defun howm-view-contents-indicator (viewer fname)
508 (insert (howm-viewer-indicator viewer fname)))
510 (defun howm-view-paragraph-region (&optional include-following-blank-p)
511 (let ((b (save-excursion
513 (re-search-backward howm-view-title-regexp
515 (line-beginning-position)))
518 (let ((found (re-search-forward howm-view-title-regexp
520 (if include-following-blank-p
521 (if found (match-beginning 0) (point-max))
525 (goto-char (point-max)))
527 (while (and (looking-at "^$")
528 (= (forward-line -1) 0)) ;; successful
534 (defun howm-view-set-mark-command ()
535 (set-mark-command nil)
536 (howm-deactivate-mark))
538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
541 (defun howm-view-file-list (&optional item-list)
542 (howm-cl-remove-duplicates* (mapcar #'howm-view-item-filename
543 (or item-list (howm-view-item-list)))
546 (defun howm-view-mtime (file)
547 (howm-view-time-to-string (howm-page-mtime file)))
549 ;; (defun howm-view-xtime (file x)
550 ;; (let* ((a (file-attributes file))
551 ;; (n (cdr (assoc x '((a . 4) (m . 5) (c . 6)))))
553 ;; (howm-view-time-to-string ti)))
555 (defun howm-view-time-to-string (ti)
556 (format-time-string "%Y%m%d-%H%M%S" ti))
558 (defun howm-view-string> (a b)
561 (defun howm-view-string<= (a b)
564 (defun howm-view-string< (a b)
567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
570 (defun howm-view-directory (dir &optional recursive-p)
571 (howm-view-summary "" (howm-folder-items dir recursive-p)))
573 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
576 (defun howm-view-filter (&optional remove-p)
578 (let* ((table howm-view-filter-methods)
579 (command (completing-read (if remove-p
580 "(Reject) filter by: "
583 (call-interactively (cdr (assoc command table)))))
585 (defun howm-view-filter-uniq ()
587 (howm-view-filter-doit #'howm-filter-items-uniq))
589 (defun howm-view-filter-by-name (&optional remove-p regexp)
591 (howm-view-filter-by-name/summary #'howm-filter-items-by-name
594 (defun howm-view-filter-by-summary (&optional remove-p regexp)
596 (howm-view-filter-by-name/summary #'howm-filter-items-by-summary
599 (defun howm-view-filter-by-name/summary (filter regexp remove-p)
600 (let* ((r (or regexp (howm-view-filter-read-from-minibuffer "Regexp: "
602 (f `(lambda (item-list rmv-p)
603 (funcall #',filter item-list ,r rmv-p))))
604 (howm-view-filter-doit f remove-p)))
606 (defun howm-view-filter-by-date (&optional remove-p)
608 (howm-view-filter-by-time-range #'howm-filter-items-by-date
611 (defun howm-view-filter-by-reminder (&optional remove-p)
613 (howm-view-filter-by-time-range #'howm-filter-items-by-reminder remove-p))
615 (defun howm-view-filter-by-mtime (&optional remove-p range)
617 (howm-view-filter-by-time-range #'howm-filter-items-by-mtime remove-p range))
619 (defun howm-view-filter-by-time-range (filter &optional remove-p range)
620 (let* ((r (or range (howm-view-ask-time-range remove-p)))
623 (f `(lambda (item-list rmv-p)
624 (funcall #',filter item-list ',from ',to rmv-p))))
625 (howm-view-filter-doit f remove-p)))
627 (defun howm-view-filter-by-region (beg end)
629 (let ((r (mapcar #'howm-view-line-number (list beg end))))
630 (howm-view-filter-by-line-range (car r) (cadr r))))
632 (defvar howm-view-filter-by-around-default 10)
633 (defun howm-view-filter-by-around (&optional distance)
635 (let* ((d (or distance howm-view-filter-by-around-default))
636 (c (howm-view-line-number)))
637 (howm-view-filter-by-line-range (- c d) (+ c d))))
639 (defun howm-view-filter-by-line-range (beg end)
640 (let ((f `(lambda (item-list remove-p)
642 (error "Not supported."))
643 ;; beg and end are counted as 1,2,3,...
647 (min ,end (length item-list))))))
648 (howm-view-filter-doit f)))
650 (defun howm-view-filter-by-contents (&optional remove-p regexp)
652 (let ((r (or regexp (howm-view-filter-read-from-minibuffer
653 "Search in result (grep): "
656 (howm-view-remove-by-contents r)
657 (howm-view-search-in-result r))))
659 (howm-if-ver1dot3 nil
660 (defcustom howm-view-search-in-result-correctly t
661 "*Non nil if search-in-result should be aware of paragraph."
663 :group 'howm-search))
665 (defun howm-view-search-in-result (regexp)
666 ;; (interactive "sSearch in result (grep): ")
667 (let* ((orig (howm-view-name))
668 (name (if (string= orig "")
670 (format "%s&%s" orig regexp)))
671 (orig-item-list (howm-view-item-list))
672 (folder (howm-make-folder-from-items orig-item-list)))
673 (howm-write-history regexp)
674 (howm-view-search-folder regexp folder name)
675 (when howm-view-search-in-result-correctly
676 (howm-view-summary-rebuild (howm-item-list-filter (howm-view-item-list)
679 (defun howm-view-remove-by-contents (regexp)
680 ;; (interactive "s(Reject) Search in result (grep): ")
681 (let ((howm-v-r-b-c-regexp regexp))
682 (howm-view-sort/filter-doit
683 (lambda (item-list switch)
684 (howm-filter-items-by-contents item-list howm-v-r-b-c-regexp t)))))
686 (defun howm-view-sort/filter-doit (proc &optional switch)
687 (let ((kw font-lock-keywords))
689 ;; return item-list for
690 ;; https://howm.osdn.jp/cgi-bin/hiki/hiki.cgi?HidePrivateReminder
691 (howm-view-summary-rebuild (funcall proc (howm-view-item-list) switch))
692 (setq font-lock-keywords kw))))
694 (defalias 'howm-view-filter-doit 'howm-view-sort/filter-doit)
696 ;; For backward compatibility with howmoney. Don't use this.
697 (defun howm-view-filter-general (pred)
698 (howm-view-filter-doit (lambda (item-list dummy)
699 (cl-remove-if-not pred item-list))))
700 ;; (defun howm-view-filter-general (pred &optional remove-p with-index)
701 ;; (let* ((item-list (howm-view-item-list))
703 ;; (howm-map-with-index #'list item-list)
706 ;; (cl-remove-if pred s)
707 ;; (cl-remove-if-not pred s)))
708 ;; (filtered (if with-index
711 ;; (howm-view-summary-rebuild filtered)))
713 (defmacro howm-filter-items (pred lis &optional remove-p)
715 (cl-remove-if ,pred ,lis)
716 (cl-remove-if-not ,pred ,lis)))
718 (defun howm-filter-items-uniq (item-list &optional remove-p)
720 (error "Not supported."))
721 (let* ((howm-view-filter-uniq-prev (if howm-view-search-in-result-correctly
724 (pred (if howm-view-search-in-result-correctly
726 (let ((page (howm-item-page item))
727 (place (howm-item-place item))
728 (range (howm-item-range item))
729 (p-page (car howm-view-filter-uniq-prev))
730 (p-range (cdr howm-view-filter-uniq-prev)))
732 (not (and (howm-page= page p-page)
734 (<= (car p-range) place)
735 (<= place (cadr p-range)))))
736 (setq howm-view-filter-uniq-prev (cons page range)))))
739 (let ((f (howm-view-item-filename item)))
741 (not (howm-page= f howm-view-filter-uniq-prev))
742 (setq howm-view-filter-uniq-prev f)))))))
743 (cl-remove-if-not pred item-list)))
745 (defun howm-filter-items-by-name (item-list regexp &optional remove-p)
746 (howm-filter-items-by-name/summary #'howm-view-item-basename
747 item-list regexp remove-p))
749 (defun howm-filter-items-by-summary (item-list regexp &optional remove-p)
750 (howm-filter-items-by-name/summary #'howm-view-item-summary
751 item-list regexp remove-p))
753 (defun howm-filter-items-by-name/summary (accessor item-list regexp remove-p)
754 (howm-filter-items (lambda (item)
755 (string-match regexp (funcall accessor item)))
758 (defun howm-filter-items-by-date (item-list from to &optional remove-p)
759 (let* ((form (howm-view-file-name-format))
760 (fts (mapcar (lambda (x)
761 (file-name-nondirectory (format-time-string form x)))
765 (howm-filter-items (lambda (item)
766 (let ((cs (howm-view-item-basename item)))
767 (and (howm-view-string<= fs cs)
768 (howm-view-string< cs ts))))
769 item-list remove-p)))
771 (defun howm-filter-items-by-reminder (item-list from to &optional remove-p)
772 (let* ((from-str (format-time-string howm-date-format from))
773 (to-str (format-time-string howm-date-format to))
774 (reg (howm-reminder-regexp howm-reminder-types)))
777 (let ((s (howm-view-item-summary item)))
778 (and (string-match reg s)
779 (let* ((x (match-string-no-properties 0 s)) ;; [2004-02-07]@
780 (d (and (string-match howm-date-regexp x)
781 (match-string-no-properties 0 x)))) ;; [2004-02-07]
782 (and (howm-view-string<= from-str d)
783 (howm-view-string< d to-str))))))
784 item-list remove-p)))
786 (defun howm-filter-items-by-mtime (item-list from to &optional remove-p)
787 (let ((fs (howm-view-time-to-string from))
788 (ts (howm-view-time-to-string to)))
791 (let ((cs (howm-view-mtime (howm-view-item-filename item))))
792 (and (howm-view-string<= fs cs)
793 (howm-view-string< cs ts))))
794 item-list remove-p)))
796 (defun howm-filter-items-by-contents (item-list regexp &optional remove-p)
797 (let* ((match (howm-view-search-folder-items-fi regexp item-list)))
798 (if howm-view-search-in-result-correctly
799 (howm-item-list-filter item-list match remove-p)
801 (let ((match-names (howm-cl-remove-duplicates*
802 (mapcar #'howm-item-name match))))
803 (howm-filter-items (lambda (item)
804 (member (howm-item-name item) match-names))
805 item-list remove-p)))))
807 (defun howm-view-file-name-format ()
808 howm-file-name-format) ;; defined in howm-common.el
810 (defun howm-view-ask-time-range (&optional remove-p)
811 (let* ((now (current-time))
812 (from (howm-view-ask-time "From" now t remove-p))
813 (to (howm-view-ask-time "To" from nil remove-p)))
816 (defvar howm-view-min-year 1950)
817 (defvar howm-view-max-year 2030)
818 (defun howm-view-ask-time (prompt default &optional from-p remove-p)
819 (let* ((z (decode-time default))
823 (let (y0 m0 d0 hour0 min0 sec0)
825 (setq y0 howm-view-min-year m0 1 d0 1
826 hour0 0 min0 0 sec0 0)
827 (setq y0 howm-view-max-year m0 12 d0 'last-day-of-month
828 hour0 24 min0 0 sec0 0))
829 (let ((y (howm-ask-time-sub prompt "year" yd remove-p)))
831 (howm-view-encode-time sec0 min0 hour0 d0 m0 y0)
832 (let ((m (howm-ask-time-sub prompt "month" md remove-p)))
834 (howm-view-encode-time sec0 min0 hour0 d0 m0 y)
835 (let ((d (or (howm-ask-time-sub prompt "date" dd remove-p) d0)))
836 (howm-view-encode-time sec0 min0 hour0 d m y)))))))))
838 (defun howm-ask-time-sub (prompt ymd default remove-p)
839 (let* ((message (format "%s %s (* = no limit) [%d]: " prompt ymd default))
840 (raw (howm-view-filter-read-from-minibuffer message remove-p))
841 (n (if (string= raw "")
843 (string-to-number raw))))
848 (defun howm-view-encode-time (sec min hour d m y)
849 (when (eq d 'last-day-of-month)
852 (encode-time sec min hour d m y))
854 (defun howm-view-filter-read-from-minibuffer (message &optional remove-p)
855 (read-from-minibuffer (if remove-p
856 (concat "(Reject) " message)
859 (defun howm-view-summary-rebuild (item-list &optional fl-keywords)
860 (howm-view-summary (howm-view-name) item-list fl-keywords))
862 (let* ((h (regexp-quote howm-view-title-header))
863 (t1 (format "Skip \"%s \"" howm-view-title-header))
864 (r1 (format "^\\(%s\\)? *$" h))
865 (t2 (format "Skip \"%s \" and \"[xxxx-xx-xx xx:xx]\""
866 howm-view-title-header))
867 (r2 (format "\\(%s\\)\\|\\(^\\[[-: 0-9]+\\]\\)" r1)))
868 (howm-if-ver1dot3 nil
869 (defcustom howm-view-title-skip-regexp r2
870 "*Regular expression for lines which should not be titles.
871 If the original title matches this regexp, the first non-matched line
872 is shown as title instead.
873 Nil disables this feature.
875 This feature does not work when `howm-view-search-in-result-correctly' is nil."
876 :type `(radio (const :tag "Off" nil)
881 :group 'howm-efficiency)))
883 (defcustom howm-view-list-title-type 1
884 "*Type of showing title in summary buffer.
885 Value 1 means \"show title instead of summary\".
886 Value 2 means \"show title before summary\".
887 You may want to set `howm-view-summary-format' to be \"\" if you never need
889 :type '(radio (const :tag "title instead of summary"
891 (const :tag "title before summary"
893 :group 'howm-experimental)
895 (defun howm-view-list-title (title-regexp)
896 (howm-view-summary-rebuild (howm-entitle-items
897 title-regexp (howm-view-item-list))))
899 (defun howm-entitle-items (title-regexp item-list)
900 (if (= howm-view-list-title-type 1)
901 (howm-entitle-items-style1 title-regexp item-list)
902 (howm-entitle-items-style2 title-regexp item-list)))
904 (defun howm-entitle-items-style1 (title-regexp item-list)
905 "Put title instead of summary."
906 (let ((items (howm-view-search-folder-items-fi title-regexp item-list)))
907 (if howm-view-search-in-result-correctly
908 (let* ((r (howm-item-list-filter items item-list 'with-rest))
910 (nohit-items (cdr r))
911 ;; should I use (howm-classify #'howm-item-place nohit-items) ?
913 (cl-remove-if #'howm-item-place nohit-items))
915 (howm-item-list-filter (cl-remove-if-not #'howm-item-place
918 (all-items (append hit-items noplace-nohit-items rest-items)))
919 (when howm-view-title-skip-regexp
920 (mapc #'howm-view-change-title all-items))
922 (let* ((pages (howm-cl-remove-duplicates* (mapcar #'howm-item-page
924 (hit-pages (mapcar #'howm-item-page items))
925 (nohit-pages (cl-remove-if
926 (lambda (p) (cl-member p hit-pages
929 (nohit-items (mapcar #'howm-make-item nohit-pages))
930 (all-items (if (null nohit-items)
932 (append items nohit-items))))
935 (defvar howm-entitle-items-style2-max-length 20)
936 (defvar howm-entitle-items-style2-format "%-13s | %s") ;; for title and summary
937 (defvar howm-entitle-items-style2-title-line nil) ;; independent title line?
938 (defun howm-entitle-items-style2 (title-regexp item-list)
939 "Put title before summary."
940 ;; fix me: howm-item-place is not set for howm-list-all
941 (let ((last-title ""))
944 (let ((orig (howm-item-summary item))
945 (titles (howm-item-titles item)))
948 (if (string= s last-title)
951 (when (> (length s) howm-entitle-items-style2-max-length)
952 (setq s (substring s 0 howm-entitle-items-style2-max-length)))
954 (let ((i (howm-item-dup item)))
955 (howm-item-set-summary i x)
957 (if (and howm-entitle-items-style2-title-line
958 (not (string= s "")))
959 (list (format howm-entitle-items-style2-format
961 (format howm-entitle-items-style2-format
963 (list (format howm-entitle-items-style2-format
965 (or titles (list "")))))
968 ;;; detect items in same paragraph (= entry = memo. sorry for inconsistent terminology)
970 (defun howm-item-with-temp-buffer (item proc)
972 (howm-page-insert (howm-item-page item))
973 (let* ((p (howm-item-place item))
975 (list (point-min) (point-max))
978 (howm-view-paragraph-region)))))
979 (narrow-to-region (car r) (cadr r))
980 (funcall proc item))))
982 (defun howm-item-titles (item)
983 "List of titles of ITEM.
984 When place (see `howm-item-place') is specified, ITEM has at most one title.
985 Otherwise, ITEM can have two or more titles."
986 (howm-item-with-temp-buffer
990 (goto-char (point-min))
991 (while (re-search-forward (howm-list-title-regexp) nil t)
993 (cons (buffer-substring-no-properties (match-beginning 0)
997 (if (string-match howm-view-title-regexp x)
998 (match-string-no-properties howm-view-title-regexp-pos x)
1000 (reverse titles))))))
1002 (defun howm-item-range (item)
1003 "List of beginning-place and end-place of paragraph to which ITEM belongs."
1004 (howm-item-with-temp-buffer
1007 (let ((r (list (point-min) (point-max))))
1013 (goto-char (cadr r))
1014 (riffle-get-place)))))))
1015 ;; (with-temp-buffer
1016 ;; (howm-page-insert (howm-item-page item))
1017 ;; (let* ((p (howm-item-place item))
1019 ;; (list (point-min) (point-max))
1021 ;; (riffle-set-place p)
1022 ;; (howm-view-paragraph-region)))))
1024 ;; (goto-char (car r))
1025 ;; (riffle-get-place))
1027 ;; (goto-char (cadr r))
1028 ;; (riffle-get-place))))))
1030 (defun howm-item-list-rangeset (item-list)
1031 "Make assoc list of page to rangeset.
1032 ITEM-LIST is list of items.
1033 Return value is assoc list; each element of it is a cons pair of page
1034 and rangeset which indicates ranges of places of paragraphs to which items
1035 in ITEM-LIST belongs."
1036 (let ((alist nil)) ;; key = page, value = rangeset of place
1037 (cl-labels ((add-to-alist (page rs)
1038 (setq alist (cons (cons page rs) alist))))
1039 (mapc (lambda (item)
1040 (let* ((page (howm-item-page item))
1041 (place (howm-item-place item))
1042 (rs (cdr (assoc page alist))))
1044 (add-to-alist page (howm-make-rangeset)))
1046 (add-to-alist page (howm-make-rangeset
1047 (howm-item-range item))))
1048 ((howm-rangeset-belong-p place rs)
1051 (howm-rangeset-add! rs (howm-item-range item))))))
1055 (defun howm-item-list-filter (item-list reference-item-list
1056 &optional remove-match)
1057 "Select items in ITEM-LIST according to REFERENCE-ITEM-LIST.
1058 When REMOVE-MATCH is nil, return value is list of items i in ITEM-LIST
1059 which satisfy the condition \"there exists i' in REFERENCE-ITEM-LIST
1060 such that i and i' belong to same paragraph\" (case 1).
1061 When REMOVE-MATCH is non-nil and not the symbol 'with-rest',
1062 return value is complement of the above list;
1063 list of items in ITEM-LIST which do not satisfy the above condition (case 2).
1064 When REMOVE-MATCH is the symbol 'with-rest',
1065 return value is (A . B), where A is the return value of case 1 and
1066 B is items in REFERENCE-ITEM-LIST that do not match in case 1."
1068 ;; split no-place items:
1069 ;; Though implementation 1 calls grep many times,
1070 ;; implementation 2 is slower in construction of folder from items.
1073 ;; implementation 1 (call grep many times)
1075 (cl-mapcan (lambda (item)
1076 (if (howm-item-place item)
1078 (or (howm-view-search-folder-items-fi
1079 (howm-view-title-regexp-grep) (list item))
1083 ;; ;; implementation 2 (making items-folder is slow)
1084 ;; (let* ((place-items (cl-remove-if-not #'howm-item-place item-list))
1085 ;; (no-place-items (cl-remove-if #'howm-item-place item-list))
1086 ;; (split-items (howm-view-search-folder-items-fi
1087 ;; (howm-view-title-regexp-grep) no-place-items))
1088 ;; ;;; !!!!!!!!! use CL !!!!!!!!!!!!!!!!!!!!!!!!!!!!
1089 ;; (no-title-items (set-difference no-place-items split-items
1090 ;; :key #'howm-item-page)))
1091 ;; (setq item-list (append place-items split-items no-title-items)))
1093 (let* ((alist (howm-item-list-rangeset reference-item-list))
1094 (matcher (lambda (item)
1095 (let* ((page (howm-item-page item))
1096 (place (howm-item-place item))
1097 (rs (cdr (assoc page alist))))
1098 (cond ((null rs) nil)
1099 ((howm-rangeset-belong-p place rs) rs)
1101 (cond ((eq remove-match 'with-rest)
1102 (let ((match (cl-remove-if-not
1104 (let ((rs (funcall matcher item)))
1105 (and rs (howm-rangeset-hit! rs))))
1109 (lambda (a) (and (not (howm-rangeset-hit-p (cdr a)))
1110 (list (howm-make-item (car a)))))
1112 (remove-match (cl-remove-if matcher item-list))
1113 (t (cl-remove-if-not matcher item-list)))))
1117 ;;; (*rangeset* (1 . 4) (5 . 6) (8 . 14))
1118 ;;; (*rangeset*) ==> "almighty"
1119 ;;; (*rangeset-hit* (1 . 4) (5 . 6) (8 . 14)) ==> "hit" is recorded
1121 (defun howm-make-rangeset (&optional beg-end)
1123 (cons '*rangeset* nil)
1124 (let ((rs (howm-make-rangeset)))
1125 (howm-rangeset-add! rs beg-end))))
1127 (defun howm-rangeset-belong-p (point rs)
1129 (cl-member-if (lambda (pair)
1130 (and (<= (car pair) point) (<= point (cdr pair))))
1133 (defun howm-rangeset-add! (rs beg-end)
1134 ;; "almighty" is ignored here. sorry for confusion...
1135 ;; c = cursor (pointing its cdr)
1139 (end (cadr beg-end)))
1140 (while (and (cdr c) beg)
1142 (cond ((< end (car p)) ;; insert [beg, end] here
1143 (rplacd c (cons (cons beg end) (cdr c)))
1145 ((< (cdr p) beg) ;; skip this
1147 (t ;; merge into [beg, end]
1148 (setq beg (min beg (car p))
1149 end (max end (cdr p)))
1150 (rplacd c (cddr c))))))
1152 (rplacd c (list (cons beg end)))))
1155 (defvar howm-rangeset-hit-indicator '*rangeset-hit*)
1157 (defun howm-rangeset-hit! (rs)
1158 (setcar rs howm-rangeset-hit-indicator))
1160 (defun howm-rangeset-hit-p (rs)
1161 (eq (car rs) howm-rangeset-hit-indicator))
1180 (((3 . 1) (4 . 1) (5 . 9))
1182 (((3 . 1) (4 . 1) (5 . 9) (2 . 6) (5 . 3))
1185 ;; inhibit 'reference to free variable' warning in byte-compilation
1187 (cl-labels ((check (ans result)
1188 (cond ((null ans) (null result))
1189 ((not (equal (car ans) (car result))) nil)
1190 (t (funcall check (cdr ans) (cdr result))))))
1192 (apply (lambda (prob ans)
1193 (let* ((rs (howm-make-rangeset)))
1194 (mapc (lambda (pair)
1195 (let ((a (car pair))
1197 (howm-rangeset-add! rs
1201 (when (not (equal (cdr rs) ans))
1202 (error "howm-rangeset-add: %s ==> %s" prob rs))))
1206 (let ((rs '(*rangeset* (1 . 4) (5 . 6) (8 . 14))))
1207 (if (and (howm-rangeset-belong-p 1 rs)
1208 (howm-rangeset-belong-p 3 rs)
1209 (howm-rangeset-belong-p 4 rs)
1210 (howm-rangeset-belong-p 5 rs)
1211 (not (howm-rangeset-belong-p 0 rs))
1212 (not (howm-rangeset-belong-p 4.5 rs))
1213 (not (howm-rangeset-belong-p 7 rs))
1214 (not (howm-rangeset-belong-p 15 rs)))
1216 (error "howm-rangeset-belong-p: wrong result")))
1218 (defun howm-view-change-title (item)
1219 (when (string-match howm-view-title-skip-regexp (howm-item-summary item))
1220 (let ((title-line (with-temp-buffer
1221 (howm-page-insert (howm-item-page item))
1222 (howm-view-set-place (or (howm-item-place item)
1223 (howm-view-get-place
1225 (howm-view-get-title-line))))
1226 (howm-item-set-summary item title-line))))
1228 (defun howm-view-get-title-line ()
1229 (while (and (looking-at howm-view-title-skip-regexp)
1230 (= (forward-line 1) 0))
1233 (buffer-substring-no-properties (line-beginning-position)
1234 (line-end-position)))
1236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1239 (defun howm-view-search (str file-list &optional
1240 name summarizer fixed-p hilit-keywords)
1241 "This function is not used in howm any more."
1242 (howm-view-search-folder str (howm-make-folder:files file-list)
1243 name summarizer fixed-p hilit-keywords))
1245 (defun howm-view-search-items (str file-list &optional summarizer fixed-p)
1246 (howm-view-search-folder-items str (howm-make-folder:files file-list)
1247 summarizer fixed-p))
1249 (defun howm-view-search-folder (&rest args)
1250 (howm-view-search-folder-doit (apply #'howm-view-search-folder-internal
1253 (defun howm-view-search-folder-internal (str folder
1254 &optional name summarizer
1255 fixed-p hilit-keywords)
1256 ;; clean me. str-orig can be string or list of strings.
1257 (let* ((str-orig str)
1258 (str-list (if (listp str-orig) str-orig (list str-orig)))
1259 (str-principal (if (listp str-orig) (car str-orig) str-orig)))
1261 (setq str str-principal)
1262 (setq name (or name str))
1263 (when howm-view-update-search-ring
1264 (isearch-update-ring str (not fixed-p)))
1265 (let* ((items (howm-view-search-folder-items str-orig
1266 folder summarizer fixed-p))
1267 (kw (or hilit-keywords
1268 (let ((r (if fixed-p
1269 (regexp-opt str-list)
1270 (mapconcat (lambda (x) (concat "\\(" x "\\)"))
1273 `((,r . howm-view-hilit-face))))))
1274 (let* ((f (expand-file-name str)))
1275 (when (file-exists-p f)
1276 (let ((fi (howm-view-make-item f)))
1277 (howm-view-item-set-privilege fi t)
1278 (setq items (cons fi items)))))
1279 (list kw name items))))
1281 (defun howm-view-search-folder-doit (p)
1282 (howm-view-summary (cadr p) (cl-caddr p) (car p)))
1284 (defun howm-view-search-folder-items (str folder &optional summarizer fixed-p)
1285 (let ((found (howm-folder-grep folder str fixed-p))
1286 (summarizer (or summarizer
1287 (lambda (file place content)
1288 (string-match "^ *\\(.*\\)" content)
1289 (match-string-no-properties 1 content)))))
1291 (let ((file (howm-page-name (howm-item-page i)))
1292 (place (howm-item-place i))
1293 (content (howm-item-summary i)))
1294 (howm-item-set-summary i (funcall summarizer
1295 file place content))))
1299 ;; sorry for confusing functions...
1301 (defun howm-view-search-folder-items-fi (regexp item-list &rest args)
1302 (apply #'howm-view-search-folder-items
1303 regexp (howm-make-folder-from-items item-list) args))
1305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1308 (defun howm-view-sort ()
1310 (let* ((table howm-view-sort-methods)
1311 (command (completing-read "sort by: " table nil t)))
1312 (call-interactively (cdr (assoc command table)))))
1314 (defmacro howm-view-defun-sort-by (name)
1315 "Define an interactive command howm-view-sort-by-NAME,
1316 which simply calls howm-sort-items-by-NAME."
1317 (let ((command (howm-get-symbol nil "howm-view-sort-by-" name))
1318 (internal (howm-get-symbol nil "howm-sort-items-by-" name)))
1319 `(defun ,command (&optional reverse-p)
1321 (howm-view-sort-doit #',internal reverse-p))))
1322 (howm-view-defun-sort-by "random")
1323 (howm-view-defun-sort-by "name")
1324 (howm-view-defun-sort-by "numerical-name")
1325 (howm-view-defun-sort-by "date")
1326 (howm-view-defun-sort-by "reverse-date")
1327 (howm-view-defun-sort-by "summary")
1328 (howm-view-defun-sort-by "reminder")
1329 (howm-view-defun-sort-by "mtime")
1330 (howm-view-defun-sort-by "reverse")
1332 (defalias 'howm-view-sort-reverse 'howm-view-sort-by-reverse)
1334 (defalias 'howm-view-sort-doit 'howm-view-sort/filter-doit)
1336 (defmacro howm-sort-items (evaluator comparer item-list
1337 &optional reverse-p)
1338 `(let* ((howm-view-s-i-comparer ,comparer)
1340 (lambda (a b) (funcall howm-view-s-i-comparer b a))
1341 howm-view-s-i-comparer)))
1342 (howm-sort ,evaluator cmp item-list)))
1344 ;; ;; generate the below aliases for howm-test080714
1345 ;; (let ((methods '("random" "name" "numerical-name" "date" "reverse-date"
1346 ;; "summary" "reminder" "mtime" "reverse")))
1347 ;; (mapcar (lambda (m)
1349 ;; (howm-get-symbol nil "howm-view-sort-by-" m))
1351 ;; (howm-get-symbol nil "howm-sort-items-by-" m))
1353 ;; (howm-get-symbol nil command "-internal")))
1354 ;; `(defalias ',obsolete ',internal)))
1357 ;; for backward compatibility with howm-test080714 only
1358 (defalias 'howm-view-sort-by-random-internal 'howm-sort-items-by-random)
1359 (defalias 'howm-view-sort-by-name-internal 'howm-sort-items-by-name)
1360 (defalias 'howm-view-sort-by-numerical-name-internal
1361 'howm-sort-items-by-numerical-name)
1362 (defalias 'howm-view-sort-by-date-internal 'howm-sort-items-by-date)
1363 (defalias 'howm-view-sort-by-reverse-date-internal
1364 'howm-sort-items-by-reverse-date)
1365 (defalias 'howm-view-sort-by-summary-internal 'howm-sort-items-by-summary)
1366 (defalias 'howm-view-sort-by-reminder-internal 'howm-sort-items-by-reminder)
1367 (defalias 'howm-view-sort-by-mtime-internal 'howm-sort-items-by-mtime)
1368 (defalias 'howm-view-sort-by-reverse-internal 'howm-sort-items-by-reverse)
1370 (defun howm-sort-items-by-random (item-list &optional reverse-p)
1371 (howm-sort-items #'(lambda (dummy) (random)) #'< item-list reverse-p))
1373 (defun howm-sort-items-by-name (item-list &optional reverse-p)
1374 (howm-sort-items #'howm-view-item-basename #'string< reverse-p))
1376 (defun howm-sort-items-by-numerical-name (item-list &optional reverse-p)
1377 (howm-sort-items (lambda (i)
1378 (let ((b (howm-view-item-basename i)))
1379 (if (string-match "^[0-9]+$" b)
1380 (string-to-number b)
1384 (defvar howm-view-sort-by-date-ignore-regexp "^[a-zA-Z]")
1385 (defun howm-sort-items-by-date (item-list &optional reverse-p)
1386 (let ((sorted (howm-sort-items #'howm-view-item-basename #'string<
1387 item-list reverse-p)))
1388 (cdr (howm-view-lift-internal #'howm-view-item-basename
1390 howm-view-sort-by-date-ignore-regexp
1393 (defun howm-sort-items-by-reverse-date (item-list &optional reverse-p)
1394 (howm-sort-items-by-date item-list (not reverse-p)))
1396 (defun howm-sort-items-by-summary (item-list &optional reverse-p)
1397 (howm-sort-items #'howm-view-item-summary #'string<
1398 item-list reverse-p))
1400 (defun howm-sort-items-by-reminder (item-list &optional reverse-p)
1401 (let* ((howm-view-s-b-r-i-regexp (howm-reminder-regexp howm-reminder-types))
1402 (howm-view-s-b-r-i-max (format-time-string
1403 howm-reminder-today-format
1404 (encode-time 59 59 23 31 12
1405 howm-view-max-year)))
1406 (evaluator (lambda (item)
1407 (let ((s (howm-view-item-summary item)))
1408 (if (string-match howm-view-s-b-r-i-regexp s)
1409 (match-string-no-properties 0 s)
1410 howm-view-s-b-r-i-max)))))
1411 (howm-sort-items evaluator #'string< item-list reverse-p)))
1413 (defun howm-sort-items-by-mtime (item-list &optional reverse-p)
1414 (howm-sort-items (lambda (item)
1415 (howm-view-mtime (howm-view-item-filename item)))
1417 item-list reverse-p))
1419 (defun howm-sort-items-by-reverse (item-list &optional dummy)
1420 (reverse item-list))
1422 ;;; lift (move matched items to the top)
1424 (defun howm-view-lift-by-name (&optional reverse-p regexp path-p)
1426 (howm-view-lift-doit (if path-p
1427 #'howm-view-lift-by-path-internal
1428 #'howm-view-lift-by-name-internal)
1431 (defun howm-view-lift-by-summary (&optional reverse-p regexp)
1433 (howm-view-lift-doit #'howm-view-lift-by-summary-internal
1436 (defun howm-view-lift-by-summary-substring (&optional reverse-p regexp
1439 (howm-view-lift-doit #'howm-view-lift-by-summary-substring-internal
1440 reverse-p regexp regexp-pos))
1442 (defun howm-view-lift-doit (sorter &optional reverse-p regexp
1444 (let* ((howm-view-s-b-m-d-regexp (or regexp
1445 (read-from-minibuffer "Regexp: ")))
1446 (howm-view-s-b-m-d-regexp-pos regexp-pos)
1447 (howm-view-s-b-m-d-sorter sorter)
1448 (howm-view-s-b-m-d-matched nil))
1449 (howm-view-sort-doit (lambda (item-list rvs-p)
1450 (let ((p (apply howm-view-s-b-m-d-sorter
1452 howm-view-s-b-m-d-regexp
1454 howm-view-s-b-m-d-regexp-pos)))
1455 (setq howm-view-s-b-m-d-matched (car p))
1458 howm-view-s-b-m-d-matched))
1460 (defun howm-view-lift-internal (picker item-list regexp
1461 &optional reverse-p regexp-pos)
1462 "Sort items and return (matched . sorted-list).
1463 matched can be nil, single, or multi."
1464 (let* ((howm-view-l-i-matched nil)
1465 (evaluator (lambda (item)
1466 (let ((str (funcall picker item)))
1467 (if (string-match regexp str)
1469 (setq howm-view-l-i-matched
1470 (if howm-view-l-i-matched 'multi 'single))
1472 (match-string-no-properties regexp-pos str)
1475 (comparer (if regexp-pos
1477 (cond ((eq x 0) nil)
1481 (let ((sorted-list (howm-sort-items evaluator comparer item-list
1483 (cons howm-view-l-i-matched sorted-list))))
1485 (defun howm-view-lift-by-name-internal (item-list regexp &optional reverse-p)
1486 (howm-view-lift-internal #'howm-view-item-basename
1487 item-list regexp reverse-p))
1489 (defun howm-view-lift-by-path-internal (item-list regexp &optional reverse-p)
1490 (howm-view-lift-internal #'howm-item-name item-list regexp reverse-p))
1492 (defun howm-view-lift-by-summary-internal (item-list regexp &optional reverse-p)
1493 (howm-view-lift-internal #'howm-view-item-summary item-list regexp reverse-p))
1495 (defun howm-view-lift-by-summary-substring-internal (item-list regexp
1499 (howm-view-lift-internal #'howm-view-item-summary item-list regexp reverse-p
1502 ;; backward compatibility
1503 (defalias 'howm-view-sort-by-name-match 'howm-view-lift-by-name)
1504 (defalias 'howm-view-sort-by-summary-match 'howm-view-lift-by-summary)
1505 (defalias 'howm-view-sort-by-summary-match-string
1506 'howm-view-lift-by-summary-substring)
1508 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1511 (defvar howm-view-dired-buffer-name "*howm-dired*")
1512 (howm-defvar-risky howm-view-dired-ls-command "ls")
1513 (howm-defvar-risky howm-view-dired-ls-options '("-l"))
1515 (defun dired-virtual (dir)
1516 (howm-inhibit-warning-in-compilation))
1518 (defun howm-view-dired ()
1520 (require (if (howm-xemacsp) 'dired-vir 'dired-x))
1521 (when (not (member major-mode
1522 '(howm-view-summary-mode howm-view-contents-mode)))
1523 (error "Invalid mode for this command."))
1524 ;; ;; bug in emacs-21.3.50?
1525 ;; (when (not (fboundp 'dired-insert-headerline))
1526 ;; (defun dired-insert-headerline (dir);; also used by dired-insert-subdir
1527 ;; ;; Insert DIR's headerline with no trailing slash, exactly like ls
1528 ;; ;; would, and put cursor where dired-build-subdir-alist puts subdir
1530 ;; (save-excursion (insert " " (directory-file-name dir) ":\n"))))
1531 (let* ((i2f (lambda (item)
1532 (file-relative-name (howm-view-item-filename item))))
1533 (current-file (funcall i2f (riffle-summary-current-item)))
1534 (files (howm-cl-remove-duplicates* (mapcar i2f (howm-view-item-list))
1536 ;; (pos (cl-position f files :test #'string=))
1537 (args (append howm-view-dired-ls-options files))
1538 (a `((howm-view-summary-mode . ,howm-view-summary-persistent)
1539 (howm-view-contents-mode . ,howm-view-contents-persistent)))
1540 (p (howm-view-persistent-p (cdr (assoc major-mode a)))))
1542 (howm-view-restore-window-configuration)
1543 (howm-view-kill-buffer))
1544 (switch-to-buffer (get-buffer-create howm-view-dired-buffer-name))
1545 (setq buffer-read-only nil)
1547 (howm-call-process-here howm-view-dired-ls-command args)
1548 (set-buffer-modified-p nil)
1549 (dired-virtual default-directory)
1550 (howm-view-dired-goto current-file)))
1552 (defun howm-view-dired-goto (rname)
1553 "In dired buffer, search file name RNAME and move cursor to corresponding line.
1554 RNAME must be relative name."
1555 (goto-char (point-min))
1556 ;; Raw call of `dired-get-filename' and `dired-next-line' causes
1557 ;; warnings in compilation.
1558 (while (let ((c (howm-funcall-if-defined (dired-get-filename 'no-dir t))))
1559 (not (and c (equal (file-relative-name c) rname))))
1560 (howm-funcall-if-defined (dired-next-line 1))))
1562 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1565 (howm-defvar-risky howm-view-summary-shell-hist '("ls -l FILE" "FILE"))
1566 (howm-defvar-risky howm-view-summary-shell-last-file "FILE")
1567 (defun howm-view-summary-shell-command ()
1569 (when (not (member major-mode
1570 '(howm-view-summary-mode)))
1571 (error "Invalid mode for this command."))
1572 (let* ((n (howm-view-line-number))
1573 (item (nth (1- n) (howm-view-item-list)))
1574 (file (howm-page-abbreviate-name (howm-view-item-filename item)))
1575 (last-reg (regexp-quote howm-view-summary-shell-last-file)))
1576 (setq howm-view-summary-shell-hist
1578 (replace-regexp-in-string last-reg file h t))
1579 howm-view-summary-shell-hist))
1580 (setq howm-view-summary-shell-last-file file)
1581 (let* ((default (car howm-view-summary-shell-hist))
1582 (c (read-string "command: "
1584 '(howm-view-summary-shell-hist . 1))))
1586 (let ((item-list (cl-remove-if (lambda (item)
1588 (howm-view-item-filename item))))
1589 (howm-view-item-list))))
1590 (setq *riffle-summary-check* nil) ;; dirty
1591 (howm-view-summary (howm-view-name) item-list)
1593 (save-selected-window
1594 (let ((b (get-buffer "*Shell Command Output*")))
1595 (cond ((not (howm-buffer-empty-p b))
1596 (switch-to-buffer-other-window b))
1597 ((eq item (riffle-summary-current-item))
1600 (setq *riffle-summary-check* t) ;; dirty
1601 (howm-view-summary-check t))))))
1604 ;;; howm-view.el ends here