howm-view.el

   1 ;;; howm-view.el --- Wiki-like note-taking tool
   2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2020
   3 ;;;   HIRAOKA Kazuyuki <khi@users.osdn.me>
   4 ;;;
   5 ;;; This program is free software; you can redistribute it and/or modify
   6 ;;; it under the terms of the GNU General Public License as published by
   7 ;;; the Free Software Foundation; either version 1, or (at your option)
   8 ;;; any later version.
   9 ;;;
  10 ;;; This program is distributed in the hope that it will be useful,
  11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;; GNU General Public License for more details.
  14 ;;;
  15 ;;; The GNU General Public License is available by anonymouse ftp from
  16 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  17 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  18 ;;; USA.
  19 ;;--------------------------------------------------------------------
  20
  21 (provide 'howm-view)
  22 (require 'howm)
  23
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;; variables
  26
  27 ;; customize
  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))
  50
  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)))
  65
  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))
  77   ))
  78
  79 ;; referred only when howm-view-use-grep is nil
  80 (defvar howm-view-watch-modified-buffer t)
  81
  82 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  83 ;;; item
  84
  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)
  89         f
  90       b)))
  91
  92 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  93 ;;; riffle
  94
  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)
 100
 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)))
 107
 108 ;;; aliases
 109
 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)
 124
 125 ;; for howmoney.el
 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)
 135
 136 ;; for howmz
 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)
 140
 141 ;;; variables
 142
 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)
 150
 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
 155   "For internal use.")
 156 (defvar howm-view-font-lock-first-time t
 157   "For internal use.")
 158 (make-variable-buffer-local 'howm-view-font-lock-keywords)
 159 (make-variable-buffer-local 'howm-view-font-lock-first-time)
 160
 161 ;;; modes
 162
 163 (riffle-define-derived-mode howm-view-summary-mode riffle-summary-mode "HowmS"
 164   "memo viewer (summary mode)
 165 key     binding
 166 ---     -------
 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
 179
 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
 184
 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
 192 "
 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)
 213   )
 214
 215 (riffle-define-derived-mode howm-view-contents-mode riffle-contents-mode "HowmC"
 216   "memo viewer (contents mode)
 217 key     binding
 218 ---     -------
 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
 229
 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
 237 "
 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)
 256     ))
 257
 258 (defun howm-view-font-lock-keywords ()
 259   (with-current-buffer (riffle-summary-buffer)
 260     howm-view-font-lock-keywords))
 261
 262 ;;; keymaps
 263
 264 ;; (defvar howm-view-summary-mode-map nil)
 265 ;; (defvar howm-view-contents-mode-map nil)
 266
 267 (defun howm-view-define-common-key (keymap)
 268   (let ((m 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)
 276     ))
 277
 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))
 291
 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))
 296
 297 ;;; summary
 298
 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))))
 303     (if (null r)
 304         (message "No match")
 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*)))
 308     r))
 309
 310 ;; (defun howm-view-summary (&optional name item-list)
 311 ;;   (let ((*howm-view-font-lock-keywords* t))
 312 ;;     (riffle-summary name item-list ':howm)))
 313
 314 (defun howm-view-summary-open (&optional reverse-delete-p)
 315   (interactive "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
 321                          (not p)
 322                        p)))
 323     (howm-record-view-window-configuration)
 324     (howm-view-summary-open-sub (not persistent))))
 325
 326 (defun howm-view-summary-open-sub (&optional kill)
 327   (interactive "P")
 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))
 334     (end-of-line)
 335     (or (search-backward looking-at-str (line-beginning-position) t)
 336         (beginning-of-line))
 337     (run-hooks 'howm-view-open-hook)))
 338
 339 (defvar howm-view-summary-item-previous-name nil
 340   "for internal use")
 341 (defun howm-view-summary-item (item)
 342   ;; Clean me. This depends on implementation of `riffle-summary-show'
 343   ;; severely.
 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))
 349                    ""
 350                  (progn
 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))))
 355
 356 (defun howm-view-summary-next-section (&optional n)
 357   (interactive "P")
 358   (setq n (or n 1))
 359   (let ((i (abs n))
 360         (step (if (>= n 0) 1 -1)))
 361     (while (and (> i 0)
 362                 (howm-view-summary-next-section-sub step))
 363       (setq i (1- i)))))
 364 (defun howm-view-summary-previous-section (&optional n)
 365   (interactive "P")
 366   (setq n (or n 1))
 367   (howm-view-summary-next-section (- n)))
 368 (defun howm-view-summary-next-section-sub (step)
 369   ;; inefficient. so what?
 370   (let* ((f (lambda ()
 371               (howm-view-item-filename (riffle-summary-current-item))))
 372 ;;               (riffle-controller 'section (riffle-summary-current-item))))
 373          (cont-p (lambda ()
 374                    (save-excursion
 375                      (let ((a (funcall f)))
 376                        (forward-line -1)
 377                        (string= a (funcall f)))))))
 378     (while (and (= (forward-line step) 0)
 379                 (funcall cont-p))
 380       ;; no body
 381       )))
 382
 383 ;;; contents
 384
 385 (defun howm-view-contents-open (&optional reverse-delete-p)
 386   (interactive "P")
 387   (let* ((p (riffle-persistent-p howm-view-contents-persistent))
 388          (persistent (if reverse-delete-p
 389                          (not p)
 390                        p)))
 391     (howm-record-view-window-configuration)
 392     (howm-view-contents-open-sub (not persistent))))
 393
 394 (defvar *howm-view-item-privilege* nil) ;; dirty
 395
 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)))
 402     (when kill
 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)
 408     (if viewer
 409         (howm-view-call-external-viewer viewer page)
 410       (howm-view-open-item item
 411                            (lambda ()
 412                              (when (or (< pos (point-min)) (<= (point-max) pos))
 413                                (widen))
 414                              (goto-char pos))
 415                            t))
 416     (run-hooks 'howm-view-open-hook)))
 417
 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)
 421   (if position-setter
 422       (funcall position-setter)
 423     (howm-view-set-place (howm-item-place item)))
 424   (recenter howm-view-open-recenter)
 425   (when (not merely)
 426     (howm-view-open-postprocess)))
 427 (defun howm-view-open-postprocess ()
 428   (run-hooks 'howm-view-open-hook))
 429
 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")
 433
 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!
 442          (done-p (if place
 443                      (and peq
 444                           (<= howm-view-previous-section-beg place)
 445                           (<= place howm-view-previous-section-end))
 446                    peq)))
 447     (if done-p
 448         ""
 449       (let* ((header (if (null (cdr (howm-view-item-list))) ;; dirty!
 450                          ""
 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)))
 455         (concat header
 456                 (howm-view-contents-item-sub item page place header viewer
 457                                              (+ (point) header-length)))))))
 458
 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
 467       (with-temp-buffer
 468         (insert str)
 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
 473     (length str)))
 474
 475 (defun howm-view-contents-item-sub (item page place header viewer c)
 476   (with-temp-buffer
 477     (let (b e h)
 478       (if viewer
 479           (howm-view-contents-indicator viewer page)
 480         (howm-page-insert page))
 481       (if place
 482           (progn
 483             (riffle-set-place place)
 484             (setq h (point))
 485             (let ((r (howm-view-contents-region page)))
 486               (setq b (car r)
 487                     e (cadr r))))
 488         (setq b (point-min)
 489               e (point-max)
 490               h b))
 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))))
 497
 498 (defvar howm-view-preview-narrow t)
 499 (defun howm-view-contents-region (filename)
 500   (when 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))))
 506
 507 (defun howm-view-contents-indicator (viewer fname)
 508   (insert (howm-viewer-indicator viewer fname)))
 509
 510 (defun howm-view-paragraph-region (&optional include-following-blank-p)
 511   (let ((b (save-excursion
 512              (end-of-line)
 513              (re-search-backward howm-view-title-regexp
 514                                  nil 'to-limit)
 515              (line-beginning-position)))
 516         (e (save-excursion
 517              (end-of-line)
 518              (let ((found (re-search-forward howm-view-title-regexp
 519                                              nil 'to-limit)))
 520                (if include-following-blank-p
 521                    (if found (match-beginning 0) (point-max))
 522                  (progn
 523                    (if found
 524                        (forward-line -1)
 525                      (goto-char (point-max)))
 526 ;                   (end-of-line)
 527                    (while (and (looking-at "^$")
 528                                (= (forward-line -1) 0)) ;; successful
 529                      nil) ;; dummy
 530                    (end-of-line)
 531                    (point)))))))
 532     (list b e)))
 533
 534 (defun howm-view-set-mark-command ()
 535   (set-mark-command nil)
 536   (howm-deactivate-mark))
 537
 538 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 539 ;;; misc.
 540
 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)))
 544                               :test #'howm-page=))
 545
 546 (defun howm-view-mtime (file)
 547   (howm-view-time-to-string (howm-page-mtime file)))
 548
 549 ;; (defun howm-view-xtime (file x)
 550 ;;   (let* ((a (file-attributes file))
 551 ;;          (n (cdr (assoc x '((a . 4) (m . 5) (c . 6)))))
 552 ;;          (ti (nth n a)))
 553 ;;     (howm-view-time-to-string ti)))
 554
 555 (defun howm-view-time-to-string (ti)
 556   (format-time-string "%Y%m%d-%H%M%S" ti))
 557
 558 (defun howm-view-string> (a b)
 559   (string< b a))
 560
 561 (defun howm-view-string<= (a b)
 562   (not (string< b a)))
 563
 564 (defun howm-view-string< (a b)
 565   (string< a b))
 566
 567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 568 ;;; dir
 569
 570 (defun howm-view-directory (dir &optional recursive-p)
 571   (howm-view-summary "" (howm-folder-items dir recursive-p)))
 572
 573 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 574 ;;; filter
 575
 576 (defun howm-view-filter (&optional remove-p)
 577   (interactive "P")
 578   (let* ((table howm-view-filter-methods)
 579          (command (completing-read (if remove-p
 580                                        "(Reject) filter by: "
 581                                      "filter by: ")
 582                                    table nil t)))
 583     (call-interactively (cdr (assoc command table)))))
 584
 585 (defun howm-view-filter-uniq ()
 586   (interactive)
 587   (howm-view-filter-doit #'howm-filter-items-uniq))
 588
 589 (defun howm-view-filter-by-name (&optional remove-p regexp)
 590   (interactive "P")
 591   (howm-view-filter-by-name/summary #'howm-filter-items-by-name
 592                                     regexp remove-p))
 593
 594 (defun howm-view-filter-by-summary (&optional remove-p regexp)
 595   (interactive "P")
 596   (howm-view-filter-by-name/summary #'howm-filter-items-by-summary
 597                                     regexp remove-p))
 598
 599 (defun howm-view-filter-by-name/summary (filter regexp remove-p)
 600   (let* ((r (or regexp (howm-view-filter-read-from-minibuffer "Regexp: "
 601                                                               remove-p)))
 602          (f `(lambda (item-list rmv-p)
 603                (funcall #',filter item-list ,r rmv-p))))
 604     (howm-view-filter-doit f remove-p)))
 605
 606 (defun howm-view-filter-by-date (&optional remove-p)
 607   (interactive "P")
 608   (howm-view-filter-by-time-range #'howm-filter-items-by-date
 609                                   remove-p))
 610
 611 (defun howm-view-filter-by-reminder (&optional remove-p)
 612   (interactive "P")
 613   (howm-view-filter-by-time-range #'howm-filter-items-by-reminder remove-p))
 614
 615 (defun howm-view-filter-by-mtime (&optional remove-p range)
 616   (interactive "P")
 617   (howm-view-filter-by-time-range #'howm-filter-items-by-mtime remove-p range))
 618
 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)))
 621          (from (car r))
 622          (to (cadr r))
 623          (f `(lambda (item-list rmv-p)
 624                (funcall #',filter item-list ',from ',to rmv-p))))
 625     (howm-view-filter-doit f remove-p)))
 626
 627 (defun howm-view-filter-by-region (beg end)
 628   (interactive "r")
 629   (let ((r (mapcar #'howm-view-line-number (list beg end))))
 630     (howm-view-filter-by-line-range (car r) (cadr r))))
 631
 632 (defvar howm-view-filter-by-around-default 10)
 633 (defun howm-view-filter-by-around (&optional distance)
 634   (interactive "P")
 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))))
 638
 639 (defun howm-view-filter-by-line-range (beg end)
 640   (let ((f `(lambda (item-list remove-p)
 641               (when remove-p
 642                 (error "Not supported."))
 643               ;; beg and end are counted as 1,2,3,...
 644               (cl-subseq item-list
 645                               (max (1- ,beg) 0)
 646                               ;; end is included.
 647                               (min ,end (length item-list))))))
 648     (howm-view-filter-doit f)))
 649
 650 (defun howm-view-filter-by-contents (&optional remove-p regexp)
 651   (interactive "P")
 652   (let ((r (or regexp (howm-view-filter-read-from-minibuffer
 653                        "Search in result (grep): "
 654                        remove-p))))
 655     (if remove-p
 656         (howm-view-remove-by-contents r)
 657       (howm-view-search-in-result r))))
 658
 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."
 662     :type 'boolean
 663     :group 'howm-search))
 664
 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 "")
 669                    regexp
 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)
 677                                                         orig-item-list)))))
 678
 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)))))
 685
 686 (defun howm-view-sort/filter-doit (proc &optional switch)
 687   (let ((kw font-lock-keywords))
 688     (prog1
 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))))
 693
 694 (defalias 'howm-view-filter-doit 'howm-view-sort/filter-doit)
 695
 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))
 702 ;;          (s (if with-index
 703 ;;                 (howm-map-with-index #'list item-list)
 704 ;;               item-list))
 705 ;;          (r (if remove-p
 706 ;;                 (cl-remove-if pred s)
 707 ;;               (cl-remove-if-not pred s)))
 708 ;;          (filtered (if with-index
 709 ;;                        (mapcar #'car r)
 710 ;;                      r)))
 711 ;;     (howm-view-summary-rebuild filtered)))
 712
 713 (defmacro howm-filter-items (pred lis &optional remove-p)
 714   `(if ,remove-p
 715        (cl-remove-if ,pred ,lis)
 716      (cl-remove-if-not ,pred ,lis)))
 717
 718 (defun howm-filter-items-uniq (item-list &optional remove-p)
 719   (when remove-p
 720     (error "Not supported."))
 721   (let* ((howm-view-filter-uniq-prev (if howm-view-search-in-result-correctly
 722                                          (cons "" nil)
 723                                        ""))
 724          (pred (if howm-view-search-in-result-correctly
 725                    (lambda (item)
 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)))
 731                        (prog1
 732                            (not (and (howm-page= page p-page)
 733                                      (and place p-range
 734                                           (<= (car p-range) place)
 735                                           (<= place (cadr p-range)))))
 736                          (setq howm-view-filter-uniq-prev (cons page range)))))
 737                  ;; old code
 738                  (lambda (item)
 739                    (let ((f (howm-view-item-filename item)))
 740                      (prog1
 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)))
 744
 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))
 748
 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))
 752
 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)))
 756                      item-list remove-p))
 757
 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)))
 762                       (list from to)))
 763          (fs (car fts))
 764          (ts (cadr fts)))
 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)))
 770
 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)))
 775     (howm-filter-items
 776      (lambda (item)
 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)))
 785
 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)))
 789     (howm-filter-items
 790      (lambda (item)
 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)))
 795
 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)
 800       ;; old behavior
 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)))))
 806
 807 (defun howm-view-file-name-format ()
 808   howm-file-name-format) ;; defined in howm-common.el
 809
 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)))
 814     (list from to)))
 815
 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))
 820          (yd (nth 5 z))
 821          (md (nth 4 z))
 822          (dd (nth 3 z)))
 823     (let (y0 m0 d0 hour0 min0 sec0)
 824       (if from-p
 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)))
 830         (if (null y)
 831             (howm-view-encode-time sec0 min0 hour0 d0 m0 y0)
 832           (let ((m (howm-ask-time-sub prompt "month" md remove-p)))
 833             (if (null m)
 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)))))))))
 837
 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 "")
 842                 default
 843               (string-to-number raw))))
 844     (if (= n 0)
 845         nil
 846       n)))
 847
 848 (defun howm-view-encode-time (sec min hour d m y)
 849   (when (eq d 'last-day-of-month)
 850     (setq m (+ m 1))
 851     (setq d -1))
 852   (encode-time sec min hour d m y))
 853
 854 (defun howm-view-filter-read-from-minibuffer (message &optional remove-p)
 855   (read-from-minibuffer (if remove-p
 856                             (concat "(Reject) " message)
 857                           message)))
 858
 859 (defun howm-view-summary-rebuild (item-list &optional fl-keywords)
 860   (howm-view-summary (howm-view-name) item-list fl-keywords))
 861
 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.
 874
 875 This feature does not work when `howm-view-search-in-result-correctly' is nil."
 876       :type `(radio (const :tag "Off" nil)
 877                     (const :tag ,t1 ,r1)
 878                     (const :tag ,t2 ,r2)
 879                     regexp)
 880       :group 'howm-title
 881       :group 'howm-efficiency)))
 882
 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
 888 to see file names."
 889   :type '(radio (const :tag "title instead of summary"
 890                        1)
 891                 (const :tag "title before summary"
 892                        2))
 893   :group 'howm-experimental)
 894
 895 (defun howm-view-list-title (title-regexp)
 896   (howm-view-summary-rebuild (howm-entitle-items
 897                               title-regexp (howm-view-item-list))))
 898
 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)))
 903
 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))
 909                (hit-items (car r))
 910                (nohit-items (cdr r))
 911                ;; should I use (howm-classify #'howm-item-place nohit-items) ?
 912                (noplace-nohit-items
 913                 (cl-remove-if #'howm-item-place nohit-items))
 914                (rest-items
 915                 (howm-item-list-filter (cl-remove-if-not #'howm-item-place
 916                                                               nohit-items)
 917                                        items t))
 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))
 921           all-items)
 922       (let* ((pages (howm-cl-remove-duplicates* (mapcar #'howm-item-page
 923                                                         item-list)))
 924              (hit-pages (mapcar #'howm-item-page items))
 925              (nohit-pages (cl-remove-if
 926                            (lambda (p) (cl-member p hit-pages
 927                                                         :test #'howm-page=))
 928                            pages))
 929              (nohit-items (mapcar #'howm-make-item nohit-pages))
 930              (all-items (if (null nohit-items)
 931                             items
 932                           (append items nohit-items))))
 933         all-items))))
 934
 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 ""))
 942     (cl-mapcan
 943      (lambda (item)
 944        (let ((orig (howm-item-summary item))
 945              (titles (howm-item-titles item)))
 946          (cl-mapcan
 947           (lambda (s)
 948             (if (string= s last-title)
 949                 (setq s "")
 950               (setq last-title s))
 951             (when (> (length s) howm-entitle-items-style2-max-length)
 952               (setq s (substring s 0 howm-entitle-items-style2-max-length)))
 953             (mapcar (lambda (x)
 954                       (let ((i (howm-item-dup item)))
 955                         (howm-item-set-summary i x)
 956                         i))
 957                     (if (and howm-entitle-items-style2-title-line
 958                              (not (string= s "")))
 959                         (list (format howm-entitle-items-style2-format
 960                                       s "")
 961                               (format howm-entitle-items-style2-format
 962                                       "" orig))
 963                       (list (format howm-entitle-items-style2-format
 964                                     s orig)))))
 965           (or titles (list "")))))
 966      item-list)))
 967
 968 ;;; detect items in same paragraph (= entry = memo. sorry for inconsistent terminology)
 969
 970 (defun howm-item-with-temp-buffer (item proc)
 971   (with-temp-buffer
 972     (howm-page-insert (howm-item-page item))
 973     (let* ((p (howm-item-place item))
 974            (r (if (null p)
 975                   (list (point-min) (point-max))
 976                 (progn
 977                   (riffle-set-place p)
 978                   (howm-view-paragraph-region)))))
 979       (narrow-to-region (car r) (cadr r))
 980       (funcall proc item))))
 981
 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
 987    item
 988    (lambda (i)
 989      (let ((titles nil))
 990        (goto-char (point-min))
 991        (while (re-search-forward (howm-list-title-regexp) nil t)
 992          (setq titles
 993                (cons (buffer-substring-no-properties (match-beginning 0)
 994                                                      (line-end-position))
 995                      titles)))
 996        (mapcar (lambda (x)
 997                  (if (string-match howm-view-title-regexp x)
 998                      (match-string-no-properties howm-view-title-regexp-pos x)
 999                    x))
1000                (reverse titles))))))
1001
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
1005    item
1006    (lambda (i)
1007      (let ((r (list (point-min) (point-max))))
1008        (widen)
1009        (list (progn
1010                (goto-char (car r))
1011                (riffle-get-place))
1012              (progn
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))
1018 ;;            (r (if (null p)
1019 ;;                   (list (point-min) (point-max))
1020 ;;                 (progn
1021 ;;                   (riffle-set-place p)
1022 ;;                   (howm-view-paragraph-region)))))
1023 ;;       (list (progn
1024 ;;               (goto-char (car r))
1025 ;;               (riffle-get-place))
1026 ;;             (progn
1027 ;;               (goto-char (cadr r))
1028 ;;               (riffle-get-place))))))
1029
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))))
1043                 (cond ((null place)
1044                        (add-to-alist page (howm-make-rangeset)))
1045                       ((null rs)
1046                        (add-to-alist page (howm-make-rangeset
1047                                            (howm-item-range item))))
1048                       ((howm-rangeset-belong-p place rs)
1049                        nil) ;; do nothing
1050                       (t
1051                        (howm-rangeset-add! rs (howm-item-range item))))))
1052             item-list)
1053       alist)))
1054
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."
1067   ;;
1068   ;; split no-place items:
1069   ;; Though implementation 1 calls grep many times,
1070   ;; implementation 2 is slower in construction of folder from items.
1071   ;; [2012-12-28]
1072   ;;
1073   ;; implementation 1 (call grep many times)
1074   (setq item-list
1075         (cl-mapcan (lambda (item)
1076                           (if (howm-item-place item)
1077                               (list item)
1078                             (or (howm-view-search-folder-items-fi
1079                                  (howm-view-title-regexp-grep) (list item))
1080                                 (list item))))
1081                         item-list))
1082   ;;
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)))
1092   ;;
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)
1100                             (t nil))))))
1101     (cond ((eq remove-match 'with-rest)
1102            (let ((match (cl-remove-if-not
1103                          (lambda (item)
1104                            (let ((rs (funcall matcher item)))
1105                              (and rs (howm-rangeset-hit! rs))))
1106                          item-list)))
1107              (cons match
1108                    (cl-mapcan
1109                     (lambda (a) (and (not (howm-rangeset-hit-p (cdr a)))
1110                                      (list (howm-make-item (car a)))))
1111                     alist))))
1112           (remove-match (cl-remove-if matcher item-list))
1113           (t (cl-remove-if-not matcher item-list)))))
1114
1115 ;;; rangeset
1116 ;;; ex.
1117 ;;; (*rangeset* (1 . 4) (5 . 6) (8 . 14))
1118 ;;; (*rangeset*) ==> "almighty"
1119 ;;; (*rangeset-hit* (1 . 4) (5 . 6) (8 . 14)) ==> "hit" is recorded
1120
1121 (defun howm-make-rangeset (&optional beg-end)
1122   (if (null beg-end)
1123       (cons '*rangeset* nil)
1124     (let ((rs (howm-make-rangeset)))
1125       (howm-rangeset-add! rs beg-end))))
1126
1127 (defun howm-rangeset-belong-p (point rs)
1128   (or (null (cdr rs))
1129       (cl-member-if (lambda (pair)
1130                            (and (<= (car pair) point) (<= point (cdr pair))))
1131                          (cdr rs))))
1132
1133 (defun howm-rangeset-add! (rs beg-end)
1134   ;; "almighty" is ignored here. sorry for confusion...
1135   ;; c = cursor (pointing its cdr)
1136   ;; p = pair
1137   (let ((c rs)
1138         (beg (car beg-end))
1139         (end (cadr beg-end)))
1140     (while (and (cdr c) beg)
1141       (let ((p (cadr c)))
1142         (cond ((< end (car p)) ;; insert [beg, end] here
1143                (rplacd c (cons (cons beg end) (cdr c)))
1144                (setq beg nil))
1145               ((< (cdr p) beg) ;; skip this
1146                (setq c (cdr c)))
1147               (t ;; merge into [beg, end]
1148                (setq beg (min beg (car p))
1149                      end (max end (cdr p)))
1150                (rplacd c (cddr c))))))
1151     (when beg
1152       (rplacd c (list (cons beg end)))))
1153   rs)
1154
1155 (defvar howm-rangeset-hit-indicator '*rangeset-hit*)
1156
1157 (defun howm-rangeset-hit! (rs)
1158   (setcar rs howm-rangeset-hit-indicator))
1159
1160 (defun howm-rangeset-hit-p (rs)
1161   (eq (car rs) howm-rangeset-hit-indicator))
1162
1163 ;; check
1164
1165 (let ((tests '(
1166                (()
1167                 ())
1168                (((3 . 5))
1169                 ((3 . 5)))
1170                (((3 . 5) (0 . 1))
1171                 ((0 . 1) (3 . 5)))
1172                (((3 . 5) (6 . 8))
1173                 ((3 . 5) (6 . 8)))
1174                (((3 . 5) (1 . 4))
1175                 ((1 . 5)))
1176                (((3 . 5) (4 . 7))
1177                 ((3 . 7)))
1178                (((3 . 5) (1 . 9))
1179                 ((1 . 9)))
1180                (((3 . 1) (4 . 1) (5 . 9))
1181                 ((1 . 4) (5 . 9)))
1182                (((3 . 1) (4 . 1) (5 . 9) (2 . 6) (5 . 3))
1183                 ((1 . 9)))
1184                ))
1185        ;; inhibit 'reference to free variable' warning in byte-compilation
1186       (check nil))
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))))))
1191     (mapc (lambda (z)
1192             (apply (lambda (prob ans)
1193                      (let* ((rs (howm-make-rangeset)))
1194                        (mapc (lambda (pair)
1195                                (let ((a (car pair))
1196                                      (b (cdr pair)))
1197                                  (howm-rangeset-add! rs
1198                                                      (list (min a b)
1199                                                            (max a b)))))
1200                              prob)
1201                        (when (not (equal (cdr rs) ans))
1202                          (error "howm-rangeset-add: %s ==> %s" prob rs))))
1203                    z))
1204           tests)))
1205
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)))
1215       t
1216     (error "howm-rangeset-belong-p: wrong result")))
1217
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
1224                                                   (point-min))))
1225                         (howm-view-get-title-line))))
1226       (howm-item-set-summary item title-line))))
1227
1228 (defun howm-view-get-title-line ()
1229   (while (and (looking-at howm-view-title-skip-regexp)
1230               (= (forward-line 1) 0))
1231     ;; do nothine
1232     )
1233   (buffer-substring-no-properties (line-beginning-position)
1234                                   (line-end-position)))
1235
1236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1237 ;;; search
1238
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))
1244
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))
1248
1249 (defun howm-view-search-folder (&rest args)
1250   (howm-view-search-folder-doit (apply #'howm-view-search-folder-internal
1251                                        args)))
1252
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)))
1260     ;; rename str
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 "\\)"))
1271                                          str-list
1272                                          "\\|"))))
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))))
1280
1281 (defun howm-view-search-folder-doit (p)
1282   (howm-view-summary (cadr p) (cl-caddr p) (car p)))
1283
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)))))
1290     (mapc (lambda (i)
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))))
1296           found)
1297     found))
1298
1299 ;; sorry for confusing functions...
1300
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))
1304
1305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1306 ;;; sort
1307
1308 (defun howm-view-sort ()
1309   (interactive)
1310   (let* ((table howm-view-sort-methods)
1311          (command (completing-read "sort by: " table nil t)))
1312     (call-interactively (cdr (assoc command table)))))
1313
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)
1320        (interactive "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")
1331
1332 (defalias 'howm-view-sort-reverse 'howm-view-sort-by-reverse)
1333
1334 (defalias 'howm-view-sort-doit 'howm-view-sort/filter-doit)
1335
1336 (defmacro howm-sort-items (evaluator comparer item-list
1337                                              &optional reverse-p)
1338   `(let* ((howm-view-s-i-comparer ,comparer)
1339           (cmp (if reverse-p
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)))
1343
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)
1348 ;;             (let* ((command
1349 ;;                     (howm-get-symbol nil "howm-view-sort-by-" m))
1350 ;;                    (internal
1351 ;;                     (howm-get-symbol nil "howm-sort-items-by-" m))
1352 ;;                    (obsolete
1353 ;;                     (howm-get-symbol nil command "-internal")))
1354 ;;               `(defalias ',obsolete ',internal)))
1355 ;;           methods))
1356
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)
1369
1370 (defun howm-sort-items-by-random (item-list &optional reverse-p)
1371   (howm-sort-items #'(lambda (dummy) (random)) #'< item-list reverse-p))
1372
1373 (defun howm-sort-items-by-name (item-list &optional reverse-p)
1374   (howm-sort-items #'howm-view-item-basename #'string< reverse-p))
1375
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)
1381                                  howm-infinity)))
1382                            #'< reverse-p))
1383
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
1389                                   sorted
1390                                   howm-view-sort-by-date-ignore-regexp
1391                                   t))))
1392
1393 (defun howm-sort-items-by-reverse-date (item-list &optional reverse-p)
1394   (howm-sort-items-by-date item-list (not reverse-p)))
1395
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))
1399
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)))
1412
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)))
1416                    #'howm-view-string>
1417                    item-list reverse-p))
1418
1419 (defun howm-sort-items-by-reverse (item-list &optional dummy)
1420   (reverse item-list))
1421
1422 ;;; lift (move matched items to the top)
1423
1424 (defun howm-view-lift-by-name (&optional reverse-p regexp path-p)
1425   (interactive "P")
1426   (howm-view-lift-doit (if path-p
1427                            #'howm-view-lift-by-path-internal
1428                          #'howm-view-lift-by-name-internal)
1429                        reverse-p regexp))
1430
1431 (defun howm-view-lift-by-summary (&optional reverse-p regexp)
1432   (interactive "P")
1433   (howm-view-lift-doit #'howm-view-lift-by-summary-internal
1434                        reverse-p regexp))
1435
1436 (defun howm-view-lift-by-summary-substring (&optional reverse-p regexp
1437                                                       regexp-pos)
1438   (interactive "P")
1439   (howm-view-lift-doit #'howm-view-lift-by-summary-substring-internal
1440                        reverse-p regexp regexp-pos))
1441
1442 (defun howm-view-lift-doit (sorter &optional reverse-p regexp
1443                                             regexp-pos)
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
1451                                            item-list
1452                                            howm-view-s-b-m-d-regexp
1453                                            rvs-p
1454                                            howm-view-s-b-m-d-regexp-pos)))
1455                              (setq howm-view-s-b-m-d-matched (car p))
1456                              (cdr p)))
1457                          reverse-p)
1458     howm-view-s-b-m-d-matched))
1459
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)
1468                             (progn
1469                               (setq howm-view-l-i-matched
1470                                     (if howm-view-l-i-matched 'multi 'single))
1471                               (if regexp-pos
1472                                   (match-string-no-properties regexp-pos str)
1473                                 1))
1474                           0))))
1475          (comparer (if regexp-pos
1476                        (lambda (x y)
1477                          (cond ((eq x 0) nil)
1478                                ((eq y 0) t)
1479                                (t (string< x y))))
1480                      #'>)))
1481     (let ((sorted-list (howm-sort-items evaluator comparer item-list
1482                                         reverse-p)))
1483       (cons howm-view-l-i-matched sorted-list))))
1484
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))
1488
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))
1491
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))
1494
1495 (defun howm-view-lift-by-summary-substring-internal (item-list regexp
1496                                                                &optional
1497                                                                reverse-p
1498                                                                regexp-pos)
1499   (howm-view-lift-internal #'howm-view-item-summary item-list regexp reverse-p
1500                            (or regexp-pos 0)))
1501
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)
1507
1508 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1509 ;;; Dired-X
1510
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"))
1514
1515 (defun dired-virtual (dir)
1516   (howm-inhibit-warning-in-compilation))
1517
1518 (defun howm-view-dired ()
1519   (interactive)
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
1529 ;;       ;; boundaries.
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))
1535                                             :test #'equal))
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)))))
1541     (if p
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)
1546     (erase-buffer)
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)))
1551
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))))
1561
1562 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1563 ;;; shell
1564
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 ()
1568   (interactive)
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
1577           (mapcar (lambda (h)
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: "
1583                            (cons default 0)
1584                            '(howm-view-summary-shell-hist . 1))))
1585       (shell-command c))
1586     (let ((item-list (cl-remove-if (lambda (item)
1587                                           (not (file-exists-p
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)
1592       (howm-goto-line n)
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))
1598                  nil)
1599                 (t (progn
1600                      (setq *riffle-summary-check* t) ;; dirty
1601                      (howm-view-summary-check t))))))
1602       )))
1603
1604 ;;; howm-view.el ends here