diff options
author | Lars Ingebrigtsen <larsi@gnus.org> | 2022-04-14 19:36:08 +0200 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-04-14 19:39:01 +0200 |
commit | be54c25dbb42425701cee3d669d37acdacfa17ce (patch) | |
tree | 93e7082f9db58dc02e476648e807eb4738f31ed0 /lisp/emacs-lisp | |
parent | eab0105696f6cd306842e3ede1830fbf1c7057ec (diff) | |
download | emacs-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.el | 47 |
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." |