;;; register.el --- register commands for Emacs
-;; Copyright (C) 1985, 1993-1994, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1993-1994, 2001-2013 Free Software Foundation,
+;; Inc.
;; Maintainer: FSF
;; Keywords: internal
(eval-when-compile (require 'cl-lib))
-(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))
+(declare-function frameset-frame-id "frameset" (frame))
+(declare-function frameset-frame-with-id "frameset" (id &optional frame-list))
+(declare-function frameset-p "frameset" (frameset))
+(declare-function frameset-restore "frameset" (frameset &rest keys) t)
+(declare-function frameset-save "frameset" (frame-list &rest keys) t)
;;; Code:
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.
+A list of the form (FRAMESET FRAME-ID POSITION)
+ represents a saved frameset plus the value of point in frame FRAME-ID.")
+
+(defgroup register nil
+ "Register commands."
+ :group 'convenience
+ :version "24.3")
+
+(defcustom register-separator nil
+ "Register containing the text to put between collected texts, or nil if none.
+
+When collecting text with
+`append-to-register' (resp. `prepend-to-register') contents of
+this register is added to the beginning (resp. end) of the marked
+text."
+ :group 'register
+ :type '(choice (const :tag "None" nil)
+ (character :tag "Use register" :value ?+)))
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
;; of point in the current buffer, so record that separately.
(set-register register (list (current-frame-configuration) (point-marker))))
+(defvar frameset-session-filter-alist)
+
+(defun frameset-to-register (register &optional _arg)
+ "Store the current frameset in register REGISTER.
+Use \\[jump-to-register] to restore the frameset.
+Argument is a character, naming the register."
+ (interactive "cFrameset to register: \nP")
+ (set-register register
+ (list (frameset-save nil
+ :app 'register
+ :filters frameset-session-filter-alist)
+ ;; frameset-save does not include the value of point
+ ;; in the current buffer, so record that separately.
+ (frameset-frame-id nil)
+ (point-marker))))
+
(defalias 'register-to-point 'jump-to-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'.)
-If the register contains a window configuration (one frame) or a frame
-configuration (all frames), restore that frame or all frames accordingly.
+If the register contains a window configuration (one frame) or a frameset
+\(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 to
-delete any existing frames that the frame configuration doesn't mention.
+delete any existing frames that the frameset doesn't mention.
\(Otherwise, these frames are iconified.)"
(interactive "cJump to register: \nP")
(let ((val (get-register register)))
((and (consp val) (window-configuration-p (car val)))
(set-window-configuration (car val))
(goto-char (cadr val)))
+ ((and (consp val) (frameset-p (car val)))
+ (let ((iconify-list (if delete nil (frame-list)))
+ frame)
+ (frameset-restore (car val)
+ :filters frameset-session-filter-alist
+ :reuse-frames (if delete t :keep))
+ (mapc #'iconify-frame iconify-list)
+ (when (setq frame (frameset-frame-with-id (cadr val)))
+ (select-frame-set-input-focus frame)
+ (goto-char (nth 2 val)))))
((markerp val)
(or (marker-buffer val)
(error "That register's buffer no longer exists"))
(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")))))
(string-to-number (match-string 0)))
0))))
-(defun increment-register (number register)
- "Add NUMBER to the contents of register REGISTER.
-Interactively, NUMBER is the prefix arg."
- (interactive "p\ncIncrement register: ")
- (or (numberp (get-register register))
- (error "Register does not contain a number"))
- (set-register register (+ number (get-register register))))
+(defun increment-register (prefix register)
+ "Augment contents of REGISTER.
+Interactively, PREFIX is in raw form.
+
+If REGISTER contains a number, add `prefix-numeric-value' of
+PREFIX to it.
+
+If REGISTER is empty or if it contains text, call
+`append-to-register' with `delete-flag' set to PREFIX."
+ (interactive "P\ncIncrement register: ")
+ (let ((register-val (get-register register)))
+ (cond
+ ((numberp register-val)
+ (let ((number (prefix-numeric-value prefix)))
+ (set-register register (+ number register-val))))
+ ((or (not register-val) (stringp register-val))
+ (append-to-register register (region-beginning) (region-end) prefix))
+ (t (error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
((and (consp val) (frame-configuration-p (car val)))
(princ "a frame configuration."))
+ ((and (consp val) (frameset-p (car val)))
+ (princ "a frameset."))
+
((and (consp val) (eq (car val) 'file))
(princ "the file ")
(prin1 (cdr 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)))
START and END are buffer positions indicating what to append."
(interactive "cAppend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat reg text))
+ ((stringp reg) (concat reg separator text))
(t (error "Register does not contain text")))))
+ (setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
((called-interactively-p 'interactive)
START and END are buffer positions indicating what to prepend."
(interactive "cPrepend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat text reg))
+ ((stringp reg) (concat text separator reg))
(t (error "Register does not contain text")))))
+ (setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
((called-interactively-p 'interactive)
HCoop / bpt / emacs.git / blobdiff