;;; register.el --- register commands for Emacs
-;; Copyright (C) 1985, 1993, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1993-1994, 2001-2012 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
;; 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))
+
;;; Global key bindings
-;;;###autoload (define-key ctl-x-r-map "\C-@" 'point-to-register)
-;;;###autoload (define-key ctl-x-r-map [?\C-\ ] 'point-to-register)
-;;;###autoload (define-key ctl-x-r-map " " 'point-to-register)
-;;;###autoload (define-key ctl-x-r-map "j" 'jump-to-register)
-;;;###autoload (define-key ctl-x-r-map "s" 'copy-to-register)
-;;;###autoload (define-key ctl-x-r-map "x" 'copy-to-register)
-;;;###autoload (define-key ctl-x-r-map "i" 'insert-register)
-;;;###autoload (define-key ctl-x-r-map "g" 'insert-register)
-;;;###autoload (define-key ctl-x-r-map "r" 'copy-rectangle-to-register)
-;;;###autoload (define-key ctl-x-r-map "n" 'number-to-register)
-;;;###autoload (define-key ctl-x-r-map "+" 'increment-register)
-;;;###autoload (define-key ctl-x-r-map "w" 'window-configuration-to-register)
-;;;###autoload (define-key ctl-x-r-map "f" 'frame-configuration-to-register)
+(define-key ctl-x-r-map "\C-@" 'point-to-register)
+(define-key ctl-x-r-map [?\C-\ ] 'point-to-register)
+(define-key ctl-x-r-map " " 'point-to-register)
+(define-key ctl-x-r-map "j" 'jump-to-register)
+(define-key ctl-x-r-map "s" 'copy-to-register)
+(define-key ctl-x-r-map "x" 'copy-to-register)
+(define-key ctl-x-r-map "i" 'insert-register)
+(define-key ctl-x-r-map "g" 'insert-register)
+(define-key ctl-x-r-map "r" 'copy-rectangle-to-register)
+(define-key ctl-x-r-map "n" 'number-to-register)
+(define-key ctl-x-r-map "+" 'increment-register)
+(define-key ctl-x-r-map "w" 'window-configuration-to-register)
+(define-key ctl-x-r-map "f" 'frame-configuration-to-register)
;;; Code:
+(defstruct
+ (registerv (:constructor nil)
+ (:constructor registerv--make (&optional data print-func
+ jump-func insert-func))
+ (:copier nil)
+ (:type vector)
+ :named)
+ (data nil :read-only t)
+ (print-func nil :read-only t)
+ (jump-func nil :read-only t)
+ (insert-func nil :read-only t))
+
+(defun* registerv-make (data &key print-func jump-func insert-func)
+ "Create a register value object.
+
+DATA can be any value.
+PRINT-FUNC if provided controls how `list-registers' and
+`view-register' print the register. It should be a function
+receiving one argument DATA and print text that completes
+this sentence:
+ Register X contains [TEXT PRINTED BY PRINT-FUNC]
+JUMP-FUNC if provided, controls how `jump-to-register' jumps to the register.
+INSERT-FUNC if provided, controls how `insert-register' insert the register.
+They both receive DATA as argument."
+ (registerv--make data print-func jump-func insert-func))
+
(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.
+NAME is a character (a number). CONTENTS is a string, number, marker, list
+or a struct returned by `registerv-make'.
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
(if arg (list (current-frame-configuration) (point-marker))
(point-marker))))
-(defun window-configuration-to-register (register &optional arg)
+(defun window-configuration-to-register (register &optional _arg)
"Store the window configuration of the selected frame in register REGISTER.
Use \\[jump-to-register] to restore the configuration.
Argument is a character, naming the register."
;; of point in the current buffer, so record that separately.
(set-register register (list (current-window-configuration) (point-marker))))
-(defun frame-configuration-to-register (register &optional arg)
+(defun frame-configuration-to-register (register &optional _arg)
"Store the window configuration of all frames in register REGISTER.
Use \\[jump-to-register] to restore the configuration.
Argument is a character, naming the register."
(interactive "cJump to register: \nP")
(let ((val (get-register register)))
(cond
+ ((registerv-p val)
+ (assert (registerv-jump-func val) nil
+ "Don't know how to jump to register %s"
+ (single-key-description register))
+ (funcall (registerv-jump-func val) (registerv-data val)))
((and (consp val) (frame-configuration-p (car val)))
(set-frame-configuration (car val) (not delete))
(goto-char (cadr val)))
(error "Register access aborted"))
(find-file (nth 1 val))
(goto-char (nth 2 val)))
+ ((and (fboundp 'semantic-foreign-tag-p)
+ semantic-mode
+ (semantic-foreign-tag-p val))
+ (switch-to-buffer (semantic-tag-buffer val))
+ (goto-char (semantic-tag-start val)))
(t
(error "Register doesn't contain a buffer position or configuration")))))
(princ " contains ")
(let ((val (get-register register)))
(cond
+ ((registerv-p val)
+ (if (registerv-print-func val)
+ (funcall (registerv-print-func val) (registerv-data val))
+ (princ "[UNPRINTABLE CONTENTS].")))
+
((numberp val)
(princ val))
(push-mark)
(let ((val (get-register register)))
(cond
+ ((registerv-p val)
+ (assert (registerv-insert-func val) nil
+ "Don't know how to insert register %s"
+ (single-key-description register))
+ (funcall (registerv-insert-func val) (registerv-data val)))
((consp val)
(insert-rectangle val))
((stringp val)
(princ val (current-buffer)))
((and (markerp val) (marker-position val))
(princ (marker-position val) (current-buffer)))
+ ((and (fboundp 'semantic-foreign-tag-p)
+ semantic-mode
+ (semantic-foreign-tag-p val))
+ (semantic-insert-foreign-tag val))
(t
(error "Register does not contain text"))))
(if (not arg) (exchange-point-and-mark)))
(extract-rectangle start end))))
(provide 'register)
-;; arch-tag: ce14dd68-8265-475f-9341-5d4ec5a53035
;;; register.el ends here