X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/1acf9ec859d39ee5c1a04cbb4d4bcf51fcb41788..c33d1d58acc301ba018f4f69dcab93c5b2246643:/packages/register-list/register-list.el

diff --git a/packages/register-list/register-list.el b/packages/register-list/register-list.el
index 19873fcbd..c93e4791c 100755
--- a/packages/register-list/register-list.el
+++ b/packages/register-list/register-list.el
@@ -1,6 +1,6 @@
-;;; 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>
@@ -70,13 +70,11 @@
 
 (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.
@@ -84,19 +82,60 @@
 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.")
@@ -114,60 +153,17 @@ Saved before editing the value of a register.")
 (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)
@@ -264,10 +260,9 @@ If FORCE-LINE is non-nil, force moving to this line."
   "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."
@@ -277,14 +272,13 @@ An optional TYPE argument restrict the list these types."
 (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:
@@ -325,12 +319,8 @@ copy the string to the kill ring or jump to the location.
 \\[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.
 
@@ -364,46 +354,45 @@ The list is displayed in a buffer named `*Register List*' in
 `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)
@@ -542,16 +531,16 @@ the register or copy its value into the kill ring."
 (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."
@@ -561,8 +550,7 @@ the register or copy its value into the kill ring."
 	    (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")
@@ -585,17 +573,12 @@ the register or copy its value into the kill ring."
       (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.