[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/tablist e0e6a06 03/60: Added tablist package.
|
From: |
Philip Kaludercic |
|
Subject: |
[nongnu] elpa/tablist e0e6a06 03/60: Added tablist package. |
|
Date: |
Sun, 1 Aug 2021 18:19:24 -0400 (EDT) |
branch: elpa/tablist
commit e0e6a0678ba1da4ac72dc23ce402666e4c89ca9e
Author: Andreas Politz <politza@hochschule-trier.de>
Commit: Andreas Politz <politza@hochschule-trier.de>
Added tablist package.
---
tablist-filter.el | 447 +++++++++++++
tablist.el | 1897 +++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 2344 insertions(+)
diff --git a/tablist-filter.el b/tablist-filter.el
new file mode 100644
index 0000000..f3d58b9
--- /dev/null
+++ b/tablist-filter.el
@@ -0,0 +1,447 @@
+;;; tablist-filter.el --- Filter expressions for tablists.
+
+;; Copyright (C) 2013 Andreas Politz
+
+;; Author: Andreas Politz <politza@fh-trier.de>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+(require 'semantic/wisent/comp)
+(require 'semantic/wisent/wisent)
+(require 'eldoc)
+
+;;; Code:
+
+(defvar tablist-filter-binary-operator
+ '((== . tablist-filter-op-equal)
+ (=~ . tablist-filter-op-regexp)
+ (< . tablist-filter-op-<)
+ (> . tablist-filter-op->)
+ (<= . tablist-filter-op-<=)
+ (>= . tablist-filter-op->=)
+ (= . tablist-filter-op-=)))
+
+(defvar tablist-filter-unary-operator nil)
+
+(defvar tablist-filter-wisent-parser nil)
+
+(defvar tablist-filter-lexer-regexps nil)
+
+(defvar tablist-filter-wisent-grammar
+ '(
+ ;; terminals
+ ;; Use lowercase for better looking error messages.
+ (operand unary-operator binary-operator or and not)
+
+ ;; terminal associativity & precedence
+ ((left binary-operator)
+ (left unary-operator)
+ (left or)
+ (left and)
+ (left not))
+
+ ;; rules
+ (filter-or-empty
+ ((nil))
+ ((?\( ?\)) nil)
+ ((filter) $1))
+ (filter
+ ((operand) $1) ;;Named filter
+ ((operand binary-operator operand) `(,(intern $2) ,$1 ,$3))
+ ((unary-operator operand) `(,(intern $1) ,$2))
+ ((not filter) `(not ,$2))
+ ((filter and filter) `(and ,$1 ,$3))
+ ((filter or filter) `(or ,$1 ,$3))
+ ((?( filter ?)) $2))))
+
+(defun tablist-filter-parser-init (&optional reinitialize interactive)
+ (interactive (list t t))
+ (unless (and tablist-filter-lexer-regexps
+ (not reinitialize))
+ (let ((re (mapcar
+ (lambda (l)
+ (let ((re (regexp-opt
+ (mapcar 'symbol-name
+ (mapcar 'car l)) t)))
+ (if (= (length re) 0)
+ ".\\`" ;;matches nothing
+ re)))
+ (list tablist-filter-binary-operator
+ tablist-filter-unary-operator))))
+ (setq tablist-filter-lexer-regexps
+ (nreverse
+ (cons (concat "\\(?:" (car re) "\\|" (cadr re)
+ "\\|[ \t\f\r\n\"!()]\\|&&\\|||\\)")
+ re)))))
+ (unless (and tablist-filter-wisent-parser
+ (not reinitialize))
+ (let ((wisent-compile-grammar*
+ (symbol-function
+ 'wisent-compile-grammar)))
+ (setq tablist-filter-wisent-parser
+ ;; Trick the byte-compile into not using the byte-compile
+ ;; handler in semantic/wisent/comp.el, since it does not
+ ;; work (wisent-context-compile-grammar n/a).
+ (funcall wisent-compile-grammar*
+ tablist-filter-wisent-grammar))))
+ (when interactive
+ (message "Parser reinitialized."))
+ nil)
+
+(defun tablist-filter-wisent-lexer ()
+ (cl-destructuring-bind (unary-op binary-op keywords)
+ tablist-filter-lexer-regexps
+ (skip-chars-forward " \t\f\r\n")
+ (cond
+ ((eobp) (list wisent-eoi-term))
+ ((= ?\" (char-after))
+ `(operand , (condition-case err
+ (read (current-buffer))
+ (error (signal (car err) (cons
+ "invalid lisp string"
+ (cdr err)))))))
+ ((looking-at unary-op)
+ (goto-char (match-end 0))
+ `(unary-operator ,(match-string-no-properties 0)))
+ ((looking-at binary-op)
+ (goto-char (match-end 0))
+ `(binary-operator ,(match-string-no-properties 0)))
+ ((looking-at "&&")
+ (forward-char 2)
+ `(and "&&"))
+ ((looking-at "||")
+ (forward-char 2)
+ `(or "||"))
+ ((= ?! (char-after))
+ (forward-char)
+ `(not "!"))
+ ((= ?\( (char-after))
+ (forward-char)
+ `(?\( "("))
+ ((= ?\) (char-after))
+ (forward-char)
+ `(?\) ")"))
+ (t
+ (let ((beg (point)))
+ (when (re-search-forward keywords nil 'move)
+ (goto-char (match-beginning 0)))
+ `(operand ,(buffer-substring-no-properties
+ beg
+ (point))))))))
+
+(defun tablist-filter-parse (filter)
+ (interactive "sFilter: ")
+ (tablist-filter-parser-init)
+ (with-temp-buffer
+ (save-excursion (insert filter))
+ (condition-case error
+ (wisent-parse tablist-filter-wisent-parser
+ 'tablist-filter-wisent-lexer
+ (lambda (msg) (signal 'error
+ (replace-regexp-in-string
+ "\\$EOI" "end of input"
+ msg t t))))
+ (error
+ (signal 'error
+ (append (if (consp (cdr error))
+ (cdr error)
+ (list (cdr error)))
+ (list (point))))))))
+
+(defun tablist-filter-unparse (filter &optional noerror)
+ (cl-labels
+ ((unparse (filter &optional noerror)
+ (cond
+ ((stringp filter)
+ (if (or (string-match (nth 2 tablist-filter-lexer-regexps)
+ filter)
+ (= 0 (length filter)))
+ (format "%S" filter)
+ filter))
+ ((and (eq (car-safe filter) 'not)
+ (= (length filter) 2))
+ (let ((paren (memq (car-safe (nth 1 filter)) '(or and))))
+ (format "!%s%s%s"
+ (if paren "(" "")
+ (unparse (cadr filter) noerror)
+ (if paren ")" ""))))
+ ((and (memq (car-safe filter) '(and or))
+ (= (length filter) 3))
+ (let ((lparen (and (eq (car filter) 'and)
+ (eq 'or (car-safe (car-safe (cdr filter))))))
+ (rparen (and (eq (car filter) 'and)
+ (eq 'or (car-safe (car-safe (cddr filter)))))))
+ (format "%s%s%s %s %s%s%s"
+ (if lparen "(" "")
+ (unparse (cadr filter) noerror)
+ (if lparen ")" "")
+ (cl-case (car filter)
+ (and "&&") (or "||"))
+ (if rparen "(" "")
+ (unparse (car (cddr filter)) noerror)
+ (if rparen ")" ""))))
+ ((and (assq (car-safe filter) tablist-filter-binary-operator)
+ (= (length filter) 3))
+ (format "%s %s %s"
+ (unparse (cadr filter) noerror)
+ (car filter)
+ (unparse (car (cddr filter)) noerror)))
+ ((and (assq (car-safe filter) tablist-filter-unary-operator)
+ (= (length filter) 2))
+ (format "%s %s"
+ (car filter)
+ (unparse (cadr filter) noerror)))
+ ((not filter) "")
+ (t (funcall (if noerror 'format 'error)
+ "Invalid filter: %s" filter)))))
+ (tablist-filter-parser-init)
+ (unparse filter noerror)))
+
+
+(defun tablist-filter-eval (filter id entry &optional named-alist)
+ (cl-labels
+ ((feval (filter)
+ (pcase filter
+ (`(not . ,(and operand (guard (not (cdr operand)))))
+ (not (feval (car operand))))
+ (`(and . ,(and operands (guard (= 2 (length operands)))))
+ (and
+ (feval (nth 0 operands))
+ (feval (nth 1 operands))))
+ (`(or . ,(and operands (guard (= 2 (length operands)))))
+ (or
+ (feval (nth 0 operands))
+ (feval (nth 1 operands))))
+ (`(,op . ,(and operands (guard (= (length operands) 1))))
+ (let ((fn (assq op tablist-filter-unary-operator)))
+ (unless fn
+ (error "Undefined unary operator: %s" op))
+ (funcall fn id entry (car operands))))
+ (`(,op . ,(and operands (guard (= (length operands) 2))))
+ (let ((fn (cdr (assq op tablist-filter-binary-operator))))
+ (unless fn
+ (error "Undefined binary operator: %s" op))
+ (funcall fn id entry (car operands)
+ (cadr operands))))
+ ((guard (stringp filter))
+ (let ((fn (cdr (assoc filter named-alist))))
+ (unless fn
+ (error "Undefined named filter: %s" filter))
+ (if (functionp fn)
+ (funcall fn id entry))
+ (feval
+ (if (stringp fn) (tablist-filter-unparse fn) fn))))
+ (`nil t)
+ (_ (error "Invalid filter: %s" filter)))))
+ (feval filter)))
+
+(defun tablist-filter-get-item-by-name (entry col-name)
+ (let* ((col (cl-position col-name tabulated-list-format
+ :key 'car
+ :test
+ (lambda (s1 s2)
+ (eq t (compare-strings
+ s1 nil nil s2 nil nil t)))))
+ (item (and col (elt entry col))))
+ (unless col
+ (error "No such column: %s" col-name))
+ (if (consp item) ;(LABEL . PROPS)
+ (car item)
+ item)))
+
+(defun tablist-filter-op-equal (id entry op1 op2)
+ "COLUMN == STRING : Matches if COLUMN's entry is equal to STRING."
+ (let ((item (tablist-filter-get-item-by-name entry op1)))
+ (string= item op2)))
+
+(defun tablist-filter-op-regexp (id entry op1 op2)
+ "COLUMN =~ REGEXP : Matches if COLUMN's entry matches REGEXP."
+ (let ((item (tablist-filter-get-item-by-name entry op1)))
+ (string-match op2 item)))
+
+(defun tablist-filter-op-< (id entry op1 op2)
+ "COLUMN < NUMBER : Matches if COLUMN's entry is less than NUMBER."
+ (tablist-filter-op-numeric '< id entry op1 op2))
+
+(defun tablist-filter-op-> (id entry op1 op2)
+ "COLUMN > NUMBER : Matches if COLUMN's entry is greater than NUMBER."
+ (tablist-filter-op-numeric '> id entry op1 op2))
+
+(defun tablist-filter-op-<= (id entry op1 op2)
+ "COLUMN <= NUMBER : Matches if COLUMN's entry is less than or equal to
NUMBER."
+ (tablist-filter-op-numeric '<= id entry op1 op2))
+
+(defun tablist-filter-op->= (id entry op1 op2)
+ "COLUMN >= NUMBER : Matches if COLUMN's entry is greater than or equal to
NUMBER."
+ (tablist-filter-op-numeric '>= id entry op1 op2))
+
+(defun tablist-filter-op-= (id entry op1 op2)
+ "COLUMN = NUMBER : Matches if COLUMN's entry as a number is equal to NUMBER."
+ (tablist-filter-op-numeric '= id entry op1 op2))
+
+(defun tablist-filter-op-numeric (op id entry op1 op2)
+ (let ((item (tablist-filter-get-item-by-name entry op1)))
+ (funcall op (string-to-number item)
+ (string-to-number op2))))
+
+(defun tablist-filter-help (&optional temporary)
+ (interactive)
+ (cl-labels
+ ((princ-op (op)
+ (princ (car op))
+ (princ (concat (make-string (max 0 (- 4 (length (symbol-name (car
op)))))
+ ?\s)
+ "- "
+ (eldoc-docstring-first-line
+ (or (documentation (cdr op))
+ (format "FIXME: Not documented: %s"
+ (cdr op))))
+ "\n"))))
+ (with-temp-buffer-window
+ "*Help*"
+ (if temporary
+ '((lambda (buf alist)
+ (let ((win
+ (or (display-buffer-reuse-window buf alist)
+ (display-buffer-in-side-window buf alist))))
+ (fit-window-to-buffer win)
+ win))
+ (side . bottom)))
+ nil
+ (princ "Filter entries with the following operators.\n\n")
+ (princ "~~~ Binary operator ~~~\n")
+ (princ "&& - FILTER1 && FILTER2 : Locical and.\n")
+ (princ "|| - FILTER1 || FILTER2 : Locical or.\n")
+ (dolist (op tablist-filter-binary-operator)
+ (princ-op op))
+ (princ "\n~~~ Unary operator ~~~\n")
+ (princ "! - ! FILTER : Locical not.\n\n")
+ (dolist (op tablist-filter-unary-operator)
+ (princ-op op))
+ (princ "\"...\" may be used to quote names and values if necessary, and
\(...\) to group expressions.")
+ (with-current-buffer standard-output
+ (help-mode)))))
+
+
+
+;;
+;; **Filter Functions
+;;
+
+;; filter ::= nil | named | fn | (OP OP1 [OP2])
+
+(defun tablist-filter-negate (filter)
+ "Return a filter not matching filter."
+ (cond
+ ((eq (car-safe filter) 'not)
+ (cadr filter))
+ (filter
+ (list 'not filter))))
+
+(defun tablist-filter-push (filter new-filter &optional or-p)
+ "Return a filter combining FILTER and NEW-FILTER.
+
+By default the filters are and'ed, unless OR-P is non-nil."
+ (if (or (null filter)
+ (null new-filter))
+ (or filter
+ new-filter)
+ (list (if or-p 'or 'and)
+ filter new-filter)))
+
+(defun tablist-filter-pop (filter)
+ "Remove the first operator or operand from filter.
+
+If filter starts with a negation, return filter unnegated,
+if filter starts with a dis- or conjuction, remove the first operand,
+if filter is nil, raise an error,
+else return nil."
+ (pcase filter
+ (`(,(or `and `or) . ,tail)
+ (car (cdr tail)))
+ (`(not . ,op1)
+ (car op1))
+ (_ (unless filter
+ (error "Filter is empty")))))
+
+(defun tablist-filter-map (fn filter)
+ (pcase filter
+ (`(,(or `and `or `not) . ,tail)
+ (cons (car filter)
+ (mapcar (lambda (f)
+ (tablist-filter-map fn f))
+ tail)))
+ (_ (funcall fn filter))))
+
+
+;;
+;; Reading filter
+;;
+
+(defvar tablist-filter-edit-history nil)
+(defvar tablist-filter-edit-display-help t)
+
+(defun tablist-filter-edit-filter (prompt &optional
+ initial-filter history
+ validate-fn)
+ (let* ((str (tablist-filter-unparse initial-filter))
+ (filter initial-filter)
+ (validate-fn (or validate-fn 'identity))
+ error done)
+ (save-window-excursion
+ (when tablist-filter-edit-display-help
+ (tablist-filter-help t))
+ (while (not done)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (when error
+ (when (car error)
+ (goto-char (+ (field-beginning)
+ (car error)))
+ (skip-chars-backward " \t\n"))
+ (minibuffer-message "%s" (cdr error))
+ (setq error nil)))
+ (setq str (propertize
+ (read-string prompt str
+ (or history 'tablist-filter-edit-history)))
+ done t))
+ (condition-case err
+ (progn
+ (setq filter (tablist-filter-parse str))
+ (funcall validate-fn filter))
+ (error
+ (setq done nil)
+ (setq error (cons (car-safe (cddr err)) nil))
+ (when (car error)
+ (setq str (with-temp-buffer
+ (insert str)
+ (goto-char (car error))
+ (set-text-properties
+ (progn
+ (skip-chars-backward " \t\n")
+ (backward-char)
+ (point))
+ (min (car error) (point-max))
+ '(face error rear-nonsticky t))
+ (buffer-string))))
+ (setcdr error (error-message-string err)))))
+ filter)))
+
+(provide 'tablist-filter)
+;;; tablist-filter.el ends here
diff --git a/tablist.el b/tablist.el
new file mode 100644
index 0000000..aff88b8
--- /dev/null
+++ b/tablist.el
@@ -0,0 +1,1897 @@
+;;; tablist.el --- Extensions for tabulated list mode. -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2013 Andreas Politz
+
+;; Author: Andreas Politz <politza@fh-trier.de>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package adds marks and filters to tabulated-list-mode.
+;;
+;; It can be used by either deriving from tablist-mode, or by using
+;; tablist-minor-mode inside a tabulated-list-mode buffer.
+;;
+;;
+;; Ideas:
+;;
+;; * Allow for structural modifications.
+;; + Reorder columns
+;; + Change width (check)
+;; + Hide columns
+;; + Interactive filtering (updateing as you type)
+;;
+;; But this would pretty much enforce modifications of
+;; tabulated-list.el.
+;;
+;; * Allow for editing of cells
+;; + in buffer ?
+;; + As CSV
+;; - Edit selected columns/rows
+;;
+;; TODO:
+;; * Fix sorting issues
+;; + tblm resorts (and toggles the order) after reverting, e.g. when
+;; resizing columns
+
+(require 'cl-lib)
+(require 'ring)
+(require 'tabulated-list)
+(require 'dired)
+(require 'tablist-filter)
+
+;;
+;; *Mode Maps
+;;
+
+(defvar tablist-mode-filter-map
+ (let ((kmap (make-sparse-keymap)))
+ (define-key kmap "p" 'tablist-pop-filter)
+ (define-key kmap "r" 'tablist-push-regexp-filter)
+ (define-key kmap "=" 'tablist-push-equal-filter)
+ (define-key kmap "n" 'tablist-push-numeric-filter)
+ (define-key kmap "!" 'tablist-negate-filter)
+ (define-key kmap "t" 'tablist-toggle-first-filter-logic)
+ (define-key kmap "/" 'tablist-display-filter)
+ (define-key kmap "z" 'tablist-suspend-filter)
+
+ (define-key kmap "a" 'tablist-push-named-filter)
+ (define-key kmap "s" 'tablist-name-current-filter)
+ (define-key kmap "D" 'tablist-delete-named-filter)
+ (define-key kmap "d" 'tablist-deconstruct-named-filter)
+ (define-key kmap "e" 'tablist-edit-filter)
+ (define-key kmap "C" 'tablist-clear-filter)
+ kmap))
+
+(defvar tablist-mode-mark-map
+ (let ((kmap (make-sparse-keymap)))
+ (define-key kmap "c" 'tablist-change-marks)
+ (define-key kmap "!" 'tablist-unmark-all-marks)
+ (define-key kmap "r" 'tablist-mark-items-regexp)
+ (define-key kmap "n" 'tablist-mark-items-numeric)
+ (define-key kmap "m" 'tablist-mark-forward)
+ kmap))
+
+(defvar tablist-mode-regexp-map
+ (let ((kmap (make-sparse-keymap)))
+ (define-key kmap "&" 'tablist-flag-gargabe-items)
+ (define-key kmap "m" 'tablist-mark-items-regexp)
+ kmap))
+
+(defvar tablist-minor-mode-map
+ (let ((kmap (make-sparse-keymap)))
+ (define-key kmap "m" 'tablist-mark-forward)
+ (define-key kmap (kbd "DEL") 'tablist-unmark-backward)
+ (define-key kmap "d" 'tablist-flag-forward)
+ (define-key kmap (kbd "RET") 'tablist-find-entry)
+ (define-key kmap "f" 'tablist-find-entry)
+ ;; (define-key kmap "~" 'tablist-flag-gargabe-items)
+ (define-key kmap "D" 'tablist-do-delete)
+ ;; (define-key kmap "C" 'tablist-do-copy)
+ ;; (define-key kmap "R" 'tablist-do-rename)
+ (define-key kmap "x" 'tablist-do-flagged-delete)
+ ;; (define-key kmap "F" 'tablist-find-marked-items)
+ ;; (define-key kmap (kbd "C-o") 'tablist-display-item)
+ (define-key kmap "k" 'tablist-do-kill-lines)
+ (define-key kmap "U" 'tablist-unmark-all-marks)
+ (define-key kmap "u" 'tablist-unmark-forward)
+ (define-key kmap "t" 'tablist-toggle-marks)
+
+ (define-key kmap (kbd "TAB") 'tablist-forward-column)
+ (define-key kmap "\t" 'tablist-forward-column)
+ (define-key kmap [backtab] 'tablist-backward-column)
+
+ (define-key kmap "%" tablist-mode-regexp-map)
+ (define-key kmap "*" tablist-mode-mark-map)
+ (define-key kmap "/" tablist-mode-filter-map)
+
+ (define-key kmap "e" 'tablist-edit-column)
+ (define-key kmap "i" 'tablist-insert-entry)
+ (define-key kmap "s" 'tablist-sort)
+ (define-key kmap [remap back-to-indentation] 'tablist-move-to-major-column)
+ (define-key kmap [remap next-line] 'tablist-next-line)
+ (define-key kmap [remap previous-line] 'tablist-previous-line)
+ (define-key kmap "<" 'tablist-shrink-column)
+ (define-key kmap ">" 'tablist-enlarge-column)
+ (define-key kmap "q" 'tablist-quit)
+ (define-key kmap "G" 'tablist-revert)
+ (define-key kmap (kbd "C-c C-e") 'tablist-export-csv)
+ kmap))
+
+(defvar tablist-mode-map
+ (let ((kmap (copy-keymap tablist-minor-mode-map)))
+ (set-keymap-parent kmap tabulated-list-mode-map)
+ kmap))
+
+
+;;
+;; *Variables
+;;
+
+;; Marking
+(defvar tablist-umark-filtered-entries t)
+(defvar tablist-marker-char dired-marker-char
+ "The character used for marking.")
+(defvar tablist-marker-face 'dired-mark
+ "The face used for the mark character.")
+(defvar tablist-marked-face 'dired-marked
+ "The face used for marked major columns.")
+
+;; Operations
+(defvar-local tablist-operations-function nil
+ "A function for handling operations on the entries.
+
+The function is called with varying number of arguments, while
+the first one is always a symbol describing one of the following
+operations.
+
+`supported-operations'
+
+This is the only mandatory operation. There are no other
+arguments and the function should return a list of symbols of
+supported operations.
+
+`delete'
+
+The 2nd argument will be a list of entry ID's. The function
+should somehow delete these entries and update
+`tabulated-list-entries'.
+
+`find-entry'
+
+The 2nd argument is the ID of an entry. The function should
+somehow find/display this entry, i.e. a kind of default
+operation.
+
+`edit-column'
+
+The function is called with 3 further arguments: ID, INDEX and
+NEW-COLUMN, where ID represents the entry to edit, INDEX is the index
+of the column and NEW-COLUMN is the proposed new value for this
+column. It should either
+
+i. return a new edited complete entry and update
+`tabulated-list-entries', or
+
+ii. throw an error, if NEW-COLUMN is not a valid value for this
+column.
+
+`complete'
+
+The function is called with 4 further arguments: ID, INDEX,
+STRING and POS, where ID represents an entry, INDEX is the index
+of the column to complete, STRING it's current value and POS an
+offset of the current position of point into STRING.
+
+The function should return a collection for this column, suitable
+as argument for the function `completion-in-region'.")
+
+;; Differentiating columns
+(defvar-local tablist-minor-columns nil
+ "Uninteresting, boring columns.")
+(defvar-local tablist-major-columns nil
+ "Columns used to mark and when querying.")
+
+;; Filter
+(defvar-local tablist-current-filter nil)
+(defvar-local tablist-filter-suspended nil)
+(defvar tablist-named-filter nil)
+
+;; History variables
+(defvar tablist-column-name-history nil)
+
+;; Hooks
+(defvar tablist-selection-changed-functions nil
+ "A hook run when ever point moves to a different entry.")
+
+;; Context Window
+(defvar-local tablist-context-window nil)
+(defvar-local tablist-context-window-function nil)
+(defvar tablist-context-window-display-action
+ `((display-buffer-reuse-window
+ display-buffer-split-below-and-attach)
+ (window-height . 0.25)
+ (inhibit-same-window . t)))
+
+;;
+;; *Setup
+;;
+
+(define-minor-mode tablist-minor-mode
+ nil nil nil nil
+ (unless (derived-mode-p 'tabulated-list-mode)
+ (error "Buffer is not in Tabulated List Mode"))
+ (tablist-init (not tablist-minor-mode)))
+
+(define-derived-mode tablist-mode tabulated-list-mode "TL"
+ (use-local-map tablist-mode-map) ;FIXME: Mhh.
+ (tablist-init))
+
+(defun tablist-init (&optional disable)
+ (when (boundp 'savehist-additional-variables)
+ (add-to-list 'savehist-additional-variables 'tablist-named-filter))
+ (let ((cleaned-misc (cl-remove 'tablist-current-filter
+ mode-line-misc-info :key 'car)))
+ (cond
+ ((not disable)
+ (set (make-local-variable 'mode-line-misc-info)
+ (append
+
+ (list
+ (list 'tablist-current-filter
+ '(:eval (format " [%s]"
+ (if tablist-filter-suspended
+ "suspended"
+ "filtered")))))))
+ (add-hook 'post-command-hook
+ 'tablist-selection-changed-handler nil t)
+ (add-hook 'tablist-selection-changed-functions
+ 'tablist-context-window-update nil t))
+ (t
+ (setq mode-line-misc-info cleaned-misc)
+ (remove-hook 'post-command-hook
+ 'tablist-selection-changed-handler t)
+ (remove-hook 'tablist-selection-changed-functions
+ 'tablist-context-window-update t)))))
+
+(defun tablist-quit ()
+ (interactive)
+ (tablist-hide-context-window)
+ (quit-window))
+
+(defvar-local tablist-selected-id nil)
+
+(defun tablist-selection-changed-handler ()
+ (unless tablist-edit-column-minor-mode
+ (let ((id tablist-selected-id)
+ (selected (tabulated-list-get-id)))
+ (unless (eq selected id)
+ (setq tablist-selected-id selected)
+ (run-hook-with-args
+ 'tablist-selection-changed-functions
+ tablist-selected-id)))))
+
+(defun tablist-context-window-update (&optional id)
+ (when (and tablist-context-window-function
+ (window-live-p tablist-context-window)
+ (not tablist-edit-column-minor-mode))
+ (unless id
+ (setq id (tabulated-list-get-id)))
+ (let ((fn tablist-context-window-function))
+ (with-selected-window tablist-context-window
+ (set-window-dedicated-p nil nil)
+ (save-selected-window (funcall fn id))
+ (when (window-live-p (selected-window))
+ (set-window-dedicated-p nil t))))))
+
+(defun tablist-display-context-window ()
+ (interactive)
+ (unless tablist-context-window-function
+ (error "No function for handling a context is defined"))
+ (unless (window-live-p tablist-context-window)
+ (setq tablist-context-window
+ (display-buffer
+ (current-buffer)
+ tablist-context-window-display-action)))
+ (prog1
+ tablist-context-window
+ (tablist-context-window-update)))
+
+(defun tablist-hide-context-window ()
+ (interactive)
+ (when (window-live-p tablist-context-window)
+ (let ((ignore-window-parameters t))
+ (delete-window tablist-context-window)))
+ (setq tablist-context-window nil))
+
+;;
+;; *Marking
+;;
+
+(defun tablist-revert ()
+ "Revert the list with marks preserved, position kept."
+ (interactive)
+ (tablist-save-marks
+ (tablist-with-remembering-entry
+ (tabulated-list-revert))))
+
+(defun tablist-major-columns ()
+ (if (null tablist-major-columns)
+ (number-sequence 0 (1- (length tabulated-list-format)))
+ (if (numberp tablist-major-columns)
+ (list tablist-major-columns)
+ tablist-major-columns)))
+
+(defun tablist-put-mark (&optional pos)
+ "Put a mark before the entry at POS.
+
+POS defaults to point. Use `tablist-marker-char',
+`tablist-marker-face', `tablist-marked-face' and
+`tablist-major-columns' to determine how to mark and what to put
+a face on."
+ (when (or (null tabulated-list-padding)
+ (< tabulated-list-padding 1))
+ (setq tabulated-list-padding 1)
+ (tabulated-list-revert))
+ (save-excursion
+ (and pos (goto-char pos))
+ (unless (tabulated-list-get-id)
+ (error "No entry at this position"))
+ (let ((inhibit-read-only t))
+ (tabulated-list-put-tag
+ (string tablist-marker-char))
+ (put-text-property
+ (point-at-bol)
+ (1+ (point-at-bol))
+ 'face tablist-marker-face)
+ (let ((columns (tablist-column-offsets)))
+ (dolist (c (tablist-major-columns))
+ (when (and (>= c 0)
+ (< c (length columns)))
+ (let ((beg (+ (point-at-bol)
+ (nth c columns)))
+ (end (if (= c (1- (length columns)))
+ (point-at-eol)
+ (+ (point-at-bol)
+ (nth (1+ c) columns)))))
+ (cond
+ ((and tablist-marked-face
+ (not (eq tablist-marker-char ?\s)))
+ (tablist--save-face-property beg end)
+ (put-text-property
+ beg end 'face tablist-marked-face))
+ (t (tablist--restore-face-property beg end))))))))))
+
+(defun tablist-mark-forward (&optional arg interactive)
+ "Mark ARG entries forward.
+
+ARG is interpreted as a prefix-arg. If interactive is non-nil,
+maybe use the active region instead of ARG.
+
+See `tablist-put-mark' for how entries are marked."
+ (interactive (list current-prefix-arg t))
+ (cond
+ ;; Mark files in the active region.
+ ((and interactive (use-region-p))
+ (save-excursion
+ (goto-char (region-beginning))
+ (beginning-of-line)
+ (tablist-repeat-over-lines
+ (1+ (count-lines
+ (point)
+ (save-excursion
+ (goto-char (region-end))
+ (beginning-of-line)
+ (point))))
+ 'tablist-put-mark)))
+ ;; Mark the current (or next ARG) files.
+ (t
+ (tablist-repeat-over-lines
+ (prefix-numeric-value arg)
+ 'tablist-put-mark))))
+
+(defun tablist-mark-backward (&optional arg interactive)
+ "Mark ARG entries backward.
+
+See `tablist-mark-forward'."
+ (interactive (list current-prefix-arg t))
+ (tablist-mark-forward (- (prefix-numeric-value arg))
+ interactive))
+
+(defun tablist-unmark-forward (&optional arg interactive)
+ "Unmark ARG entries forward.
+
+See `tablist-mark-forward'."
+ (interactive (list current-prefix-arg t))
+ (let ((tablist-marker-char ?\s)
+ tablist-marked-face)
+ (tablist-mark-forward arg interactive)))
+
+(defun tablist-unmark-backward (&optional arg interactive)
+ "Unmark ARG entries backward.
+
+See `tablist-mark-forward'."
+ (interactive (list current-prefix-arg t))
+ (let ((tablist-marker-char ?\s)
+ tablist-marked-face)
+ (tablist-mark-backward arg interactive)))
+
+(defun tablist-flag-forward (&optional arg interactive)
+ "Flag ARG entries forward.
+
+See `tablist-mark-forward'."
+ (interactive (list current-prefix-arg t))
+ (let ((tablist-marker-char ?D)
+ (tablist-marked-face 'dired-flagged))
+ (tablist-mark-forward arg interactive)))
+
+(defun tablist-change-marks (old new)
+ "Change all OLD marks to NEW marks.
+
+OLD and NEW are both characters used to mark files."
+ (interactive
+ (let* ((cursor-in-echo-area t)
+ (old (progn (message "Change (old mark): ") (read-char)))
+ (new (progn (message "Change %c marks to (new mark): " old)
+ (read-char))))
+ (list old new)))
+ (when (eq new ?\n)
+ (error "Mark character \\n is not allowed"))
+ (let ((default-mark-p (equal tablist-marker-char new))
+ (tablist-marker-char old))
+ (save-excursion
+ (tablist-map-over-marks
+ (lambda nil
+ (pcase new
+ (?D
+ (tablist-flag-forward 1))
+ (t
+ (let ((tablist-marker-char new)
+ (tablist-marked-face
+ (and default-mark-p
+ tablist-marked-face)))
+ (tablist-put-mark)))))))))
+
+(defun tablist-unmark-all-marks (&optional marks interactive)
+ "Remove alls marks in MARKS.
+
+MARKS should be a string of mark characters to match and defaults
+to all marks. Interactively, remove all marks, unless a prefix
+arg was given, in which case ask about which ones to remove.
+Give a message, if interactive is non-nil.
+
+Returns the number of unmarked marks."
+ (interactive
+ (list (if current-prefix-arg
+ (read-string "Remove marks: ")) t))
+ (let ((re (if marks
+ (tablist-marker-regexp marks)
+ "^[^ ]"))
+ (removed 0))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (let ((tablist-marker-char ?\s)
+ tablist-marker-face
+ tablist-marked-face)
+ (tablist-put-mark))
+ (cl-incf removed)))
+ (when interactive
+ (message "Removed %d marks" removed))
+ removed))
+
+(defun tablist-toggle-marks ()
+ "Unmark all marked and mark all unmarked entries.
+
+See `tablist-put-mark'."
+ (interactive)
+ (let ((marked-re (tablist-marker-regexp))
+ (not-marked-re
+ (let ((tablist-marker-char ?\s))
+ (tablist-marker-regexp))))
+ (save-excursion
+ (goto-char (point-min))
+ (tablist-skip-invisible-entries)
+ (while (not (eobp))
+ (cond
+ ((looking-at marked-re)
+ (save-excursion (tablist-unmark-backward -1)))
+ ((looking-at not-marked-re)
+ (tablist-put-mark)))
+ (tablist-forward-entry)))
+ (tablist-move-to-major-column)))
+
+(defun tablist-get-marked-items (&optional arg distinguish-one-marked)
+ "Return marked or ARG entries."
+ (let ((items (save-excursion
+ (tablist-map-over-marks
+ (lambda () (cons (tabulated-list-get-id)
+ (tabulated-list-get-entry)))
+ arg nil distinguish-one-marked))))
+ (if (and distinguish-one-marked
+ (eq (car items) t))
+ items
+ (nreverse items))))
+
+(defun tablist-mark-items-regexp (column-name regexp)
+ "Mark entries matching REGEXP in column COLUMN-NAME."
+ (interactive
+ (tablist-read-regexp-filter "Mark" current-prefix-arg ))
+ (tablist-map-with-filter
+ 'tablist-put-mark
+ `(=~ ,column-name ,regexp)))
+
+(defun tablist-mark-items-numeric (binop column-name operand)
+ "Mark items fulfilling BINOP with arg OPERAND in column COLUMN-NAME.
+
+First the column's value is coerced to a number N. Then the test
+proceeds as \(BINOP N OPERAND\)."
+ (interactive
+ (tablist-read-numeric-filter "Mark" current-prefix-arg))
+ (tablist-map-with-filter
+ 'tablist-put-mark
+ `(,binop ,column-name ,operand)))
+
+(defun tablist-map-over-marks (fn &optional arg show-progress
+ distinguish-one-marked)
+ (prog1
+ (cond
+ ((and arg (integerp arg))
+ (let (results)
+ (tablist-repeat-over-lines
+ arg
+ (lambda ()
+ (if show-progress (sit-for 0))
+ (push (funcall fn) results)))
+ (if (< arg 0)
+ (nreverse results)
+ results)))
+ (arg
+ ;; non-nil, non-integer ARG means use current item:
+ (tablist-skip-invisible-entries)
+ (unless (eobp)
+ (list (funcall fn))))
+ (t
+ (cl-labels ((search (re)
+ (let (sucess)
+ (tablist-skip-invisible-entries)
+ (while (and (setq sucess
+ (re-search-forward re nil t))
+ (invisible-p (point)))
+ (tablist-forward-entry))
+ sucess)))
+ (let ((regexp (tablist-marker-regexp))
+ next-position results found)
+ (save-excursion
+ (goto-char (point-min))
+ ;; remember position of next marked file before BODY
+ ;; can insert lines before the just found file,
+ ;; confusing us by finding the same marked file again
+ ;; and again and...
+ (setq next-position (and (search regexp)
+ (point-marker))
+ found (not (null next-position)))
+ (while next-position
+ (goto-char next-position)
+ (if show-progress (sit-for 0))
+ (push (funcall fn) results)
+ ;; move after last match
+ (goto-char next-position)
+ (forward-line 1)
+ (set-marker next-position nil)
+ (setq next-position (and (search regexp)
+ (point-marker)))))
+ (if (and distinguish-one-marked (= (length results) 1))
+ (setq results (cons t results)))
+ (if found
+ results
+ (unless (or (eobp) (invisible-p (point)))
+ (list (funcall fn))))))))
+ (tablist-move-to-major-column)))
+
+(defun tablist-marker-regexp (&optional marks)
+ "Return a regexp matching marks in MARKS.
+
+MARKS should be a string of mark characters to match and defaults
+to the current value of `tablist-marker-char' as a string."
+ (concat (format "^[%s]"
+ (or marks (string tablist-marker-char)))))
+
+(defun tablist-get-mark-state ()
+ "Return the mark state of the entry at point."
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at "^\\([^ ]\\)")
+ (let ((mark (buffer-substring
+ (match-beginning 1)
+ (match-end 1))))
+ (tablist-move-to-major-column)
+ (list (aref mark 0)
+ (get-text-property 0 'face mark)
+ (get-text-property (point) 'face))))))
+
+(defun tablist-put-mark-state (state)
+ "Set the mark of the entry at point according to STATE.
+
+STATE is a return value of `tablist-get-mark-state'."
+ (cl-destructuring-bind (tablist-marker-char
+ tablist-marker-face
+ tablist-marked-face)
+ state
+ (tablist-put-mark)))
+
+(defmacro tablist-save-marks (&rest body)
+ "Eval body, while preserving all marks."
+ (let ((marks (make-symbol "marks")))
+ `(let (,marks)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((re "^\\([^ ]\\)"))
+ (while (re-search-forward re nil t)
+ (push (cons (tabulated-list-get-id)
+ (tablist-get-mark-state))
+ ,marks))))
+ (unwind-protect
+ (progn ,@body)
+ (save-excursion
+ (dolist (m ,marks)
+ (let ((id (pop m)))
+ (goto-char (point-min))
+ (while (and id (not (eobp)))
+ (when (equal id (tabulated-list-get-id))
+ (tablist-put-mark-state m)
+ (setq id nil))
+ (forward-line)))))))))
+
+
+(defun tablist-mark-prompt (arg items)
+ "Return a string suitable for use in a tablist prompt."
+ ;; distinguish-one-marked can cause the first element to be just t.
+ (if (eq (car items) t) (setq items (cdr items)))
+ (let ((count (length items)))
+ (if (= count 1)
+ (car items)
+ ;; more than 1 item:
+ (if (integerp arg)
+ ;; abs(arg) = count
+ ;; Perhaps this is nicer, but it also takes more screen space:
+ ;;(format "[%s %d items]" (if (> arg 0) "next" "previous")
+ ;; count)
+ (format "[next %d item%s]"
+ arg (dired-plural-s arg))
+ (format "%c [%d item%s]" dired-marker-char count
+ (dired-plural-s count))))))
+
+;;
+;; *Movement
+;;
+
+(defun tablist-forward-entry (&optional n)
+ "Move past the next N unfiltered entries."
+ (unless n (setq n 1))
+ (while (and (> n 0)
+ (not (eobp)))
+ (forward-line)
+ (when (invisible-p (point))
+ (tablist-skip-invisible-entries))
+ (cl-decf n))
+ (while (and (< n 0)
+ (not (bobp)))
+ (forward-line -1)
+ (when (invisible-p (point))
+ (tablist-skip-invisible-entries t))
+ (cl-incf n))
+ n)
+
+(defun tablist-next-line (&optional n)
+ (interactive "p")
+ (when (and (< n 0)
+ (save-excursion
+ (end-of-line 0)
+ (tablist-skip-invisible-entries t)
+ (bobp)))
+ (signal 'beginning-of-buffer nil))
+ (when (and (> n 0)
+ (save-excursion
+ (tablist-forward-entry)
+ (eobp)))
+ (signal 'end-of-buffer nil))
+
+ (let ((col (tablist-current-column)))
+ (tablist-forward-entry (or n 1))
+ (if col
+ (tablist-move-to-column col)
+ (tablist-move-to-major-column))))
+
+(defun tablist-previous-line (&optional n)
+ (interactive "p")
+ (tablist-next-line (- (or n 1))))
+
+(defun tablist-repeat-over-lines (arg function)
+ "Call FUNCTION for the next ARG entries."
+ ;; Move out of potentially invisble area.
+ (tablist-skip-invisible-entries)
+ (let ((pos (make-marker)))
+ (while (and (> arg 0)
+ (not (eobp)))
+ (cl-decf arg)
+ (save-excursion
+ (tablist-forward-entry)
+ (move-marker pos (1+ (point))))
+ (unless (eobp)
+ (save-excursion (funcall function)))
+ ;; Advance to the next line--actually, to the line that *was* next.
+ ;; (If FUNCTION inserted some new lines in between, skip them.)
+ (goto-char pos))
+ (while (and (< arg 0) (not (bobp)))
+ (cl-incf arg)
+ (tablist-forward-entry -1)
+ (save-excursion (funcall function)))
+ (move-marker pos nil)
+ (tablist-move-to-major-column)))
+
+(defun tablist-move-to-column (n)
+ "Move to the N'th list column."
+ (interactive "p")
+ (when (tabulated-list-get-id)
+ (let ((columns (tablist-column-offsets)))
+ (when (or (< n 0)
+ (>= n (length columns)))
+ (error "No such column: %s" n))
+ (beginning-of-line)
+ (forward-char (nth n columns))
+ (when (and (plist-get (nthcdr 3 (elt tabulated-list-format n))
+ :right-align)
+ (not (= n (1- (length columns)))))
+ (forward-char (1- (car (cdr (elt tabulated-list-format n)))))))))
+
+
+
+(defun tablist-move-to-major-column (&optional first-skip-invisible-p)
+ "Move to the first major column."
+ (interactive (list t))
+ (when first-skip-invisible-p
+ (tablist-skip-invisible-entries))
+ (tablist-move-to-column (car (tablist-major-columns))))
+
+(defun tablist-forward-column (n)
+ "Move n columns forward, while wrapping around."
+ (interactive "p")
+ (unless (tabulated-list-get-id)
+ (error "No entry on this line"))
+ (let* ((columns (tablist-column-offsets t))
+ (current (1- (length columns))))
+ ;; find current column
+ (while (and (>= current 0)
+ (> (nth current columns)
+ (current-column)))
+ (cl-decf current))
+ ;; there may be an invisible spec here
+ (when (bolp)
+ (forward-char))
+ ;; before any columns
+ (when (< current 0)
+ (goto-char (+ (point-at-bol) (if (> n 0)
+ (car columns)
+ (car (last columns)))))
+ (setq n (* (cl-signum n) (1- (abs n)))))
+ (when (/= n 0)
+ (tablist-move-to-column
+ (+ (length tablist-minor-columns)
+ (mod (+ current n) (length columns)))))))
+
+(defun tablist-backward-column (n)
+ "Move n columns backward, while wrapping around."
+ (interactive "p")
+ (tablist-forward-column (- n)))
+
+;;
+(defun tablist-skip-invisible-entries (&optional backward)
+ "Skip invisible entries BACKWARD or forward.
+
+Do nothing, if the entry at point is visible. Otherwise move to
+the beginning of the next visible entry in the direction
+determined by BACKWARD.
+
+Return t, if point is now in a visible area."
+
+ (cond
+ ((and backward
+ (not (bobp))
+ (get-text-property (point) 'invisible))
+ (when (get-text-property (1- (point)) 'invisible)
+ (goto-char (previous-single-property-change
+ (point)
+ 'invisible nil (point-min))))
+ (forward-line -1))
+ ((and (not backward)
+ (not (eobp))
+ (get-text-property (point) 'invisible))
+ (goto-char (next-single-property-change
+ (point)
+ 'invisible nil (point-max)))))
+ (not (invisible-p (point))))
+
+;;
+;; *Operations
+;;
+
+(defun tablist-yes-or-no-p (operation arg items)
+ "Query the user whether to proceed with some operation.
+
+Operation should be a symbol or string describing the operation,
+ARG the prefix-arg of the command used in
+`tablist-get-marked-items' or elsewhere, to get the ITEMS."
+
+ (let ((pp-items (mapcar 'tablist-pretty-print-entry
+ (mapcar 'cdr items)))
+ dired-no-confirm
+ (op-str (upcase-initials
+ (if (stringp operation)
+ operation
+ (symbol-name operation)))))
+ (dired-mark-pop-up
+ (format " *%s*" op-str) nil
+ pp-items
+ dired-deletion-confirmer
+ (format "%s %s "
+ op-str
+ (tablist-mark-prompt arg pp-items)))))
+
+
+(defun tablist-operation-available-p (op)
+ (and (functionp tablist-operations-function)
+ (memq op (funcall tablist-operations-function
+ 'supported-operations))))
+
+(defun tablist-do-delete (&optional arg)
+ "Delete ARG entries."
+ (interactive "P")
+ (unless (tablist-operation-available-p 'delete)
+ (error "Deleting entries is not available in this buffer"))
+ (let ((items (tablist-get-marked-items arg)))
+ (when (tablist-yes-or-no-p 'delete arg items)
+ (tablist-do-kill-lines arg)
+ (funcall tablist-operations-function
+ 'delete (mapcar 'car items))
+ (tablist-move-to-major-column))))
+
+(defun tablist-do-flagged-delete (&optional interactive)
+ "Delete all entries marked with a D."
+ (interactive "p")
+ (let* ((tablist-marker-char ?D))
+ (if (save-excursion
+ (goto-char (point-min))
+ (re-search-forward (tablist-marker-regexp) nil t))
+ (tablist-do-delete)
+ (or (not interactive)
+ (message "(No deletions requested)")))))
+
+(defun tablist-do-kill-lines (&optional arg interactive)
+ "Remove ARG lines from the display."
+ (interactive (list current-prefix-arg t))
+ (save-excursion
+ (let ((positions
+ (tablist-map-over-marks 'point arg))
+ (inhibit-read-only t))
+ (dolist (pos positions)
+ (goto-char pos)
+ (tabulated-list-delete-entry))
+ (when interactive
+ (message (format "Killed %d line%s"
+ (length positions)
+ (dired-plural-s (length positions))))))))
+
+(defun tablist-do-operation (arg fn operation &optional delete-p revert-p)
+ "Operate on marked items.
+
+ARG should be the `current-prefix-arg', FN is a function of two
+arguments \(ID ENTRY\) handling the operation. It gets called
+repeatly with all marked items. OPERATION is a symbol or string
+describing the operation, it is used for display.
+
+Optional non-nil DELETE-P means, remove the items from the display.
+Optional REVERT-P means, revert the display afterwards."
+ (let ((items (tablist-get-marked-items arg)))
+ (unless items
+ (error "No items marked"))
+ (when (tablist-yes-or-no-p operation arg items)
+ (when delete-p
+ (tablist-do-kill-lines arg))
+ (dolist (item items)
+ (funcall fn (car item)))
+ (when revert-p
+ (tablist-revert))
+ (tablist-move-to-major-column))))
+
+;;
+;; *Editing
+;;
+(defvar tablist-edit-column-minor-mode-map
+ (let ((kmap (make-sparse-keymap)))
+ (set-keymap-parent kmap (current-global-map))
+ (define-key kmap [remap self-insert-command] 'self-insert-command)
+ (define-key kmap "\r" 'tablist-edit-column-commit)
+ (define-key kmap (kbd "C-g") 'tablist-edit-column-quit)
+ (define-key kmap (kbd "C-c C-c") 'tablist-edit-column-commit)
+ (define-key kmap (kbd "C-c C-q") 'tablist-edit-column-quit)
+ (define-key kmap "\t" 'tablist-edit-column-complete)
+ (define-key kmap (kbd "TAB") 'tablist-edit-column-complete)
+ (define-key kmap [remap end-of-buffer] 'end-of-line)
+ (define-key kmap [remap beginning-of-buffer] 'beginning-of-line)
+ (define-key kmap [remap mark-whole-buffer] 'tablist-edit-column-mark-field)
+ kmap))
+
+(define-minor-mode tablist-edit-column-minor-mode
+ "" nil nil nil
+ (unless (or tablist-minor-mode
+ (derived-mode-p 'tablist-mode))
+ (error "Not in a tablist buffer"))
+ (cond
+ (tablist-edit-column-minor-mode
+ (add-to-list 'mode-line-misc-info
+ '(tablist-edit-column-minor-mode "[edit]"))
+ (add-hook 'post-command-hook 'tablist-edit-column-constrain-point nil t)
+ (read-only-mode -1))
+ (t
+ (remove-hook 'post-command-hook 'tablist-edit-column-constrain-point t)
+ (read-only-mode 1))))
+
+
+(defun tablist-edit-column (&optional n)
+ (interactive "P")
+ (unless n (setq n (tablist-current-column)))
+ (tablist-assert-column-editable n)
+ (let* ((offsets (append (tablist-column-offsets)
+ (list (- (point-at-eol)
+ (point-at-bol)))))
+ (beg (+ (point-at-bol)
+ (nth n offsets)))
+ (end (+ (point-at-bol)
+ (nth (1+ n) offsets)))
+ (entry (tabulated-list-get-entry beg))
+ (inhibit-read-only t)
+ (inhibit-field-text-motion t)
+ (alist `((entry . ,entry)
+ (column . ,n)
+ (id . ,(tabulated-list-get-id beg))))
+ ov)
+ (goto-char beg)
+ (delete-region beg end)
+ (add-text-properties
+ (point-at-bol) (point-at-eol)
+ '(read-only t field t))
+ (unless (= beg (point-at-bol))
+ (put-text-property (1- beg) beg 'rear-nonsticky t))
+ (save-excursion
+ ;; Keep one read-only space at the end for keeping text
+ ;; properties.
+ (insert
+ (propertize
+ (concat
+ (tablist-nth-entry n entry)
+ (propertize " "
+ 'display `(space :align-to ,(- end (point-at-bol)))))
+ 'field nil
+ 'front-sticky '(tablist-edit)
+ 'rear-nonsticky '(read-only field)
+ 'tablist-edit alist))
+ (setq end (point)))
+ (add-text-properties
+ (1- end) end '(read-only t field 'tablist-edit-end))
+ (setq ov (make-overlay beg end))
+ (overlay-put ov 'priority 9999)
+ (overlay-put ov 'face '(:background "deep sky blue" :foreground "white"))
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'tablist-edit t)
+ (tablist-edit-column-minor-mode 1)))
+
+(defun tablist-edit-column-quit ()
+ (interactive)
+ (tablist-edit-column-commit t))
+
+(defun tablist-edit-column-commit (&optional abandon-edit)
+ (interactive (list current-prefix-arg))
+ (let ((inhibit-read-only t)
+ (inhibit-field-text-motion t)
+ bounds)
+ (condition-case nil
+ (setq bounds (tablist-edit-column-bounds))
+ (error
+ (tablist-edit-column-minor-mode -1)
+ (tabulated-list-revert)
+ (put-text-property (point-min) (point-max)
+ 'tablist-edit nil)
+ (error "Unable to complete the edit")))
+ (let* ((beg (car bounds))
+ (end (cdr bounds))
+ (alist (get-text-property beg 'tablist-edit))
+ (column (cdr (assq 'column alist)))
+ (id (cdr (assq 'id alist)))
+ (entry (cdr (assq 'entry alist)))
+ (item (buffer-substring-no-properties beg (1- end))))
+
+ (unless abandon-edit
+ ;; Throws an error, if item is invalid.
+ (setq entry (funcall tablist-operations-function
+ 'edit-column id column item)))
+ (tablist-edit-column-minor-mode -1)
+ (remove-overlays beg end 'tablist-edit t)
+ (put-text-property beg end 'tablist-edit nil)
+ (delete-region (point-at-bol) (1+ (point-at-eol)))
+ (save-excursion
+ (tabulated-list-print-entry id entry))
+ (forward-char (nth column (tablist-column-offsets))))))
+
+(defun tablist-edit-column-complete ()
+ (interactive)
+ (unless (tablist-operation-available-p 'complete)
+ (error "Completion not available"))
+ (cl-destructuring-bind (beg &rest end)
+ (tablist-edit-column-bounds t)
+ (let* ((string (buffer-substring-no-properties
+ beg end))
+ (alist (get-text-property beg 'tablist-edit))
+ (completions (funcall tablist-operations-function
+ 'complete
+ (cdr (assq 'id alist))
+ (cdr (assq 'column alist))
+ string
+ (- (point) beg))))
+ (unless completions
+ (error "No completions available"))
+ (completion-in-region beg end completions))))
+
+(defun tablist-column-editable (n)
+ (and (tablist-operation-available-p 'edit-column)
+ (not (tablist-column-property n :read-only))))
+
+(defun tablist-assert-column-editable (n)
+ (unless (and (>= n 0)
+ (< n (length tabulated-list-format)))
+ (error "Invalid column number: %s" n))
+ (unless (tablist-operation-available-p 'edit-column)
+ (error "Editing columns not enabled in this buffer"))
+ (when (tablist-column-property n :read-only)
+ (error "This column is read-only")))
+
+(defun tablist-edit-column-constrain-point ()
+ (unless tablist-edit-column-minor-mode
+ (error "Not editing a column"))
+ (unless (get-text-property (point) 'tablist-edit)
+ (let ((bounds (tablist-edit-column-bounds)))
+ (when bounds
+ (if (> (point) (cdr bounds))
+ (goto-char (1- (cdr bounds)))
+ (goto-char (car bounds)))
+ (point)))))
+
+(defun tablist-edit-column-bounds (&optional skip-final-space)
+ (unless tablist-edit-column-minor-mode
+ (error "Not editing a column"))
+ (let ((pos (next-single-property-change
+ (point) 'tablist-edit))
+ beg end)
+ (cond
+ ((null pos)
+ (setq end (previous-single-property-change
+ (point-max) 'tablist-edit)
+ beg (previous-single-property-change
+ end 'tablist-edit)))
+ ((get-text-property pos 'tablist-edit)
+ (setq beg pos
+ end (next-single-property-change
+ pos 'tablist-edit)))
+ (pos
+ (setq end pos
+ beg (previous-single-property-change
+ pos 'tablist-edit))))
+
+ (unless (and beg end (get-text-property beg 'tablist-edit))
+ (error "Unable to locate edited text"))
+ (cons beg (if skip-final-space (1- end) end))))
+
+(defun tablist-edit-column-mark-field ()
+ (interactive)
+ (save-restriction
+ (narrow-to-region (field-beginning) (field-end))
+ (mark-whole-buffer)))
+
+(defun tablist-find-entry (&optional id)
+ (interactive)
+ (unless (tablist-operation-available-p 'find-entry)
+ (error "Finding entries not supported in this buffer"))
+ (funcall tablist-operations-function
+ 'find-entry
+ (or id (tabulated-list-get-id))))
+
+;;
+;; *Utility
+;;
+
+(defun tablist-column-property (n prop)
+ (plist-get
+ (nthcdr 3 (aref tabulated-list-format n))
+ prop))
+
+(defun tablist-current-column ()
+ "Return the column number at point."
+ (let ((columns
+ (tablist-column-offsets))
+ (index 0))
+ (when (eq 0 (car columns))
+ (cl-incf index))
+ (while (and columns
+ (<= (car columns)
+ (current-column)))
+ (cl-incf index)
+ (setq columns (cdr columns)))
+ (if (> index 0)
+ (1- index)
+ (if columns
+ 0))))
+
+(defun tablist-column-offsets (&optional exclude-minor-columns-p)
+ "Return a list of column positions.
+
+This is a list of offsets from the beginning of the line."
+ (let ((cc tabulated-list-padding)
+ columns)
+ (dotimes (i (length tabulated-list-format))
+ (let* ((c (aref tabulated-list-format i))
+ (len (nth 1 c))
+ (pad (or (plist-get (nthcdr 3 c) :pad-right)
+ 1)))
+ (unless (and exclude-minor-columns-p
+ (memq i tablist-minor-columns))
+ (push cc columns))
+ (when (numberp len)
+ (cl-incf cc len))
+ (when pad
+ (cl-incf cc pad))))
+ (nreverse columns)))
+
+(defun tablist-pretty-print-entry (item)
+ (mapconcat (lambda (i)
+ (tablist-nth-entry i item))
+ (tablist-major-columns) " "))
+
+(defun tablist--save-face-property (beg end)
+ ;; We need to distinguish ,,not set'' from ''no face''.
+ (unless (and (text-property-not-all beg end 'face nil)
+ (< beg end))
+ (put-text-property beg (1+ beg) 'face 'default))
+ (unless (text-property-not-all beg end 'tablist-saved-face nil)
+ (tablist-copy-text-property beg end 'face 'tablist-saved-face)))
+
+(defun tablist--restore-face-property (beg end)
+ (when (text-property-not-all beg end 'tablist-saved-face nil)
+ (tablist-copy-text-property beg end 'tablist-saved-face 'face)))
+
+(defun tablist-copy-text-property (beg end from to)
+ "Copy text property FROM to TO in region BEG to END."
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (while (< beg end)
+ (goto-char beg)
+ (put-text-property
+ (point)
+ (setq beg (next-single-property-change
+ (point) from nil end))
+ to
+ (get-text-property (point) from))))))
+
+;;
+(defun tablist-read-column-name (arg &optional prompt default)
+ "Read the name of a column using ARG.
+
+If ARG is a number, return column ARG.
+If ARG is nil, return DEFAULT or the current column.
+Else ask the user, using PROMPT and DEFAULT."
+ (cond
+ ((numberp arg)
+ (or (tablist-column-name
+ (prefix-numeric-value arg))
+ (error "No such column: %d" (prefix-numeric-value arg))))
+ ((null arg)
+ (or default
+ (tablist-column-name
+ (or (tablist-current-column)
+ (car (tablist-major-columns))
+ 0))))
+ (t
+ (let* ((default (or default
+ (tablist-column-name
+ (car (tablist-major-columns)))))
+ (result
+ (completing-read
+ (format "%s %s: "
+ (or prompt "Use column")
+ (if default
+ (format "(default %s)"
+ default)
+ ""))
+ (tablist-column-names)
+ nil t nil 'tablist-column-name-history)))
+ (if (> (length result) 0)
+ result
+ (if (not default)
+ (error "No column selected")
+ default))))))
+
+
+(defmacro tablist-with-remembering-entry (&rest body)
+ "Remember where body left of and restore previous position.
+
+If the current entry is still visible, move to it. Otherwise move
+to the next visible one after it. If that also fails, goto to
+the beginning of the buffer. Finally move point to the major
+column."
+ (declare (indent 0) (debug t))
+ (let ((re (make-symbol "re"))
+ (id (make-symbol "id"))
+ (col (make-symbol "col")))
+ `(let ((,re
+ (replace-regexp-in-string
+ "[\t ]+" "[\t ]*" (regexp-quote
+ (or (thing-at-point 'line) ""))
+ t t))
+ (,id (tabulated-list-get-id))
+ (,col (tablist-current-column)))
+ (progn
+ ,@body
+ (let (success pos)
+ (goto-char (point-min))
+ (setq pos (point))
+ (while (and (setq success (re-search-forward ,re nil t))
+ (> (point) (prog1 pos (setq pos (point))))
+ (forward-line -1)
+ (not (equal ,id (tabulated-list-get-id))))
+ (forward-line))
+ (unless success
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (not success))
+ (if (equal (tabulated-list-get-id) ,id)
+ (setq success t)
+ (forward-line))))
+ (unless (and success (not (invisible-p (point))))
+ (goto-char (point-min)))
+ (tablist-skip-invisible-entries)
+ (tablist-move-to-column
+ (or ,col (car (tablist-major-columns))))
+ (dolist (win (get-buffer-window-list))
+ (set-window-point win (point))))))))
+
+(defun tablist-column-name (n)
+ "Return the name of column N."
+ (when (and n
+ (>= n 0)
+ (< n (length tabulated-list-format)))
+ (substring-no-properties
+ (car (elt tabulated-list-format n)) 0)))
+
+(defun tablist-column-names ()
+ "Return a list of all column-names."
+ (mapcar 'tablist-column-name
+ (number-sequence 0 (1- (length tabulated-list-format)))))
+
+(defun tablist-nth-entry (n &optional entry)
+ (unless entry (setq entry (tabulated-list-get-entry)))
+ (when (and entry
+ (>= n 0)
+ (< n (length entry)))
+ (let ((str (elt entry n)))
+ (if (stringp str)
+ str
+ (car str)))))
+
+(defun tablist-major-column-name ()
+ "Return a list of the major column names."
+ (tablist-column-name (car (tablist-major-columns))))
+
+(defun tablist-export-csv (&optional separator always-quote-p
+ invisible-p out-buffer display-p)
+ "Export a tabulated list to a CSV format.
+
+Use SEPARATOR (or ;) and quote if necessary (or always if
+ALWAYS-QUOTE-P is non-nil). Only consider non-filtered entries,
+unless invisible-p is non-nil. Create a buffer for the output or
+insert it after point in OUT-BUFFER. Finally if DISPLAY-P is
+non-nil, display this buffer.
+
+Return the output buffer."
+
+ (interactive (list nil t nil nil t))
+ (unless (derived-mode-p 'tabulated-list-mode)
+ (error "Not in Tabulated List Mode"))
+ (unless (stringp separator)
+ (setq separator (string (or separator ?\;))))
+ (let* ((outb (or out-buffer
+ (get-buffer-create
+ (format "%s.csv" (buffer-name)))))
+ (escape-re (format "[%s\"\n]" separator))
+ (header (tablist-column-names)))
+ (unless (buffer-live-p outb)
+ (error "Expected a live buffer: %s" outb))
+ (cl-labels
+ ((printit (entry)
+ (insert
+ (mapconcat
+ (lambda (e)
+ (unless (stringp e)
+ (setq e (car e)))
+ (if (or always-quote-p
+ (string-match escape-re e))
+ (concat "\""
+ (replace-regexp-in-string "\"" "\"\"" e t t)
+ "\"")
+ e))
+ entry separator))
+ (insert ?\n)))
+ (with-current-buffer outb
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (printit header)))
+ (save-excursion
+ (goto-char (point-min))
+ (unless invisible-p
+ (tablist-skip-invisible-entries))
+ (while (not (eobp))
+ (let* ((entry (tabulated-list-get-entry)))
+ (with-current-buffer outb
+ (let ((inhibit-read-only t))
+ (printit entry)))
+ (if invisible-p
+ (forward-line)
+ (tablist-forward-entry)))))
+ (if display-p
+ (display-buffer outb))
+ outb)))
+
+;;
+
+(defun tablist-enlarge-column (&optional column width)
+ "Enlarge column COLUMN by WIDTH.
+
+This function is lazy and therfore pretty slow."
+ (interactive
+ (list nil (* (prefix-numeric-value current-prefix-arg)
+ 3)))
+ (unless column (setq column (tablist-current-column)))
+ (unless column
+ (error "No column given and no entry at point"))
+ (unless width (setq width 1))
+ (when (or (not (numberp column))
+ (< column 0)
+ (>= column (length tabulated-list-format)))
+ (error "No such column: %d" column))
+ (when (= column (1- (length tabulated-list-format)))
+ (error "Can't resize last column"))
+
+ (let* ((cur-width (cadr (elt tabulated-list-format column))))
+ (setcar (cdr (elt tabulated-list-format column))
+ (max 3 (+ cur-width width)))
+ (tablist-with-remembering-entry
+ (tablist-save-marks
+ (tabulated-list-init-header)
+ (tabulated-list-print)))))
+
+
+(defun tablist-shrink-column (&optional column width)
+ (interactive
+ (list nil (* (prefix-numeric-value current-prefix-arg)
+ 3)))
+ (tablist-enlarge-column column (- (or width 1))))
+
+
+;; *Sorting
+;;
+
+(defun tablist-sort (&optional column)
+ "Sort the tabulated-list by COLUMN.
+
+COLUMN may be either a name or an index. The default compare
+function is given by the `tabulated-list-format', which see.
+
+This function saves the current sort column and the inverse
+sort-direction in the variable `tabulated-list-sort-key', which
+also determines the default COLUMN and direction.
+
+The main difference to `tabulated-list-sort' is, that this
+function sorts the buffer in-place and it ignores a nil sort
+entry in `tabulated-list-format' and sorts on the column anyway."
+
+ (interactive
+ (list
+ (if (null current-prefix-arg)
+ (tablist-column-name
+ (or (tablist-current-column)
+ (car (tablist-major-columns))
+ 0))
+ (tablist-read-column-name
+ '(4) "Sort by column"
+ (tablist-column-name (car (tablist-major-columns)))))))
+
+ (unless column
+ (setq column (or (car tabulated-list-sort-key)
+ (tablist-column-name (car (tablist-major-columns)))
+ (tablist-column-name 0))))
+ (when (numberp column)
+ (let ((column-name (tablist-column-name column)))
+ (unless column-name
+ (error "No such column: %d" column))
+ (setq column column-name)))
+
+ (setq tabulated-list-sort-key
+ (cons column
+ (if (equal column (car tabulated-list-sort-key))
+ (cdr tabulated-list-sort-key))))
+
+ (let* ((entries (if (functionp tabulated-list-entries)
+ (funcall tabulated-list-entries)
+ tabulated-list-entries))
+ (reverse (cdr tabulated-list-sort-key))
+ (n (tabulated-list--column-number ;;errors if column is n/a
+ (car tabulated-list-sort-key)))
+ (compare-fn (nth 2 (aref tabulated-list-format n))))
+
+ (when (or (null compare-fn)
+ (eq compare-fn t))
+ (setq compare-fn
+ (lambda (a b)
+ (setq a (aref (cadr a) n))
+ (setq b (aref (cadr b) n))
+ (string< (if (stringp a) a (car a))
+ (if (stringp b) b (car b))))))
+
+ (unless compare-fn
+ (error "This column cannot be sorted: %s" column))
+
+ (setcdr tabulated-list-sort-key (not reverse))
+ ;; Presort the entries and hash the result and sort the buffer.
+ (setq entries (sort (copy-sequence entries) compare-fn))
+ (let ((hash (make-hash-table :test 'equal)))
+ (dotimes (i (length entries))
+ (puthash (caar entries) i hash)
+ (setq entries (cdr entries)))
+ (tablist-with-remembering-entry
+ (goto-char (point-min))
+ (tablist-skip-invisible-entries)
+ (let ((inhibit-read-only t))
+ (sort-subr
+ nil 'tablist-forward-entry 'end-of-line
+ (lambda ()
+ (gethash (tabulated-list-get-id) hash 0))
+ nil (if reverse '< '>))))
+ (tablist-move-to-column n)
+ ;; Make the sort arrows display.
+ (tabulated-list-init-header))))
+
+;;
+;; *Filter
+;;
+
+(defun tablist-read-filter-name (prompt)
+ (let ((filter (cdr (assq major-mode tablist-named-filter))))
+ (unless filter
+ (error "No filter defined for %s mode" mode-name))
+ (let ((name (completing-read
+ (format "%s: " prompt)
+ filter
+ nil t)))
+ (unless (> (length name) 0)
+ (error "No filter selected"))
+ name)))
+
+(defun tablist-apply-filter (&optional filter)
+ "Apply FILTER to the current tabulated list.
+
+FILTER defaults to `tablist-current-filter'."
+ (unless filter (setq filter tablist-current-filter))
+ (tablist-filter-unhide-buffer)
+ (when (and filter
+ (null tablist-filter-suspended))
+ (tablist-with-remembering-entry
+ (tablist-map-with-filter
+ (lambda nil
+ (if tablist-umark-filtered-entries
+ (save-excursion (tablist-unmark-forward)))
+ (tablist-filter-hide-entry))
+ (tablist-filter-negate filter))))
+ (force-mode-line-update))
+
+(defadvice tabulated-list-print (after tabulated-list activate)
+ "Reapply the filter."
+ (when (or tablist-minor-mode
+ (derived-mode-p 'tablist-mode))
+ (tablist-apply-filter)))
+
+(defun tablist-eval-filter (filter)
+ (tablist-filter-eval
+ filter
+ (tabulated-list-get-id)
+ (tabulated-list-get-entry)
+ (cdr (assq major-mode tablist-named-filter))))
+
+(defun tablist-map-with-filter (fn filter &optional show-progress
+ distinguish-one-marked)
+ "Call FN for every unfiltered entry matching FILTER."
+ (prog1
+ (cl-labels ((search ()
+ (tablist-skip-invisible-entries)
+ (while (and (not (eobp))
+ (not (tablist-eval-filter filter)))
+ (tablist-forward-entry))
+ (unless (eobp)
+ (point-marker))))
+ (let (next-position results)
+ (save-excursion
+ (goto-char (point-min))
+ (setq next-position (search))
+ (while next-position
+ (goto-char next-position)
+ (if show-progress (sit-for 0))
+ (push (funcall fn) results)
+ ;; move after last match
+ (goto-char next-position)
+ (forward-line 1)
+ (set-marker next-position nil)
+ (setq next-position (search)))
+ (if (and distinguish-one-marked (= (length results) 1))
+ (setq results (cons t results))))))))
+
+;;
+;; **Filter Commands
+;;
+(defun tablist-push-filter (filter &optional interactive or-p)
+ (setq tablist-current-filter
+ (tablist-filter-push
+ tablist-current-filter
+ filter or-p))
+ (tablist-apply-filter)
+ (when interactive
+ (tablist-display-filter-temporarily)))
+
+(defun tablist-pop-filter (&optional n interactive)
+ "Remove the first N filter components."
+ (interactive (list (prefix-numeric-value current-prefix-arg) t))
+ (while (and tablist-current-filter
+ (> n 0))
+ (setq tablist-current-filter
+ (tablist-filter-pop
+ tablist-current-filter))
+ (cl-decf n))
+ (tablist-apply-filter)
+ (when interactive
+ (when (> n 0)
+ (message "The filter is empty."))
+ (tablist-display-filter-temporarily))
+ n)
+
+(defun tablist-negate-filter (&optional interactive)
+ "Negate the current filter."
+ (interactive (list t))
+ (setq tablist-current-filter
+ (tablist-filter-negate
+ tablist-current-filter))
+ (tablist-apply-filter)
+ (when interactive
+ (tablist-display-filter-temporarily)))
+
+(defun tablist-toggle-first-filter-logic ()
+ "Toggle between and/or for the first filter operand."
+ (interactive)
+ (setq tablist-current-filter
+ (pcase tablist-current-filter
+ (`(or ,x1 ,x2)
+ `(and ,x1 ,x2))
+ (`(and ,x1 ,x2)
+ `(or ,x1 ,x2))
+ (else else)))
+ (tablist-apply-filter)
+ (when (called-interactively-p 'any)
+ (tablist-display-filter-temporarily)))
+
+(defun tablist-suspend-filter (&optional flag)
+ "Temporarily disable filtering according to FLAG.
+
+Interactively, this command toggles filtering."
+ (interactive
+ (list (not tablist-filter-suspended)))
+ (let ((state tablist-filter-suspended))
+ (unless (eq (not (not state))
+ (not (not flag)))
+ (set (make-local-variable 'tablist-filter-suspended) flag)
+ (tablist-apply-filter))))
+
+(defun tablist-read-regexp-filter (operation arg)
+ (let ((column-name (tablist-read-column-name arg)))
+ (list
+ column-name
+ (let ((re
+ (read-regexp (format "%s where %s matches: " operation
column-name))))
+ (unless (> (length re) 0)
+ (error "No regexp given"))
+ re))))
+
+(defun tablist-read-equal-filter (operation arg)
+ (let ((column-name (tablist-read-column-name arg)))
+ (list
+ column-name
+ (read-string (format "%s where %s equals: " operation column-name)))))
+
+(defun tablist-read-numeric-filter (operation arg)
+ (let* ((entry (tabulated-list-get-entry 1))
+ (default (cl-some
+ (lambda (idx)
+ (let ((value (tablist-nth-entry idx entry)))
+ (when (or (not (eq 0 (string-to-number value)))
+ (equal "0" value))
+ (tablist-column-name idx))))
+ (number-sequence 0 (length entry))))
+ (column-name (tablist-read-column-name arg nil default))
+ (op (completing-read
+ (format "%s %s matching binary op: " operation column-name)
+ '("=" "<" ">" "<=" ">=") nil t))
+ oper)
+
+ (when (equal "" op)
+ (error "No operation selected"))
+ (setq op (intern op))
+ (setq oper (number-to-string
+ (read-number
+ (format "%s where %s %s " operation column-name op))))
+
+ (list op column-name oper)))
+
+(defun tablist-push-regexp-filter (column-name regexp)
+ "Add a new filter matching REGEXP in COLUMN-NAME.
+
+The filter is and'ed with the current filter. Use
+`tablist-toggle-first-filter-logic' to change this."
+ (interactive
+ (tablist-with-filter-displayed
+ (tablist-read-regexp-filter "Filter" current-prefix-arg)))
+ (tablist-push-filter
+ `(=~ ,column-name ,regexp)
+ (called-interactively-p 'any)))
+
+(defun tablist-push-equal-filter (column-name string)
+ "Add a new filter whre string equals COLUMN-NAME's value.
+
+The filter is and'ed with the current filter. Use
+`tablist-toggle-first-filter-logic' to change this."
+ (interactive
+ (tablist-with-filter-displayed
+ (tablist-read-equal-filter "Filter" current-prefix-arg)))
+ (tablist-push-filter
+ `(== ,column-name ,string)
+ (called-interactively-p 'any)))
+
+(defun tablist-push-numeric-filter (op column-name 2nd-arg)
+ "Add a new filter matching a numeric predicate.
+
+The filter is and'ed with the current filter. Use
+`tablist-toggle-first-filter-logic' to change this."
+ (interactive
+ (tablist-with-filter-displayed
+ (tablist-read-numeric-filter "Filter" current-prefix-arg)))
+ (tablist-push-filter
+ `(,op ,column-name ,2nd-arg)
+ (called-interactively-p 'any)))
+
+(defun tablist-push-named-filter (name)
+ "Add a named filter called NAME.
+
+Named filter are saved in the variable `tablist-named-filter'."
+ (interactive
+ (tablist-with-filter-displayed
+ (list
+ (tablist-read-filter-name "Add filter"))))
+ (when (and name (symbolp name))
+ (setq name (symbol-name name)))
+ (tablist-push-filter name (called-interactively-p 'any)))
+
+(defun tablist-delete-named-filter (name &optional mode)
+ (interactive
+ (tablist-with-filter-displayed
+ (list
+ (tablist-read-filter-name "Delete filter"))))
+ (setq tablist-current-filter
+ (tablist-filter-map
+ (lambda (f)
+ (when (equal f name)
+ (setq f (tablist-get-named-filter f)))
+ f)
+ tablist-current-filter))
+ (unless mode (setq mode major-mode))
+ (let ((mode-filter
+ (assq mode tablist-named-filter)))
+ (when mode-filter
+ (setcdr mode-filter
+ (cl-remove name (cdr mode-filter)
+ :test 'equal :key 'car)))))
+
+(defun tablist-name-current-filter (name)
+ (interactive
+ (list (tablist-with-filter-displayed
+ (read-string
+ "Add name for current filter: "))))
+ (unless tablist-current-filter
+ (error "Filter is empty"))
+ (unless (> (length name) 0)
+ (error "No name given"))
+ (tablist-put-named-filter
+ name (if (stringp tablist-current-filter)
+ (tablist-get-named-filter
+ tablist-current-filter)
+ tablist-current-filter))
+ (setq tablist-current-filter name)
+ (force-mode-line-update))
+
+(defun tablist-deconstruct-named-filter ()
+ (interactive)
+ (let (found)
+ (setq tablist-current-filter
+ (tablist-filter-map
+ (lambda (f)
+ (when (and (not found)
+ (stringp f))
+ (setq found t)
+ (let ((df (tablist-get-named-filter f)))
+ (unless df
+ (error "Filter is not defined: %s" f))
+ (setq f df)))
+ f)
+ tablist-current-filter))
+ (unless found
+ (error "No named filter found"))
+ (force-mode-line-update)))
+
+
+(defun tablist-filter-names (&optional mode)
+ (mapcar 'car (cdr (assq (or mode major-mode)
+ tablist-named-filter))))
+
+(defun tablist-get-named-filter (name &optional mode)
+ (cdr (assoc name
+ (cdr (assq (or mode major-mode)
+ tablist-named-filter)))))
+
+(defun tablist-put-named-filter (name filter &optional mode)
+ (unless mode (setq mode major-mode))
+ (let ((mode-filter
+ (assq mode tablist-named-filter)))
+ (unless mode-filter
+ (setq mode-filter (cons mode nil))
+ (push mode-filter tablist-named-filter))
+ (let ((entry (assoc name mode-filter)))
+ (if entry
+ (setcdr entry filter)
+ (setcdr mode-filter
+ (list (cons name filter)))))))
+
+(defun tablist-validate-named-filter (filter)
+ (tablist-filter-map
+ (lambda (f)
+ (when (and (stringp f)
+ (null (tablist-get-named-filter f)))
+ (error "Undefined named filter: %s (defined: %s)" f
+ (mapconcat 'identity (tablist-filter-names) ","))))
+ filter))
+
+(defun tablist-edit-filter ()
+ (interactive)
+ (setq tablist-current-filter
+ (tablist-with-filter-displayed
+ (tablist-filter-edit-filter
+ "Edit filter: "
+ tablist-current-filter
+ nil
+ 'tablist-validate-named-filter)))
+ (tablist-apply-filter))
+
+(defun tablist-clear-filter ()
+ (interactive)
+ (setq tablist-current-filter nil)
+ (tablist-apply-filter))
+
+;; **Displaying filter
+;;
+
+(defmacro tablist-with-filter-displayed (&rest body)
+ "Display the current filter in the mode while evalling BODY."
+ (let ((state (make-symbol "state")))
+ `(let ((,state (tablist-display-filter 'state)))
+ (tablist-display-filter t)
+ (unwind-protect
+ (progn ,@body)
+ (tablist-display-filter ,state)))))
+
+(defconst tablist-display-filter-mode-line-tag nil)
+
+(defun tablist-display-filter (&optional flag)
+ "Display the current filter according to FLAG.
+
+If FLAG has the value 'toggle, toggle it's visibility.
+If FLAG has the 'state, then do nothing but return the current
+visibility."
+ (interactive (list 'toggle))
+ (let* ((tag 'tablist-display-filter-mode-line-tag)
+ (displayed-p (not (not (assq tag mode-line-format)))))
+ (if (eq flag 'state)
+ displayed-p
+ (let ((display-p (not (not (if (eq flag 'toggle)
+ (not displayed-p)
+ flag)))))
+ (unless (eq displayed-p display-p)
+ (setq mode-line-format
+ (if display-p
+ (list (cons tag mode-line-format)
+ '(:eval
+ (replace-regexp-in-string
+ "%" "%%"
+ (concat
+ (propertize "Filter: " 'face 'minibuffer-prompt)
+ (and tablist-filter-suspended
+ "[suspended] ")
+ (if tablist-current-filter
+ (tablist-filter-unparse
+ tablist-current-filter t)
+ "[none]")))))
+ (cdr (assq tag mode-line-format)))))
+ (force-mode-line-update)
+ display-p))))
+
+(defun tablist-display-filter-temporarily ()
+ (tablist-with-filter-displayed
+ (sit-for 9999)))
+
+;;
+;; **Hiding/Unhiding Entries
+;;
+(defun tablist-filter-set-entry-hidden (flag &optional pos)
+ (save-excursion
+ (when pos (goto-char pos))
+ (beginning-of-line)
+ (let ((inhibit-read-only t))
+ (add-text-properties
+ (point-at-bol)
+ (1+ (point-at-eol))
+ `(invisible ,flag)))))
+
+(defun tablist-filter-hide-entry (&optional pos)
+ (interactive)
+ (tablist-filter-set-entry-hidden t pos))
+
+(defun tablist-filter-unhide-entry (&optional pos)
+ (tablist-filter-set-entry-hidden nil pos))
+
+(defun tablist-filter-unhide-buffer ()
+ (let ((inhibit-read-only t))
+ (remove-text-properties
+ (point-min) (point-max)
+ '(invisible))))
+
+
+(provide 'tablist)
+;;; tablist.el ends here
+
+;; Local Variables:
+;; End:
+
+
- [nongnu] branch elpa/tablist created (now faab7a0), Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 51bf2bf 02/60: Initial commit., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist e0e6a06 03/60: Added tablist package.,
Philip Kaludercic <=
- [nongnu] elpa/tablist 20eab2c 01/60: Initial commit., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 94bc289 09/60: Fixed warning., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 662243a 06/60: Remove minor-columns feature. Avoid a compiler warning., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist ad275a1 13/60: Merged branch renderpages., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist b90fff4 11/60: *** empty log message ***, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 9019123 17/60: Remove tablist package., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist e10e086 18/60: Readded tablist package., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 2077a99 19/60: Fix typo in description, and trailing line to satisfy package.el, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 0f1e499 21/60: Add .dir-locals.el, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 3ade133 15/60: Handle recent changes in eldoc., Philip Kaludercic, 2021/08/01