howm-view.el

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