[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/tablist 9019123 17/60: Remove tablist package.
|
From: |
Philip Kaludercic |
|
Subject: |
[nongnu] elpa/tablist 9019123 17/60: Remove tablist package. |
|
Date: |
Sun, 1 Aug 2021 18:19:27 -0400 (EDT) |
branch: elpa/tablist
commit 9019123a5ed8e268434ce9767b80d795223ac995
Author: Andreas Politz <politza@hochschule-trier.de>
Commit: Andreas Politz <politza@hochschule-trier.de>
Remove tablist package.
---
tablist-filter.el | 445 -------------
tablist.el | 1909 -----------------------------------------------------
2 files changed, 2354 deletions(-)
diff --git a/tablist-filter.el b/tablist-filter.el
deleted file mode 100644
index a401a2b..0000000
--- a/tablist-filter.el
+++ /dev/null
@@ -1,445 +0,0 @@
-;;; tablist-filter.el --- Filter expressions for tablists.
-
-;; Copyright (C) 2013, 2014 Andreas Politz
-
-;; Author: Andreas Politz <politza@fh-trier.de>
-;; Keywords: extensions, lisp
-
-;; 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)
-
-;;; 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
- ;; always 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)
- "- "
- (car (split-string
- (or (documentation (cdr op))
- (format "FIXME: Not documented: %s"
- (cdr op)))
- "\n" t))
- "\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 "&& - FILTER1 && FILTER2 : Locical and.\n")
- (princ "|| - FILTER1 || FILTER2 : Locical or.\n")
- (dolist (op tablist-filter-binary-operator)
- (princ-op op))
- (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
deleted file mode 100644
index 62a60d5..0000000
--- a/tablist.el
+++ /dev/null
@@ -1,1909 +0,0 @@
-;;; tablist.el --- Extensions for tabulated list mode. -*- lexical-binding: t
-*-
-
-;; Copyright (C) 2013, 2014 Andreas Politz
-
-;; Author: Andreas Politz <politza@fh-trier.de>
-;; Keywords: extensions, lisp
-
-;; 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
-;; also kind of puts a dired face on tabulated list buffers.
-;;
-;; It can be used by deriving from tablist-mode and some features 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)
-(require 'pdf-util)
-
-;;
-;; *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 "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)
- (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)
- 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-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
-;;
-
-(defvar savehist-additional-variables)
-(add-hook 'savehist-save-hook
- (lambda nil
- (add-to-list 'savehist-additional-variables 'tablist-named-filter)))
-
-(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"
- (tablist-init))
-
-(defun tablist-init (&optional disable)
- (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)))))
-
-(defvar tablist-context-window-update--timer nil)
-
-(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)))
- (when (timerp tablist-context-window-update--timer)
- (cancel-timer tablist-context-window-update--timer))
- (setq tablist-context-window-update--timer
- (run-with-idle-timer 0.1 nil
- (lambda (fn window)
- (when (window-live-p window)
- (with-selected-window 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)))))
- tablist-context-window-function
- tablist-context-window))))
-
-(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))
-
-(defun tablist-toggle-context-window ()
- (interactive)
- (if (window-live-p tablist-context-window)
- (tablist-hide-context-window)
- (tablist-display-context-window)))
-
-
-;;
-;; *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))
- (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
- (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)
- (push-mark (field-beginning))
- (push-mark (field-end) nil t)
- (goto-char (field-beginning)))
-
-(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.
-
-Returns nil, if point is before the first column."
- (let ((column
- (1- (cl-position
- (current-column)
- (append (tablist-column-offsets)
- (list most-positive-fixnum))
- :test (lambda (column offset) (> offset column))))))
- (when (>= column 0)
- column)))
-
-(defun tablist-column-offsets ()
- "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)))
- (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 (why not ?)."
-
- (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))
- (`(not ,x) x)
- (x `(not ,x))))
- (tablist-apply-filter)
- (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, 2021/08/01
- [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 <=
- [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
- [nongnu] elpa/tablist 6c03338 12/60: *** empty log message ***, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 6d03439 20/60: Added dir-locals.el, Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist d65235d 14/60: Fixed a bug regarding tablist columns., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist 9c0c56d 22/60: * lisp/pdf-occur.el: New and improved asynchronous, multiple file occur., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist a0c8192 23/60: Bumped version added NEWS., Philip Kaludercic, 2021/08/01
- [nongnu] elpa/tablist bf2e139 04/60: Fixed some bindings., Philip Kaludercic, 2021/08/01