1 ;;; riffle.el --- template of list browser with immediate preview
2 ;;; Copyright (C) 2004, 2005-2018
3 ;;; HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
4 ;;; $Id: riffle.el,v 1.42 2012-12-29 08:57:18 hira Exp $
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)
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.
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,
20 ;;--------------------------------------------------------------------
24 ;; Not yet. See sample at the bottom of this file.
30 (require 'howm-common)
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;; These howm-view-xxx will be renamed to riffle-xxx in future.
37 (defcustom howm-view-summary-window-size nil
38 "Size of summary window, or nil for half size."
39 :type '(radio (const :tag "Half" nil)
41 :group 'howm-list-bufwin)
42 (defcustom howm-view-split-horizontally nil
43 "If non-nil, split window horizontally to show summary and contents."
45 :group 'howm-list-bufwin)
46 (defcustom howm-view-keep-one-window nil
47 "If nil, split windows automatically for summary and contents
48 even if you delete other windows explicitly."
50 :group 'howm-list-bufwin)
51 (defcustom howm-view-pop-up-windows t
52 "If non-nil, override `pop-up-windows'."
54 :group 'howm-list-bufwin)
56 ;; clean me: This value is copied to howm-view-open-recenter.
57 (defvar howm-view-search-recenter 5)
59 ;; experimental [2008-05-23]
60 (defvar riffle-keep-window nil)
62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63 ;;; internal variables and accessors
65 (defvar *riffle-summary-check* t)
67 (defvar riffle-name nil)
68 (defvar riffle-item-list nil)
69 (defvar riffle-type nil)
70 (defvar riffle-summary-last-line nil)
71 (defvar riffle-contents-end nil)
72 (make-variable-buffer-local 'riffle-name)
73 (make-variable-buffer-local 'riffle-item-list)
74 (make-variable-buffer-local 'riffle-type)
75 ; update contents when changed
76 (make-variable-buffer-local 'riffle-summary-last-line)
78 (make-variable-buffer-local 'riffle-contents-end)
80 (defun riffle-name () riffle-name)
81 (defun riffle-item-list () riffle-item-list)
82 (defun riffle-set-item-list (item-list) (setq riffle-item-list item-list))
85 (defun riffle-p () riffle-type)
86 (defun riffle-contents-first-time-p () (null riffle-contents-end))
88 (defvar *riffle-preview-p* nil)
89 (defun riffle-preview-p () *riffle-preview-p*)
91 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 ;; In xemacs, define-derived-mode makes the mode call
95 ;; derived-mode-merge-syntax-tables, which takes long time.
96 ;; To avoid it, we need ":syntax-table nil". Sigh...
98 (defmacro riffle-define-derived-mode (child parent name
102 `(define-derived-mode ,child ,parent ,name
108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 (defun riffle-type (&rest r)
113 (defvar riffle-dispatchers (list #'riffle-type))
114 (put 'riffle-dispatchers 'risky-local-variable t)
116 (gfunc-with riffle-dispatchers
117 (gfunc-def riffle-home (item))
118 (gfunc-def riffle-summary-item (item))
119 (gfunc-def riffle-contents-item (item))
120 (gfunc-def riffle-summary-set-mode ())
121 (gfunc-def riffle-contents-set-mode ())
122 (gfunc-def riffle-summary-name-format ())
123 (gfunc-def riffle-contents-name-format ())
124 (gfunc-def riffle-post-update (item)))
126 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 (defcustom riffle-mode-hook nil
130 "Hook run at the end of function `riffle-mode'"
134 (defvar riffle-mode-map nil)
135 (put 'riffle-mode-map 'risky-local-variable t)
136 (defvar riffle-mode-syntax-table (make-syntax-table))
137 (defvar riffle-mode-abbrev-table nil)
139 (defun riffle-mode ()
141 (setq major-mode 'riffle-mode
143 (use-local-map riffle-mode-map)
144 (set-syntax-table riffle-mode-syntax-table)
145 (define-abbrev-table 'riffle-mode-abbrev-table nil)
146 (run-hooks 'riffle-mode-hook))
148 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
151 (defun riffle-summary (&optional name item-list type background)
152 "Create summary buffer for NAME, ITEM-LIST, and TYPE.
153 When NAME is nil, default values for them are selected.
154 Created buffer is shown immediately as far as BACKGROUND is nil.
155 This function returns effective value of ITEM-LIST."
157 (setq name (riffle-name)
158 item-list (riffle-item-list)
162 (let ((d default-directory))
163 (riffle-setup-buffer #'riffle-summary-name-format name item-list type)
164 (setq default-directory d)
165 (when (not background)
166 (riffle-summary-subr name item-list))
169 (defun riffle-summary-subr (name item-list)
170 (riffle-summary-set-mode)
171 (riffle-summary-show item-list)
172 (unless riffle-keep-window
173 (riffle-summary-check t)))
175 (defun riffle-summary-show (item-list)
176 (buffer-disable-undo)
177 (setq buffer-read-only nil)
179 (mapc 'riffle-summary-show-item item-list)
180 (set-buffer-modified-p nil)
181 (setq buffer-read-only t
183 (goto-char (point-min))
184 (setq riffle-summary-last-line -777))
186 (defun riffle-summary-show-item (item)
187 (insert (riffle-summary-item item) "\n"))
189 (riffle-define-derived-mode riffle-summary-mode riffle-mode "RiffleS"
191 ;; make-local-hook is obsolete for emacs >= 21.1.
192 (when (fboundp 'make-local-hook) (make-local-hook 'post-command-hook))
193 (add-hook 'post-command-hook 'riffle-post-command t t))
195 (defun riffle-post-command ()
196 (unless riffle-keep-window
197 (if *riffle-summary-check*
198 (riffle-summary-check)
199 (setq *riffle-summary-check* t))))
201 (defun riffle-summary-current-item ()
202 (let ((n (riffle-line-number)))
203 (nth (1- n) (riffle-item-list))))
205 (defun riffle-summary-check (&optional force)
206 (let ((keep-one howm-view-keep-one-window))
208 (riffle-refresh-window-configuration)
210 (let ((n (riffle-line-number))
211 (howm-view-keep-one-window keep-one))
212 (when (or (not (= n riffle-summary-last-line))
214 (setq riffle-summary-last-line n)
215 (let ((item (riffle-summary-current-item)))
216 (when (and item *riffle-summary-check*)
217 (riffle-summary-update item force)))))))
219 (defun riffle-summary-update (item &optional new)
220 (unless (and howm-view-keep-one-window (one-window-p))
221 (riffle-summary-update-subr item new)))
222 (defun riffle-summary-update-subr (item &optional new)
223 (let* ((*riffle-preview-p* t) ;; dirty
224 (vbuf (riffle-contents-buffer new))
225 (cwin (selected-window))
226 (pop-up-windows (or pop-up-windows howm-view-pop-up-windows))
227 ;; (section (riffle-controller 'section item))
229 (type riffle-type)) ;; be careful to buffer local var.
230 (riffle-pop-to-buffer vbuf howm-view-summary-window-size)
231 (riffle-contents name (list item) type default-directory)
232 (goto-char (point-min))
233 (let ((home (riffle-home item)))
234 ;; (let ((home (howm-view-item-home item)))
237 (recenter howm-view-search-recenter))
239 (riffle-post-update item))))
240 ;; (message "View: %s" section)
242 (defun riffle-pop-window ()
244 (let ((r (one-window-p)))
246 (riffle-summary-check t))
249 (defun riffle-pop-or-scroll-other-window ()
251 (or (riffle-pop-window)
252 (scroll-other-window)))
254 (defun riffle-toggle-window ()
256 (or (riffle-pop-window)
257 (delete-other-windows)))
259 (defun riffle-summary-to-contents ()
261 (let ((b (current-buffer)))
262 (unless riffle-keep-window
263 (delete-other-windows)
265 (let ((n (riffle-line-number)))
266 (riffle-contents (riffle-name) (riffle-item-list) riffle-type
268 (goto-char (riffle-contents-beginning (1- n))))))
270 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
273 ;; (defvar riffle-contents-mode-variant nil)
275 (defun riffle-contents (name item-list type default-dir)
279 (riffle-setup-buffer #'riffle-contents-name-format name item-list type)
280 (setq default-directory default-dir)
281 (when (riffle-contents-first-time-p)
282 (riffle-contents-set-mode))
283 ;; (let ((cm (riffle-controller 'contents-mode)))
284 ;; (when (not (eq major-mode cm))
286 (riffle-contents-show item-list))))
288 (riffle-define-derived-mode riffle-contents-mode riffle-mode "RiffleC"
292 (defun riffle-contents-show (item-list)
293 (buffer-disable-undo)
294 (setq buffer-read-only nil)
296 (setq riffle-contents-end
297 (mapcar (lambda (item) (riffle-contents-show-item item))
299 (set-buffer-modified-p nil)
300 (setq buffer-read-only t)
301 (goto-char (point-min))
304 (defun riffle-contents-show-item (item)
305 (insert (riffle-contents-item item))
308 (defun riffle-contents-item-number (position)
309 (let ((rest riffle-contents-end)
311 (while (and rest (<= (car rest) position))
312 (setq rest (cdr rest)
314 (min n (1- (length riffle-contents-end))))) ;; for the last line
316 (defun riffle-contents-current-item ()
317 (nth (riffle-contents-item-number (point)) (riffle-item-list)))
319 (defun riffle-contents-beginning (n)
320 (nth n (cons 1 riffle-contents-end)))
322 (defun riffle-contents-to-summary ()
324 (let ((n (riffle-contents-item-number (point))))
325 (riffle-summary (riffle-name) (riffle-item-list) riffle-type)
326 ; (howm-view-summary (riffle-name) (riffle-item-list))
327 (howm-goto-line (1+ n)))) ;; top = 1 for goto-line
329 (defun riffle-contents-goto-next-item (&optional n)
332 ;; remember that riffle-contents-end has duplicats
333 (stops (cl-remove-duplicates
334 (sort `(1 ,c ,@(copy-sequence riffle-contents-end))
336 (pos (cl-position c stops))
339 (goto-char (point-min))
340 (error "Beginning of buffer"))
341 ((>= new (length stops))
342 (goto-char (point-max))
343 (error "End of buffer"))
345 (goto-char (nth new stops))))))
347 (defun riffle-contents-goto-previous-item (&optional n)
349 (riffle-contents-goto-next-item (- n)))
351 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
354 (defun riffle-summary-buffer (&optional new)
355 (riffle-get-buffer (riffle-summary-name-format) nil new))
356 (defun riffle-contents-buffer (&optional new)
357 (riffle-get-buffer (riffle-contents-name-format) nil new))
358 ;; (defun riffle-contents-buffer (&optional new)
359 ;; (riffle-get-buffer howm-view-contents-name nil new))
360 ;; (defun riffle-summary-buffer (&optional new)
361 ;; (riffle-get-buffer howm-view-summary-name nil new))
362 (defun riffle-get-buffer (name-format &optional name new)
363 (let* ((bufname (format name-format (or name (riffle-name))))
364 (buf (get-buffer bufname)))
367 (get-buffer-create bufname)))
369 (defun riffle-kill-buffer ()
372 (let* ((s (riffle-summary-buffer))
373 (c (riffle-contents-buffer))
374 (sw (get-buffer-window s)))
379 (riffle-restore-window-configuration))))
381 (defun riffle-setup-buffer (name-format-func name item-list type)
382 (let ((name-format (let ((riffle-type type))
383 (funcall name-format-func))))
384 (switch-to-buffer (riffle-get-buffer name-format name))
385 (setq riffle-type type)
386 (setq riffle-name name
387 riffle-item-list item-list)))
389 (defun riffle-line-number (&optional pos)
395 (let ((raw (count-lines (point-min) (point))))
400 (defun riffle-persistent-p (z)
401 "Return whether the buffer should be persistent or not.
402 Note that the value of Z is funcall-ed if it is a function;
403 consider to set `risky-local-variable' property.
405 snap://Info-mode/elisp#File Local Variables
406 snap://Info-mode/emacs#File Variables
408 (riffle-get-value z))
410 (defun riffle-get-value (z)
415 (defun riffle-restore-window-configuration ()
416 (riffle-refresh-window-configuration))
418 (defun riffle-refresh-window-configuration ()
419 ;; (message "%s -- %s" (buffer-name) (if (riffle-p) t nil)) ;; debug
421 (riffle-setup-window-configuration)
422 (unless riffle-keep-window
423 (delete-other-windows))))
425 (defvar riffle-window-initializer 'delete-other-windows)
426 ;; (setq riffle-window-initializer '(lambda () (pop-to-buffer nil)))
427 (put 'riffle-window-initializer 'risky-local-variable t)
428 (defun riffle-setup-window-configuration ()
429 (let ((orig (current-buffer))
430 (s (riffle-summary-buffer))
431 (c (riffle-contents-buffer)))
432 (when (functionp riffle-window-initializer)
433 (funcall riffle-window-initializer))
435 (riffle-pop-to-buffer c howm-view-summary-window-size)
437 (select-window (get-buffer-window orig))))
439 (defun riffle-scroll-up (count)
442 (defun riffle-scroll-down (count)
445 (defun riffle-scroll-other-window (count)
447 (scroll-other-window count))
448 (defun riffle-scroll-other-window-down (count)
450 (scroll-other-window-down count))
452 (defvar even-window-heights nil) ;; xemacs doesn't have it.
453 (defun riffle-pop-to-buffer (buf &optional size)
454 (if riffle-keep-window
455 (switch-to-buffer buf)
458 (split-window nil size howm-view-split-horizontally))
459 (let ((even-window-heights (if size
461 even-window-heights))
462 ;; Don't split windows further even when
463 ;; riffle-pop-to-buffer is called twice.
464 (pop-up-windows nil))
465 (pop-to-buffer buf)))))
467 ;; 'Place' is line number at now
468 (defun riffle-set-place (place)
469 (howm-goto-line place))
470 (defun riffle-get-place (&optional point)
471 (riffle-line-number point))
474 ;; (defun riffle-jump-to-summary ()
476 ;; (riffle-jump-to-buffer (riffle-summary-buffer)))
477 ;; (defun riffle-jump-to-contents ()
479 ;; (riffle-jump-to-buffer (riffle-contents-buffer)))
480 ;; (defun riffle-jump-to-buffer (buf)
481 ;; (let ((w (get-buffer-window buf)))
484 ;; (switch-to-buffer buf))))
486 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
489 ;; (defun riffle-make-controller (alist)
491 ;; (defun riffle-send (object command &rest args)
492 ;; (if (eq command 'self)
494 ;; (let ((func (cdr (assoc command object))))
495 ;; (apply func args))))
497 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
502 (let ((m (make-sparse-keymap)))
503 (define-key m "n" 'next-line)
504 (define-key m "p" 'previous-line)
505 (define-key m "?" 'describe-mode)
506 (define-key m "q" 'riffle-kill-buffer)
507 (setq riffle-mode-map m))
509 ;;; riffle-summary-mode
511 (let ((m riffle-summary-mode-map))
512 (define-key m " " 'riffle-pop-or-scroll-other-window)
513 (define-key m [backspace] 'scroll-other-window-down)
514 (define-key m "\C-h" 'scroll-other-window-down)
515 (define-key m "j" 'riffle-scroll-other-window)
516 (define-key m "k" 'riffle-scroll-other-window-down)
517 (define-key m "@" 'riffle-summary-to-contents)
518 (define-key m "0" 'riffle-summary-to-contents)
519 (define-key m "1" 'delete-other-windows)
520 (define-key m "2" 'riffle-pop-window)
521 (define-key m "v" 'riffle-toggle-window)
522 ;; (define-key m "o" 'riffle-jump-to-contents)
525 ;;; riffle-contents-mode
527 (let ((m riffle-contents-mode-map))
528 (define-key m " " 'scroll-up)
529 (define-key m [backspace] 'scroll-down)
530 (define-key m "\C-h" 'scroll-down)
531 (define-key m "j" 'riffle-scroll-up)
532 (define-key m "k" 'riffle-scroll-down)
533 (define-key m "@" 'riffle-contents-to-summary)
534 (define-key m "0" 'riffle-contents-to-summary)
535 (define-key m "\C-i" 'riffle-contents-goto-next-item)
536 (define-key m "\M-\C-i" 'riffle-contents-goto-previous-item)
537 (define-key m [tab] 'riffle-contents-goto-next-item)
538 (define-key m [(meta tab)] 'riffle-contents-goto-previous-item)
539 ;; (define-key m "o" 'riffle-jump-to-summary)
542 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
546 ;; (For more realistic example, see "riffle" section in howm-view.el.)
547 ;; snap:///~/elisp/howm/howm-view.el#136:;;; riffle
550 ;; 1. M-x load-file <this file>
551 ;; 2. M-x riffle-sample
552 ;; 3. Move cursor. Type ? for help.
554 (defvar riffle-sample-item-list
556 ("foo1" "foo1 line1\nfoo1 line2\nfoo1 line3\nfoo1 line4\n")
557 ("foo2" "foo2 line1\nfoo2 line2\nfoo2 line3\nfoo2 line4\n")
558 ("bar1" "bar1 line1\nbar1 line2\nbar1 line3\nbar1 line4\n")
559 ("bar2" "bar2 line1\nbar2 line2\nbar2 line3\nbar2 line4\n")
562 (defvar riffle-sample-summary-name "sampleS:%s")
563 (defvar riffle-sample-contents-name "sampleC:%s")
564 (defvar riffle-sample-cursor-point 3)
566 (defun riffle-home:sample (item)
567 riffle-sample-cursor-point)
568 (defun riffle-summary-item:sample (item)
570 (defun riffle-contents-item:sample (item)
571 (concat (format "<%s>\n" (car item)) (cadr item) "\n"))
572 (defun riffle-summary-set-mode:sample ()
573 (riffle-sample-summary-mode))
574 (defun riffle-contents-set-mode:sample ()
575 (riffle-sample-contents-mode))
576 (defun riffle-summary-name-format:sample ()
577 riffle-sample-summary-name)
578 (defun riffle-contents-name-format:sample ()
579 riffle-sample-contents-name)
580 (defun riffle-post-update:sample (item)
581 (message "%s" (car item)))
583 (riffle-define-derived-mode riffle-sample-summary-mode riffle-summary-mode
585 "Sample summary mode.
588 \\[next-line] Next item
589 \\[previous-line] Previous item
590 \\[riffle-pop-or-scroll-other-window] Pop and scroll contents
591 \\[scroll-other-window-down] Scroll contents
592 \\[riffle-scroll-other-window] Scroll contents one line
593 \\[riffle-scroll-other-window-down] Scroll contents one line
594 \\[riffle-summary-to-contents] Concatenate all contents
596 \\[delete-other-windows] Delete contents window
597 \\[riffle-pop-window] Pop contents window
598 \\[riffle-toggle-window] Toggle contents window
600 \\[describe-mode] This help
601 \\[riffle-kill-buffer] Quit
605 (riffle-define-derived-mode riffle-sample-contents-mode riffle-contents-mode
607 "Sample contents mode.
610 \\[next-line] Next line
611 \\[previous-line] Previous line
612 \\[scroll-up] Scroll up
613 \\[scroll-down] Scroll down
614 \\[riffle-scroll-up] Scroll one line up
615 \\[riffle-scroll-down] Scroll one line down
616 \\[riffle-contents-to-summary] Summary
617 \\[riffle-contents-goto-next-item] Next item
618 \\[riffle-contents-goto-previous-item] Previous item
620 \\[describe-mode] This help
621 \\[riffle-kill-buffer] Quit
625 (defun riffle-sample ()
627 (riffle-summary "sample-list" riffle-sample-item-list ':sample))
629 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
634 ;;; riffle.el ends here