howm-view.el

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