code.delx.au - gnu-emacs-elpa/blob - packages/register-list/register-list.el

   1 ;;; register-list.el ---  Interactively list/edit registers  -*- lexical-binding:t -*-
   2 ;;
   3 ;; Copyright (C) 2011-2014  Free Software Foundation, Inc.
   4 ;;
   5 ;; Filename: register-list.el
   6 ;; Author: Bastien Guerry <bzg AT altern DOT org>
   7 ;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
   8 ;; Keywords: register
   9 ;; Description: List and edit the register
  10 ;; Version: 0.1
  11 ;;
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, write to the Free Software
  24 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25 ;;
  26 ;; This is not part of GNU Emacs.
  27 ;;
  28 ;;; Commentary:
  29 ;;
  30 ;; This library lets you list and edit registers.  M-x `register-list'
  31 ;; displays a list of currently set registers.
  32
  33 ;; This list is similar to that of `bookmark-bmenu-list': you can set
  34 ;; registers to delete with `d' and delete them with `x'.  If you want
  35 ;; to concatenate the content of registers, mark them with `c' and
  36 ;; process with `x'.
  37
  38 ;; You can also edit the register's key with `k' and its value with `v'
  39 ;; Hitting RET on a value string will jump to the register's location or
  40 ;; add the text to the kill ring.  Hitting RET on a register's type will
  41 ;; restrict the list to registers of this type.
  42 ;;
  43 ;; Put this file into your load-path and the following into your ~/.emacs:
  44 ;;   (require 'register-list)
  45 ;;
  46 ;;; Todo:
  47 ;;
  48 ;; - better sorting (interactive)
  49 ;; - overlay register when deleting duplicates
  50 ;; - more useful message when selecting a type
  51 ;; - concatenation -> merge
  52 ;; - support merging rectangles
  53 ;; - add numbers when "merging" them
  54 ;; - C-k to kill a register
  55 ;;
  56 ;;; History:
  57 ;;
  58 ;; - [2008-03-09] Released v0.1
  59 ;;   http://article.gmane.org/gmane.emacs.sources/2832
  60 ;;
  61 ;;; Code:
  62
  63 (eval-when-compile
  64   (require 'cl))
  65
  66 (defgroup register-list nil
  67   "Interactively list/edit registers."
  68   :tag "Register List"
  69   :group 'register)
  70
  71 (defcustom register-list-string-width nil
  72   "Maximum width for the register value string."
  73   :type 'integer)
  74
  75 (defcustom register-list-preserve-fontification nil
  76   "Non-nil means keep the value strings fontified."
  77   :type 'integer)
  78
  79 (defcustom register-list-default-types "[FNMRSW]"
  80   "A regexp matching the default register types to list.
  81
  82 The available types are: [F]rame [N]umber [M]arkers [R]ectangle
  83 \[S]string and [W]window.  [FW] will list markers, frame and
  84 window configuration, [SM] will list strings and markers, etc."
  85   :type 'regexp)
  86
  87 (defface register-list-off-rectangle
  88   '((t (:inverse-video t)))
  89   "Face used to show what falls out of a rectangle.")
  90
  91 ;;; Variables, map, mode
  92
  93 (defvar register-list-mode-map
  94   (let ((map (make-keymap)))
  95     (suppress-keymap map t)
  96     (define-key map "q" 'quit-window)
  97     (define-key map "Q" 'register-list-quit)
  98     (define-key map [(tab)] 'register-list-tab)
  99     (define-key map "d" 'register-list-mark-delete)
 100     (define-key map "D" 'register-list-delete-duplicates)
 101     (define-key map "c" 'register-list-mark-concat)
 102     (define-key map "x" 'register-list-execute)
 103     (define-key map "+" 'register-list-increment-key)
 104     (define-key map "-" 'register-list-decrement-key)
 105     (define-key map "e" 'register-list-edit-key)
 106     (define-key map "E" 'register-list-edit-value)
 107     (define-key map "f" 'register-list-toggle-fontification)
 108     (define-key map " " 'next-line)
 109     (define-key map "n" 'next-line)
 110     (define-key map "p" 'previous-line)
 111     (define-key map "u" 'register-list-unmark)
 112     (define-key map "U" 'register-list-unmark-all)
 113     (define-key map "g" 'register-list-refresh)
 114     (define-key map "F"
 115       (lambda () (interactive) (register-list-refresh "F")))
 116     (define-key map "N"
 117       (lambda () (interactive) (register-list-refresh "N")))
 118     (define-key map "M"
 119       (lambda () (interactive) (register-list-refresh "M")))
 120     (define-key map "R"
 121       (lambda () (interactive) (register-list-refresh "R")))
 122     (define-key map "S"
 123       (lambda () (interactive) (register-list-refresh "S")))
 124     (define-key map "W"
 125       (lambda () (interactive) (register-list-refresh "W")))
 126     (define-key map "G"
 127       (lambda() (interactive) (register-list-refresh "[FNMRSW]")))
 128     (define-key map "?" 'describe-mode)
 129
 130     (define-key map [follow-link] 'mouse-face)
 131     (define-key map [mouse-2] 'register-list-call-handler-at-mouse)
 132     (define-key map [(return)] 'register-list-call-handler-at-point)
 133     map)
 134   "Keymap for `register-list-mode'.")
 135 (defvar register-list-edit-value-mode-map
 136   (let ((map (make-sparse-keymap)))
 137     (define-key map (kbd "C-c C-c") 'register-list-send-value)
 138     map)
 139   "Keymap for editing the value of a register.")
 140 (defvar register-list-current-type nil
 141   "The current type for the register menu.")
 142 (defvar register-list-current-fontification nil
 143   "Whether the value strings are currently fontified.")
 144 (defvar register-list-temp-pos nil
 145   "Temporary store the line the cursor is on.")
 146 (defvar register-list-temp-window-cfg nil
 147   "Temporary window configuration.
 148 Saved before editing the value of a register.")
 149 (defvar register-list-temp-register nil
 150   "Temporary value of the edited register.")
 151 (defvar register-list-edit-value-type nil
 152   "The type of the edited value.")
 153 (defvar register-list-rectangle-column nil
 154   "End of a rectangle line.")
 155
 156 ;;; Marks
 157
 158 (defmacro register-list-preserve-pos (force-line &rest body)
 159   "Preserve the position and execute BODY.
 160 If FORCE-LINE is non-nil, force moving to this line."
 161   (declare (debug t) (indent 1))
 162   `(let (,@(unless force-line '((line (line-number-at-pos (point)))))
 163          (col (current-column)))
 164      ,@body
 165      (goto-char (point-min))
 166      (forward-line ,(or force-line '(1- line)))
 167      (line-move-to-column col)))
 168
 169 (defmacro register-list-map-lines (let-vals &rest body)
 170   "Execute BODY inside a let form with LET-VALS on all lines."
 171   `(save-excursion
 172      (goto-char (point-min))
 173      (while (not (eobp))
 174        (let* ,let-vals
 175          ,@body
 176          (forward-line 1)))))
 177
 178 (defvar register-list-concat-separator "\n"
 179   "Default separator when merging.")
 180
 181 (defvar register-list-concat-key-select 'last)
 182
 183 ;; FIXME skip rectangle (or handle them separatly
 184 (defun register-list-execute nil
 185   "Delete/concatenate registers marker for deletion/concatenation."
 186   (interactive)
 187   (let ((line (line-number-at-pos (point))) newreg concat)
 188     (goto-char (point-min))
 189     (while (re-search-forward "^[DC]" nil t)
 190       (let* ((reg-point (next-single-property-change (point) 'register))
 191              (reg (get-text-property reg-point 'register)))
 192         (if (string= (match-string 0) "D")
 193             (setq register-alist (delete reg register-alist))
 194           (push reg concat))))
 195     (when concat
 196       ;; set the new register
 197       (setq newreg
 198             (cons (cond ((eq register-list-concat-key-select 'first)
 199                          (caar concat))
 200                         ((eq register-list-concat-key-select 'last)
 201                          (caar (reverse concat)))
 202                         (t (read-char
 203                             (format "Key [%s]: "
 204                                     (mapconcat (lambda(x) (char-to-string (car x)))
 205                                                concat "")))))
 206                   (mapconcat (lambda (i) (cdr i)) (reverse concat)
 207                              (cond ((eq register-list-concat-separator 'ask)
 208                                     (read-from-minibuffer "Separator: "))
 209                                    ((stringp register-list-concat-separator)
 210                                     register-list-concat-separator)
 211                                    (t "")))))
 212       ;; delete old registers
 213       (dolist (r concat)
 214         (setq register-alist (delete r register-alist)))
 215       ;; push the new register
 216       (push newreg register-alist))
 217     (register-list register-list-current-type
 218                    register-list-current-fontification)
 219     ;; move the cursor back
 220     (goto-char (point-min))
 221     (line-move (- line 2) t)))
 222
 223 (defun register-list-set-mark (mark)
 224   "Set mark at the beginning of the line."
 225   (let ((inhibit-read-only t))
 226     (beginning-of-line)
 227     (unless (get-text-property (point) 'intangible)
 228       (delete-char 1)
 229       (save-excursion (insert mark))
 230       (unless (save-excursion (forward-line 1) (eobp))
 231         (forward-line 1)))))
 232
 233 (defun register-list-mark-delete nil
 234   "Mark the register at point for deletion."
 235   (interactive)
 236   (register-list-set-mark "D"))
 237
 238 (defun register-list-mark-concat nil
 239   "Mark the register at point for further concatenation."
 240   (interactive)
 241   (register-list-set-mark "C"))
 242
 243 (defun register-list-unmark nil
 244   "Unmark the register at point."
 245   (interactive)
 246   (register-list-set-mark " "))
 247
 248 (defun register-list-unmark-all nil
 249   "Unmark all registers."
 250   (interactive)
 251   (let ((inhibit-read-only t))
 252     (save-excursion
 253       (goto-char (point-min))
 254       (forward-line 1)
 255       (while (and (forward-line 1) (not (eobp)))
 256         (delete-char 1)
 257         (insert " ")))))
 258
 259 (defun register-list-refresh (&optional type)
 260   "Refresh the list of registers.
 261 An optional TYPE argument restrict the list these types."
 262   (interactive "P")
 263   (register-list-preserve-pos nil
 264     (register-list (or type register-list-current-type)
 265                    register-list-current-fontification)))
 266
 267 (defun register-list-quit nil
 268   "Quit the register list and kill its buffer."
 269   (interactive)
 270   (kill-buffer (current-buffer)))
 271
 272 (defun register-list-toggle-fontification nil
 273   "Toggle fontification of the value strings."
 274   (interactive)
 275   (register-list-preserve-pos nil
 276     (setq register-list-current-fontification
 277           (not register-list-current-fontification))
 278     (register-list register-list-current-type
 279                    register-list-current-fontification)))
 280
 281 (define-derived-mode register-list-mode special-mode "Register List"
 282   "Major mode for editing a list of register keys.
 283
 284 Each line is of the form:
 285
 286 \[Delete-flag] Key Type Value
 287
 288 The leftmost column displays a `D' character if the register key
 289 is flagged for further deletion.  You can add such flag by hitting
 290 \\[register-list-delete].
 291
 292 The Key column displays the character used for this register.
 293 Hitting \\[register-list-call-handler-at-point] on the key will
 294 prompt for a replacement.
 295
 296 The Type column displays the type of the register, either [F]rame
 297 \[N]umber [M]arkers [R]ectangle [S]string or [W]window.  Hitting
 298 \\[register-list-call-handler-at-point] on this column will
 299 restrict the register list to this type of registers.  To quickly
 300 list a specific type, hit the type character among [FNMRSW].
 301
 302 The Value column displays information about the value of the
 303 register: either a string if the register's value is a string, a
 304 number or a rectangle, or the location of the marker or some
 305 information about window and frame configuration.  Hitting
 306 \\[register-list-call-handler-at-point] on this column will
 307 copy the string to the kill ring or jump to the location.
 308
 309 \\[register-list-edit-key] -- edit the key for this register.
 310 \\[register-list-edit-value] -- edit the value for this register.
 311 \\[register-list-increment-key] -- increment key at point.
 312 \\[register-list-decrement-key] -- decrement key at point.
 313 \\[register-list-mark-delete] -- mark the register at point for deletion.
 314 \\[register-list-mark-concat] -- mark the register at point for concatenation.
 315 \\[register-list-unmark] -- unmark the register at point.
 316 \\[register-list-unmark-all] -- unmark all registers.
 317 \\[register-list-execute] -- execute deletions or concatenations.
 318 \\[register-list-toggle-fontification] -- toggle fontification of value strings.
 319 \\[register-list-refresh] -- refresh the register menu display.
 320 \\[register-list-tab] -- cycle between the key, the type and the value.
 321 \\[register-list-quit] -- quit the register menu."
 322   (setq truncate-lines t)
 323   (setq buffer-read-only t))
 324
 325 ;;\\[register-list-edit-key-or-value] -- edit the key for this register.
 326
 327 (defun register-list-tab nil
 328   "Cycle between the register key, the type and the value."
 329   (interactive)
 330   (let* ((eol (save-excursion (end-of-line) (point)))
 331          (m-f-chg (next-single-property-change (point) 'mouse-face nil eol))
 332          (m-f-pos (text-property-any m-f-chg eol 'mouse-face 'highlight))
 333          (r-f-chg (next-single-property-change (point) 'register nil eol))
 334          (r-f-prop (get-text-property r-f-chg 'register)) point)
 335     (cond (r-f-prop (goto-char r-f-chg))
 336           (m-f-pos (goto-char m-f-pos))
 337           (t  (beginning-of-line 2)
 338               (if (setq point (next-single-property-change
 339                                (point) 'register))
 340                   (goto-char point))))))
 341
 342 ;;;###autoload
 343 (defun register-list (&optional type fontify)
 344   "Display a list of registers.
 345 An optional argument TYPE defines a regexp to restrict the
 346 register menu to.  A second optional argument FONTIFICATION
 347 decides if the display preserves original fontification for
 348 values.
 349
 350 The default types are defined in `register-list-default-types',
 351 which see.
 352
 353 The list is displayed in a buffer named `*Register List*' in
 354 `register-list-mode', which see."
 355   (interactive)
 356   (switch-to-buffer (get-buffer-create "*Register List*"))
 357   (let ((inhibit-read-only t))
 358     (setq type (or type register-list-default-types))
 359     (setq register-list-current-fontification
 360           (or fontify register-list-preserve-fontification))
 361     (setq register-list-current-type type)
 362
 363     (setq register-alist ;; TODO better sorting.
 364           (sort register-alist (lambda (a b) (< (car a) (car b)))))
 365     (erase-buffer)
 366     ;; FIXME: Why `intangible'?
 367     (insert (concat (propertize "% Key  Type  Value\n"
 368                                 'face 'font-lock-type-face
 369                                 'intangible t) ;; 'front-sticky t)
 370                     (propertize "- ---  ----  -----\n"
 371                                 'intangible t
 372                                 'face 'font-lock-comment-delimiter-face)))
 373     (dolist (register register-alist)
 374       (let* ((key (char-to-string (car register)))
 375              (val (cdr register))
 376              (typ (register-list-get-type val))
 377              (hdl (register-list-get-handler register typ)))
 378         (when (string-match typ type)
 379           (insert
 380            (format "  %s    %s   %s\n"
 381                    (propertize key 'face 'bold 'register register
 382                                'register-handler hdl)
 383                    (propertize (concat "[" typ "]")
 384                                'mouse-face 'highlight
 385                                'help-echo "mouse-2: restrict to this type"
 386                                'register-handler
 387                                (lambda ()
 388                                  (register-list-preserve-pos nil
 389                                    (register-list
 390                                     typ register-list-current-fontification))))
 391                    (propertize (register-list-prepare-string
 392                                 (register-list-value-to-string val typ) fontify)
 393                                'mouse-face 'highlight
 394                                'register-handler hdl
 395                                'help-echo "mouse-2: use this register")))))))
 396   (register-list-mode)
 397   (goto-char (point-min))
 398   (line-move 2 t)
 399   (if (called-interactively-p 'interactive)
 400       (message "[d]elete  [e/E]dit key/value  RET:jump/copy  [FNRSW]:select type  ?:help")
 401     (message "Register type: %s" register-list-current-type)))
 402
 403 (defun register-list-call-handler-at-mouse (ev)
 404   "Call the register handler at point.
 405 See `register-list-call-handler-at-point' for details."
 406   (interactive "e")
 407   (mouse-set-point ev)
 408   (register-list-call-handler-at-point))
 409
 410 (defun register-list-call-handler-at-point nil
 411   "Call the register handler at point.
 412 If the point is on a register key, edit the key.  If the point is
 413 on a register type, rebuild the list restricting to registers of
 414 this type.  If the point is on a register value, either jump to
 415 the register or copy its value into the kill ring."
 416   (interactive)
 417   (let ((handler (get-text-property (point) 'register-handler)))
 418     (if handler
 419         (condition-case nil
 420             (funcall (get-text-property (point) 'register-handler))
 421           (error (message "Can't jump to register location"))))))
 422
 423 (defun register-list-get-handler (register type)
 424   "Return a handler function for a REGISTER with TYPE."
 425   (cond ((string= "?" type)
 426          `(lambda() (message "No action with this type")))
 427         ((string= "S" type)
 428          `(lambda()
 429             (kill-new ,(cdr register))
 430             (message "String copied to the kill ring")))
 431         ((string= "N" type)
 432          `(lambda()
 433             (kill-new ,(number-to-string (cdr register)))
 434             (message "Number copied to the kill ring as a string")))
 435         ((string= "R" type)
 436          `(lambda()
 437             (kill-new ,(mapconcat 'identity (cdr register) "\n"))
 438             (message "Rectangle copied to the kill ring")))
 439         ((string-match "[FMW]" type)
 440          `(lambda()
 441             (jump-to-register ,(car register))
 442             (message (format "Jumped to register %s"
 443                              ,(char-to-string (car register))))))))
 444
 445 (defun register-list-value-to-string (value type)
 446   "Convert a register VALUE into a string according to its TYPE."
 447   (cond ((string= "M" type)
 448          (cond ((marker-position value)
 449                 (format "[Marker at point %d in buffer %s]"
 450                         (marker-position value)
 451                         (buffer-name (marker-buffer value))))
 452                ((marker-buffer value)
 453                 (format "[Marker in buffer %s]"
 454                         (buffer-name (marker-buffer value))))
 455                (t (format "[Marker gone?]"))))
 456         ((string= "N" type)
 457          (format "Number: %s" (number-to-string value)))
 458         ((string= "S" type)
 459          (replace-regexp-in-string "[\n\r\t]" " " value))
 460         ((string= "R" type)
 461          (mapconcat 'identity value "\\ "))
 462         ((string= "W" type)
 463          (format "[Window configuration in frame \"%s\"]"
 464                   (frame-parameter
 465                    (window-configuration-frame (car value)) 'name)))
 466         ((string= "F" type)
 467          (format "[Frame configuration]"))
 468         (t "[Error: unknow type]")))
 469
 470 (defun register-list-get-type (key)
 471   "Get the type for register's KEY."
 472   (if (atom key)
 473       (cond ((stringp key) "S")
 474             ((markerp key) "M")
 475             ((numberp key) "N")
 476             (t "error"))
 477     (cond ((window-configuration-p (car key)) "W")
 478           ((frame-configuration-p (car key)) "F")
 479           ((stringp (car key)) "R")
 480           ((string= "Unprintable entity" (car key)) "?")
 481           (t "error"))))
 482
 483 ;;; Edit key/value of the register
 484
 485 ;; FIXME delete?
 486 ;; (defun register-list-edit-key-or-value nil
 487 ;;   "Edit the register key or value depending on the point."
 488 ;;   (interactive)
 489 ;;   (if (get-text-property (point) 'register)
 490 ;;       (register-list-edit-key)
 491 ;;     (register-list-edit-value)))
 492
 493 (defun register-list-edit-key nil
 494   "Edit the key of the register at point."
 495   (interactive)
 496   (register-list-set-key
 497    (lambda (v) (read-char (format "New key (%s): "
 498                                   (char-to-string v))))))
 499
 500 (defun register-list-increment-key nil
 501   "Increment the key of the register at point."
 502   (interactive)
 503   (register-list-set-key '1+))
 504
 505 (defun register-list-delete-duplicates nil
 506   "Interactively delete duplicates."
 507   (interactive)
 508   (mapc (lambda (r)
 509           (mapc (lambda(rr)
 510                   (if (and (eq (car r) (car rr))
 511                            (y-or-n-p
 512                             (format "Delete register with key `%s'? "
 513                                     (char-to-string (car rr)))))
 514                       (setq register-alist (delete rr register-alist))))
 515                 (cdr (member r register-alist))))
 516         register-alist))
 517
 518 ;; (defun register-list- (register)
 519 ;;   "Overline the register with KEY."
 520 ;;   (save-excursion
 521 ;;     (goto-char (point-min))
 522 ;;     (while (re-search-forward (concat "^[ DC]" (char-to-string key)) nil t)
 523 ;;       (goto-char
 524 ;;     (while (next-single-property-change (point) 'register)
 525
 526 (defun register-list-decrement-key nil
 527   "Decrement the key of the register at point."
 528   (interactive)
 529   (register-list-set-key '1-))
 530
 531 (defun register-list-set-key (function)
 532   "Update the regsiter key by applying FUNCTION."
 533   (register-list-preserve-pos
 534       2 ;; go back to top of the sorted list
 535     (beginning-of-line)
 536     (let* ((reg-point (next-single-property-change (point) 'register))
 537            (reg (get-text-property reg-point 'register))
 538            (val (car reg)))
 539       (setq register-alist (delete reg register-alist))
 540       (add-to-list 'register-alist
 541                    (cons (setcar reg (funcall function val)) (cdr reg)))
 542       (register-list register-list-current-type
 543                      register-list-current-fontification))))
 544
 545 (defun register-list-edit-value nil
 546   "Edit the value of the register at point."
 547   (interactive)
 548   (let* ((reg-at-point
 549           (save-excursion
 550             (beginning-of-line)
 551             (next-single-property-change (point) 'register)))
 552          (reg (get-text-property reg-at-point 'register))
 553          (val (cdr reg)))
 554     (if (not (or (stringp val) (numberp val)
 555                  (and (listp val) (stringp (car val)))))
 556         (message "Can't edit this type of register")
 557       (setq register-list-temp-window-cfg (current-window-configuration))
 558       (setq register-list-temp-register reg)
 559       (setq register-list-temp-pos
 560             (cons (line-number-at-pos (point)) (current-column)))
 561       (setq register-list-edit-value-type
 562             (cond ((numberp val) 'number)
 563                   ((listp val) 'rectangle)
 564                   (t 'string)))
 565       (pop-to-buffer (get-buffer-create "*Register Edit*"))
 566       (erase-buffer)
 567       (insert (cond ((numberp val) (number-to-string val))
 568                     ((listp val) (mapconcat 'identity val "\n"))
 569                     (t val)))
 570       (setq register-list-rectangle-column
 571             (if (eq register-list-edit-value-type 'rectangle)
 572                 (length (car val)) nil))
 573       (register-list-edit-value-mode)
 574       (message "Press C-c C-c when you're done"))))
 575
 576 (define-derived-mode register-list-edit-value-mode text-mode
 577   "Edit Register Value"
 578   "Mode for editing the value of a register.
 579 When you are done editing the value, store it with \\[register-list-send-string].
 580
 581 \\{register-list-edit-value-mode-map}")
 582
 583 (defun register-list-add-rectangle-overlays (column)
 584   "Add overlays to display strings beyond COLUMN.
 585 Do this on all lines in the current buffer."
 586   (register-list-map-lines
 587    ((beg (progn (forward-char column) (point)))
 588     (end (progn (end-of-line) (point))))
 589    (unless (eq beg end)
 590      (overlay-put (make-overlay beg end)
 591                   'face 'register-list-off-rectangle))))
 592
 593 (defun register-list-add-trailing-whitespace (column)
 594   "Add trailing whitespaces to fill to COLUMN.
 595 Do this on all lines in the current buffer."
 596   (register-list-map-lines
 597    ((eol (save-excursion (end-of-line) (point)))
 598     (rem (% eol (1+ column))))
 599    (if (and (not (eq rem 0))
 600             (< eol (* (1+ column) (line-number-at-pos (point)))))
 601        (save-excursion
 602          (end-of-line)
 603          (insert (make-string (- (1+ column) rem) 32))))))
 604
 605 (defun register-list-send-value nil
 606   "Use the buffer to store the new value of a register.
 607 Convert the buffer to a number or a rectangle if required."
 608   (interactive)
 609   (catch 'cancel
 610     (when register-list-rectangle-column
 611       ;; fix whitespace before sending a rectangle
 612       (register-list-add-trailing-whitespace
 613        register-list-rectangle-column)
 614       ;; cut off trailing string before sending a rectangle
 615       (register-list-add-rectangle-overlays
 616        register-list-rectangle-column)
 617       (if (and (delq nil (overlay-lists))
 618                (not (y-or-n-p "Cut off the fontified part of the rectangle? ")))
 619           (throw 'cancel (message "Back to editing"))))
 620     ;; now send the value
 621     (set-register (car register-list-temp-register)
 622                   (cond ((eq register-list-edit-value-type 'number)
 623                          (string-to-number (buffer-string)))
 624                         ((eq register-list-edit-value-type 'rectangle)
 625                          (mapcar (lambda (l) (truncate-string-to-width
 626                                               l register-list-rectangle-column
 627                                               0 32))
 628                                  (split-string (buffer-string) "\n")))
 629                         (t (buffer-string))))
 630     (kill-buffer (current-buffer))
 631     (register-list register-list-current-type
 632                    register-list-current-fontification)
 633     (set-window-configuration register-list-temp-window-cfg)
 634     (line-move (1- (car register-list-temp-pos)) t)
 635     (line-move-to-column (cdr register-list-temp-pos)))
 636   ;; remove overlays if sending was cancelled
 637   (mapc (lambda(ovs) (mapc (lambda(o) (delete-overlay o)) ovs))
 638         (overlay-lists))
 639   (message "New value stored"))
 640
 641 (defun register-list-prepare-string (string &optional fontify)
 642   "Prepare STRING for the register list.
 643 An optional argument FONTIFY takes precedence over
 644 `register-list-preserve-fontification' to decide whether the
 645 string should keep its original fontification.  Also shorten the
 646 output string to `register-list-string-width'."
 647   (if (and register-list-string-width
 648            (> (length string) register-list-string-width))
 649       (setq string (substring string 0 register-list-string-width)))
 650   (when (or fontify register-list-preserve-fontification)
 651     (remove-text-properties 0 (length string) '(face nil) string))
 652   string)
 653
 654 (provide 'register-list)
 655
 656 ;;; register-list.el ends here