summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorLars Ingebrigtsen <larsi@gnus.org>2022-04-14 19:36:08 +0200
committerLars Ingebrigtsen <larsi@gnus.org>2022-04-14 19:39:01 +0200
commitbe54c25dbb42425701cee3d669d37acdacfa17ce (patch)
tree93e7082f9db58dc02e476648e807eb4738f31ed0 /lisp/emacs-lisp
parenteab0105696f6cd306842e3ede1830fbf1c7057ec (diff)
downloademacs-be54c25dbb42425701cee3d669d37acdacfa17ce.tar.gz
emacs-be54c25dbb42425701cee3d669d37acdacfa17ce.tar.bz2
emacs-be54c25dbb42425701cee3d669d37acdacfa17ce.zip
Allow resizing vtable columns by dragging
* lisp/emacs-lisp/vtable.el (vtable--insert-header-line): Allow resizing by dragging headers. (vtable--drag-resize-column): New function. (vtable-narrow-current-column): Refactor out common bits. (vtable--alter-column-width): To here. (vtable-widen-current-column): Rewrite to use vtable-narrow-current-column.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/vtable.el47
1 files changed, 31 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index d53f8b07450..5900d886e80 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -579,7 +579,11 @@ This also updates the displayed table."
(lambda (column index)
(let* ((name (propertize
(vtable-column-name column)
- 'face (list 'header-line (vtable-face table))))
+ 'face (list 'header-line (vtable-face table))
+ 'keymap (define-keymap
+ "<header-line> <drag-mouse-1>"
+ #'vtable--drag-resize-column
+ "<header-line> <down-mouse-1>" #'ignore)))
(start (point))
(indicator (vtable--indicator table index))
(indicator-width (string-pixel-width indicator))
@@ -606,6 +610,24 @@ This also updates the displayed table."
(insert "\n")
(add-face-text-property start (point) 'header-line)))
+(defun vtable--drag-resize-column (e)
+ "Resize the column by dragging."
+ (interactive "e")
+ (let* ((pos-start (event-start e))
+ (obj (posn-object pos-start)))
+ (with-current-buffer (window-buffer (posn-window pos-start))
+ (let ((column
+ (get-text-property (if obj (cdr obj)
+ (posn-point pos-start))
+ 'vtable-column
+ (car obj)))
+ (start-x (car (posn-x-y pos-start)))
+ (end-x (car (posn-x-y (event-end e)))))
+ (when (> column 0)
+ (vtable--alter-column-width (vtable-current-table)
+ (1- column)
+ (- end-x start-x)))))))
+
(defun vtable--recompute-numerical (table line)
"Recompute numericalness of columns if necessary."
(let ((columns (vtable-columns table))
@@ -768,14 +790,17 @@ If N isn't given, N defaults to 1.
Interactively, N is the prefix argument."
(interactive "p")
(let* ((table (vtable-current-table))
- (column (vtable-current-column))
- (widths (vtable--widths table)))
+ (column (vtable-current-column)))
(unless column
(user-error "No column under point"))
+ (vtable--alter-column-width table column
+ (- (* (vtable--char-width table) (or n 1))))))
+
+(defun vtable--alter-column-width (table column delta)
+ (let ((widths (vtable--widths table)))
(setf (aref widths column)
(max (* (vtable--char-width table) 2)
- (- (aref widths column)
- (* (vtable--char-width table) (or n 1)))))
+ (+ (aref widths column) delta)))
;; Store the width so it'll be respected on a revert.
(setf (vtable-column-width (elt (vtable-columns table) column))
(format "%dpx" (aref widths column)))
@@ -787,17 +812,7 @@ If N isn't given, N defaults to 1.
Interactively, N is the prefix argument."
(interactive "p")
- (let* ((table (vtable-current-table))
- (column (vtable-current-column))
- (widths (vtable--widths table)))
- (unless column
- (user-error "No column under point"))
- (cl-incf (aref widths column)
- (* (vtable--char-width table) (or n 1)))
- ;; Store the width so it'll be respected on a revert.
- (setf (vtable-column-width (elt (vtable-columns table) column))
- (format "%dpx" (aref widths column)))
- (vtable-revert)))
+ (vtable-narrow-current-column (- n)))
(defun vtable-previous-column ()
"Go to the previous column."