1 ;;; riffle.el --- template of list browser with immediate preview
2 ;;; Copyright (C) 2004, 2005-2020
3 ;;; HIRAOKA Kazuyuki <khi@users.osdn.me>
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)
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.
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,
19 ;;--------------------------------------------------------------------
23 ;; Not yet. See sample at the bottom of this file.
29 (require 'howm-common)
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 ;; These howm-view-xxx will be renamed to riffle-xxx in future.
36 (defcustom howm-view-summary-window-size nil
37 "Size of summary window, or nil for half size."
38 :type '(radio (const :tag "Half" nil)
40 :group 'howm-list-bufwin)
41 (defcustom howm-view-split-horizontally nil
42 "If non-nil, split window horizontally to show summary and contents."
44 :group 'howm-list-bufwin)
45 (defcustom howm-view-keep-one-window nil
46 "If nil, split windows automatically for summary and contents
47 even if you delete other windows explicitly."
49 :group 'howm-list-bufwin)
50 (defcustom howm-view-pop-up-windows t
51 "If non-nil, override `pop-up-windows'."
53 :group 'howm-list-bufwin)
55 ;; clean me: This value is copied to howm-view-open-recenter.
56 (defvar howm-view-search-recenter 5)
58 ;; experimental [2008-05-23]
59 (defvar riffle-keep-window nil)
61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 ;;; internal variables and accessors
64 (defvar *riffle-summary-check* t)
66 (defvar riffle-name nil)
67 (defvar riffle-item-list nil)
68 (defvar riffle-type nil)
69 (defvar riffle-summary-last-line nil)
70 (defvar riffle-contents-end nil)
71 (make-variable-buffer-local 'riffle-name)
72 (make-variable-buffer-local 'riffle-item-list)
73 (make-variable-buffer-local 'riffle-type)
74 ; update contents when changed
75 (make-variable-buffer-local 'riffle-summary-last-line)
77 (make-variable-buffer-local 'riffle-contents-end)
79 (defun riffle-name () riffle-name)
80 (defun riffle-item-list () riffle-item-list)
81 (defun riffle-set-item-list (item-list) (setq riffle-item-list item-list))
84 (defun riffle-p () riffle-type)
85 (defun riffle-contents-first-time-p () (null riffle-contents-end))
87 (defvar *riffle-preview-p* nil)
88 (defun riffle-preview-p () *riffle-preview-p*)
90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93 ;; In xemacs, define-derived-mode makes the mode call
94 ;; derived-mode-merge-syntax-tables, which takes long time.
95 ;; To avoid it, we need ":syntax-table nil". Sigh...
97 (defmacro riffle-define-derived-mode (child parent name
101 `(define-derived-mode ,child ,parent ,name
107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
110 (defun riffle-type (&rest r)
112 (defvar riffle-dispatchers (list #'riffle-type))
113 (put 'riffle-dispatchers 'risky-local-variable t)
115 (gfunc-with riffle-dispatchers
116 (gfunc-def riffle-home (item))
117 (gfunc-def riffle-summary-item (item))
118 (gfunc-def riffle-contents-item (item))
119 (gfunc-def riffle-summary-set-mode ())
120 (gfunc-def riffle-contents-set-mode ())
121 (gfunc-def riffle-summary-name-format ())
122 (gfunc-def riffle-contents-name-format ())
123 (gfunc-def riffle-post-update (item)))
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
128 (defcustom riffle-mode-hook nil
129 "Hook run at the end of function `riffle-mode'"
133 (defvar riffle-mode-map nil)
134 (put 'riffle-mode-map 'risky-local-variable t)
135 (defvar riffle-mode-syntax-table (make-syntax-table))
136 (defvar riffle-mode-abbrev-table nil)
138 (defun riffle-mode ()
140 (setq major-mode 'riffle-mode
142 (use-local-map riffle-mode-map)
143 (set-syntax-table riffle-mode-syntax-table)
144 (define-abbrev-table 'riffle-mode-abbrev-table nil)
145 (run-hooks 'riffle-mode-hook))
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
150 (defun riffle-summary (&optional name item-list type background)
151 "Create summary buffer for NAME, ITEM-LIST, and TYPE.
152 When NAME is nil, default values for them are selected.
153 Created buffer is shown immediately as far as BACKGROUND is nil.
154 This function returns effective value of ITEM-LIST."
156 (setq name (riffle-name)
157 item-list (riffle-item-list)
161 (let ((d default-directory))
162 (riffle-setup-buffer #'riffle-summary-name-format name item-list type)
163 (setq default-directory d)
164 (when (not background)
165 (riffle-summary-subr name item-list))
168 (defun riffle-summary-subr (name item-list)
169 (riffle-summary-set-mode)
170 (riffle-summary-show item-list)
171 (unless riffle-keep-window
172 (riffle-summary-check t)))
174 (defun riffle-summary-show (item-list)
175 (buffer-disable-undo)
176 (setq buffer-read-only nil)
178 (mapc 'riffle-summary-show-item item-list)
179 (set-buffer-modified-p nil)
180 (setq buffer-read-only t
182 (goto-char (point-min))
183 (setq riffle-summary-last-line -777))
185 (defun riffle-summary-show-item (item)
186 (insert (riffle-summary-item item) "\n"))
188 (riffle-define-derived-mode riffle-summary-mode riffle-mode "RiffleS"
190 ;; make-local-hook is obsolete for emacs >= 21.1.
191 (when (fboundp 'make-local-hook) (make-local-hook 'post-command-hook))
192 (add-hook 'post-command-hook 'riffle-post-command t t))
194 (defun riffle-post-command ()
195 (unless riffle-keep-window
196 (if *riffle-summary-check*
197 (riffle-summary-check)
198 (setq *riffle-summary-check* t))))
200 (defun riffle-summary-current-item ()
201 (let ((n (riffle-line-number)))
202 (nth (1- n) (riffle-item-list))))
204 (defun riffle-summary-check (&optional force)
205 (let ((keep-one howm-view-keep-one-window))
207 (riffle-refresh-window-configuration)
209 (let ((n (riffle-line-number))
210 (howm-view-keep-one-window keep-one))
211 (when (or (not (= n riffle-summary-last-line))
213 (setq riffle-summary-last-line n)
214 (let ((item (riffle-summary-current-item)))
215 (when (and item *riffle-summary-check*)
216 (riffle-summary-update item force)))))))
218 (defun riffle-summary-update (item &optional new)
219 (unless (and howm-view-keep-one-window (one-window-p))
220 (riffle-summary-update-subr item new)))
221 (defun riffle-summary-update-subr (item &optional new)
222 (let* ((*riffle-preview-p* t) ;; dirty
223 (vbuf (riffle-contents-buffer new))
224 (cwin (selected-window))
225 (pop-up-windows (or pop-up-windows howm-view-pop-up-windows))
226 ;; (section (riffle-controller 'section item))
228 (type riffle-type)) ;; be careful to buffer local var.
229 (riffle-pop-to-buffer vbuf howm-view-summary-window-size)
230 (riffle-contents name (list item) type default-directory)
231 (goto-char (point-min))
232 (let ((home (riffle-home item)))
233 ;; (let ((home (howm-view-item-home item)))
236 (recenter howm-view-search-recenter))
238 (riffle-post-update item))))
239 ;; (message "View: %s" section)
241 (defun riffle-pop-window ()
243 (let ((r (one-window-p)))
245 (riffle-summary-check t))
248 (defun riffle-pop-or-scroll-other-window ()
250 (or (riffle-pop-window)
251 (scroll-other-window)))
253 (defun riffle-toggle-window ()
255 (or (riffle-pop-window)
256 (delete-other-windows)))
258 (defun riffle-summary-to-contents ()
260 (let ((b (current-buffer)))
261 (unless riffle-keep-window
262 (delete-other-windows)
264 (let ((n (riffle-line-number)))
265 (riffle-contents (riffle-name) (riffle-item-list) riffle-type
267 (goto-char (riffle-contents-beginning (1- n))))))
269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
272 ;; (defvar riffle-contents-mode-variant nil)
274 (defun riffle-contents (name item-list type default-dir)
278 (riffle-setup-buffer #'riffle-contents-name-format name item-list type)
279 (setq default-directory default-dir)
280 (when (riffle-contents-first-time-p)
281 (riffle-contents-set-mode))
282 ;; (let ((cm (riffle-controller 'contents-mode)))
283 ;; (when (not (eq major-mode cm))
285 (riffle-contents-show item-list))))
287 (riffle-define-derived-mode riffle-contents-mode riffle-mode "RiffleC"
291 (defun riffle-contents-show (item-list)
292 (buffer-disable-undo)
293 (setq buffer-read-only nil)
295 (setq riffle-contents-end
296 (mapcar (lambda (item) (riffle-contents-show-item item))
298 (set-buffer-modified-p nil)
299 (setq buffer-read-only t)
300 (goto-char (point-min))
303 (defun riffle-contents-show-item (item)
304 (insert (riffle-contents-item item))
307 (defun riffle-contents-item-number (position)
308 (let ((rest riffle-contents-end)
310 (while (and rest (<= (car rest) position))
311 (setq rest (cdr rest)
313 (min n (1- (length riffle-contents-end))))) ;; for the last line
315 (defun riffle-contents-current-item ()
316 (nth (riffle-contents-item-number (point)) (riffle-item-list)))
318 (defun riffle-contents-beginning (n)
319 (nth n (cons 1 riffle-contents-end)))
321 (defun riffle-contents-to-summary ()
323 (let ((n (riffle-contents-item-number (point))))
324 (riffle-summary (riffle-name) (riffle-item-list) riffle-type)
325 ; (howm-view-summary (riffle-name) (riffle-item-list))
326 (howm-goto-line (1+ n)))) ;; top = 1 for goto-line
328 (defun riffle-contents-goto-next-item (&optional n)
331 ;; remember that riffle-contents-end has duplicats
332 (stops (cl-remove-duplicates
333 (sort `(1 ,c ,@(copy-sequence riffle-contents-end))
335 (pos (cl-position c stops))
338 (goto-char (point-min))
339 (error "Beginning of buffer"))
340 ((>= new (length stops))
341 (goto-char (point-max))
342 (error "End of buffer"))
344 (goto-char (nth new stops))))))
346 (defun riffle-contents-goto-previous-item (&optional n)
348 (riffle-contents-goto-next-item (- n)))
350 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
353 (defun riffle-summary-buffer (&optional new)
354 (riffle-get-buffer (riffle-summary-name-format) nil new))
355 (defun riffle-contents-buffer (&optional new)
356 (riffle-get-buffer (riffle-contents-name-format) nil new))
357 ;; (defun riffle-contents-buffer (&optional new)
358 ;; (riffle-get-buffer howm-view-contents-name nil new))
359 ;; (defun riffle-summary-buffer (&optional new)
360 ;; (riffle-get-buffer howm-view-summary-name nil new))
361 (defun riffle-get-buffer (name-format &optional name new)
362 (let* ((bufname (format name-format (or name (riffle-name))))
363 (buf (get-buffer bufname)))
366 (get-buffer-create bufname)))
368 (defun riffle-kill-buffer ()
371 (let* ((s (riffle-summary-buffer))
372 (c (riffle-contents-buffer))
373 (sw (get-buffer-window s)))
378 (riffle-restore-window-configuration))))
380 (defun riffle-setup-buffer (name-format-func name item-list type)
381 (let ((name-format (let ((riffle-type type))
382 (funcall name-format-func))))
383 (switch-to-buffer (riffle-get-buffer name-format name))
384 (setq riffle-type type)
385 (setq riffle-name name
386 riffle-item-list item-list)))
388 (defun riffle-line-number (&optional pos)
394 (let ((raw (count-lines (point-min) (point))))
399 (defun riffle-persistent-p (z)
400 "Return whether the buffer should be persistent or not.
401 Note that the value of Z is funcall-ed if it is a function;
402 consider to set `risky-local-variable' property.
404 snap://Info-mode/elisp#File Local Variables
405 snap://Info-mode/emacs#File Variables
407 (riffle-get-value z))
409 (defun riffle-get-value (z)
414 (defun riffle-restore-window-configuration ()
415 (riffle-refresh-window-configuration))
417 (defun riffle-refresh-window-configuration ()
418 ;; (message "%s -- %s" (buffer-name) (if (riffle-p) t nil)) ;; debug
420 (riffle-setup-window-configuration)
421 (unless riffle-keep-window
422 (delete-other-windows))))
424 (defvar riffle-window-initializer 'delete-other-windows)
425 ;; (setq riffle-window-initializer '(lambda () (pop-to-buffer nil)))
426 (put 'riffle-window-initializer 'risky-local-variable t)
427 (defun riffle-setup-window-configuration ()
428 (let ((orig (current-buffer))
429 (s (riffle-summary-buffer))
430 (c (riffle-contents-buffer)))
431 (when (functionp riffle-window-initializer)
432 (funcall riffle-window-initializer))
434 (riffle-pop-to-buffer c howm-view-summary-window-size)
436 (select-window (get-buffer-window orig))))
438 (defun riffle-scroll-up (count)
441 (defun riffle-scroll-down (count)
444 (defun riffle-scroll-other-window (count)
446 (scroll-other-window count))
447 (defun riffle-scroll-other-window-down (count)
449 (scroll-other-window-down count))
451 (defvar even-window-heights nil) ;; xemacs doesn't have it.
452 (defun riffle-pop-to-buffer (buf &optional size)
453 (if riffle-keep-window
454 (switch-to-buffer buf)
457 (split-window nil size howm-view-split-horizontally))
458 (let ((even-window-heights (if size
460 even-window-heights))
461 ;; Don't split windows further even when
462 ;; riffle-pop-to-buffer is called twice.
463 (pop-up-windows nil))
464 (pop-to-buffer buf)))))
466 ;; 'Place' is line number at now
467 (defun riffle-set-place (place)
468 (howm-goto-line place))
469 (defun riffle-get-place (&optional point)
470 (riffle-line-number point))
473 ;; (defun riffle-jump-to-summary ()
475 ;; (riffle-jump-to-buffer (riffle-summary-buffer)))
476 ;; (defun riffle-jump-to-contents ()
478 ;; (riffle-jump-to-buffer (riffle-contents-buffer)))
479 ;; (defun riffle-jump-to-buffer (buf)
480 ;; (let ((w (get-buffer-window buf)))
483 ;; (switch-to-buffer buf))))
485 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
488 ;; (defun riffle-make-controller (alist)
490 ;; (defun riffle-send (object command &rest args)
491 ;; (if (eq command 'self)
493 ;; (let ((func (cdr (assoc command object))))
494 ;; (apply func args))))
496 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
501 (let ((m (make-sparse-keymap)))
502 (define-key m "n" 'next-line)
503 (define-key m "p" 'previous-line)
504 (define-key m "?" 'describe-mode)
505 (define-key m "q" 'riffle-kill-buffer)
506 (setq riffle-mode-map m))
508 ;;; riffle-summary-mode
510 (let ((m riffle-summary-mode-map))
511 (define-key m " " 'riffle-pop-or-scroll-other-window)
512 (define-key m [backspace] 'scroll-other-window-down)
513 (define-key m "\C-h" 'scroll-other-window-down)
514 (define-key m "j" 'riffle-scroll-other-window)
515 (define-key m "k" 'riffle-scroll-other-window-down)
516 (define-key m "@" 'riffle-summary-to-contents)
517 (define-key m "0" 'riffle-summary-to-contents)
518 (define-key m "1" 'delete-other-windows)
519 (define-key m "2" 'riffle-pop-window)
520 (define-key m "v" 'riffle-toggle-window)
521 ;; (define-key m "o" 'riffle-jump-to-contents)
524 ;;; riffle-contents-mode
526 (let ((m riffle-contents-mode-map))
527 (define-key m " " 'scroll-up)
528 (define-key m [backspace] 'scroll-down)
529 (define-key m "\C-h" 'scroll-down)
530 (define-key m "j" 'riffle-scroll-up)
531 (define-key m "k" 'riffle-scroll-down)
532 (define-key m "@" 'riffle-contents-to-summary)
533 (define-key m "0" 'riffle-contents-to-summary)
534 (define-key m "\C-i" 'riffle-contents-goto-next-item)
535 (define-key m "\M-\C-i" 'riffle-contents-goto-previous-item)
536 (define-key m [tab] 'riffle-contents-goto-next-item)
537 (define-key m [(meta tab)] 'riffle-contents-goto-previous-item)
538 ;; (define-key m "o" 'riffle-jump-to-summary)
541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
545 ;; (For more realistic example, see "riffle" section in howm-view.el.)
546 ;; snap:///~/elisp/howm/howm-view.el#136:;;; riffle
549 ;; 1. M-x load-file <this file>
550 ;; 2. M-x riffle-sample
551 ;; 3. Move cursor. Type ? for help.
553 (defvar riffle-sample-item-list
555 ("foo1" "foo1 line1\nfoo1 line2\nfoo1 line3\nfoo1 line4\n")
556 ("foo2" "foo2 line1\nfoo2 line2\nfoo2 line3\nfoo2 line4\n")
557 ("bar1" "bar1 line1\nbar1 line2\nbar1 line3\nbar1 line4\n")
558 ("bar2" "bar2 line1\nbar2 line2\nbar2 line3\nbar2 line4\n")
561 (defvar riffle-sample-summary-name "sampleS:%s")
562 (defvar riffle-sample-contents-name "sampleC:%s")
563 (defvar riffle-sample-cursor-point 3)
565 (defun riffle-home:sample (item)
566 riffle-sample-cursor-point)
567 (defun riffle-summary-item:sample (item)
569 (defun riffle-contents-item:sample (item)
570 (concat (format "<%s>\n" (car item)) (cadr item) "\n"))
571 (defun riffle-summary-set-mode:sample ()
572 (riffle-sample-summary-mode))
573 (defun riffle-contents-set-mode:sample ()
574 (riffle-sample-contents-mode))
575 (defun riffle-summary-name-format:sample ()
576 riffle-sample-summary-name)
577 (defun riffle-contents-name-format:sample ()
578 riffle-sample-contents-name)
579 (defun riffle-post-update:sample (item)
580 (message "%s" (car item)))
582 (riffle-define-derived-mode riffle-sample-summary-mode riffle-summary-mode
584 "Sample summary mode.
587 \\[next-line] Next item
588 \\[previous-line] Previous item
589 \\[riffle-pop-or-scroll-other-window] Pop and scroll contents
590 \\[scroll-other-window-down] Scroll contents
591 \\[riffle-scroll-other-window] Scroll contents one line
592 \\[riffle-scroll-other-window-down] Scroll contents one line
593 \\[riffle-summary-to-contents] Concatenate all contents
595 \\[delete-other-windows] Delete contents window
596 \\[riffle-pop-window] Pop contents window
597 \\[riffle-toggle-window] Toggle contents window
599 \\[describe-mode] This help
600 \\[riffle-kill-buffer] Quit
604 (riffle-define-derived-mode riffle-sample-contents-mode riffle-contents-mode
606 "Sample contents mode.
609 \\[next-line] Next line
610 \\[previous-line] Previous line
611 \\[scroll-up] Scroll up
612 \\[scroll-down] Scroll down
613 \\[riffle-scroll-up] Scroll one line up
614 \\[riffle-scroll-down] Scroll one line down
615 \\[riffle-contents-to-summary] Summary
616 \\[riffle-contents-goto-next-item] Next item
617 \\[riffle-contents-goto-previous-item] Previous item
619 \\[describe-mode] This help
620 \\[riffle-kill-buffer] Quit
624 (defun riffle-sample ()
626 (riffle-summary "sample-list" riffle-sample-item-list ':sample))
628 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
633 ;;; riffle.el ends here