From: Leo <sdl.web@gmail.com>
To: emacs-devel@gnu.org
Subject: Make register easier to hook
Date: Mon, 28 Mar 2011 23:35:27 +0800 [thread overview]
Message-ID: <m1tyen45s0.fsf@gmail.com> (raw)
Hello all,
I would like to extend register.el so that 3rd party packages can add
new register and have C-x r j, C-x r i and M-x list-registers work with
it without needing to modify register.el.
With the attached draft patch, one can now do:
(defun WHATEVER-to-register (register)
(interactive)
(register-set register
(register-make :info WHATEVER
:jump-func function-to-handle-WHATEVER)))
And C-x r j will call function-to-handle-WHATEVER for jumping.
Any comments will be highly appreciated. Thanks.
Leo
=== modified file 'lisp/register.el'
--- lisp/register.el 2011-01-25 04:08:28 +0000
+++ lisp/register.el 2011-03-28 15:23:23 +0000
@@ -28,6 +28,8 @@
;; pieces of buffer state to named variables. The entry points are
;; documented in the Emacs user's manual.
+(eval-when-compile (require 'cl))
+
(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag))
(declare-function semantic-tag-buffer "semantic/tag" (tag))
(declare-function semantic-tag-start "semantic/tag" (tag))
@@ -50,9 +52,16 @@
;;; Code:
-(defvar register-alist nil
- "Alist of elements (NAME . CONTENTS), one for each Emacs register.
-NAME is a character (a number). CONTENTS is a string, number, marker or list.
+(defstruct (register (:constructor register-make)
+ (:copier nil)
+ (:type list)
+ :named)
+ info print-func jump-func insert-func)
+
+;; Add documentation string for the constructor
+(setf (documentation-property 'register-make 'function-documentation)
+ "Constructor for register objects.
+INFO holds the contents of the register. It can be a string, number, marker or list.
A list of strings represents a rectangle.
A list of the form (file . FILE-NAME) represents the file named FILE-NAME.
A list of the form (file-query FILE-NAME POSITION) represents
@@ -61,13 +70,27 @@
A list of the form (WINDOW-CONFIGURATION POSITION)
represents a saved window configuration plus a saved value of point.
A list of the form (FRAME-CONFIGURATION POSITION)
- represents a saved frame configuration plus a saved value of point.")
+ represents a saved frame configuration plus a saved value of point.
+
+PRINT-FUNC if set controls how `list-registers' and
+`view-register' print a register. It should be a function
+recieving one argument INFO.
+
+If JUMP-FUNC is set, `jump-to-register' calls it to do the work.
+
+If INSERT-FUNC is set, `insert-register' calls it to do the work.
-(defun get-register (register)
+\(fn &key INFO PRINT-FUNC JUMP-FUNC INSERT-FUNC)")
+
+(defvar register-alist nil
+ "Alist of elements (NAME . OBJECT), one for each Emacs register.
+NAME is a character (a number). OBJECT is created by `register-make'.")
+
+(defun register-get (register)
"Return contents of Emacs register named REGISTER, or nil if none."
(cdr (assq register register-alist)))
-(defun set-register (register value)
+(defun register-set (register value)
"Set contents of Emacs register named REGISTER to VALUE. Returns VALUE.
See the documentation of the variable `register-alist' for possible VALUEs."
(let ((aelt (assq register register-alist)))
@@ -76,6 +99,9 @@
(push (cons register value) register-alist))
value))
+(define-obsolete-function-alias 'get-register 'register-get "24.1")
+(define-obsolete-function-alias 'set-register 'register-set "24.1")
+
(defun point-to-register (register &optional arg)
"Store current location of point in register REGISTER.
With prefix argument, store current frame configuration.
@@ -84,7 +110,7 @@
(interactive "cPoint to register: \nP")
;; Turn the marker into a file-ref if the buffer is killed.
(add-hook 'kill-buffer-hook 'register-swap-out nil t)
- (set-register register
+ (register-set register
(if arg (list (current-frame-configuration) (point-marker))
(point-marker))))
@@ -95,7 +121,7 @@
(interactive "cWindow configuration to register: \nP")
;; current-window-configuration does not include the value
;; of point in the current buffer, so record that separately.
- (set-register register (list (current-window-configuration) (point-marker))))
+ (register-set register (list (current-window-configuration) (point-marker))))
(defun frame-configuration-to-register (register &optional arg)
"Store the window configuration of all frames in register REGISTER.
@@ -104,7 +130,7 @@
(interactive "cFrame configuration to register: \nP")
;; current-frame-configuration does not include the value
;; of point in the current buffer, so record that separately.
- (set-register register (list (current-frame-configuration) (point-marker))))
+ (register-set register (list (current-frame-configuration) (point-marker))))
(defalias 'register-to-point 'jump-to-register)
(defun jump-to-register (register &optional delete)
@@ -118,8 +144,14 @@
delete any existing frames that the frame configuration doesn't mention.
\(Otherwise, these frames are iconified.)"
(interactive "cJump to register: \nP")
- (let ((val (get-register register)))
+ (let* ((object (register-get register))
+ (val (if (register-p object)
+ (register-info object)
+ object))
+ (jump (and (register-p object)
+ (register-jump-func object))))
(cond
+ (jump (funcall jump val))
((and (consp val) (frame-configuration-p (car val)))
(set-frame-configuration (car val) (not delete))
(goto-char (cadr val)))
@@ -165,7 +197,7 @@
at point, and point moves to the end of that number.
Interactively, NUMBER is the prefix arg (none means nil)."
(interactive "P\ncNumber to register: ")
- (set-register register
+ (register-set register
(if number
(prefix-numeric-value number)
(if (looking-at "\\s-*-?[0-9]+")
@@ -180,13 +212,13 @@
(interactive "p\ncIncrement register: ")
(or (numberp (get-register register))
(error "Register does not contain a number"))
- (set-register register (+ number (get-register register))))
+ (register-set register (+ number (get-register register))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
The Lisp value REGISTER is a character."
(interactive "cView register: ")
- (let ((val (get-register register)))
+ (let ((val (register-get register)))
(if (null val)
(message "Register %s is empty" (single-key-description register))
(with-output-to-temp-buffer "*Output*"
@@ -199,7 +231,7 @@
(setq list (sort list (lambda (a b) (< (car a) (car b)))))
(with-output-to-temp-buffer "*Output*"
(dolist (elt list)
- (when (get-register (car elt))
+ (when (register-get (car elt))
(describe-register-1 (car elt))
(terpri))))))
@@ -207,8 +239,15 @@
(princ "Register ")
(princ (single-key-description register))
(princ " contains ")
- (let ((val (get-register register)))
+ (let* ((object (register-get register))
+ (val (if (register-p object)
+ (register-info object)
+ object))
+ (printfunc (and (register-p object)
+ (register-print-func object))))
(cond
+ (printfunc (funcall printfunc val))
+
((numberp val)
(princ val))
@@ -283,8 +322,14 @@
Interactively, second arg is non-nil if prefix arg is supplied."
(interactive "*cInsert register: \nP")
(push-mark)
- (let ((val (get-register register)))
+ (let* ((object (register-get register))
+ (val (if (register-p object)
+ (register-info object)
+ object))
+ (insert-func (and (register-p object)
+ (register-insert-func object))))
(cond
+ (insert-func (funcall insert-func val))
((consp val)
(insert-rectangle val))
((stringp val)
@@ -307,7 +352,7 @@
Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions indicating what to copy."
(interactive "cCopy to register: \nr\nP")
- (set-register register (filter-buffer-substring start end))
+ (register-set register (filter-buffer-substring start end))
(if delete-flag (delete-region start end)))
(defun append-to-register (register start end &optional delete-flag)
@@ -318,7 +363,7 @@
(interactive "cAppend to register: \nr\nP")
(let ((reg (get-register register))
(text (filter-buffer-substring start end)))
- (set-register
+ (register-set
register (cond ((not reg) text)
((stringp reg) (concat reg text))
(t (error "Register does not contain text")))))
@@ -332,7 +377,7 @@
(interactive "cPrepend to register: \nr\nP")
(let ((reg (get-register register))
(text (filter-buffer-substring start end)))
- (set-register
+ (register-set
register (cond ((not reg) text)
((stringp reg) (concat text reg))
(t (error "Register does not contain text")))))
@@ -346,7 +391,7 @@
Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG.
START and END are buffer positions giving two corners of rectangle."
(interactive "cCopy rectangle to register: \nr\nP")
- (set-register register
+ (register-set register
(if delete-flag
(delete-extract-rectangle start end)
(extract-rectangle start end))))
next reply other threads:[~2011-03-28 15:35 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-03-28 15:35 Leo [this message]
2011-03-28 17:37 ` Make register easier to hook Daniel Colascione
2011-03-29 0:52 ` Leo
2011-03-29 2:14 ` Daniel Colascione
2011-03-28 17:39 ` Davis Herring
2011-03-31 10:37 ` Leo
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m1tyen45s0.fsf@gmail.com \
--to=sdl.web@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.