emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/boxy 268f4a7 1/4: Added patch from Stefan Monnier


From: ELPA Syncer
Subject: [elpa] externals/boxy 268f4a7 1/4: Added patch from Stefan Monnier
Date: Tue, 5 Oct 2021 11:57:08 -0400 (EDT)

branch: externals/boxy
commit 268f4a72d03d43c5b4035d4c6f51772ee34aa8b5
Author: Tyler Grinn <tylergrinn@gmail.com>
Commit: Tyler Grinn <tylergrinn@gmail.com>

    Added patch from Stefan Monnier
---
 boxy.el                  | 205 ++++++++++++++++++++++-------------------------
 tests/boxy-test-setup.el |   3 +-
 2 files changed, 96 insertions(+), 112 deletions(-)

diff --git a/boxy.el b/boxy.el
index f293228..e4aaff6 100644
--- a/boxy.el
+++ b/boxy.el
@@ -112,6 +112,7 @@
 
 ;;;; Requirements
 
+(require 'easy-mmode)
 (require 'eieio)
 (require 'cl-lib)
 
@@ -123,58 +124,47 @@
 
 (defcustom boxy-default-margin-x 2
   "Default horizontal margin to be used when displaying boxes."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-default-margin-y 1
   "Default vertical margin to be used when displaying boxes."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-default-padding-x 2
   "Default horizontal padding to be used when displaying boxes."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-default-padding-y 1
   "Default vertical padding to be used when displaying boxes."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-flex-width 80
   "When flexibly displaying boxes, try to keep width below this."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-default-visibility 2
   "Default level to display boxes."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-tooltips t
   "Show tooltips in a boxy diagram."
-  :type 'boolean
-  :group 'boxy)
+  :type 'boolean)
 
 (defcustom boxy-tooltip-timeout 0.5
   "Idle time before showing tooltip in a boxy diagram."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 (defcustom boxy-tooltip-max-width 30
   "Maximum width of all tooltips."
-  :type 'number
-  :group 'boxy)
+  :type 'number)
 
 ;;;; Faces
 
 (defface boxy-default nil
-  "Default face used in Boxy mode."
-  :group 'boxy)
+  "Default face used in Boxy mode.")
 
 (defface boxy-primary nil
-  "Face for highlighting the name of a box."
-  :group 'boxy)
+  "Face for highlighting the name of a box.")
 
 (face-spec-set
  'boxy-primary
@@ -183,8 +173,7 @@
  'face-defface-spec)
 
 (defface boxy-selected nil
-  "Face for the current box border under cursor."
-  :group 'boxy)
+  "Face for the current box border under cursor.")
 
 (face-spec-set
  'boxy-selected
@@ -192,8 +181,7 @@
  'face-defface-spec)
 
 (defface boxy-rel nil
-  "Face for the box which is related to the box under the cursor."
-  :group 'boxy)
+  "Face for the box which is related to the box under the cursor.")
 
 (face-spec-set
  'boxy-rel
@@ -201,8 +189,7 @@
  'face-defface-spec)
 
 (defface boxy-tooltip nil
-  "Face for tooltips in a boxy diagram."
-  :group 'boxy)
+  "Face for tooltips in a boxy diagram.")
 
 (face-spec-set
  'boxy-tooltip
@@ -393,11 +380,11 @@
   "Recalculate the position of all boxes in `boxy--boxes'."
   (setq boxy--box-ring
         (seq-sort
-         '<
+         #'<
          (seq-filter
-          'identity
+          #'identity
           (mapcar
-           'boxy--get-position
+           #'boxy--get-position
            (seq-filter
             (lambda (box) (boxy-is-visible box t))
             boxy--boxes))))))
@@ -418,38 +405,34 @@
      (if (slot-boundp box :height) (slot-makeunbound box :height)))
    boxy--boxes))
 
+(defvar boxy-mode-map
+  (easy-mmode-define-keymap
+    (mapcar (lambda (key) (cons (kbd (car key)) (cdr key)))
+            '(("TAB"       . boxy-mode-cycle)
+              ("<right>"   . boxy-mode-cycle)
+              ("C-f"       . boxy-mode-cycle)
+              ("M-f"       . boxy-mode-cycle)
+              ("f"         . boxy-mode-cycle)
+              ("<left>"    . boxy-mode-uncycle)
+              ("C-b"       . boxy-mode-uncycle)
+              ("M-b"       . boxy-mode-uncycle)
+              ("b"         . boxy-mode-uncycle)
+              ("<up>"      . boxy-mode-cycle-up)
+              ("C-p"       . boxy-mode-cycle-up)
+              ("p"         . boxy-mode-cycle-up)
+              ("<down>"    . boxy-mode-cycle-down)
+              ("C-n"       . boxy-mode-cycle-down)
+              ("n"         . boxy-mode-cycle-down)
+              ("<backtab>" . boxy-mode-cycle-visibility)))))
+
 (define-derived-mode boxy-mode special-mode
   "Boxy"
-  "Mode for viewing an boxy diagram.
-
-The following commands are available:
-
-\\{boxy-mode-map}"
-  (let ((inhibit-message t))
+  "Mode for viewing an boxy diagram."
+  (let ((inhibit-message t))     ;FIXME: Please report the message as an error.
     (setq indent-tabs-mode nil)
     (cursor-sensor-mode t)
     (toggle-truncate-lines t)))
 
-(mapc
- (lambda (key) (define-key boxy-mode-map (kbd (car key)) (cdr key)))
- '(("TAB"       . boxy-mode-cycle)
-   ("<right>"   . boxy-mode-cycle)
-   ("C-f"       . boxy-mode-cycle)
-   ("M-f"       . boxy-mode-cycle)
-   ("f"         . boxy-mode-cycle)
-   ("<left>"    . boxy-mode-uncycle)
-   ("C-b"       . boxy-mode-uncycle)
-   ("M-b"       . boxy-mode-uncycle)
-   ("b"         . boxy-mode-uncycle)
-   ("<up>"      . boxy-mode-cycle-up)
-   ("C-p"       . boxy-mode-cycle-up)
-   ("p"         . boxy-mode-cycle-up)
-   ("<down>"    . boxy-mode-cycle-down)
-   ("C-n"       . boxy-mode-cycle-down)
-   ("n"         . boxy-mode-cycle-down)
-   ("<backtab>" . boxy-mode-cycle-visibility)))
-
-
 (cl-defun boxy-pp (box
                    &key
                    (display-buffer-fn 'display-buffer-pop-up-window)
@@ -528,7 +511,7 @@ diagram."
       (setq boxy--selected-face selected-face)
       (boxy-mode-update-visibility)
       (boxy-mode-redraw)
-      (let* ((width (apply 'max (mapcar 'length (split-string (buffer-string) 
"\n"))))
+      (let* ((width (apply #'max (mapcar #'length (split-string 
(buffer-string) "\n"))))
              (height (count-lines (point-min) (point-max)))
              (window (or (get-buffer-window buffer)
                          (display-buffer buffer
@@ -1001,10 +984,10 @@ Uses `boxy--offset' to determine row and column offsets."
                 (setq r (+ r 1))))))))
     (if border-face
         (if box-coords (list box-coords) nil)
-      (apply 'append
+      (apply #'append
              (if box-coords (list box-coords) nil)
              (mapcar
-              'boxy-draw
+              #'boxy-draw
               (boxy--get-children box))))))
 
 (cl-defmethod boxy--get-width ((box boxy-box))
@@ -1014,52 +997,54 @@ Uses `boxy--offset' to determine row and column offsets."
         stored-width
       (let* ((margin (boxy--margin-x box))
              (padding (boxy--padding-x box))
-             (base-width (+ 2 ; box walls
+             (base-width (+ 2           ; box walls
                             (* 2 padding)))
              (width (+ base-width
                        (if (slot-boundp box :name)
                            (with-slots (name) box (length name))
                          0)))
              (children (boxy--get-children box)))
-        (if (not children)
-            (setq stored-width width)
-          (let* ((row-indices (cl-delete-duplicates
-                               (mapcar
-                                (lambda (child) (with-slots (y-order) child 
y-order))
-                                children)))
-                 (rows (mapcar
-                        (lambda (r)
-                          (cl-delete-duplicates
-                           (seq-filter
-                            (lambda (child) (with-slots (y-order) child (= r 
y-order)))
-                            children)
-                           :test #'(lambda (a b)
-                                     (and (slot-boundp a :name)
-                                          (slot-boundp b :name)
-                                          (string= (with-slots (name) a name)
-                                                   (with-slots (name) b 
name))))))
-                        row-indices))
-                 (children-width (apply 'max
-                                        (mapcar
-                                         (lambda (row)
-                                           (seq-reduce
-                                            (lambda (sum width)
-                                              (+ sum width margin))
-                                            (mapcar 'boxy--get-width row)
-                                            (* -1 margin)))
-                                         rows))))
-            (if (> width (+ (* 2 padding) children-width))
-                (setq stored-width width)
-              (setq stored-width (+ base-width children-width)))))))))
+        (setq stored-width
+              (if (not children)
+                  width
+                (let* ((row-indices (cl-delete-duplicates
+                                     (mapcar
+                                      (lambda (child) (with-slots (y-order) 
child y-order))
+                                      children)))
+                       (rows (mapcar
+                              (lambda (r)
+                                (cl-delete-duplicates
+                                 (seq-filter
+                                  (lambda (child) (with-slots (y-order) child 
(= r y-order)))
+                                  children)
+                                 :test #'(lambda (a b)
+                                           (and (slot-boundp a :name)
+                                                (slot-boundp b :name)
+                                                (string= (with-slots (name) a 
name)
+                                                         (with-slots (name) b 
name))))))
+                              row-indices))
+                       (children-width (apply #'max
+                                              (mapcar
+                                               (lambda (row)
+                                                 (seq-reduce
+                                                  (lambda (sum width)
+                                                    (+ sum width margin))
+                                                  (mapcar #'boxy--get-width 
row)
+                                                  (* -1 margin)))
+                                               rows))))
+                  (if (> width (+ (* 2 padding) children-width))
+                      width
+                    (+ base-width children-width)))))))))
 
 (cl-defmethod boxy--get-on-top-height ((box boxy-box))
   "Get the height of any boxes on top of BOX."
-  (apply 'max 0
+  (apply #'max 0
          (mapcar
-          'boxy--get-on-top-height-helper
+          #'boxy--get-on-top-height-helper
           (seq-filter
-           (lambda (child) (with-slots (rel) child (and (slot-boundp child 
:rel)
-                                                        (string= rel "on top 
of"))))
+           (lambda (child) (with-slots (rel) child
+                        (and (slot-boundp child :rel)
+                             (string= rel "on top of"))))
            (boxy--get-children box)))))
 
 (cl-defmethod boxy--get-on-top-height-helper ((child boxy-box))
@@ -1067,9 +1052,9 @@ Uses `boxy--offset' to determine row and column offsets."
   (with-slots (rel) child
     (+
      (boxy--get-height child)
-     (apply 'max 0
+     (apply #'max 0
             (mapcar
-             'boxy--get-on-top-height-helper
+             #'boxy--get-on-top-height-helper
              (seq-filter
               (lambda (grandchild)
                 (with-slots ((grandchild-rel rel)) grandchild
@@ -1106,7 +1091,7 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
                                        (+ sum margin row))
                                      (mapcar
                                       (lambda (r)
-                                        (apply 'max 0
+                                        (apply #'max 0
                                                (mapcar
                                                 (lambda (child) 
(boxy--get-height child t))
                                                 (seq-filter
@@ -1153,7 +1138,7 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
                                             siblings
                                             '()))
                            (above-bottom (+ margin
-                                             (apply 'max
+                                             (apply #'max
                                                     (mapcar
                                                      (lambda (sibling)
                                                        (+ (boxy--get-top 
sibling)
@@ -1360,7 +1345,7 @@ BOX is the box the button is being made for."
     (if (not (boxy-is-visible box))
         (if children (cl-rotatef children hidden-children))
       (boxy--expand-box box))
-    (mapc 'boxy--update-visibility children)))
+    (mapc #'boxy--update-visibility children)))
 
 (cl-defmethod boxy--get-position ((box boxy-box))
   "Get the buffer position of the names of BOX and its children."
@@ -1443,19 +1428,19 @@ If FORCE-VISIBLE, always make CHILD visible in PARENT."
   "Get a list of boxes from BOX which have no further relatives."
   (if (slot-boundp box :parent)
       (if-let ((next-boxes (boxy--next box)))
-          (apply 'append (mapcar 'boxy--primary-boxes next-boxes))
+          (apply #'append (mapcar #'boxy--primary-boxes next-boxes))
         (list box))
-    (apply 'append (mapcar 'boxy--primary-boxes (boxy--get-children box 
'all)))))
+    (apply #'append (mapcar #'boxy--primary-boxes (boxy--get-children box 
'all)))))
 
 (cl-defmethod boxy--expand ((box boxy-box))
   "Get a list of all boxes, including BOX, that are related to BOX."
   (if (slot-boundp box :parent)
-      (apply 'append (list box) (mapcar 'boxy--expand (boxy--next box)))
-    (apply 'append (mapcar 'boxy--expand (boxy--get-children box 'all)))))
+      (apply #'append (list box) (mapcar #'boxy--expand (boxy--next box)))
+    (apply #'append (mapcar #'boxy--expand (boxy--get-children box 'all)))))
 
 (cl-defmethod boxy--get-all ((box boxy-box))
   "Get all boxes, including BOX, that are children of BOX."
-  (apply 'append (list box) (mapcar 'boxy--get-all (boxy--get-children box 
'all))))
+  (apply #'append (list box) (mapcar #'boxy--get-all (boxy--get-children box 
'all))))
 
 (cl-defmethod boxy--next ((box boxy-box) &optional exclude-children)
   "Retrieve any boxes for which the :rel-box slot is BOX.
@@ -1536,10 +1521,10 @@ If EXCLUDE-CHILDREN, only retrieve sibling boxes."
                                         (not (or in-front on-top))))
                                     (boxy--get-children parent)))))
             (if (string= rel "above")
-                (setq y-order (- (apply 'min 0 sibling-y-orders) 1))
-              (setq y-order (+ 1 (apply 'max 0 sibling-y-orders))))))
+                (setq y-order (- (apply #'min 0 sibling-y-orders) 1))
+              (setq y-order (+ 1 (apply #'max 0 sibling-y-orders))))))
          ((or on-top in-front)
-          (setq x-order (+ 1 (apply 'max 0
+          (setq x-order (+ 1 (apply #'max 0
                                     (mapcar
                                      (lambda (child) (with-slots (x-order) 
child x-order))
                                      (seq-filter
@@ -1656,7 +1641,7 @@ characters if possible."
          (rows (split-string content "\n"))
          (height (length rows))
          (width (+ 2 (min boxy--tooltip-max-width
-                          (apply 'max 0 (mapcar 'length rows)))))
+                          (apply #'max 0 (mapcar #'length rows)))))
          (top (if (< (- cur-line 2 height) min-line)
                   (+ cur-line 2)
                 (- cur-line 1 height)))
@@ -1689,7 +1674,7 @@ characters if possible."
         (setq top (+ top 1))))
     (save-excursion (boxy-mode-recalculate-box-ring))
     (push (read-event nil) unread-command-events)
-    (mapc 'delete-overlay overlays)))
+    (mapc #'delete-overlay overlays)))
 
 (provide 'boxy)
 
diff --git a/tests/boxy-test-setup.el b/tests/boxy-test-setup.el
index a669138..38bbbdf 100644
--- a/tests/boxy-test-setup.el
+++ b/tests/boxy-test-setup.el
@@ -6,7 +6,7 @@
 
 ;;; Code:
 
-(load-file "boxy.el")
+(require 'boxy "boxy.el")
 
 (setq boxy-default-margin-x 0)
 (setq boxy-default-margin-y 1)
@@ -16,4 +16,3 @@
 (provide 'boxy-test-setup)
 
 ;;; boxy-test-setup.el ends here
-



reply via email to

[Prev in Thread] Current Thread [Next in Thread]