;;; register.el --- register commands for Emacs.;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.;; Maintainer: FSF;; Keywords: internal;; This file is part of GNU Emacs.;; GNU Emacs 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.;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.;;; Commentary:;; This package of functions emulates and somewhat extends the venerable;; TECO's `register' feature, which permits you to save various useful;; pieces of buffer state to named variables. The entry points are;; documented in the Emacs user's manual.;;; Code:(defvarregister-alistnil"Alist of elements (NAME . CONTENTS), one for each Emacs register.NAME is a character (a number). CONTENTS is a string, number,frame configuration, mark or list.A list of strings represents a rectangle.A list of the form (file . NAME) represents the file named NAME.")(defunget-register(reg)"Return contents of Emacs register named REG, or nil if none."(cdr(assqregregister-alist)))(defunset-register(registervalue)"Set contents of Emacs register named REGISTER to VALUE. Returns VALUE.See the documentation of the variable `register-alist' for possible VALUE."(let((aelt(assqregisterregister-alist)))(ifaelt(setcdraeltvalue)(setqaelt(consregistervalue))(setqregister-alist(consaeltregister-alist)))value))(defunpoint-to-register(register&optionalarg)"Store current location of point in register REGISTER.With prefix argument, store current frame configuration.Use \\[jump-to-register] to go to that location or restore that configuration.Argument is a character, naming the register."(interactive"cPoint to register: \nP")(set-registerregister(ifarg(current-frame-configuration)(point-marker))))(defunwindow-configuration-to-register(register&optionalarg)"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."(interactive"cWindow configuration to register: \nP")(set-registerregister(current-window-configuration)))(defunframe-configuration-to-register(register&optionalarg)"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"cFrame configuration to register: \nP")(set-registerregister(current-frame-configuration)))(defalias'register-to-point'jump-to-register)(defunjump-to-register(register&optionaldelete)"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'.)If the register contains a window configuration (one frame) or a frameconfiguration (all frames), restore that frame or all frames accordingly.First argument is a character, naming the register.Optional second arg non-nil (interactively, prefix argument) says todelete any existing frames that the frame configuration doesn't mention.\(Otherwise, these frames are iconified.)"(interactive"cJump to register: \nP")(let((val(get-registerregister)))(cond((and(fboundp'frame-configuration-p)(frame-configuration-pval))(set-frame-configurationval(notdelete)))((window-configuration-pval)(set-window-configurationval))((markerpval)(or(marker-bufferval)(error"That register's buffer no longer exists"))(switch-to-buffer(marker-bufferval))(goto-charval))((and(conspval)(eq(carval)'file))(find-file(cdrval)))(t(error"Register doesn't contain a buffer position or configuration")))));(defun number-to-register (arg char); "Store a number in a register.;Two args, NUMBER and REGISTER (a character, naming the register).;If NUMBER is nil, digits in the buffer following point are read;to get the number to store.;Interactively, NUMBER is the prefix arg (none means nil)."; (interactive "P\ncNumber to register: "); (set-register char ; (if arg; (prefix-numeric-value arg); (if (looking-at "[0-9][0-9]*"); (save-excursion; (save-restriction; (narrow-to-region (point); (progn (skip-chars-forward "0-9"); (point))); (goto-char (point-min)); (read (current-buffer)))); 0))));(defun increment-register (arg char); "Add NUMBER to the contents of register REGISTER.;Interactively, NUMBER is the prefix arg (none means nil)." ; (interactive "p\ncNumber to register: "); (or (integerp (get-register char)); (error "Register does not contain a number")); (set-register char (+ arg (get-register char))))(defunview-register(register)"Display what is contained in register named REGISTER.The Lisp value REGISTER is a character."(interactive"cView register: ")(let((val(get-registerregister)))(if(nullval)(message"Register %s is empty"(single-key-descriptionregister))(with-output-to-temp-buffer"*Output*"(princ"Register ")(princ(single-key-descriptionregister))(princ" contains ")(cond((integerpval)(princval))((markerpval)(let((buf(marker-bufferval)))(if(nullbuf)(princ"a marker in no buffer")(princ"a buffer position:\nbuffer ")(princ(buffer-namebuf))(princ", position ")(princ(marker-positionval)))))((window-configuration-pval)(princ"a window configuration."))((frame-configuration-pval)(princ"a frame configuration."))((and(conspval)(eq(carval)'file))(princ"the file ")(prin1(cdrval))(princ"."))((conspval)(princ"the rectangle:\n")(whileval(princ(carval))(terpri)(setqval(cdrval))))((stringpval)(princ"the text:\n")(princval))(t(princ"Garbage:\n")(prin1val)))))))(defuninsert-register(register&optionalarg)"Insert contents of register REGISTER. (REGISTER is a character.)Normally puts point before and mark after the inserted text.If optional second arg is non-nil, puts mark before and point after.Interactively, second arg is non-nil if prefix arg is supplied."(interactive"*cInsert register: \nP")(push-mark)(let((val(get-registerregister)))(cond((conspval)(insert-rectangleval))((stringpval)(insertval))((integerpval)(princval(current-buffer)))((and(markerpval)(marker-positionval))(princ(marker-positionval)(current-buffer)))(t(error"Register does not contain text"))))(if(notarg)(exchange-point-and-mark)))(defuncopy-to-register(registerstartend&optionaldelete-flag)"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")(set-registerregister(buffer-substringstartend))(ifdelete-flag(delete-regionstartend)))(defunappend-to-register(registerstartend&optionaldelete-flag)"Append region to text in 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 append."(interactive"cAppend to register: \nr\nP")(or(stringp(get-registerregister))(error"Register does not contain text"))(set-registerregister(concat(get-registerregister)(buffer-substringstartend)))(ifdelete-flag(delete-regionstartend)))(defunprepend-to-register(registerstartend&optionaldelete-flag)"Prepend region to text in 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 prepend."(interactive"cPrepend to register: \nr\nP")(or(stringp(get-registerregister))(error"Register does not contain text"))(set-registerregister(concat(buffer-substringstartend)(get-registerregister)))(ifdelete-flag(delete-regionstartend)))(defuncopy-rectangle-to-register(registerstartend&optionaldelete-flag)"Copy rectangular 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 giving two corners of rectangle."(interactive"cCopy rectangle to register: \nr\nP")(set-registerregister(ifdelete-flag(delete-extract-rectanglestartend)(extract-rectanglestartend))));;; register.el ends here