-;;; register-list.el --- Interactively list/edit registers
+;;; register-list.el --- Interactively list/edit registers -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
;;
;; Filename: register-list.el
;; Author: Bastien Guerry <bzg AT altern DOT org>
(defcustom register-list-string-width nil
"Maximum width for the register value string."
- :type 'integer
- :group 'register-list)
+ :type 'integer)
(defcustom register-list-preserve-fontification nil
"Non-nil means keep the value strings fontified."
- :type 'integer
- :group 'register-list)
+ :type 'integer)
(defcustom register-list-default-types "[FNMRSW]"
"A regexp matching the default register types to list.
The available types are: [F]rame [N]umber [M]arkers [R]ectangle
\[S]string and [W]window. [FW] will list markers, frame and
window configuration, [SM] will list strings and markers, etc."
- :type 'regexp
- :group 'register-list)
+ :type 'regexp)
(defface register-list-off-rectangle
'((t (:inverse-video t)))
- "Face used to show what falls out of a rectangle."
- :group 'register-list)
+ "Face used to show what falls out of a rectangle.")
;;; Variables, map, mode
-(defvar register-list-mode-map nil
+(defvar register-list-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map t)
+ (define-key map "q" 'quit-window)
+ (define-key map "Q" 'register-list-quit)
+ (define-key map [(tab)] 'register-list-tab)
+ (define-key map "d" 'register-list-mark-delete)
+ (define-key map "D" 'register-list-delete-duplicates)
+ (define-key map "c" 'register-list-mark-concat)
+ (define-key map "x" 'register-list-execute)
+ (define-key map "+" 'register-list-increment-key)
+ (define-key map "-" 'register-list-decrement-key)
+ (define-key map "e" 'register-list-edit-key)
+ (define-key map "E" 'register-list-edit-value)
+ (define-key map "f" 'register-list-toggle-fontification)
+ (define-key map " " 'next-line)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ (define-key map "u" 'register-list-unmark)
+ (define-key map "U" 'register-list-unmark-all)
+ (define-key map "g" 'register-list-refresh)
+ (define-key map "F"
+ (lambda () (interactive) (register-list-refresh "F")))
+ (define-key map "N"
+ (lambda () (interactive) (register-list-refresh "N")))
+ (define-key map "M"
+ (lambda () (interactive) (register-list-refresh "M")))
+ (define-key map "R"
+ (lambda () (interactive) (register-list-refresh "R")))
+ (define-key map "S"
+ (lambda () (interactive) (register-list-refresh "S")))
+ (define-key map "W"
+ (lambda () (interactive) (register-list-refresh "W")))
+ (define-key map "G"
+ (lambda() (interactive) (register-list-refresh "[FNMRSW]")))
+ (define-key map "?" 'describe-mode)
+
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'register-list-call-handler-at-mouse)
+ (define-key map [(return)] 'register-list-call-handler-at-point)
+ map)
"Keymap for `register-list-mode'.")
-(defvar register-list-edit-value-mode-map (copy-keymap text-mode-map)
+(defvar register-list-edit-value-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") 'register-list-send-value)
+ map)
"Keymap for editing the value of a register.")
(defvar register-list-current-type nil
"The current type for the register menu.")
(defvar register-list-rectangle-column nil
"End of a rectangle line.")
-(if register-list-mode-map
- nil
- (setq register-list-mode-map (make-keymap))
- (suppress-keymap register-list-mode-map t)
- (define-key register-list-mode-map "q" 'quit-window)
- (define-key register-list-mode-map "Q" 'register-list-quit)
- (define-key register-list-mode-map [(tab)] 'register-list-tab)
- (define-key register-list-mode-map "d" 'register-list-mark-delete)
- (define-key register-list-mode-map "D" 'register-list-delete-duplicates)
- (define-key register-list-mode-map "c" 'register-list-mark-concat)
- (define-key register-list-mode-map "x" 'register-list-execute)
- (define-key register-list-mode-map "+" 'register-list-increment-key)
- (define-key register-list-mode-map "-" 'register-list-decrement-key)
- (define-key register-list-mode-map "e" 'register-list-edit-key)
- (define-key register-list-mode-map "E" 'register-list-edit-value)
- (define-key register-list-mode-map "f" 'register-list-toggle-fontification)
- (define-key register-list-mode-map " " 'next-line)
- (define-key register-list-mode-map "n" 'next-line)
- (define-key register-list-mode-map "p" 'previous-line)
- (define-key register-list-mode-map "u" 'register-list-unmark)
- (define-key register-list-mode-map "U" 'register-list-unmark-all)
- (define-key register-list-mode-map "g" 'register-list-refresh)
- (define-key register-list-mode-map "F"
- (lambda () (interactive) (register-list-refresh "F")))
- (define-key register-list-mode-map "N"
- (lambda () (interactive) (register-list-refresh "N")))
- (define-key register-list-mode-map "M"
- (lambda () (interactive) (register-list-refresh "M")))
- (define-key register-list-mode-map "R"
- (lambda () (interactive) (register-list-refresh "R")))
- (define-key register-list-mode-map "S"
- (lambda () (interactive) (register-list-refresh "S")))
- (define-key register-list-mode-map "W"
- (lambda () (interactive) (register-list-refresh "W")))
- (define-key register-list-mode-map "G"
- (lambda() (interactive) (register-list-refresh "[FNMRSW]")))
- (define-key register-list-mode-map "?" 'describe-mode))
-
-(define-key register-list-mode-map [follow-link] 'mouse-face)
-(define-key register-list-mode-map [mouse-2] 'register-list-call-handler-at-mouse)
-(define-key register-list-mode-map [(return)] 'register-list-call-handler-at-point)
-(define-key register-list-edit-value-mode-map (kbd "C-c C-c")
- 'register-list-send-value)
-
;;; Marks
(defmacro register-list-preserve-pos (force-line &rest body)
"Preserve the position and execute BODY.
If FORCE-LINE is non-nil, force moving to this line."
- `(let ((line (line-number-at-pos (point)))
+ (declare (debug t) (indent 1))
+ `(let (,@(unless force-line '((line (line-number-at-pos (point)))))
(col (current-column)))
,@body
(goto-char (point-min))
- (line-move ,(or (eval force-line) '(1- line)) t)
+ (forward-line ,(or force-line '(1- line)))
(line-move-to-column col)))
(defmacro register-list-map-lines (let-vals &rest body)
"Refresh the list of registers.
An optional TYPE argument restrict the list these types."
(interactive "P")
- (register-list-preserve-pos
- (1- (line-number-at-pos (point)))
- (register-list (or type register-list-current-type)
- register-list-current-fontification)))
+ (register-list-preserve-pos nil
+ (register-list (or type register-list-current-type)
+ register-list-current-fontification)))
(defun register-list-quit nil
"Quit the register list and kill its buffer."
(defun register-list-toggle-fontification nil
"Toggle fontification of the value strings."
(interactive)
- (register-list-preserve-pos
- nil
- (setq register-list-current-fontification
- (not register-list-current-fontification))
- (register-list register-list-current-type
- register-list-current-fontification)))
+ (register-list-preserve-pos nil
+ (setq register-list-current-fontification
+ (not register-list-current-fontification))
+ (register-list register-list-current-type
+ register-list-current-fontification)))
-(defun register-list-mode ()
+(define-derived-mode register-list-mode special-mode "Register List"
"Major mode for editing a list of register keys.
Each line is of the form:
\\[register-list-refresh] -- refresh the register menu display.
\\[register-list-tab] -- cycle between the key, the type and the value.
\\[register-list-quit] -- quit the register menu."
- (kill-all-local-variables)
- (use-local-map register-list-mode-map)
(setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'register-list-mode)
- (setq mode-name "Register List"))
+ (setq buffer-read-only t))
;;\\[register-list-edit-key-or-value] -- edit the key for this register.
`register-list-mode', which see."
(interactive)
(switch-to-buffer (get-buffer-create "*Register List*"))
- (let ((inhibit-read-only t) reg-alist)
+ (let ((inhibit-read-only t))
(setq type (or type register-list-default-types))
(setq register-list-current-fontification
(or fontify register-list-preserve-fontification))
(setq register-list-current-type type)
- (setq register-alist ;; TODO better sorting
+ (setq register-alist ;; TODO better sorting.
(sort register-alist (lambda (a b) (< (car a) (car b)))))
(erase-buffer)
+ ;; FIXME: Why `intangible'?
(insert (concat (propertize "% Key Type Value\n"
'face 'font-lock-type-face
'intangible t) ;; 'front-sticky t)
(propertize "- --- ---- -----\n"
'intangible t
'face 'font-lock-comment-delimiter-face)))
- (mapc
- (lambda (register)
- (let* ((key (char-to-string (car register)))
- (val (cdr register))
- (typ (register-list-get-type val))
- (hdl (register-list-get-handler register typ)))
- (when (string-match typ type)
- (insert
- (format " %s %s %s\n"
- (propertize key 'face 'bold 'register register
- 'register-handler hdl)
- (propertize (concat "[" typ "]")
- 'mouse-face 'highlight
- 'help-echo "mouse-2: restrict to this type"
- 'register-handler
- `(lambda()
- (register-list-preserve-pos nil
- (register-list
- ,typ ,register-list-current-fontification))))
- (propertize (register-list-prepare-string
- (register-list-value-to-string val typ) fontify)
- 'mouse-face 'highlight
- 'register-handler hdl
- 'help-echo "mouse-2: use this register"))))))
- register-alist))
+ (dolist (register register-alist)
+ (let* ((key (char-to-string (car register)))
+ (val (cdr register))
+ (typ (register-list-get-type val))
+ (hdl (register-list-get-handler register typ)))
+ (when (string-match typ type)
+ (insert
+ (format " %s %s %s\n"
+ (propertize key 'face 'bold 'register register
+ 'register-handler hdl)
+ (propertize (concat "[" typ "]")
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2: restrict to this type"
+ 'register-handler
+ (lambda ()
+ (register-list-preserve-pos nil
+ (register-list
+ typ register-list-current-fontification))))
+ (propertize (register-list-prepare-string
+ (register-list-value-to-string val typ) fontify)
+ 'mouse-face 'highlight
+ 'register-handler hdl
+ 'help-echo "mouse-2: use this register")))))))
(register-list-mode)
(goto-char (point-min))
(line-move 2 t)
(defun register-list-set-key (function)
"Update the regsiter key by applying FUNCTION."
(register-list-preserve-pos
- 2 ;; go back to top of the sorted list
- (beginning-of-line)
- (let* ((reg-point (next-single-property-change (point) 'register))
- (reg (get-text-property reg-point 'register))
- (val (car reg)))
- (setq register-alist (delete reg register-alist))
- (add-to-list 'register-alist
- (cons (setcar reg (funcall function val)) (cdr reg)))
- (register-list register-list-current-type
- register-list-current-fontification))))
+ 2 ;; go back to top of the sorted list
+ (beginning-of-line)
+ (let* ((reg-point (next-single-property-change (point) 'register))
+ (reg (get-text-property reg-point 'register))
+ (val (car reg)))
+ (setq register-alist (delete reg register-alist))
+ (add-to-list 'register-alist
+ (cons (setcar reg (funcall function val)) (cdr reg)))
+ (register-list register-list-current-type
+ register-list-current-fontification))))
(defun register-list-edit-value nil
"Edit the value of the register at point."
(beginning-of-line)
(next-single-property-change (point) 'register)))
(reg (get-text-property reg-at-point 'register))
- (val (cdr reg))
- new-val)
+ (val (cdr reg)))
(if (not (or (stringp val) (numberp val)
(and (listp val) (stringp (car val)))))
(message "Can't edit this type of register")
(register-list-edit-value-mode)
(message "Press C-c C-c when you're done"))))
-(defun register-list-edit-value-mode nil
+(define-derived-mode register-list-edit-value-mode text-mode
+ "Edit Register Value"
"Mode for editing the value of a register.
When you are done editing the value, store it with \\[register-list-send-string].
-\\{register-list-edit-value-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map register-list-edit-value-mode-map)
- (setq major-mode 'register-list-edit-value-mode
- mode-name "Edit Register Value")
- (run-mode-hooks 'text-mode-hook))
+\\{register-list-edit-value-mode-map}")
(defun register-list-add-rectangle-overlays (column)
"Add overlays to display strings beyond COLUMN.