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

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