X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/26e06f4464c58704889bdc536edc25b73e8c0179..e4f761f1e3df7fbc7793c73c5d808b8da0b3a700:/lisp/register.el diff --git a/lisp/register.el b/lisp/register.el index 6a8156e329..44f15e4a69 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -1,10 +1,10 @@ ;;; register.el --- register commands for Emacs -;; Copyright (C) 1985, 1993, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 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. @@ -28,43 +28,77 @@ ;; 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 . NAME) represents the file named NAME. -A list of the form (file-query NAME POSITION) represents position POSITION - in the file named NAME, but query before visiting it. +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 + position POSITION in the file named FILE-NAME, but query before + visiting it. 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.") -(defun get-register (reg) - "Return contents of Emacs register named REG, or nil if none." - (cdr (assq reg register-alist))) +(defun get-register (register) + "Return contents of Emacs register named REGISTER, or nil if none." + (cdr (assq register register-alist))) (defun set-register (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. -See the documentation of the variable `register-alist' for possible VALUE." +See the documentation of the variable `register-alist' for possible VALUEs." (let ((aelt (assq register register-alist))) (if aelt (setcdr aelt value) @@ -83,7 +117,7 @@ Argument is a character, naming the register." (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." @@ -92,7 +126,7 @@ 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." @@ -105,7 +139,7 @@ Argument is a character, naming the register." (defun jump-to-register (register &optional delete) "Move point to location stored in a register. If the register contains a file name, find that file. - \(To put a file name in a register, you must use `set-register'.) +\(To put a file name in a register, you must use `set-register'.) If the register contains a window configuration (one frame) or a frame configuration (all frames), restore that frame or all frames accordingly. First argument is a character, naming the register. @@ -115,6 +149,11 @@ delete any existing frames that the frame configuration doesn't mention. (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))) @@ -134,6 +173,11 @@ delete any existing frames that the frame configuration doesn't mention. (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"))))) @@ -199,6 +243,11 @@ The Lisp value REGISTER is a character." (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)) @@ -275,6 +324,11 @@ Interactively, second arg is non-nil if prefix arg is supplied." (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) @@ -283,12 +337,17 @@ Interactively, second arg is non-nil if prefix arg is supplied." (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))) (defun copy-to-register (register start end &optional delete-flag) - "Copy region into register REGISTER. With prefix arg, delete as well. + "Copy region into register REGISTER. +With prefix arg, delete as well. 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") @@ -325,8 +384,8 @@ START and END are buffer positions indicating what to prepend." (defun copy-rectangle-to-register (register start end &optional delete-flag) "Copy rectangular region into register REGISTER. -With prefix arg, delete as well. To insert this register -in the buffer, use \\[insert-register]. +With prefix arg, delete as well. +To insert this register in the buffer, use \\[insert-register]. Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." @@ -337,5 +396,4 @@ START and END are buffer positions giving two corners of rectangle." (extract-rectangle start end)))) (provide 'register) -;; arch-tag: ce14dd68-8265-475f-9341-5d4ec5a53035 ;;; register.el ends here