[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
list-register 1.8 -- List contents of register
From: |
Akihisa Matsushita |
Subject: |
list-register 1.8 -- List contents of register |
Date: |
Tue, 18 May 2004 22:21:29 +0900 |
User-agent: |
T-gnus/6.17.3 (based on No Gnus v0.3) SEMI/1.14.6 (Maruoka) FLIM/1.14.6 (Marutamachi) APEL/10.6 Emacs/21.1 (i386-mingw-nt5.1.2600) MULE/5.0 (SAKAKI) Meadow/2.00pre2 (KIKYOU) |
;;; list-register.el --- List register
;; -*- Mode: Emacs-Lisp -*-
;; $Id: list-register.el,v 1.8 2004/05/18 13:18:30 akihisa Exp $
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
;;; Install:
;; Put this file into load-path'ed directory, and byte compile it if
;; desired. And put the following expression into your ~/.emacs.
;;
;; (require 'list-register)
;; The latest version of this program can be downloaded from
;; http://www.bookshelf.jp/elc/list-register.el
;; M-x list-register
;;; Commentary:
;;
;;; Code:
(defvar list-register-buffer "*reg Output*")
(defvar list-register-edit-buffer "*Edit Register*")
;; internal
(defvar list-register-mode-map nil)
(defvar list-register-edit-mode-map nil)
(defvar list-register-parent-buffer nil)
(defvar list-register-edit-reg nil)
;; util
(defun current-line ()
"Return the vertical position of point..."
(1+ (count-lines 1 (point))))
(defun max-line ()
"Return the vertical position of point..."
(save-excursion
(goto-char (point-max))
(current-line)))
(or list-register-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "e"
(function list-register-edit-text))
(define-key map "\C-m"
(function list-register-insert))
(define-key map "q"
(function list-register-quit))
(define-key map "p"
(function previous-line))
(define-key map "n"
(function next-line))
(define-key map "+"
(function list-register-increment))
(define-key map "-"
(function list-register-decrement))
(setq list-register-mode-map map)))
(or list-register-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c"
(function list-register-edit-quit))
(define-key map "\C-c\C-q"
(function list-register-edit-cancel))
(define-key map "\C-c\C-s"
(function list-register-edit-set-register))
(setq list-register-edit-mode-map map)))
(defun list-register-quit ()
"Exit *list-register* buffer."
(interactive)
(set-buffer list-register-parent-buffer)
(condition-case ()
(delete-window (get-buffer-window list-register-buffer))
(error ))
(kill-buffer list-register-buffer))
(defun list-register-change-number (num)
"Add number of register to NUM."
(let (reg str)
(save-excursion
(beginning-of-line)
(if (re-search-forward "^[ \n]*\\([^\n:]+\\):[ \n]*\\([^:\n]+\\):.+$"
(line-end-position) t)
(progn
(setq reg (buffer-substring
(match-beginning 1) (match-end 1)))
(setq str (buffer-substring
(match-beginning 2) (match-end 2)))))
(if (string-match "num" str)
(increment-register num (string-to-char reg))
(message "Register does not contain a number!"))))
(list-register-review))
(defun list-register-increment (num)
"Add number of register to NUM."
(interactive "nIncrement Num: ")
(list-register-change-number num))
(defun list-register-decrement (num)
"Subtract NUM from number of register."
(interactive "nDecrement Num: ")
(list-register-change-number (* -1 num)))
;; edit register
(defun list-register-edit-text-do (reg)
"Make the buffer to edit text of REG."
(switch-to-buffer (get-buffer-create list-register-edit-buffer))
(erase-buffer)
(list-insert-register (string-to-char reg))
(kill-all-local-variables)
(make-local-variable 'list-register-edit-reg)
(setq list-register-edit-reg reg)
(use-local-map list-register-edit-mode-map))
(defun list-register-edit-text ()
"Edit text of register of current line."
(interactive)
(let (reg str)
(save-excursion
(beginning-of-line)
(if (re-search-forward
"^[ \n]*\\([^\n:]+\\):[ \n]*\\([^:\n]+\\):.+$"
(line-end-position) t)
(progn
(setq reg (buffer-substring
(match-beginning 1) (match-end 1)))
(setq str (buffer-substring
(match-beginning 2) (match-end 2)))))
(if (string-match "[0-9]+" str)
(list-register-edit-text-do reg)
(message "Register does not contain a text!")))))
(defun list-register-edit-quit ()
"Exit the buffer to edit the register."
(interactive)
(set-register
(string-to-char list-register-edit-reg)
(buffer-substring (point-min) (point-max)))
;;(delete-window (get-buffer-window list-register-edit-buffer))
(kill-buffer list-register-edit-buffer)
(switch-to-buffer list-register-buffer)
(list-register-review))
(defun list-register-edit-set-register (char)
"Save text of a register to another register (CHAR)."
(interactive "cCopy to register: ")
(set-register
char
(buffer-substring (point-min) (point-max)))
;;(delete-window (get-buffer-window list-register-edit-buffer))
(kill-buffer list-register-edit-buffer)
(switch-to-buffer list-register-buffer)
(list-register-review))
(defun list-register-edit-cancel ()
"Cancel to edit a register."
(interactive)
(kill-buffer list-register-edit-buffer)
(switch-to-buffer list-register-buffer))
(defun list-register-insert ()
"Insert text of a register."
(interactive)
(let (reg str)
(save-excursion
(beginning-of-line)
(if (re-search-forward
"^[ \n]*\\([^\n:]+\\):[ \n]*\\([^:\n]+\\):.+$"
(line-end-position) t)
(progn
(setq reg (buffer-substring
(match-beginning 1) (match-end 1)))
(setq str (buffer-substring
(match-beginning 2) (match-end 2)))))
(set-buffer list-register-parent-buffer)
(cond
((or
(string-match "file" str)
(string-match "conf" str)
(string-match "pos" str))
(list-jump-to-register (string-to-char reg)))
((or
(string-match "num" str)
(string-match "[0-9]+" str))
(list-insert-register (string-to-char reg))
(condition-case ()
(delete-window (get-buffer-window list-register-buffer))
(error ))
(kill-buffer list-register-buffer))))))
(defun list-register-print-text (arg)
"Print the text of register of ARG."
(interactive "p")
(let ((x (get-register arg)) (w (- (window-width) 15))
str strtmp lines prev)
(setq str (split-string x "\n"))
(setq strtmp str)
(setq lines (format "%4d" (length str)))
(setq str (mapconcat (lambda (y) y) str " "))
(if (string-match "^[ \t]*$" str)
()
(insert (format "%s: %s\n" lines
(truncate-string
(mapconcat (lambda (y) y) strtmp
"^J") w)))
(setq prev str))))
(defun list-register ()
"List contents of register."
(interactive)
(let ((lst register-alist) val reg st (pbuf (current-buffer))
lines)
(with-output-to-temp-buffer list-register-buffer
(set-buffer list-register-buffer)
(kill-all-local-variables)
(make-local-variable 'list-register-parent-buffer)
(setq list-register-parent-buffer pbuf)
(use-local-map list-register-mode-map)
(princ "List of register\n")
(setq st (point))
(while lst
(setq reg (car lst))
(setq lst (cdr lst))
(princ
(concat
;;"-------------------------------------------------\n"
(format "%3s"
(single-key-description (car reg)))
":"))
(setq val (get-register (car reg)))
(cond
((numberp val)
(insert " num:")
(insert (int-to-string val))
(insert "\n"))
((markerp val)
(insert " pos:")
(let ((buf (marker-buffer val)))
(if (null buf)
(insert "a marker in no buffer")
(insert "a buffer position:")
(insert (buffer-name buf))
(insert ", position ")
(insert (int-to-string (marker-position val)))
(insert "\n"))))
((and (consp val) (window-configuration-p (car val)))
(insert "conf:a window configuration.\n"))
((and (consp val) (frame-configuration-p (car val)))
(insert "conf:a frame configuration.\n"))
((and (consp val) (eq (car val) 'file))
(insert "file:")
(prin1 (cdr val))
(insert ".\n"))
((and (consp val) (eq (car val) 'file-query))
(insert "file:a file-query reference: file ")
(insert (car (cdr val)))
(insert ", position ")
(insert (int-to-string (car (cdr (cdr val)))))
(insert ".\n"))
((consp val)
(setq lines (format "%4d" (length val)))
(insert (format "%s: %s\n" lines
(truncate-string
(mapconcat (lambda (y) y) val
"^J") (- (window-width) 15)))))
((stringp val)
(list-register-print-text (car reg)))
(t
;;(insert "Garbage:\n")
;;(prin1 val))
)))
(sort-lines nil st (point-max))
(setq buffer-read-only t)))
(pop-to-buffer list-register-buffer))
(defun list-register-review ()
"Update list-register buffer."
(let ((pbuf list-register-parent-buffer)
(cp (current-line)))
(list-register)
(next-line (- cp 1))
(setq list-register-parent-buffer pbuf)))
(defun my-jump-to-register (&optional arg)
(interactive)
(let (char)
(message "Jump to register: ")
(list-register)
(setq char (read-char))
(list-jump-to-register char)))
(defun data-to-resgister (arg)
(interactive "P")
(let ((char))
(message "Copy to register: ")
(setq char (read-char))
(cond
(mark-active
(if (and
(not (= (save-excursion
(goto-char (region-beginning)) (current-column))
(save-excursion
(goto-char (region-end)) (current-column))))
(not (= (save-excursion
(goto-char (region-beginning)) (current-line))
(save-excursion
(goto-char (region-end)) (current-line)))))
(if (y-or-n-p "Rectangle? ")
(progn
(copy-rectangle-to-register
char (region-beginning) (region-end) arg))
(set-register char (buffer-substring
(region-beginning) (region-end)))
(if arg
(delete-region (region-beginning) (region-end))))))
(t
(message "f)rame w)indow p)oint")
(let ((c (char-to-string (read-char))))
(cond
((string-match "f" c)
(frame-configuration-to-register char arg))
((string-match "w" c)
(window-configuration-to-register char arg))
((string-match "p" c)
(point-to-register char arg))))))))
(defun list-insert-register (register)
(push-mark)
(let ((val (get-register register)))
(cond
((consp val)
(insert-rectangle val))
((stringp val)
(insert val))
((numberp val)
(princ val (current-buffer)))
((and (markerp val) (marker-position val))
(princ (marker-position val) (current-buffer)))
(t
(error "Register does not contain text")))))
(defun list-jump-to-register (register)
(let ((val (get-register register)))
(cond
((and (consp val) (frame-configuration-p (car val)))
(set-frame-configuration (car val))
(goto-char (cadr val)))
((and (consp val) (window-configuration-p (car val)))
(set-window-configuration (car val))
(goto-char (cadr val)))
((markerp val)
(or (marker-buffer val)
(error "That register's buffer no longer exists"))
(switch-to-buffer (marker-buffer val))
(goto-char val))
((and (consp val) (eq (car val) 'file))
(find-file (cdr val)))
((and (consp val) (eq (car val) 'file-query))
(or (find-buffer-visiting (nth 1 val))
(y-or-n-p (format "Visit file %s again? " (nth 1 val)))
(error "Register access aborted"))
(find-file (nth 1 val))
(goto-char (nth 2 val)))
(t
(error "Register doesn't contain a buffer position or configuration")))))
(provide 'list-register)
;;; list-register.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- list-register 1.8 -- List contents of register,
Akihisa Matsushita <=