Merge commit '7c14dedc79bf0c6eaad5bf50b80ea80dd721afdc' from company

[gnu-emacs-elpa] / packages / register-list / register-list.el

diff --git a/packages/register-list/register-list.el b/packages/register-list/register-list.el
index 19873fcbd8eecf9394025b5f2e699a7d3b3472c5..c93e4791c8b713122ca8fbd5cbbba07656d2c962 100755 (executable)
--- 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>
 ;;
 ;; 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."
 
 (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."
 
 (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.
 
 (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."
 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)))
 
 (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
 
 
 ;;; 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'.")
   "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.")
   "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.")
 
 (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."
 ;;; 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))
         (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)
      (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")
   "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-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)
 (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:
   "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."
 \\[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 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-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*"))
 `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 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)
          (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)))
     (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)
   (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
 (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."
 
 (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))
            (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")
     (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"))))
 
       (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].
 
   "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.
 
 (defun register-list-add-rectangle-overlays (column)
   "Add overlays to display strings beyond COLUMN.