« back to all changes in this revision
Viewing changes to howm-view.el
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Yuki Fujimura
- Date: 2006-01-06 18:31:02 UTC
- Revision ID: james.westby@ubuntu.com-20060106183102-vsqskmgvf9kdbm5b
Tags: upstream-1.3.2
Import upstream version 1.3.2
- files added:
- doc
- en
- ext
- ja
- sample
added
removed
howm-view.el
1
;;; howm-view.el --- Wiki-like note-taking tool
2
;;; Copyright (c) 2002, 2003, 2004, 2005
3
;;; by HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
4
;;; $Id: howm-view.el,v 1.204 2005/10/26 15:38:00 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
(require 'riffle)
23
(require 'howm-common)
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" width) "s " howm-view-summary-sep " ")))
34
;; (concat "%-" (format "%s" width) "s | ")))
35
(defvar howm-view-header-format
36
"\n==========================>>> %s\n"
37
"Format string of header for howm-view-contents.
38
%s is replaced with file name. See `format'.")
39
(defvar howm-view-header-regexp "^==========================>>> .*$")
40
(defvar howm-view-open-recenter howm-view-search-recenter)
41
(defvar howm-view-title-header "=")
42
;; howm-view-title-regexp is assumed to have a form "^xxxxxxx$"
43
(defvar howm-view-title-regexp (format "^%s\\( +\\(.*\\)\\|\\)$"
44
(regexp-quote howm-view-title-header)))
45
(defvar howm-view-title-regexp-pos 2)
46
(defvar howm-view-title-regexp-grep (format "^%s +"
47
(regexp-quote howm-view-title-header)))
48
(defun howm-view-title-regexp-grep ()
49
(if howm-view-use-grep
50
howm-view-title-regexp-grep
51
howm-view-title-regexp))
52
53
(defvar howm-view-sort-methods
54
'(("random" . howm-view-sort-by-random)
55
("name" . howm-view-sort-by-name)
56
("name-match" . howm-view-sort-by-name-match)
57
("numerical-name" . howm-view-sort-by-numerical-name)
58
("summary" . howm-view-sort-by-summary)
59
("summary-match" . howm-view-sort-by-summary-match)
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
(defvar 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
(message "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-summary-to-contents 'riffle-summary-to-contents)
121
(defalias 'howm-view-restore-window-configuration #'riffle-restore-window-configuration)
122
123
;; for howmoney.el
124
;; http://howm.sourceforge.jp/cgi-bin/hiki/hiki.cgi?howmoney
125
(defun howm-view-get-buffer (name-format &optional name new)
126
(let ((riffle-type ':howm)) ;; cheat
127
(riffle-get-buffer name-format name new)))
128
(defun howm-view-summary-buffer (&optional new)
129
(let ((riffle-type ':howm)) ;; cheat
130
(riffle-summary-buffer new)))
131
(defalias 'howm-view-summary-show 'riffle-summary-show)
132
(defalias 'howm-view-set-item-list 'riffle-set-item-list)
133
134
;; for howmz
135
;; http://noir.s7.xrea.com/archives/000136.html
136
;; http://noir.s7.xrea.com/pub/zaurus/howmz.el
137
(defalias 'howm-view-sort-items 'howm-sort)
138
139
;;; variables
140
141
(defvar howm-view-font-lock-silent t
142
"Inhibit font-lock-verbose if non-nil.")
143
(defvar howm-view-summary-font-lock-keywords
144
'(("^[^ \t\r\n]+ +" . howm-view-name-face)
145
("^ +" . howm-view-empty-face)))
146
(defvar howm-view-contents-font-lock-keywords nil)
147
148
(defvar *howm-view-font-lock-keywords* nil
149
"For internal use. Don't set this variable.
150
This is a shameful global variable and should be clearned in future.")
151
(defvar howm-view-font-lock-keywords nil
152
"For internal use.")
153
(defvar howm-view-font-lock-first-time t
154
"For internal use.")
155
(make-variable-buffer-local 'howm-view-font-lock-keywords)
156
(make-variable-buffer-local 'howm-view-font-lock-first-time)
157
158
;;; modes
159
160
(riffle-define-derived-mode howm-view-summary-mode riffle-summary-mode "HowmS"
161
"memo viewer (summary mode)
162
key binding
163
--- -------
164
\\[howm-view-summary-open] Open file
165
\\[next-line] Next item
166
\\[previous-line] Previous item
167
\\[riffle-pop-or-scroll-other-window] Pop and scroll contents
168
\\[scroll-other-window-down] Scroll contents
169
\\[riffle-scroll-other-window] Scroll contents one line
170
\\[riffle-scroll-other-window-down] Scroll contents one line
171
\\[riffle-summary-to-contents] Concatenate all contents
172
\\[howm-view-filter-uniq] Remove duplication of same file
173
\\[howm-view-summary-shell-command] Execute command in inferior shell
174
175
\\[delete-other-windows] Delete contents window
176
\\[riffle-pop-window] Pop contents window
177
\\[riffle-toggle-window] Toggle contents window
178
\\[howm-list-title] Show Title
179
180
\\[howm-view-filter] Filter (by date, contents, etc.)
181
\\[howm-view-filter-by-contents] Search (= filter by contents)
182
\\[howm-view-sort] Sort (by date, summary line, etc.)
183
\\[howm-view-sort-reverse] Reverse order
184
\\[howm-view-dired] Invoke Dired-X
185
\\[describe-mode] This help
186
\\[riffle-kill-buffer] Quit
187
"
188
(make-local-variable 'font-lock-keywords)
189
(make-local-variable 'font-lock-keywords-only)
190
(make-local-variable 'font-lock-keywords-case-fold-search)
191
(cheat-font-lock-mode howm-view-font-lock-silent)
192
(when howm-view-font-lock-first-time
193
(setq howm-view-font-lock-first-time nil)
194
(cheat-font-lock-merge-keywords howm-user-font-lock-keywords
195
howm-view-summary-font-lock-keywords))
196
(when *howm-view-font-lock-keywords*
197
(setq howm-view-font-lock-keywords *howm-view-font-lock-keywords*)
198
(cheat-font-lock-merge-keywords *howm-view-font-lock-keywords*
199
howm-user-font-lock-keywords
200
howm-view-summary-font-lock-keywords))
201
(setq font-lock-keywords-only t)
202
(setq font-lock-keywords-case-fold-search t)
203
;; (setq font-lock-keywords-case-fold-search
204
;; howm-view-grep-ignore-case-option)
205
(howm-fontify)
206
)
207
208
(riffle-define-derived-mode howm-view-contents-mode riffle-contents-mode "HowmC"
209
"memo viewer (contents mode)
210
key binding
211
--- -------
212
\\[howm-view-contents-open] Open file
213
\\[next-line] Next line
214
\\[previous-line] Previous line
215
\\[scroll-up] Scroll up
216
\\[scroll-down] Scroll down
217
\\[riffle-scroll-up] Scroll one line up
218
\\[riffle-scroll-down] Scroll one line down
219
\\[riffle-contents-to-summary] Summary
220
\\[riffle-contents-goto-next-item] Next item
221
\\[riffle-contents-goto-previous-item] Previous item
222
223
\\[howm-view-filter] Filter (by date, contents, etc.)
224
\\[howm-view-filter-by-contents] Search (= filter by contents)
225
\\[howm-view-sort] Sort
226
\\[howm-view-sort-reverse] Reverse order
227
\\[howm-view-dired] Invoke Dired-X
228
\\[describe-mode] This help
229
\\[riffle-kill-buffer] Quit
230
"
231
; (kill-all-local-variables)
232
(make-local-variable 'font-lock-keywords)
233
(make-local-variable 'font-lock-keywords-only)
234
(make-local-variable 'font-lock-keywords-case-fold-search)
235
(cheat-font-lock-mode howm-view-font-lock-silent)
236
(let ((ck `((,howm-view-header-regexp (0 howm-view-hilit-face))))
237
(sk (or (howm-view-font-lock-keywords)
238
*howm-view-font-lock-keywords*)))
239
;; ;; extremely dirty!! [2003/10/06 21:08]
240
;; (sk (or (with-current-buffer (riffle-summary-buffer)
241
;; font-lock-keywords)
242
;; *howm-view-font-lock-keywords*)))
243
(cheat-font-lock-merge-keywords sk ck
244
howm-user-font-lock-keywords
245
howm-view-contents-font-lock-keywords)
246
(setq font-lock-keywords-only t)
247
(setq font-lock-keywords-case-fold-search
248
howm-view-grep-ignore-case-option)
249
(howm-fontify)
250
))
251
252
(defun howm-view-font-lock-keywords ()
253
(with-current-buffer (riffle-summary-buffer)
254
howm-view-font-lock-keywords))
255
256
;;; keymaps
257
258
;; (defvar howm-view-summary-mode-map nil)
259
;; (defvar howm-view-contents-mode-map nil)
260
261
(defun howm-view-define-common-key (keymap)
262
(let ((m keymap))
263
;; (define-key m "?" 'howm-view-help)
264
(define-key m "f" 'howm-view-filter)
265
(define-key m "G" 'howm-view-filter-by-contents)
266
(define-key m "S" 'howm-view-sort)
267
(define-key m "R" 'howm-view-sort-reverse)
268
(define-key m "q" 'howm-view-kill-buffer)
269
(define-key m "X" 'howm-view-dired)
270
))
271
272
(let ((m howm-view-summary-mode-map))
273
(define-key m "\C-m" 'howm-view-summary-open)
274
(define-key m "\C-j" 'howm-view-summary-open)
275
(define-key m "u" 'howm-view-filter-uniq)
276
(define-key m "!" 'howm-view-summary-shell-command)
277
(define-key m "T" 'howm-list-title) ;; defined in other file. dirty!
278
;; (define-key m howm-reminder-quick-check-key 'howm-reminder-quick-check)
279
;; (define-key m ";" 'howm-view-invoke-action-lock)
280
(define-key m "\C-i" 'howm-view-summary-next-section)
281
(define-key m "\M-\C-i" 'howm-view-summary-previous-section)
282
(define-key m [tab] 'howm-view-summary-next-section)
283
(define-key m [(meta tab)] 'howm-view-summary-previous-section)
284
(howm-view-define-common-key m))
285
286
(let ((m howm-view-contents-mode-map))
287
(define-key m "\C-m" 'howm-view-contents-open)
288
(define-key m "\C-j" 'howm-view-contents-open)
289
(howm-view-define-common-key m))
290
291
;;; summary
292
293
(defun howm-view-summary (&optional name item-list)
294
(let ((r (riffle-summary name item-list ':howm
295
(howm-view-in-background-p))))
296
(when (null r)
297
(message "No match"))
298
r))
299
300
;; (defun howm-view-summary (&optional name item-list)
301
;; (let ((*howm-view-font-lock-keywords* t))
302
;; (riffle-summary name item-list ':howm)))
303
304
(defun howm-view-summary-open (&optional reverse-delete-p)
305
(interactive "P")
306
(when (not (and howm-view-summary-keep-cursor
307
(get-buffer-window (riffle-contents-buffer))))
308
(riffle-summary-check t))
309
(let* ((p (riffle-persistent-p howm-view-summary-persistent))
310
(persistent (if reverse-delete-p
311
(not p)
312
p)))
313
(howm-record-view-window-configuration)
314
(howm-view-summary-open-sub (not persistent))))
315
316
(defun howm-view-summary-open-sub (&optional kill)
317
(interactive "P")
318
(let ((b (riffle-contents-buffer))
319
(looking-at-str (buffer-substring-no-properties (point)
320
(line-end-position))))
321
(riffle-pop-to-buffer b howm-view-summary-window-size)
322
(let ((howm-view-open-hook nil)) ;; Don't execute it in contents-open.
323
(howm-view-contents-open-sub kill))
324
(end-of-line)
325
(or (search-backward looking-at-str (line-beginning-position) t)
326
(beginning-of-line))
327
(run-hooks 'howm-view-open-hook)))
328
329
(defvar howm-view-summary-item-previous-name nil
330
"for internal use")
331
(defun howm-view-summary-item (item)
332
;; Clean me. This depends on implementation of `riffle-summary-show'
333
;; severely.
334
(when (eq (point) (point-min))
335
(setq howm-view-summary-item-previous-name ""))
336
(let* ((f (howm-view-item-basename item t))
337
(name (if (and howm-view-summary-omit-same-name
338
(string= f howm-view-summary-item-previous-name))
339
""
340
;; setq returns the last value.
341
(setq howm-view-summary-item-previous-name f)))
342
(h (format howm-view-summary-format name)))
343
(concat h (howm-view-item-summary item))))
344
345
(defun howm-view-summary-next-section (&optional n)
346
(interactive "P")
347
(setq n (or n 1))
348
(let ((i (abs n))
349
(step (if (>= n 0) 1 -1)))
350
(while (and (> i 0)
351
(howm-view-summary-next-section-sub step))
352
(setq i (1- i)))))
353
(defun howm-view-summary-previous-section (&optional n)
354
(interactive "P")
355
(setq n (or n 1))
356
(howm-view-summary-next-section (- n)))
357
(defun howm-view-summary-next-section-sub (step)
358
(let ((orig (howm-view-item-filename (riffle-summary-current-item))))
359
;; (let ((orig (riffle-controller 'section
360
;; (riffle-summary-current-item))))
361
(while (and (string= orig
362
(howm-view-item-filename (riffle-summary-current-item)))
363
;; (riffle-controller 'section
364
;; (riffle-summary-current-item)))
365
(= (forward-line step) 0))
366
;; no body
367
)))
368
369
;;; contents
370
371
(defun howm-view-contents-open (&optional reverse-delete-p)
372
(interactive "P")
373
(let* ((p (riffle-persistent-p howm-view-contents-persistent))
374
(persistent (if reverse-delete-p
375
(not p)
376
p)))
377
(howm-record-view-window-configuration)
378
(howm-view-contents-open-sub (not persistent))))
379
380
(defvar *howm-view-item-privilege* nil) ;; dirty
381
382
(defun howm-view-contents-open-sub (&optional kill)
383
(let* ((n (riffle-contents-item-number (point)))
384
(item (nth n (riffle-item-list)))
385
(page (howm-item-page item))
386
(offset (howm-view-item-offset item))
387
(pos (- (point) offset))
388
(viewer (howm-view-external-viewer page)))
389
(when kill
390
(riffle-kill-buffer))
391
(when (howm-view-item-privilege item)
392
(riffle-restore-window-configuration)) ;; force without mode check
393
(setq *howm-view-item-privilege* (howm-view-item-privilege item)) ;; dirty
394
(run-hooks 'howm-view-before-open-hook)
395
(if viewer
396
(howm-view-call-external-viewer viewer page)
397
(progn
398
(howm-page-open page)
399
(howm-view-set-mark-command)
400
(when (or (< pos (point-min)) (<= (point-max) pos))
401
(widen))
402
(goto-char pos)
403
(recenter howm-view-open-recenter)))
404
(run-hooks 'howm-view-open-hook)))
405
406
(defvar howm-view-previous-section-page nil "For internal use")
407
(defvar howm-view-previous-section-beg nil "For internal use")
408
(defvar howm-view-previous-section-end nil "For internal use")
409
410
(defun howm-view-contents-item (item)
411
(when (howm-buffer-empty-p)
412
(setq howm-view-previous-section-page ""
413
howm-view-previous-section-beg nil
414
howm-view-previous-section-end nil))
415
(let* ((page (howm-item-page item))
416
(place (howm-view-item-place item))
417
(peq (howm-page= page howm-view-previous-section-page)) ;; dirty!
418
(done-p (if place
419
(and peq
420
(<= howm-view-previous-section-beg place)
421
(<= place howm-view-previous-section-end))
422
peq)))
423
(if done-p
424
""
425
(let* ((header (format howm-view-header-format
426
(howm-page-abbreviate-name page)))
427
(header-length (howm-view-string-point-count header))
428
(viewer (howm-view-external-viewer page)))
429
(concat header
430
(howm-view-contents-item-sub item page place header viewer
431
(+ (point) header-length)))))))
432
433
(defvar howm-view-string-point-count-strict nil)
434
(defun howm-view-string-point-count (str)
435
"Count points of string STR.
436
Namely, it is the difference between start position and end position
437
of STR if STR is inserted to a buffer.
438
It looks to be simply equal to (length STR) on emacs-21.1.1.
439
But I'm not sure for multi-byte characters on other versions of emacsen."
440
(if howm-view-string-point-count-strict
441
(with-temp-buffer
442
(insert str)
443
(- (point) (point-min)))
444
;; I assume (length (buffer-substring-no-properties START END))
445
;; is equal to (abs (- START END))). Is it correct?
446
;; (cf.) snap://Info-mode/elisp#Positions
447
(length str)))
448
449
(defun howm-view-contents-item-sub (item page place header viewer c)
450
(with-temp-buffer
451
(let (b e h)
452
(if viewer
453
(howm-view-contents-indicator viewer page)
454
(howm-page-insert page))
455
(if place
456
(progn
457
(riffle-set-place place)
458
(setq h (point))
459
(let ((r (howm-view-contents-region page)))
460
(setq b (car r)
461
e (second r))))
462
(setq b (point-min)
463
e (point-max)
464
h b))
465
(howm-view-item-set-offset item (- c b))
466
(howm-view-item-set-home item (+ c (- b) h))
467
(setq howm-view-previous-section-page page ;; dirty!
468
howm-view-previous-section-beg (riffle-get-place b)
469
howm-view-previous-section-end (riffle-get-place e))
470
(buffer-substring-no-properties b e))))
471
472
(defvar howm-view-preview-narrow t)
473
(defun howm-view-contents-region (filename)
474
(when filename
475
(howm-page-set-configuration filename))
476
(if (or howm-view-preview-narrow
477
(not (riffle-preview-p)))
478
(howm-view-paragraph-region)
479
(list (point-min) (point-max))))
480
481
(defun howm-view-contents-indicator (viewer fname)
482
(insert "%%% "
483
(howm-viewer-indicator viewer fname)
484
" %%%"))
485
486
(defun howm-view-paragraph-region (&optional include-following-blank-p)
487
(let ((b (save-excursion
488
(end-of-line)
489
(re-search-backward howm-view-title-regexp
490
nil 'to-limit)
491
(line-beginning-position)))
492
(e (save-excursion
493
(end-of-line)
494
(let ((found (re-search-forward howm-view-title-regexp
495
nil 'to-limit)))
496
(if include-following-blank-p
497
(if found (match-beginning 0) (point-max))
498
(progn
499
(if found
500
(forward-line -1)
501
(goto-char (point-max)))
502
; (end-of-line)
503
(while (and (looking-at "^$")
504
(= (forward-line -1) 0)) ;; successful
505
nil) ;; dummy
506
(end-of-line)
507
(point)))))))
508
(list b e)))
509
510
(defun howm-view-set-mark-command ()
511
(set-mark-command nil)
512
(howm-deactivate-mark))
513
514
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
515
;;; misc.
516
517
(defun howm-view-file-list (&optional item-list)
518
(howm-cl-remove-duplicates (mapcar #'howm-view-item-filename
519
(or item-list (howm-view-item-list)))
520
:test #'howm-page=))
521
522
(defun howm-view-xtime (file x)
523
(if (eq x 'm)
524
(howm-view-time-to-string (howm-page-mtime file))
525
(error "Not supported: %stime" x)))
526
527
;; (defun howm-view-xtime (file x)
528
;; (let* ((a (file-attributes file))
529
;; (n (cdr (assoc x '((a . 4) (m . 5) (c . 6)))))
530
;; (ti (nth n a)))
531
;; (howm-view-time-to-string ti)))
532
533
(defun howm-view-time-to-string (ti)
534
(format-time-string "%Y%m%d-%H%M%S" ti))
535
536
(defun howm-view-string> (a b)
537
(string< b a))
538
539
(defun howm-view-string<= (a b)
540
(not (string< b a)))
541
542
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
543
;;; dir
544
545
(defcustom howm-ruby-mode-bug nil
546
"Non nil if ruby-mode.el is old and has a bug around font-lock;
547
global value of font-lock-keywords is set wrongly."
548
:type 'boolean
549
:group 'howm-experimental)
550
551
(defun howm-view-directory (dir &optional recursive-p)
552
(howm-view-summary "" (howm-view-directory-items dir recursive-p))
553
(when howm-ruby-mode-bug
554
;; sloppy!
555
;; (for old ruby-mode.el which sets global value of font-lock-keywords)
556
(setq font-lock-keywords nil))
557
)
558
559
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
560
;;; filter
561
562
(defun howm-view-filter (&optional remove-p)
563
(interactive "P")
564
(let* ((table howm-view-filter-methods)
565
(command (completing-read (if remove-p
566
"(Reject) filter by: "
567
"filter by: ")
568
table nil t)))
569
(call-interactively (cdr (assoc command table)))))
570
571
(defvar howm-view-filter-uniq-prev "")
572
(defun howm-view-filter-uniq ()
573
(interactive)
574
(setq howm-view-filter-uniq-prev
575
(if howm-view-search-in-result-correctly
576
(cons "" nil)
577
""))
578
(howm-view-filter-general
579
(lambda (item)
580
(if howm-view-search-in-result-correctly
581
(let ((page (howm-item-page item))
582
(place (howm-item-place item))
583
(range (howm-item-range item))
584
(p-page (car howm-view-filter-uniq-prev))
585
(p-range (cdr howm-view-filter-uniq-prev)))
586
(prog1
587
(not (and (howm-page= page p-page)
588
(and place p-range
589
(<= (car p-range) place)
590
(<= place (second p-range)))))
591
(setq howm-view-filter-uniq-prev (cons page range))))
592
;; old code
593
(let ((f (howm-view-item-filename item)))
594
(prog1
595
(not (howm-page= f howm-view-filter-uniq-prev))
596
(setq howm-view-filter-uniq-prev f)))))))
597
598
(defun howm-view-filter-by-name (&optional remove-p regexp)
599
(interactive "P")
600
(howm-view-filter-by-name/summary #'howm-view-item-basename
601
remove-p regexp))
602
603
(defun howm-view-filter-by-summary (&optional remove-p regexp)
604
(interactive "P")
605
(howm-view-filter-by-name/summary #'howm-view-item-summary
606
remove-p regexp))
607
608
(defun howm-view-filter-by-name/summary (accessor remove-p regexp)
609
(let ((r (or regexp (howm-view-filter-read-from-minibuffer "Regexp: "
610
remove-p))))
611
(howm-view-filter-general (lambda (item)
612
(string-match r (funcall accessor item)))
613
remove-p)))
614
615
(defun howm-view-filter-by-date (&optional remove-p)
616
(interactive "P")
617
(let* ((r (howm-view-ask-time-range remove-p))
618
(from (car r))
619
(to (second r))
620
(form (howm-view-file-name-format))
621
(fts (mapcar (lambda (x)
622
(file-name-nondirectory (format-time-string form x)))
623
(list from to)))
624
(fs (car fts))
625
(ts (second fts)))
626
(howm-view-filter-general
627
(lambda (item)
628
(let ((cs (howm-view-item-basename item)))
629
(and (howm-view-string<= fs cs) (howm-view-string<= cs ts))))
630
remove-p)
631
))
632
633
(defun howm-view-filter-by-reminder (&optional remove-p)
634
(interactive "P")
635
(let* ((r (howm-view-ask-time-range remove-p))
636
(from (car r))
637
(to (second r))
638
(from-str (format-time-string howm-date-format from))
639
(to-str (format-time-string howm-date-format to))
640
(reg (howm-reminder-regexp howm-reminder-types)))
641
(howm-view-filter-general
642
(lambda (item)
643
(let ((s (howm-view-item-summary item)))
644
(and (string-match reg s)
645
(let* ((x (match-string-no-properties 0 s)) ;; [2004-02-07]@
646
(d (and (string-match howm-date-regexp x)
647
(match-string-no-properties 0 x)))) ;; [2004-02-07]
648
(and (howm-view-string<= from-str d)
649
(howm-view-string<= d to-str))))))
650
remove-p)
651
))
652
653
(defun howm-view-file-name-format ()
654
howm-file-name-format) ;; defined in howm-common.el
655
656
;; needless
657
; (defun howm-view-filter-by-ctime (&optional remove-p)
658
; (interactive "P")
659
; (howm-view-filter-by-xtime 'c remove-p))
660
661
(defun howm-view-filter-by-mtime (&optional remove-p range)
662
(interactive "P")
663
(howm-view-filter-by-xtime 'm remove-p range))
664
665
(defun howm-view-filter-by-xtime (x remove-p &optional range)
666
(let* ((r (or range (howm-view-ask-time-range remove-p)))
667
(from (car r))
668
(to (second r))
669
(fs (howm-view-time-to-string from))
670
(ts (howm-view-time-to-string to)))
671
(howm-view-filter-general
672
(lambda (item)
673
(let* ((cs (howm-view-xtime (howm-view-item-filename item) x)))
674
(and (howm-view-string<= fs cs) (howm-view-string<= cs ts))))
675
remove-p)))
676
677
(defun howm-view-ask-time-range (&optional remove-p)
678
(let* ((now (current-time))
679
(from (howm-view-ask-time "From" now t remove-p))
680
(to (howm-view-ask-time "To" from nil remove-p)))
681
(list from to)))
682
683
(defvar howm-view-min-year 1950)
684
(defvar howm-view-max-year 2030)
685
(defun howm-view-ask-time (prompt default &optional from-p remove-p)
686
(let* ((z (decode-time default))
687
(yd (nth 5 z))
688
(md (nth 4 z))
689
(dd (nth 3 z)))
690
(let (y0 m0 d0 hour0 min0 sec0)
691
(if from-p
692
(setq y0 howm-view-min-year m0 1 d0 1
693
hour0 0 min0 0 sec0 0)
694
(setq y0 howm-view-max-year m0 12 d0 'last-day-of-month
695
hour0 24 min0 0 sec0 0))
696
(let ((y (howm-ask-time-sub prompt "year" yd remove-p)))
697
(if (null y)
698
(howm-view-encode-time sec0 min0 hour0 d0 m0 y0)
699
(let ((m (howm-ask-time-sub prompt "month" md remove-p)))
700
(if (null m)
701
(howm-view-encode-time sec0 min0 hour0 d0 m0 y)
702
(let ((d (or (howm-ask-time-sub prompt "date" dd remove-p) d0)))
703
(howm-view-encode-time sec0 min0 hour0 d m y)))))))))
704
705
(defun howm-ask-time-sub (prompt ymd default remove-p)
706
(let* ((message (format "%s %s (* = no limit) [%d]: " prompt ymd default))
707
(raw (howm-view-filter-read-from-minibuffer message remove-p))
708
(n (if (string= raw "")
709
default
710
(string-to-number raw))))
711
(if (= n 0)
712
nil
713
n)))
714
715
(defun howm-view-encode-time (sec min hour d m y)
716
(when (eq d 'last-day-of-month)
717
(setq m (+ m 1))
718
(setq d -1))
719
(encode-time sec min hour d m y))
720
721
(defun howm-view-filter-by-region (beg end)
722
(interactive "r")
723
(let ((r (mapcar #'howm-view-line-number (list beg end))))
724
(howm-view-filter-by-line-range (car r) (second r))))
725
726
(defvar howm-view-filter-by-around-default 10)
727
(defun howm-view-filter-by-around (&optional distance)
728
(interactive "P")
729
(let* ((d (or distance howm-view-filter-by-around-default))
730
(c (howm-view-line-number)))
731
(howm-view-filter-by-line-range (- c d) (+ c d))))
732
733
(defun howm-view-filter-by-line-range (beg end)
734
(let ((howm-view-filter-by-line-range-beg beg)
735
(howm-view-filter-by-line-range-end end))
736
(howm-view-filter-general (lambda (item-count)
737
(let* ((line (1+ (second item-count)))
738
(b howm-view-filter-by-line-range-beg)
739
(e howm-view-filter-by-line-range-end))
740
(and (<= b line) (<= line e))))
741
nil t)))
742
743
(defun howm-view-filter-general (pred &optional remove-p with-index)
744
(let* ((item-list (howm-view-item-list))
745
(s (if with-index
746
(howm-map-with-index #'list item-list)
747
item-list))
748
(r (if remove-p
749
(howm-cl-remove-if pred s)
750
(howm-cl-remove-if-not pred s)))
751
(filtered (if with-index
752
(mapcar #'car r)
753
r)))
754
(howm-view-summary-rebuild filtered)))
755
756
(defun howm-view-filter-read-from-minibuffer (message &optional remove-p)
757
(read-from-minibuffer (if remove-p
758
(concat "(Reject) " message)
759
message)))
760
761
(defun howm-view-summary-rebuild (item-list)
762
(howm-view-summary (howm-view-name) item-list))
763
764
(defun howm-view-filter-by-contents (&optional remove-p regexp)
765
(interactive "P")
766
(let ((r (or regexp (howm-view-filter-read-from-minibuffer
767
"Search in result (grep): "
768
remove-p))))
769
(if remove-p
770
(howm-view-remove-by-contents r)
771
(howm-view-search-in-result r))))
772
773
(defcustom howm-view-search-in-result-correctly nil
774
"*Non nil if search-in-result should be aware of paragraph."
775
:type 'boolean
776
:group 'howm-experimental)
777
778
(defun howm-view-search-in-result (regexp)
779
;; (interactive "sSearch in result (grep): ")
780
(let* ((orig (howm-view-name))
781
(name (if (string= orig "")
782
regexp
783
(format "%s&%s" orig regexp)))
784
(orig-item-list (howm-view-item-list))
785
(folder (howm-make-folder-from-items orig-item-list)))
786
(howm-write-history regexp)
787
(howm-view-search-folder regexp folder name)
788
(when howm-view-search-in-result-correctly
789
(howm-view-summary-rebuild (howm-item-list-filter (howm-view-item-list)
790
orig-item-list)))))
791
792
(defun howm-view-remove-by-contents (regexp)
793
;; (interactive "s(Reject) Search in result (grep): ")
794
(let* ((orig (howm-view-item-list))
795
(folder (howm-make-folder-from-items orig)))
796
(if howm-view-search-in-result-correctly
797
(let ((rejects (howm-view-search-folder-items regexp folder)))
798
(howm-view-summary-rebuild (howm-item-list-filter orig rejects t)))
799
;; old code
800
(let ((rejects (howm-cl-remove-duplicates
801
(mapcar #'howm-item-name
802
(howm-view-search-folder-items regexp folder)))))
803
(howm-view-filter-general (lambda (item)
804
(member (howm-item-name item) rejects))
805
t)))))
806
807
(defcustom howm-view-title-skip-regexp nil
808
"*Regular expression for lines which should not be titles.
809
If the original title matches this regexp, the first non-matched line
810
is shown as title instead.
811
Nil disables this feature.
812
813
This feature does not work when `howm-view-search-in-result-correctly' is nil."
814
:type '(radio (const :tag "Off"
815
nil)
816
(const :tag "Skip \"= \""
817
"^=? *$")
818
(const :tag "Skip \"= \" and \"[xxxx-xx-xx xx:xx]\""
819
"\\(^=? *$\\)\\|\\(^\\[[-: 0-9]+\\]\\)")
820
regexp)
821
;; :group 'howm-efficiency
822
:group 'howm-experimental)
823
824
(defun howm-view-list-title (title-regexp)
825
(let* ((folder (howm-make-folder-from-items (howm-view-item-list)))
826
(items (howm-view-search-folder-items title-regexp folder))
827
(kw *howm-view-font-lock-keywords*))
828
(if howm-view-search-in-result-correctly
829
(let* ((hit-items (howm-item-list-filter items (howm-view-item-list)))
830
(nohit-items (howm-item-list-filter (howm-view-item-list)
831
items t))
832
(all-items (if (null nohit-items)
833
hit-items
834
(append hit-items nohit-items))))
835
(when howm-view-title-skip-regexp
836
(mapcar #'howm-view-change-title all-items))
837
(let ((*howm-view-font-lock-keywords* kw)) ;; dirty!
838
(howm-view-summary-rebuild all-items)))
839
;; old code
840
(let* ((pages (howm-cl-remove-duplicates (mapcar #'howm-item-page
841
(howm-view-item-list))))
842
(hit-pages (mapcar #'howm-item-page items))
843
(nohit-pages (howm-cl-remove-if
844
(lambda (p) (howm-cl-member* p hit-pages
845
:test #'howm-page=))
846
pages))
847
(nohit-items (mapcar #'howm-make-item nohit-pages))
848
(all-items (if (null nohit-items)
849
items
850
(append items nohit-items))))
851
(let ((*howm-view-font-lock-keywords* kw)) ;; dirty!
852
(howm-view-summary-rebuild all-items))))))
853
854
;;; detect items in same paragraph (= entry = memo. sorry for inconsistent terminology)
855
856
(defun howm-item-range (item)
857
"List of beginning-place and end-place of paragraph to which ITEM belongs."
858
(with-temp-buffer
859
(howm-page-insert (howm-item-page item))
860
(let* ((p (howm-item-place item))
861
(r (if (null p)
862
(list (point-min) (point-max))
863
(progn
864
(riffle-set-place p)
865
(howm-view-paragraph-region)))))
866
(list (progn
867
(goto-char (car r))
868
(riffle-get-place))
869
(progn
870
(goto-char (second r))
871
(riffle-get-place))))))
872
873
(defun howm-item-list-rangeset (item-list)
874
"Make assoc list of page to rangeset.
875
ITEM-LIST is list of items.
876
Return value is assoc list; each element of it is a cons pair of page
877
and rangeset which indicates ranges of places of paragraphs to which items
878
in ITEM-LIST belongs."
879
(let ((alist nil)) ;; key = page, value = rangeset of place
880
(mapc (lambda (item)
881
(let* ((page (howm-item-page item))
882
(place (howm-item-place item))
883
(rs (cdr (assoc page alist))))
884
(cond ((null rs)
885
(setq alist (cons (cons page (howm-make-rangeset
886
(howm-item-range item)))
887
alist)))
888
((howm-rangeset-belong-p place rs)
889
nil)
890
(t
891
(howm-rangeset-add! rs (howm-item-range item))))))
892
item-list)
893
alist))
894
895
(defun howm-item-list-filter (item-list reference-item-list
896
&optional remove-match)
897
"Select items in ITEM-LIST according to REFERENCE-ITEM-LIST.
898
When REMOVE-MATCH is nil, return value is list of items i in ITEM-LIST
899
which satisfy the condition \"there exists i' in REFERENCE-ITEM-LIST
900
such that i and i' belong to same paragraph\".
901
When REMOVE-MATCH is non-nil, return value is complement of the above list;
902
list of items in ITEM-LIST which do not satisfy the above condition."
903
;; split no-place items
904
(setq item-list
905
(howm-cl-mapcan (lambda (item)
906
(if (howm-item-place item)
907
(list item)
908
(let ((f (howm-make-folder-from-items (list item))))
909
(or (howm-view-search-folder-items (howm-view-title-regexp-grep)
910
f)
911
(list item)))))
912
item-list))
913
(let* ((alist (howm-item-list-rangeset reference-item-list))
914
(matcher (lambda (item)
915
(let* ((page (howm-item-page item))
916
(place (howm-item-place item))
917
(rs (cdr (assoc page alist))))
918
(cond ((null rs) nil)
919
((null place) t)
920
(t (howm-rangeset-belong-p place rs)))))))
921
(if remove-match
922
(howm-cl-remove-if matcher item-list)
923
(howm-cl-remove-if-not matcher item-list))))
924
925
;;; rangeset
926
;;; ex. (*rangeset* (1 . 4) (5 . 6) (8 . 14))
927
928
(defun howm-make-rangeset (&optional beg-end)
929
(if (null beg-end)
930
(cons '*rangeset* nil)
931
(let ((rs (howm-make-rangeset)))
932
(howm-rangeset-add! rs beg-end))))
933
934
(defun howm-rangeset-belong-p (point rs)
935
(howm-cl-member-if (lambda (pair)
936
(and (<= (car pair) point) (<= point (cdr pair))))
937
(cdr rs)))
938
939
(defun howm-rangeset-add! (rs beg-end)
940
;; c = cursor (pointing its cdr)
941
;; p = pair
942
(let ((c rs)
943
(beg (car beg-end))
944
(end (second beg-end)))
945
(while (and (cdr c) beg)
946
(let ((p (cadr c)))
947
(cond ((< end (car p)) ;; insert [beg, end] here
948
(rplacd c (cons (cons beg end) (cdr c)))
949
(setq beg nil))
950
((< (cdr p) beg) ;; skip this
951
(setq c (cdr c)))
952
(t ;; merge into [beg, end]
953
(setq beg (min beg (car p))
954
end (max end (cdr p)))
955
(rplacd c (cddr c))))))
956
(when beg
957
(rplacd c (list (cons beg end)))))
958
rs)
959
960
;; check
961
962
(let ((tests '(
963
(()
964
())
965
(((3 . 5))
966
((3 . 5)))
967
(((3 . 5) (0 . 1))
968
((0 . 1) (3 . 5)))
969
(((3 . 5) (6 . 8))
970
((3 . 5) (6 . 8)))
971
(((3 . 5) (1 . 4))
972
((1 . 5)))
973
(((3 . 5) (4 . 7))
974
((3 . 7)))
975
(((3 . 5) (1 . 9))
976
((1 . 9)))
977
(((3 . 1) (4 . 1) (5 . 9))
978
((1 . 4) (5 . 9)))
979
(((3 . 1) (4 . 1) (5 . 9) (2 . 6) (5 . 3))
980
((1 . 9)))
981
))
982
;; inhibit 'reference to free variable' warning in byte-compilation
983
(check nil))
984
(flet ((check (ans result)
985
(cond ((null ans) (null result))
986
((not (equal (car ans) (car result))) nil)
987
(t (funcall check (cdr ans) (cdr result))))))
988
(mapc (lambda (z)
989
(apply (lambda (prob ans)
990
(let* ((rs (howm-make-rangeset)))
991
(mapc (lambda (pair)
992
(let ((a (car pair))
993
(b (cdr pair)))
994
(howm-rangeset-add! rs
995
(list (min a b)
996
(max a b)))))
997
prob)
998
(when (not (equal (cdr rs) ans))
999
(error "howm-rangeset-add: %s ==> %s" prob rs))))
1000
z))
1001
tests)))
1002
1003
(let ((rs '(*rangeset* (1 . 4) (5 . 6) (8 . 14))))
1004
(if (and (howm-rangeset-belong-p 1 rs)
1005
(howm-rangeset-belong-p 3 rs)
1006
(howm-rangeset-belong-p 4 rs)
1007
(howm-rangeset-belong-p 5 rs)
1008
(not (howm-rangeset-belong-p 0 rs))
1009
(not (howm-rangeset-belong-p 4.5 rs))
1010
(not (howm-rangeset-belong-p 7 rs))
1011
(not (howm-rangeset-belong-p 15 rs)))
1012
t
1013
(error "howm-rangeset-belong-p: wrong result")))
1014
1015
(defun howm-view-change-title (item)
1016
(when (string-match howm-view-title-skip-regexp (howm-item-summary item))
1017
(let ((title-line (with-temp-buffer
1018
(howm-page-insert (howm-item-page item))
1019
(howm-view-set-place (howm-item-place item))
1020
(howm-view-get-title-line))))
1021
(howm-item-set-summary item title-line))))
1022
1023
(defun howm-view-get-title-line ()
1024
(while (and (looking-at howm-view-title-skip-regexp)
1025
(= (forward-line 1) 0))
1026
;; do nothine
1027
)
1028
(buffer-substring-no-properties (line-beginning-position)
1029
(line-end-position)))
1030
1031
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1032
;;; search
1033
1034
(defun howm-view-search (str file-list &optional
1035
name summarizer fixed-p hilit-keywords)
1036
(howm-view-search-folder str (howm-make-folder:files file-list)
1037
name summarizer fixed-p hilit-keywords))
1038
1039
(defun howm-view-search-items (str file-list &optional summarizer fixed-p)
1040
(howm-view-search-folder-items str (howm-make-folder:files file-list)
1041
summarizer fixed-p))
1042
1043
(defun howm-view-search-folder (str folder &optional
1044
name summarizer fixed-p hilit-keywords)
1045
;; clean me. str-orig can be string or list of strings.
1046
(let* ((str-orig str)
1047
(str-list (if (listp str-orig) str-orig (list str-orig)))
1048
(str-principal (if (listp str-orig) (car str-orig) str-orig)))
1049
;; rename str
1050
(setq str str-principal)
1051
(setq name (or name str))
1052
(when howm-view-update-search-ring
1053
(isearch-update-ring str (not fixed-p)))
1054
(let* ((items (howm-view-search-folder-items str-orig
1055
folder summarizer fixed-p))
1056
(kw (or hilit-keywords
1057
`((,(regexp-opt str-list) . howm-view-hilit-face))))
1058
;; `((,(regexp-quote str) . howm-view-hilit-face))))
1059
)
1060
(let* ((f (expand-file-name str)))
1061
(when (file-exists-p f)
1062
(let ((fi (howm-view-make-item f)))
1063
(howm-view-item-set-privilege fi t)
1064
(setq items (cons fi items)))))
1065
(let ((*howm-view-font-lock-keywords* kw)) ;; dirty!
1066
(howm-view-summary name items)))))
1067
1068
(defun howm-view-search-folder-items (str folder &optional summarizer fixed-p)
1069
(let ((found (howm-folder-grep folder str fixed-p))
1070
(summarizer (or summarizer
1071
(lambda (file place content)
1072
(string-match "^ *\\(.*\\)" content)
1073
(match-string-no-properties 1 content)))))
1074
(mapc (lambda (i)
1075
(let ((file (howm-page-name (howm-item-page i)))
1076
(place (howm-item-place i))
1077
(content (howm-item-summary i)))
1078
(howm-item-set-summary i (funcall summarizer
1079
file place content))))
1080
found)
1081
found))
1082
1083
;; (defun howm-view-search-items (str file-list &optional summarizer fixed-p)
1084
;; (let ((found (howm-view-grep str file-list fixed-p))
1085
;; (summarizer (or summarizer
1086
;; (lambda (file place content)
1087
;; (string-match "^ *\\(.*\\)" content)
1088
;; (match-string-no-properties 1 content)))))
1089
;; (mapcar (lambda (z)
1090
;; (let ((file (car z))
1091
;; (place (second z))
1092
;; (content (third z)))
1093
;; (howm-view-make-item file
1094
;; (funcall summarizer
1095
;; file place content)
1096
;; place)))
1097
;; found)))
1098
1099
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1100
;;; sort
1101
1102
(defun howm-view-sort ()
1103
(interactive)
1104
(let* ((table howm-view-sort-methods)
1105
(command (completing-read "sort by: " table nil t)))
1106
(call-interactively (cdr (assoc command table)))))
1107
1108
(defun howm-view-sort-by-random (&optional reverse-p)
1109
(interactive "P")
1110
(howm-view-sort-general #'(lambda (dummy) (random)) #'< reverse-p))
1111
1112
(defun howm-view-sort-by-name (&optional reverse-p)
1113
(interactive "P")
1114
(howm-view-sort-general #'howm-view-item-basename #'string< reverse-p))
1115
1116
(defun howm-view-sort-by-numerical-name (&optional reverse-p)
1117
(interactive "P")
1118
(howm-view-sort-general #'(lambda (i)
1119
(let ((b (howm-view-item-basename i)))
1120
(if (string-match "^[0-9]+$" b)
1121
(string-to-number b)
1122
howm-infinity)))
1123
#'< reverse-p))
1124
1125
(defun howm-view-sort-by-name-match (&optional reverse-p regexp path-p)
1126
(interactive "P")
1127
(howm-view-sort-by-general-match (if path-p
1128
#'howm-item-name
1129
;; #'howm-view-item-filename
1130
#'howm-view-item-basename)
1131
reverse-p regexp))
1132
1133
(defvar howm-view-sort-by-date-ignore-regexp "^[a-zA-Z]")
1134
(defun howm-view-sort-by-date (&optional reverse-p)
1135
(interactive "P")
1136
(howm-view-sort-general #'howm-view-item-basename #'string<
1137
reverse-p)
1138
(howm-view-sort-by-general-match #'howm-view-item-basename t
1139
howm-view-sort-by-date-ignore-regexp))
1140
(defun howm-view-sort-by-reverse-date (&optional reverse-p)
1141
(interactive "P")
1142
(howm-view-sort-by-date (not reverse-p)))
1143
1144
(defun howm-view-sort-by-summary (&optional reverse-p)
1145
(interactive "P")
1146
(howm-view-sort-general #'howm-view-item-summary #'string< reverse-p))
1147
1148
(defun howm-view-sort-by-summary-match (&optional reverse-p regexp)
1149
(interactive "P")
1150
(howm-view-sort-by-general-match #'howm-view-item-summary
1151
reverse-p regexp))
1152
1153
(defun howm-view-sort-by-general-match (picker &optional reverse-p regexp)
1154
(let ((r (or regexp (read-from-minibuffer "Regexp: ")))
1155
(howm-view-s-b-g-m-matched nil)) ;; need unique name?? :-(
1156
(howm-view-sort-general (lambda (item)
1157
(if (string-match r
1158
(funcall picker item))
1159
(progn
1160
(setq howm-view-s-b-g-m-matched t)
1161
1)
1162
0))
1163
#'>
1164
reverse-p)
1165
howm-view-s-b-g-m-matched))
1166
1167
(defun howm-view-sort-by-reminder (&optional reverse-p)
1168
(interactive "P")
1169
(howm-view-sort-general (lambda (item)
1170
(let ((s (howm-view-item-summary item))
1171
(r (howm-reminder-regexp howm-reminder-types))
1172
(max-str (format-time-string
1173
howm-reminder-today-format
1174
(encode-time 59 59 23 31 12
1175
howm-view-max-year))))
1176
(if (string-match r s)
1177
(match-string-no-properties 0 s)
1178
max-str)))
1179
#'string< reverse-p))
1180
1181
;; nonsense
1182
; (defun howm-view-sort-by-atime (&optional reverse-p)
1183
; (interactive "P")
1184
; (howm-view-sort-by-xtime 'a reverse-p))
1185
1186
;; needless
1187
; (defun howm-view-sort-by-ctime (&optional reverse-p)
1188
; (interactive "P")
1189
; (howm-view-sort-by-xtime 'c reverse-p))
1190
1191
(defun howm-view-sort-by-mtime (&optional reverse-p)
1192
(interactive "P")
1193
(howm-view-sort-by-xtime 'm reverse-p))
1194
1195
(defun howm-view-sort-by-xtime (x reverse-p)
1196
(howm-view-sort-general (lambda (item)
1197
(howm-view-xtime (howm-view-item-filename item)
1198
x))
1199
; #'>
1200
; reverse-p
1201
#'howm-view-string>
1202
reverse-p
1203
))
1204
1205
(defun howm-view-sort-general (evaluator comparer &optional reverse-p)
1206
(let* ((howm-view-s-g-comparer comparer) ;; need unique name?? :-(
1207
(cmp (if reverse-p
1208
(lambda (a b) (funcall howm-view-s-g-comparer b a))
1209
howm-view-s-g-comparer))
1210
(sorted (howm-sort evaluator cmp (howm-view-item-list))))
1211
(howm-view-summary (howm-view-name) sorted)))
1212
1213
(defun howm-view-sort-reverse ()
1214
(interactive)
1215
(howm-view-summary (howm-view-name)
1216
(reverse (howm-view-item-list))))
1217
1218
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1219
;;; Dired-X
1220
1221
(defvar howm-view-dired-buffer-name "*howm-dired*")
1222
(defvar howm-view-dired-ls-command "ls")
1223
(defvar howm-view-dired-ls-options '("-l"))
1224
1225
(defun dired-virtual (dir)
1226
(howm-inhibit-warning-in-compilation))
1227
1228
(defun howm-view-dired ()
1229
(interactive)
1230
(require (if (howm-xemacsp) 'dired-vir 'dired-x))
1231
(when (not (member major-mode
1232
'(howm-view-summary-mode howm-view-contents-mode)))
1233
(error "Invalid mode for this command."))
1234
;; ;; bug in emacs-21.3.50?
1235
;; (when (not (fboundp 'dired-insert-headerline))
1236
;; (defun dired-insert-headerline (dir);; also used by dired-insert-subdir
1237
;; ;; Insert DIR's headerline with no trailing slash, exactly like ls
1238
;; ;; would, and put cursor where dired-build-subdir-alist puts subdir
1239
;; ;; boundaries.
1240
;; (save-excursion (insert " " (directory-file-name dir) ":\n"))))
1241
(let* ((i2f (lambda (item)
1242
(file-relative-name (howm-view-item-filename item))))
1243
(current-file (funcall i2f (riffle-summary-current-item)))
1244
(files (howm-cl-remove-duplicates (mapcar i2f (howm-view-item-list))
1245
:test #'equal))
1246
;; (pos (howm-cl-position f files :test #'string=))
1247
(args (append howm-view-dired-ls-options files))
1248
(a `((howm-view-summary-mode . ,howm-view-summary-persistent)
1249
(howm-view-contents-mode . ,howm-view-contents-persistent)))
1250
(p (howm-view-persistent-p (cdr (assoc major-mode a)))))
1251
(if p
1252
(howm-view-restore-window-configuration)
1253
(howm-view-kill-buffer))
1254
(switch-to-buffer (get-buffer-create howm-view-dired-buffer-name))
1255
(setq buffer-read-only nil)
1256
(erase-buffer)
1257
(howm-call-process-here howm-view-dired-ls-command args)
1258
(set-buffer-modified-p nil)
1259
(dired-virtual default-directory)
1260
(when howm-view-dired-keep-cursor
1261
(howm-view-dired-goto current-file))))
1262
1263
(defun howm-view-dired-goto (rname)
1264
"In dired buffer, search file name RNAME and move cursor to corresponding line.
1265
RNAME must be relative name."
1266
(goto-char (point-min))
1267
;; Raw call of `dired-get-filename' and `dired-next-line' causes
1268
;; warnings in compilation.
1269
(while (let ((c (howm-funcall-if-defined (dired-get-filename 'no-dir t))))
1270
(not (and c (equal (file-relative-name c) rname))))
1271
(howm-funcall-if-defined (dired-next-line 1))))
1272
1273
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1274
;;; shell
1275
1276
(defvar howm-view-summary-shell-hist '("ls -l FILE" "FILE"))
1277
(defvar howm-view-summary-shell-last-file "FILE")
1278
(defun howm-view-summary-shell-command ()
1279
(interactive)
1280
(when (not (member major-mode
1281
'(howm-view-summary-mode)))
1282
(error "Invalid mode for this command."))
1283
(let* ((n (howm-view-line-number))
1284
(item (nth (1- n) (howm-view-item-list)))
1285
(file (howm-page-abbreviate-name (howm-view-item-filename item)))
1286
(last-reg (regexp-quote howm-view-summary-shell-last-file)))
1287
(setq howm-view-summary-shell-hist
1288
(mapcar (lambda (h)
1289
(replace-regexp-in-string last-reg file h t))
1290
howm-view-summary-shell-hist))
1291
(setq howm-view-summary-shell-last-file file)
1292
(let* ((default (car howm-view-summary-shell-hist))
1293
(c (read-string "command: "
1294
(cons default 0)
1295
'(howm-view-summary-shell-hist . 1))))
1296
(shell-command c))
1297
(let ((item-list (howm-cl-remove-if (lambda (item)
1298
(not (file-exists-p
1299
(howm-view-item-filename item))))
1300
(howm-view-item-list))))
1301
(setq *riffle-summary-check* nil) ;; dirty
1302
(howm-view-summary (howm-view-name) item-list)
1303
(goto-line n)
1304
(save-selected-window
1305
(let ((b (get-buffer "*Shell Command Output*")))
1306
(cond ((not (howm-buffer-empty-p b))
1307
(switch-to-buffer-other-window b))
1308
((eq item (riffle-summary-current-item))
1309
nil)
1310
(t (progn
1311
(setq *riffle-summary-check* t) ;; dirty
1312
(howm-view-summary-check t))))))
1313
)))
1314
1315
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1316
;;; provide
1317
1318
(provide 'howm-view)
1319
1320
;;; howm-view.el ends here
Loggerhead is a web-based interface for Breezy
Version: 2.0.1