tablist.el - dotemacs - My Emacs configuration

tablist.el (66667B)
      1 ;;; tablist.el --- Extended tabulated-list-mode -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2013, 2014  Andreas Politz
      4 
      5 ;; Author: Andreas Politz <politza@fh-trier.de>
      6 ;; Keywords: extensions, lisp
      7 ;; Package: tablist
      8 ;; Version: 1.0
      9 ;; Package-Requires: ((emacs "24.3"))
     10 
     11 ;; This program is free software; you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; This program is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 ;;
     26 ;; This package adds marks and filters to tabulated-list-mode.  It
     27 ;; also kind of puts a dired face on tabulated list buffers.
     28 ;;
     29 ;; It can be used by deriving from tablist-mode and some features by
     30 ;; using tablist-minor-mode inside a tabulated-list-mode buffer.
     31 ;;
     32 
     33 ;;; Code:
     34 
     35 (require 'cl-lib)
     36 (require 'ring)
     37 (require 'tabulated-list)
     38 (require 'dired)
     39 (require 'tablist-filter)
     40 
     41 ;;
     42 ;; *Macros
     43 ;;
     44 
     45 (defmacro tablist-save-marks (&rest body)
     46   "Eval body, while preserving all marks."
     47   (let ((marks (make-symbol "marks")))
     48     `(let (,marks)
     49        (save-excursion
     50          (goto-char (point-min))
     51          (let ((re "^\\([^ ]\\)"))
     52            (while (re-search-forward re nil t)
     53              (push (cons (tabulated-list-get-id)
     54                          (tablist-get-mark-state))
     55                    ,marks))))
     56        (unwind-protect
     57            (progn ,@body)
     58          (save-excursion
     59            (dolist (m ,marks)
     60              (let ((id (pop m)))
     61                (goto-char (point-min))
     62                (while (and id (not (eobp)))
     63                  (when (equal id (tabulated-list-get-id))
     64                    (tablist-put-mark-state m)
     65                    (setq id nil))
     66                  (forward-line)))))))))
     67 
     68 (defmacro tablist-with-remembering-entry (&rest body)
     69   "Remember where body left of and restore previous position.
     70 
     71 If the current entry is still visible, move to it. Otherwise move
     72 to the next visible one after it.  If that also fails, goto to
     73 the beginning of the buffer.  Finally move point to the major
     74 column."
     75   (declare (indent 0) (debug t))
     76   (let ((re (make-symbol "re"))
     77         (id (make-symbol "id"))
     78         (col (make-symbol "col")))
     79     `(let ((,re
     80             (replace-regexp-in-string
     81              "[\t ]+" "[\t ]*" (regexp-quote
     82                                 (or (thing-at-point 'line) ""))
     83              t t))
     84            (,id (tabulated-list-get-id))
     85            (,col (tablist-current-column)))
     86        (progn
     87          ,@body
     88          (let (success pos)
     89            (goto-char (point-min))
     90            (setq pos (point))
     91            (while (and (setq success (re-search-forward ,re nil t))
     92                        (> (point) (prog1 pos (setq pos (point))))
     93                        (forward-line -1)
     94                        (not (equal ,id (tabulated-list-get-id))))
     95              (forward-line))
     96            (unless success
     97              (goto-char (point-min))
     98              (while (and (not (eobp))
     99                          (not success))
    100                (if (equal (tabulated-list-get-id) ,id)
    101                    (setq success t)
    102                  (forward-line))))
    103            (unless (and success (not (invisible-p (point))))
    104              (goto-char (point-min)))
    105            (tablist-skip-invisible-entries)
    106            (tablist-move-to-column
    107             (or ,col (car (tablist-major-columns))))
    108            (dolist (win (get-buffer-window-list))
    109              (set-window-point win (point))))))))
    110 
    111 (defmacro tablist-with-filter-displayed (&rest body)
    112   "Display the current filter in the mode while evalling BODY."
    113   (let ((state (make-symbol "state")))
    114     `(let ((,state (tablist-display-filter 'state)))
    115        (tablist-display-filter t)
    116        (unwind-protect
    117            (progn ,@body)
    118          (tablist-display-filter ,state)))))
    119 
    120 ;;
    121 ;; *Mode Maps
    122 ;;
    123 
    124 (defvar tablist-mode-filter-map
    125   (let ((kmap (make-sparse-keymap)))
    126     (define-key kmap "p" 'tablist-pop-filter)
    127     (define-key kmap "r" 'tablist-push-regexp-filter)
    128     (define-key kmap "=" 'tablist-push-equal-filter)
    129     (define-key kmap "n" 'tablist-push-numeric-filter)
    130     (define-key kmap "!" 'tablist-negate-filter)
    131     (define-key kmap "t" 'tablist-toggle-first-filter-logic)
    132     (define-key kmap "/" 'tablist-display-filter)
    133     (define-key kmap "z" 'tablist-suspend-filter)
    134 
    135     (define-key kmap "a" 'tablist-push-named-filter)
    136     (define-key kmap "s" 'tablist-name-current-filter)
    137     (define-key kmap "D" 'tablist-delete-named-filter)
    138     (define-key kmap "d" 'tablist-deconstruct-named-filter)
    139     (define-key kmap "e" 'tablist-edit-filter)
    140     (define-key kmap "C" 'tablist-clear-filter)
    141     kmap))
    142 
    143 (defvar tablist-mode-mark-map
    144   (let ((kmap (make-sparse-keymap)))
    145     (define-key kmap "c" 'tablist-change-marks)
    146     (define-key kmap "!" 'tablist-unmark-all-marks)
    147     (define-key kmap "r" 'tablist-mark-items-regexp)
    148     (define-key kmap "n" 'tablist-mark-items-numeric)
    149     (define-key kmap "m" 'tablist-mark-forward)
    150     kmap))
    151 
    152 (defvar tablist-mode-regexp-map
    153   (let ((kmap (make-sparse-keymap)))
    154     ;; (define-key kmap "&" 'tablist-flag-gargabe-items)
    155     (define-key kmap "m" 'tablist-mark-items-regexp)
    156     kmap))
    157 
    158 (defvar tablist-minor-mode-map
    159   (let ((kmap (make-sparse-keymap)))
    160     (define-key kmap "m" 'tablist-mark-forward)
    161     (define-key kmap (kbd "DEL") 'tablist-unmark-backward)
    162     (define-key kmap "k" 'tablist-do-kill-lines)
    163     (define-key kmap "U" 'tablist-unmark-all-marks)
    164     (define-key kmap "u" 'tablist-unmark-forward)
    165     (define-key kmap "t" 'tablist-toggle-marks)
    166 
    167     (define-key kmap (kbd "TAB") 'tablist-forward-column)
    168     (define-key kmap "\t" 'tablist-forward-column)
    169     (define-key kmap [backtab] 'tablist-backward-column)
    170 
    171     (define-key kmap "%" tablist-mode-regexp-map)
    172     (define-key kmap "*" tablist-mode-mark-map)
    173     (define-key kmap "/" tablist-mode-filter-map)
    174 
    175     ;; (define-key kmap "e" 'tablist-edit-column)
    176     ;; (define-key kmap "i" 'tablist-insert-entry)
    177     (define-key kmap "s" 'tablist-sort)
    178     (define-key kmap [remap back-to-indentation] 'tablist-move-to-major-column)
    179     (define-key kmap [remap next-line] 'tablist-next-line)
    180     (define-key kmap [remap previous-line] 'tablist-previous-line)
    181     (define-key kmap "<" 'tablist-shrink-column)
    182     (define-key kmap ">" 'tablist-enlarge-column)
    183     (define-key kmap "q" 'tablist-quit)
    184     (define-key kmap "G" 'tablist-revert)
    185     (define-key kmap (kbd "C-c C-e") 'tablist-export-csv)
    186     kmap))
    187 
    188 (defvar tablist-mode-map
    189   (let ((kmap (copy-keymap tablist-minor-mode-map)))
    190     (set-keymap-parent kmap tabulated-list-mode-map)
    191     (define-key kmap "d" 'tablist-flag-forward)
    192     (define-key kmap (kbd "RET") 'tablist-find-entry)
    193     (define-key kmap "f" 'tablist-find-entry)
    194     ;; (define-key kmap "~" 'tablist-flag-gargabe-items)
    195     (define-key kmap "D" 'tablist-do-delete)
    196     (define-key kmap "C" 'tablist-do-copy)
    197     (define-key kmap "R" 'tablist-do-rename)
    198     (define-key kmap "x" 'tablist-do-flagged-delete)
    199     ;; (define-key kmap "F" 'tablist-find-marked-items)
    200     ;; (define-key kmap (kbd "C-o") 'tablist-display-item)
    201     kmap))
    202 
    203 ;;
    204 ;; *Variables
    205 ;;
    206 
    207 ;; Marking
    208 (defvar tablist-umark-filtered-entries t)
    209 (defvar tablist-marker-char dired-marker-char
    210   "The character used for marking.")
    211 (defvar tablist-marker-face 'dired-mark
    212   "The face used for the mark character.")
    213 (defvar tablist-marked-face  'dired-marked
    214   "The face used for marked major columns.")
    215 
    216 ;; Operations
    217 (defvar-local tablist-operations-function nil
    218   "A function for handling operations on the entries.
    219 
    220 The function is called with varying number of arguments, while
    221 the first one is always a symbol describing one of the following
    222 operations.
    223 
    224 `supported-operations'
    225 
    226 This is the only mandatory operation. There are no other
    227 arguments and the function should return a list of symbols of
    228 supported operations.
    229 
    230 `delete'
    231 
    232 The 2nd argument will be a list of entry ID's.  The function
    233 should somehow delete these entries and update
    234 `tabulated-list-entries'.
    235 
    236 `find-entry'
    237 
    238 The 2nd argument is the ID of an entry.  The function should
    239 somehow find/display this entry, i.e. a kind of default
    240 operation.
    241 
    242 `edit-column'
    243 
    244 The function is called with 3 further arguments: ID, INDEX and
    245 NEW-COLUMN, where ID represents the entry to edit, INDEX is the index
    246 of the column and NEW-COLUMN is the proposed new value for this
    247 column.  It should either
    248 
    249 i.  return a new edited complete entry and update
    250 `tabulated-list-entries', or
    251 
    252 ii. throw an error, if NEW-COLUMN is not a valid value for this
    253 column.
    254 
    255 `complete'
    256 
    257 The function is called with 4 further arguments: ID, INDEX,
    258 STRING and POS, where ID represents an entry, INDEX is the index
    259 of the column to complete, STRING it's current value and POS an
    260 offset of the current position of point into STRING.
    261 
    262 The function should return a collection for this column, suitable
    263 as argument for the function `completion-in-region'.")
    264 
    265 ;; Differentiating columns
    266 (defvar-local tablist-major-columns nil
    267   "Columns used to mark and when querying.")
    268 
    269 ;; Filter
    270 (defvar-local tablist-current-filter nil)
    271 (defvar-local tablist-filter-suspended nil)
    272 (defvar tablist-named-filter nil)
    273 
    274 ;; History variables
    275 (defvar tablist-column-name-history nil)
    276 
    277 ;; Hooks
    278 (defvar tablist-selection-changed-functions nil
    279   "A hook run when ever point moves to a different entry.")
    280 
    281 ;; Context Window
    282 (defvar-local tablist-context-window nil)
    283 (defvar-local tablist-context-window-function nil)
    284 (defvar tablist-context-window-display-action
    285   `((display-buffer-reuse-window
    286      tablist-display-buffer-split-below-and-attach)
    287     (window-height . 0.25)
    288     (inhibit-same-window . t)))
    289 
    290 ;;
    291 ;; *Setup
    292 ;;
    293 
    294 (defvar savehist-additional-variables)
    295 (add-hook 'savehist-save-hook
    296           (lambda nil
    297             (add-to-list 'savehist-additional-variables 'tablist-named-filter)))
    298 
    299 ;;;###autoload
    300 (define-minor-mode tablist-minor-mode
    301   nil nil nil nil
    302   (unless (derived-mode-p 'tabulated-list-mode)
    303     (error "Buffer is not in Tabulated List Mode"))
    304   (tablist-init (not tablist-minor-mode)))
    305 
    306 ;;;###autoload
    307 (define-derived-mode tablist-mode tabulated-list-mode "TL"
    308   (tablist-init))
    309 
    310 (defun tablist-init (&optional disable)
    311   (let ((cleaned-misc (cl-remove 'tablist-current-filter
    312                                  mode-line-misc-info :key 'car)))
    313     (cond
    314      ((not disable)
    315       (set (make-local-variable 'mode-line-misc-info)
    316            (append
    317             (list
    318              (list 'tablist-current-filter
    319                    '(:eval (format " [%s]"
    320                                    (if tablist-filter-suspended
    321                                        "suspended"
    322                                      "filtered")))))))
    323       (add-hook 'post-command-hook
    324                 'tablist-selection-changed-handler nil t)
    325       (add-hook 'tablist-selection-changed-functions
    326                 'tablist-context-window-update nil t))
    327      (t
    328       (setq mode-line-misc-info cleaned-misc)
    329       (remove-hook 'post-command-hook
    330                    'tablist-selection-changed-handler t)
    331       (remove-hook 'tablist-selection-changed-functions
    332                    'tablist-context-window-update t)))))
    333 
    334 (defun tablist-quit ()
    335   (interactive)
    336   (tablist-hide-context-window)
    337   (quit-window))
    338 
    339 (defvar-local tablist-selected-id nil)
    340 (defvar tablist-edit-column-minor-mode)
    341 
    342 (defun tablist-selection-changed-handler ()
    343   (unless tablist-edit-column-minor-mode
    344     (let ((id tablist-selected-id)
    345           (selected (tabulated-list-get-id)))
    346       (unless (eq selected id)
    347         (setq tablist-selected-id selected)
    348         (run-hook-with-args
    349          'tablist-selection-changed-functions
    350          tablist-selected-id)))))
    351 
    352 (defvar tablist-context-window-update--timer nil)
    353 
    354 (defun tablist-context-window-update (&optional id)
    355   (when (and tablist-context-window-function
    356              (window-live-p tablist-context-window)
    357              (not tablist-edit-column-minor-mode))
    358     (unless id
    359       (setq id (tabulated-list-get-id)))
    360     (when (timerp tablist-context-window-update--timer)
    361       (cancel-timer tablist-context-window-update--timer))
    362     (setq tablist-context-window-update--timer
    363           (run-with-idle-timer 0.1 nil
    364                                (lambda (fn window)
    365                                  (when (window-live-p window)
    366                                    (with-selected-window window
    367                                      (set-window-dedicated-p nil nil)
    368                                      (save-selected-window
    369                                        (funcall fn id))
    370                                      (when (window-live-p (selected-window))
    371                                        (set-window-dedicated-p nil t)))))
    372                                tablist-context-window-function
    373                                tablist-context-window))))
    374 
    375 (defun tablist-display-context-window ()
    376   (interactive)
    377   (unless tablist-context-window-function
    378     (error "No function for handling a context is defined"))
    379   (unless (window-live-p tablist-context-window)
    380     (setq tablist-context-window
    381           (display-buffer
    382            (current-buffer)
    383            tablist-context-window-display-action)))
    384   (prog1
    385       tablist-context-window
    386     (tablist-context-window-update)))
    387 
    388 (defun tablist-hide-context-window ()
    389   (interactive)
    390   (when (window-live-p tablist-context-window)
    391     (let ((ignore-window-parameters t))
    392       (delete-window tablist-context-window)))
    393   (setq tablist-context-window nil))
    394 
    395 (defun tablist-toggle-context-window ()
    396   (interactive)
    397   (if (window-live-p tablist-context-window)
    398       (tablist-hide-context-window)
    399     (tablist-display-context-window)))
    400 
    401 ;;
    402 ;; *Marking
    403 ;;
    404 
    405 (defun tablist-revert ()
    406   "Revert the list with marks preserved, position kept."
    407   (interactive)
    408   (tablist-save-marks
    409    (tablist-with-remembering-entry
    410      (tabulated-list-revert))))
    411 
    412 (defun tablist-major-columns ()
    413   (if (null tablist-major-columns)
    414       (number-sequence 0 (1- (length tabulated-list-format)))
    415     (if (numberp tablist-major-columns)
    416         (list tablist-major-columns)
    417       tablist-major-columns)))
    418 
    419 (defun tablist-put-mark (&optional pos)
    420   "Put a mark before the entry at POS.
    421 
    422 POS defaults to point. Use `tablist-marker-char',
    423 `tablist-marker-face', `tablist-marked-face' and
    424 `tablist-major-columns' to determine how to mark and what to put
    425 a face on."
    426   (when (or (null tabulated-list-padding)
    427             (< tabulated-list-padding 1))
    428     (setq tabulated-list-padding 1)
    429     (tabulated-list-revert))
    430   (save-excursion
    431     (and pos (goto-char pos))
    432     (unless (tabulated-list-get-id)
    433       (error "No entry at this position"))
    434     (let ((inhibit-read-only t))
    435       (tabulated-list-put-tag
    436        (string tablist-marker-char))
    437       (put-text-property
    438        (point-at-bol)
    439        (1+ (point-at-bol))
    440        'face tablist-marker-face)
    441       (let ((columns (tablist-column-offsets)))
    442         (dolist (c (tablist-major-columns))
    443           (when (and (>= c 0)
    444                      (< c (length columns)))
    445             (let ((beg (+ (point-at-bol)
    446                           (nth c columns)))
    447                   (end (if (= c (1- (length columns)))
    448                            (point-at-eol)
    449                          (+ (point-at-bol)
    450                             (nth (1+ c) columns)))))
    451               (cond
    452                ((and tablist-marked-face
    453                      (not (eq tablist-marker-char ?\s)))
    454                 (tablist--save-face-property beg end)
    455                 (put-text-property
    456                  beg end 'face tablist-marked-face))
    457                (t (tablist--restore-face-property beg end))))))))))
    458 
    459 (defun tablist-mark-forward (&optional arg interactive)
    460   "Mark ARG entries forward.
    461 
    462 ARG is interpreted as a prefix-arg.  If interactive is non-nil,
    463 maybe use the active region instead of ARG.
    464 
    465 See `tablist-put-mark' for how entries are marked."
    466   (interactive (list current-prefix-arg t))
    467   (cond
    468    ;; Mark files in the active region.
    469    ((and interactive (use-region-p))
    470     (save-excursion
    471       (goto-char (region-beginning))
    472       (beginning-of-line)
    473       (tablist-repeat-over-lines
    474        (1+ (count-lines
    475             (point)
    476             (save-excursion
    477               (goto-char (region-end))
    478               (beginning-of-line)
    479               (point))))
    480        'tablist-put-mark)))
    481    ;; Mark the current (or next ARG) files.
    482    (t
    483     (tablist-repeat-over-lines
    484      (prefix-numeric-value arg)
    485      'tablist-put-mark))))
    486 
    487 (defun tablist-mark-backward (&optional arg interactive)
    488   "Mark ARG entries backward.
    489 
    490 See `tablist-mark-forward'."
    491   (interactive (list current-prefix-arg t))
    492   (tablist-mark-forward (- (prefix-numeric-value arg))
    493                         interactive))
    494 
    495 (defun tablist-unmark-forward (&optional arg interactive)
    496   "Unmark ARG entries forward.
    497 
    498 See `tablist-mark-forward'."
    499   (interactive (list current-prefix-arg t))
    500   (let ((tablist-marker-char ?\s)
    501         tablist-marked-face)
    502     (tablist-mark-forward arg interactive)))
    503 
    504 (defun tablist-unmark-backward (&optional arg interactive)
    505   "Unmark ARG entries backward.
    506 
    507 See `tablist-mark-forward'."
    508   (interactive (list current-prefix-arg t))
    509   (let ((tablist-marker-char ?\s)
    510         tablist-marked-face)
    511     (tablist-mark-backward arg interactive)))
    512 
    513 (defun tablist-flag-forward (&optional arg interactive)
    514   "Flag ARG entries forward.
    515 
    516 See `tablist-mark-forward'."
    517   (interactive (list current-prefix-arg t))
    518   (let ((tablist-marker-char ?D)
    519         (tablist-marked-face 'dired-flagged))
    520     (tablist-mark-forward arg interactive)))
    521 
    522 (defun tablist-change-marks (old new)
    523   "Change all OLD marks to NEW marks.
    524 
    525 OLD and NEW are both characters used to mark files."
    526   (interactive
    527    (let* ((cursor-in-echo-area t)
    528           (old (progn (message "Change (old mark): ") (read-char)))
    529           (new (progn (message  "Change %c marks to (new mark): " old)
    530                       (read-char))))
    531      (list old new)))
    532   (when (eq new ?\n)
    533     (error "Mark character \\n is not allowed"))
    534   (let ((default-mark-p (equal tablist-marker-char new))
    535         (tablist-marker-char old))
    536     (save-excursion
    537       (tablist-map-over-marks
    538        (lambda nil
    539          (pcase new
    540            (?D
    541             (tablist-flag-forward 1))
    542            (_
    543             (let ((tablist-marker-char new)
    544                   (tablist-marked-face
    545                    (and default-mark-p
    546                         tablist-marked-face)))
    547               (tablist-put-mark)))))))))
    548 
    549 (defun tablist-unmark-all-marks (&optional marks interactive)
    550   "Remove alls marks in MARKS.
    551 
    552 MARKS should be a string of mark characters to match and defaults
    553 to all marks.  Interactively, remove all marks, unless a prefix
    554 arg was given, in which case ask about which ones to remove.
    555 Give a message, if interactive is non-nil.
    556 
    557 Returns the number of unmarked marks."
    558   (interactive
    559    (list (if current-prefix-arg
    560              (read-string "Remove marks: ")) t))
    561   (let ((re (if marks
    562                 (tablist-marker-regexp marks)
    563               "^[^ ]"))
    564         (removed 0))
    565     (save-excursion
    566       (goto-char (point-min))
    567       (while (re-search-forward re nil t)
    568         (let ((tablist-marker-char ?\s)
    569               tablist-marker-face
    570               tablist-marked-face)
    571           (tablist-put-mark))
    572         (cl-incf removed)))
    573     (when interactive
    574       (message "Removed %d marks" removed))
    575     removed))
    576 
    577 (defun tablist-toggle-marks ()
    578   "Unmark all marked and mark all unmarked entries.
    579 
    580 See `tablist-put-mark'."
    581   (interactive)
    582   (let ((marked-re (tablist-marker-regexp))
    583         (not-marked-re
    584          (let ((tablist-marker-char ?\s))
    585            (tablist-marker-regexp))))
    586     (save-excursion
    587       (goto-char (point-min))
    588       (tablist-skip-invisible-entries)
    589       (while (not (eobp))
    590         (cond
    591          ((looking-at marked-re)
    592           (save-excursion (tablist-unmark-backward -1)))
    593          ((looking-at not-marked-re)
    594           (tablist-put-mark)))
    595         (tablist-forward-entry)))
    596     (tablist-move-to-major-column)))
    597 
    598 (defun tablist-get-marked-items (&optional arg distinguish-one-marked)
    599   "Return marked or ARG entries."
    600   (let ((items (save-excursion
    601                  (tablist-map-over-marks
    602                   (lambda () (cons (tabulated-list-get-id)
    603                                    (tabulated-list-get-entry)))
    604                   arg nil distinguish-one-marked))))
    605     (if (and distinguish-one-marked
    606              (eq (car items) t))
    607         items
    608       (nreverse items))))
    609 
    610 (defun tablist-mark-items-regexp (column-name regexp)
    611   "Mark entries matching REGEXP in column COLUMN-NAME."
    612   (interactive
    613    (tablist-read-regexp-filter "Mark" current-prefix-arg ))
    614   (tablist-map-with-filter
    615    'tablist-put-mark
    616    `(=~  ,column-name ,regexp)))
    617 
    618 (defun tablist-mark-items-numeric (binop column-name operand)
    619   "Mark items fulfilling BINOP with arg OPERAND in column COLUMN-NAME.
    620 
    621 First the column's value is coerced to a number N.  Then the test
    622 proceeds as \(BINOP N OPERAND\)."
    623   (interactive
    624    (tablist-read-numeric-filter "Mark" current-prefix-arg))
    625   (tablist-map-with-filter
    626    'tablist-put-mark
    627    `(,binop ,column-name ,operand)))
    628 
    629 (defun tablist-map-over-marks (fn &optional arg show-progress
    630                                   distinguish-one-marked)
    631   (prog1
    632       (cond
    633        ((and arg (integerp arg))
    634         (let (results)
    635           (tablist-repeat-over-lines
    636            arg
    637            (lambda ()
    638              (if show-progress (sit-for 0))
    639              (push (funcall fn) results)))
    640           (if (< arg 0)
    641               (nreverse results)
    642             results)))
    643        (arg
    644         ;; non-nil, non-integer ARG means use current item:
    645         (tablist-skip-invisible-entries)
    646         (unless (eobp)
    647           (list (funcall fn))))
    648        (t
    649         (cl-labels ((search (re)
    650                             (let (sucess)
    651                               (tablist-skip-invisible-entries)
    652                               (while (and (setq sucess
    653                                                 (re-search-forward re nil t))
    654                                           (invisible-p (point)))
    655                                 (tablist-forward-entry))
    656                               sucess)))
    657           (let ((regexp (tablist-marker-regexp))
    658                 next-position results found)
    659             (save-excursion
    660               (goto-char (point-min))
    661               ;; remember position of next marked file before BODY
    662               ;; can insert lines before the just found file,
    663               ;; confusing us by finding the same marked file again
    664               ;; and again and...
    665               (setq next-position (and (search regexp)
    666                                        (point-marker))
    667                     found (not (null next-position)))
    668               (while next-position
    669                 (goto-char next-position)
    670                 (if show-progress (sit-for 0))
    671                 (push (funcall fn) results)
    672                 ;; move after last match
    673                 (goto-char next-position)
    674                 (forward-line 1)
    675                 (set-marker next-position nil)
    676                 (setq next-position (and (search regexp)
    677                                          (point-marker)))))
    678             (if (and distinguish-one-marked (= (length results) 1))
    679                 (setq results (cons t results)))
    680             (if found
    681                 results
    682               (unless (or (eobp) (invisible-p (point)))
    683                 (list (funcall fn))))))))
    684     (tablist-move-to-major-column)))
    685 
    686 (defun tablist-marker-regexp (&optional marks)
    687   "Return a regexp matching marks in MARKS.
    688 
    689 MARKS should be a string of mark characters to match and defaults
    690 to the current value of `tablist-marker-char' as a string."
    691   (concat (format "^[%s]"
    692                   (or marks (string tablist-marker-char)))))
    693 
    694 (defun tablist-get-mark-state ()
    695   "Return the mark state of the entry at point."
    696   (save-excursion
    697     (beginning-of-line)
    698     (when (looking-at "^\\([^ ]\\)")
    699       (let ((mark (buffer-substring
    700                    (match-beginning 1)
    701                    (match-end 1))))
    702         (tablist-move-to-major-column)
    703         (list (aref mark 0)
    704               (get-text-property 0 'face mark)
    705               (get-text-property (point) 'face))))))
    706 
    707 (defun tablist-put-mark-state (state)
    708   "Set the mark of the entry at point according to STATE.
    709 
    710 STATE is a return value of `tablist-get-mark-state'."
    711   (cl-destructuring-bind (tablist-marker-char
    712                           tablist-marker-face
    713                           tablist-marked-face)
    714       state
    715     (tablist-put-mark)))
    716 
    717 (defun tablist-mark-prompt (arg items)
    718   "Return a string suitable for use in a tablist prompt."
    719   ;; distinguish-one-marked can cause the first element to be just t.
    720   (if (eq (car items) t) (setq items (cdr items)))
    721   (let ((count (length items)))
    722     (if (= count 1)
    723         (car items)
    724       ;; more than 1 item:
    725       (if (integerp arg)
    726           ;; abs(arg) = count
    727           ;; Perhaps this is nicer, but it also takes more screen space:
    728           ;;(format "[%s %d items]" (if (> arg 0) "next" "previous")
    729           ;;                        count)
    730           (format "[next %d item%s]"
    731                   arg (dired-plural-s arg))
    732         (format "%c [%d item%s]" dired-marker-char count
    733                 (dired-plural-s count))))))
    734 
    735 ;;
    736 ;; *Movement
    737 ;;
    738 
    739 (defun tablist-forward-entry (&optional n)
    740   "Move past the next N unfiltered entries."
    741   (unless n (setq n 1))
    742   (while (and (> n 0)
    743               (not (eobp)))
    744     (forward-line)
    745     (when (invisible-p (point))
    746       (tablist-skip-invisible-entries))
    747     (cl-decf n))
    748   (while (and (< n 0)
    749               (not (bobp)))
    750     (forward-line -1)
    751     (when (invisible-p (point))
    752       (tablist-skip-invisible-entries t))
    753     (cl-incf n))
    754   n)
    755 
    756 (defun tablist-next-line (&optional n)
    757   (interactive "p")
    758   (when (and (< n 0)
    759              (save-excursion
    760                (end-of-line 0)
    761                (tablist-skip-invisible-entries t)
    762                (bobp)))
    763     (signal 'beginning-of-buffer nil))
    764   (when (and (> n 0)
    765              (save-excursion
    766                (tablist-forward-entry)
    767                (eobp)))
    768     (signal 'end-of-buffer nil))
    769 
    770   (let ((col (tablist-current-column)))
    771     (tablist-forward-entry (or n 1))
    772     (if col
    773         (tablist-move-to-column col)
    774       (tablist-move-to-major-column))))
    775 
    776 (defun tablist-previous-line (&optional n)
    777   (interactive "p")
    778   (tablist-next-line (- (or n 1))))
    779 
    780 (defun tablist-repeat-over-lines (arg function)
    781   "Call FUNCTION for the next ARG entries."
    782   ;; Move out of potentially invisble area.
    783   (tablist-skip-invisible-entries)
    784   (let ((pos (make-marker)))
    785     (while (and (> arg 0)
    786                 (not (eobp)))
    787       (cl-decf arg)
    788       (save-excursion
    789         (tablist-forward-entry)
    790         (move-marker pos (1+ (point))))
    791       (unless (eobp)
    792         (save-excursion (funcall function)))
    793       ;; Advance to the next line--actually, to the line that *was* next.
    794       ;; (If FUNCTION inserted some new lines in between, skip them.)
    795       (goto-char pos))
    796     (while (and (< arg 0) (not (bobp)))
    797       (cl-incf arg)
    798       (tablist-forward-entry -1)
    799       (save-excursion (funcall function)))
    800     (move-marker pos nil)
    801     (tablist-move-to-major-column)))
    802 
    803 (defun tablist-move-to-column (n)
    804   "Move to the N'th list column."
    805   (interactive "p")
    806   (when (tabulated-list-get-id)
    807     (let ((columns (tablist-column-offsets)))
    808       (when (or (< n 0)
    809                 (>= n (length columns)))
    810         (error "No such column: %s" n))
    811       (beginning-of-line)
    812       (forward-char (nth n columns))
    813       (when (and (plist-get (nthcdr 3 (elt tabulated-list-format n))
    814                             :right-align)
    815                  (not (= n (1- (length columns)))))
    816         (forward-char (1- (car (cdr (elt tabulated-list-format n)))))))))
    817 
    818 (defun tablist-move-to-major-column (&optional first-skip-invisible-p)
    819   "Move to the first major column."
    820   (interactive (list t))
    821   (when first-skip-invisible-p
    822     (tablist-skip-invisible-entries))
    823   (tablist-move-to-column (car (tablist-major-columns))))
    824 
    825 (defun tablist-forward-column (n)
    826   "Move n columns forward, while wrapping around."
    827   (interactive "p")
    828   (unless (tabulated-list-get-id)
    829     (error "No entry on this line"))
    830   (let* ((columns (tablist-column-offsets))
    831          (current (1- (length columns))))
    832     ;; find current column
    833     (while (and (>= current 0)
    834                 (> (nth current columns)
    835                    (current-column)))
    836       (cl-decf current))
    837     ;; there may be an invisible spec here
    838     (when (bolp)
    839       (forward-char))
    840     ;; before any columns
    841     (when (< current 0)
    842       (goto-char (+ (point-at-bol) (if (> n 0)
    843                                        (car columns)
    844                                      (car (last columns)))))
    845       (setq n (* (cl-signum n) (1- (abs n)))))
    846     (when (/= n 0)
    847       (tablist-move-to-column
    848        (mod (+ current n) (length columns))))))
    849 
    850 (defun tablist-backward-column (n)
    851   "Move n columns backward, while wrapping around."
    852   (interactive "p")
    853   (tablist-forward-column (- n)))
    854 
    855 ;;
    856 (defun tablist-skip-invisible-entries (&optional backward)
    857   "Skip invisible entries BACKWARD or forward.
    858 
    859 Do nothing, if the entry at point is visible.  Otherwise move to
    860 the beginning of the next visible entry in the direction
    861 determined by BACKWARD.
    862 
    863 Return t, if point is now in a visible area."
    864 
    865   (cond
    866    ((and backward
    867          (not (bobp))
    868          (get-text-property (point) 'invisible))
    869     (when (get-text-property (1- (point)) 'invisible)
    870       (goto-char (previous-single-property-change
    871                   (point)
    872                   'invisible nil (point-min))))
    873     (forward-line -1))
    874    ((and (not backward)
    875          (not (eobp))
    876          (get-text-property (point) 'invisible))
    877     (goto-char (next-single-property-change
    878                 (point)
    879                 'invisible nil (point-max)))))
    880   (not (invisible-p (point))))
    881 
    882 ;;
    883 ;; *Operations
    884 ;;
    885 
    886 (defun tablist-yes-or-no-p (operation arg items)
    887   "Query the user whether to proceed with some operation.
    888 
    889 Operation should be a symbol or string describing the operation,
    890 ARG the prefix-arg of the command used in
    891 `tablist-get-marked-items' or elsewhere, to get the ITEMS."
    892 
    893   (let ((pp-items (mapcar 'tablist-pretty-print-entry
    894                           (mapcar 'cdr items)))
    895         dired-no-confirm
    896         (op-str (upcase-initials
    897                  (if (stringp operation)
    898                      operation
    899                    (symbol-name operation)))))
    900     (dired-mark-pop-up
    901      (format " *%s*" op-str) nil
    902      pp-items
    903      dired-deletion-confirmer
    904      (format "%s %s "
    905              op-str
    906              (tablist-mark-prompt arg pp-items)))))
    907 
    908 (defun tablist-operation-available-p (op)
    909   (and (functionp tablist-operations-function)
    910        (memq op (funcall tablist-operations-function
    911                          'supported-operations))))
    912 
    913 (defun tablist-do-delete (&optional arg)
    914   "Delete ARG entries."
    915   (interactive "P")
    916   (unless (tablist-operation-available-p 'delete)
    917     (error "Deleting entries is not available in this buffer"))
    918   (let ((items (tablist-get-marked-items arg)))
    919     (when (tablist-yes-or-no-p 'delete arg items)
    920       (tablist-do-kill-lines arg)
    921       (funcall tablist-operations-function
    922                'delete (mapcar 'car items))
    923       (tablist-move-to-major-column))))
    924 
    925 (defun tablist-do-flagged-delete (&optional interactive)
    926   "Delete all entries marked with a D."
    927   (interactive "p")
    928   (let* ((tablist-marker-char ?D))
    929     (if (save-excursion
    930           (goto-char (point-min))
    931           (re-search-forward (tablist-marker-regexp) nil t))
    932         (tablist-do-delete)
    933       (or (not interactive)
    934           (message "(No deletions requested)")))))
    935 
    936 (defun tablist-do-kill-lines (&optional arg interactive)
    937   "Remove ARG lines from the display."
    938   (interactive (list current-prefix-arg t))
    939   (save-excursion
    940     (let ((positions
    941            (tablist-map-over-marks 'point arg))
    942           (inhibit-read-only t))
    943       (dolist (pos positions)
    944         (goto-char pos)
    945         (tabulated-list-delete-entry))
    946       (when interactive
    947         (message (format "Killed %d line%s"
    948                          (length positions)
    949                          (dired-plural-s (length positions))))))))
    950 
    951 (defun tablist-do-operation (arg fn operation &optional delete-p revert-p)
    952   "Operate on marked items.
    953 
    954 ARG should be the `current-prefix-arg', FN is a function of two
    955 arguments \(ID ENTRY\) handling the operation.  It gets called
    956 repeatly with all marked items.  OPERATION is a symbol or string
    957 describing the operation, it is used for display.
    958 
    959 Optional non-nil DELETE-P means, remove the items from the display.
    960 Optional REVERT-P means, revert the display afterwards."
    961   (let ((items (tablist-get-marked-items arg)))
    962     (unless items
    963       (error "No items marked"))
    964     (when (tablist-yes-or-no-p operation arg items)
    965       (when delete-p
    966         (tablist-do-kill-lines arg))
    967       (dolist (item items)
    968         (funcall fn (car item)))
    969       (when revert-p
    970         (tablist-revert))
    971       (tablist-move-to-major-column))))
    972 
    973 ;;
    974 ;; *Editing
    975 ;;
    976 (defvar tablist-edit-column-minor-mode-map
    977   (let ((kmap (make-sparse-keymap)))
    978     (set-keymap-parent kmap (current-global-map))
    979     (define-key kmap [remap self-insert-command] 'self-insert-command)
    980     (define-key kmap "\r" 'tablist-edit-column-commit)
    981     (define-key kmap (kbd "C-g") 'tablist-edit-column-quit)
    982     (define-key kmap (kbd "C-c C-c") 'tablist-edit-column-commit)
    983     (define-key kmap (kbd "C-c C-q") 'tablist-edit-column-quit)
    984     (define-key kmap "\t" 'tablist-edit-column-complete)
    985     (define-key kmap (kbd "TAB") 'tablist-edit-column-complete)
    986     (define-key kmap [remap end-of-buffer] 'end-of-line)
    987     (define-key kmap [remap beginning-of-buffer] 'beginning-of-line)
    988     (define-key kmap [remap mark-whole-buffer] 'tablist-edit-column-mark-field)
    989     kmap))
    990 
    991 (define-minor-mode tablist-edit-column-minor-mode
    992   "" nil nil nil
    993   (unless (or tablist-minor-mode
    994               (derived-mode-p 'tablist-mode))
    995     (error "Not in a tablist buffer"))
    996   (cond
    997    (tablist-edit-column-minor-mode
    998     (add-to-list 'mode-line-misc-info
    999                  '(tablist-edit-column-minor-mode "[edit]"))
   1000     (add-hook 'post-command-hook 'tablist-edit-column-constrain-point nil t)
   1001     (read-only-mode -1))
   1002    (t
   1003     (remove-hook 'post-command-hook 'tablist-edit-column-constrain-point t)
   1004     (read-only-mode 1))))
   1005 
   1006 (defun tablist-edit-column (&optional n)
   1007   (interactive "P")
   1008   (unless n (setq n (tablist-current-column)))
   1009   (tablist-assert-column-editable n)
   1010   (let* ((offsets (append (tablist-column-offsets)
   1011                           (list (- (point-at-eol)
   1012                                    (point-at-bol)))))
   1013          (beg (+ (point-at-bol)
   1014                  (nth n offsets)))
   1015          (end (+ (point-at-bol)
   1016                  (nth (1+ n) offsets)))
   1017          (entry (tabulated-list-get-entry beg))
   1018          (inhibit-read-only t)
   1019          (inhibit-field-text-motion t)
   1020          (alist `((entry . ,entry)
   1021                   (column . ,n)
   1022                   (id . ,(tabulated-list-get-id beg))))
   1023          ov)
   1024     (goto-char beg)
   1025     (delete-region beg end)
   1026     (add-text-properties
   1027      (point-at-bol) (point-at-eol)
   1028      '(read-only t field t))
   1029     (unless (= beg (point-at-bol))
   1030       (put-text-property (1- beg) beg 'rear-nonsticky t))
   1031     (save-excursion
   1032       ;; Keep one read-only space at the end for keeping text
   1033       ;; properties.
   1034       (insert
   1035        (propertize
   1036         (concat
   1037          (tablist-nth-entry n entry)
   1038          (propertize " "
   1039                      'display `(space :align-to ,(- end (point-at-bol)))))
   1040         'field nil
   1041         'front-sticky '(tablist-edit)
   1042         'rear-nonsticky '(read-only field)
   1043         'tablist-edit alist))
   1044       (setq end (point)))
   1045     (add-text-properties
   1046      (1- end) end '(read-only t field 'tablist-edit-end))
   1047     (setq ov (make-overlay beg end))
   1048     (overlay-put ov 'priority 9999)
   1049     (overlay-put ov 'face '(:background "deep sky blue" :foreground "white"))
   1050     (overlay-put ov 'evaporate t)
   1051     (overlay-put ov 'tablist-edit t)
   1052     (tablist-edit-column-minor-mode 1)))
   1053 
   1054 (defun tablist-edit-column-quit ()
   1055   (interactive)
   1056   (tablist-edit-column-commit t))
   1057 
   1058 (defun tablist-edit-column-commit (&optional abandon-edit)
   1059   (interactive (list current-prefix-arg))
   1060   (let ((inhibit-read-only t)
   1061         (inhibit-field-text-motion t)
   1062         bounds)
   1063     (condition-case nil
   1064         (setq bounds (tablist-edit-column-bounds))
   1065       (error
   1066        (tablist-edit-column-minor-mode -1)
   1067        (tabulated-list-revert)
   1068        (put-text-property (point-min) (point-max)
   1069                           'tablist-edit nil)
   1070        (error "Unable to complete the edit")))
   1071     (let* ((beg (car bounds))
   1072            (end (cdr bounds))
   1073            (alist (get-text-property beg 'tablist-edit))
   1074            (column (cdr (assq 'column alist)))
   1075            (id (cdr (assq 'id alist)))
   1076            (entry (cdr (assq 'entry alist)))
   1077            (item (buffer-substring-no-properties beg (1- end))))
   1078 
   1079       (unless abandon-edit
   1080         ;; Throws an error, if item is invalid.
   1081         (setq entry (funcall tablist-operations-function
   1082                              'edit-column id column item)))
   1083       (tablist-edit-column-minor-mode -1)
   1084       (remove-overlays beg end 'tablist-edit t)
   1085       (put-text-property beg end 'tablist-edit nil)
   1086       (delete-region (point-at-bol) (1+ (point-at-eol)))
   1087       (save-excursion
   1088         (tabulated-list-print-entry id entry))
   1089       (forward-char (nth column (tablist-column-offsets))))))
   1090 
   1091 (defun tablist-edit-column-complete ()
   1092   (interactive)
   1093   (unless (tablist-operation-available-p 'complete)
   1094     (error "Completion not available"))
   1095   (cl-destructuring-bind (beg &rest end)
   1096       (tablist-edit-column-bounds t)
   1097     (let* ((string (buffer-substring-no-properties
   1098                     beg end))
   1099            (alist (get-text-property beg 'tablist-edit))
   1100            (completions (funcall tablist-operations-function
   1101                                  'complete
   1102                                  (cdr (assq 'id alist))
   1103                                  (cdr (assq 'column alist))
   1104                                  string
   1105                                  (- (point) beg))))
   1106       (unless completions
   1107         (error "No completions available"))
   1108       (completion-in-region beg end completions))))
   1109 
   1110 (defun tablist-column-editable (n)
   1111   (and (tablist-operation-available-p 'edit-column)
   1112        (not (tablist-column-property n :read-only))))
   1113 
   1114 (defun tablist-assert-column-editable (n)
   1115   (unless (and (>= n 0)
   1116                (< n (length tabulated-list-format)))
   1117     (error "Invalid column number: %s" n))
   1118   (unless (tablist-operation-available-p 'edit-column)
   1119     (error "Editing columns not enabled in this buffer"))
   1120   (when (tablist-column-property n :read-only)
   1121     (error "This column is read-only")))
   1122 
   1123 (defun tablist-edit-column-constrain-point ()
   1124   (unless tablist-edit-column-minor-mode
   1125     (error "Not editing a column"))
   1126   (unless (get-text-property (point) 'tablist-edit)
   1127     (let ((bounds (tablist-edit-column-bounds)))
   1128       (when bounds
   1129         (if (> (point) (cdr bounds))
   1130             (goto-char (1- (cdr bounds)))
   1131           (goto-char (car bounds)))
   1132         (point)))))
   1133 
   1134 (defun tablist-edit-column-bounds (&optional skip-final-space)
   1135   (unless tablist-edit-column-minor-mode
   1136     (error "Not editing a column"))
   1137   (let ((pos (next-single-property-change
   1138               (point) 'tablist-edit))
   1139         beg end)
   1140     (cond
   1141      ((null pos)
   1142       (setq end (previous-single-property-change
   1143                  (point-max) 'tablist-edit)
   1144             beg (previous-single-property-change
   1145                  end 'tablist-edit)))
   1146      ((get-text-property pos 'tablist-edit)
   1147       (setq beg pos
   1148             end (next-single-property-change
   1149                  pos 'tablist-edit)))
   1150      (pos
   1151       (setq end pos
   1152             beg (previous-single-property-change
   1153                  pos 'tablist-edit))))
   1154 
   1155     (unless (and beg end (get-text-property beg 'tablist-edit))
   1156       (error "Unable to locate edited text"))
   1157     (cons beg (if skip-final-space (1- end) end))))
   1158 
   1159 (defun tablist-edit-column-mark-field ()
   1160   (interactive)
   1161   (push-mark (field-beginning))
   1162   (push-mark (field-end) nil t)
   1163   (goto-char (field-beginning)))
   1164 
   1165 (defun tablist-find-entry (&optional id)
   1166   (interactive)
   1167   (unless (tablist-operation-available-p 'find-entry)
   1168     (error "Finding entries not supported in this buffer"))
   1169   (funcall tablist-operations-function
   1170            'find-entry
   1171            (or id (tabulated-list-get-id))))
   1172 
   1173 ;;
   1174 ;; *Utility
   1175 ;;
   1176 
   1177 (defun tablist-column-property (n prop)
   1178   (plist-get
   1179    (nthcdr 3 (aref tabulated-list-format n))
   1180    prop))
   1181 
   1182 (defun tablist-current-column ()
   1183   "Return the column number at point.
   1184 
   1185 Returns nil, if point is before the first column."
   1186   (let ((column
   1187          (1- (cl-position
   1188               (current-column)
   1189               (append (tablist-column-offsets)
   1190                       (list most-positive-fixnum))
   1191               :test (lambda (column offset) (> offset column))))))
   1192     (when (>= column 0)
   1193       column)))
   1194 
   1195 (defun tablist-column-offsets ()
   1196   "Return a list of column positions.
   1197 
   1198 This is a list of offsets from the beginning of the line."
   1199   (let ((cc tabulated-list-padding)
   1200         columns)
   1201     (dotimes (i (length tabulated-list-format))
   1202       (let* ((c (aref tabulated-list-format i))
   1203              (len (nth 1 c))
   1204              (pad (or (plist-get (nthcdr 3 c) :pad-right)
   1205                       1)))
   1206         (push cc columns)
   1207         (when (numberp len)
   1208           (cl-incf cc len))
   1209         (when pad
   1210           (cl-incf cc pad))))
   1211     (nreverse columns)))
   1212 
   1213 (defun tablist-pretty-print-entry (item)
   1214   (mapconcat (lambda (i)
   1215                (tablist-nth-entry i item))
   1216              (tablist-major-columns) " "))
   1217 
   1218 (defun tablist--save-face-property (beg end)
   1219   ;; We need to distinguish ,,not set'' from ''no face''.
   1220   (unless (and (text-property-not-all beg end 'face nil)
   1221                (< beg end))
   1222     (put-text-property beg (1+ beg) 'face 'default))
   1223   (unless (text-property-not-all beg end 'tablist-saved-face nil)
   1224     (tablist-copy-text-property beg end 'face 'tablist-saved-face)))
   1225 
   1226 (defun tablist--restore-face-property (beg end)
   1227   (when (text-property-not-all beg end 'tablist-saved-face nil)
   1228     (tablist-copy-text-property beg end 'tablist-saved-face 'face)))
   1229 
   1230 (defun tablist-copy-text-property (beg end from to)
   1231   "Copy text property FROM to TO in region BEG to END."
   1232   (let ((inhibit-read-only t))
   1233     (save-excursion
   1234       (while (< beg end)
   1235         (goto-char beg)
   1236         (put-text-property
   1237          (point)
   1238          (setq beg (next-single-property-change
   1239                     (point) from nil end))
   1240          to
   1241          (get-text-property (point) from))))))
   1242 
   1243 ;;
   1244 (defun tablist-read-column-name (arg &optional prompt default)
   1245   "Read the name of a column using ARG.
   1246 
   1247 If ARG is a number, return column ARG.
   1248 If ARG is nil, return DEFAULT or the current column.
   1249 Else ask the user, using PROMPT and DEFAULT."
   1250   (cond
   1251    ((numberp arg)
   1252     (or (tablist-column-name
   1253          (prefix-numeric-value arg))
   1254         (error "No such column: %d" (prefix-numeric-value arg))))
   1255    ((null arg)
   1256     (or default
   1257         (tablist-column-name
   1258          (or (tablist-current-column)
   1259              (car (tablist-major-columns))
   1260              0))))
   1261    (t
   1262     (let* ((default (or default
   1263                         (tablist-column-name
   1264                          (car (tablist-major-columns)))))
   1265            (result
   1266             (completing-read
   1267              (format "%s %s: "
   1268                      (or prompt "Use column")
   1269                      (if default
   1270                          (format "(default %s)"
   1271                                  default)
   1272                        ""))
   1273              (tablist-column-names)
   1274              nil t nil 'tablist-column-name-history)))
   1275       (if (> (length result) 0)
   1276           result
   1277         (if (not default)
   1278             (error "No column selected")
   1279           default))))))
   1280 
   1281 (defun tablist-column-name (n)
   1282   "Return the name of column N."
   1283   (when (and n
   1284              (>= n 0)
   1285              (< n (length tabulated-list-format)))
   1286     (substring-no-properties
   1287      (car (elt tabulated-list-format n)) 0)))
   1288 
   1289 (defun tablist-column-names ()
   1290   "Return a list of all column-names."
   1291   (mapcar 'tablist-column-name
   1292           (number-sequence 0 (1- (length tabulated-list-format)))))
   1293 
   1294 (defun tablist-nth-entry (n &optional entry)
   1295   (unless entry (setq entry (tabulated-list-get-entry)))
   1296   (when (and entry
   1297              (>= n 0)
   1298              (< n (length entry)))
   1299     (let ((str (elt entry n)))
   1300       (if (stringp str)
   1301           str
   1302         (car str)))))
   1303 
   1304 (defun tablist-major-column-name ()
   1305   "Return a list of the major column names."
   1306   (tablist-column-name (car (tablist-major-columns))))
   1307 
   1308 (defun tablist-export-csv (&optional separator always-quote-p
   1309                                      invisible-p out-buffer display-p)
   1310   "Export a tabulated list to a CSV format.
   1311 
   1312 Use SEPARATOR (or ;) and quote if necessary (or always if
   1313 ALWAYS-QUOTE-P is non-nil).  Only consider non-filtered entries,
   1314 unless invisible-p is non-nil.  Create a buffer for the output or
   1315 insert it after point in OUT-BUFFER.  Finally if DISPLAY-P is
   1316 non-nil, display this buffer.
   1317 
   1318 Return the output buffer."
   1319 
   1320   (interactive (list nil t nil nil t))
   1321   (unless (derived-mode-p 'tabulated-list-mode)
   1322     (error "Not in Tabulated List Mode"))
   1323   (unless (stringp separator)
   1324     (setq separator (string (or separator ?\;))))
   1325   (let* ((outb (or out-buffer
   1326                    (get-buffer-create
   1327                     (format "%s.csv" (buffer-name)))))
   1328          (escape-re (format "[%s\"\n]" separator))
   1329          (header (tablist-column-names)))
   1330     (unless (buffer-live-p outb)
   1331       (error "Expected a live buffer: %s" outb))
   1332     (cl-labels
   1333         ((printit (entry)
   1334                   (insert
   1335                    (mapconcat
   1336                     (lambda (e)
   1337                       (unless (stringp e)
   1338                         (setq e (car e)))
   1339                       (if (or always-quote-p
   1340                               (string-match escape-re e))
   1341                           (concat "\""
   1342                                   (replace-regexp-in-string "\"" "\"\"" e t t)
   1343                                   "\"")
   1344                         e))
   1345                     entry separator))
   1346                   (insert ?\n)))
   1347       (with-current-buffer outb
   1348         (let ((inhibit-read-only t))
   1349           (erase-buffer)
   1350           (printit header)))
   1351       (save-excursion
   1352         (goto-char (point-min))
   1353         (unless invisible-p
   1354           (tablist-skip-invisible-entries))
   1355         (while (not (eobp))
   1356           (let* ((entry (tabulated-list-get-entry)))
   1357             (with-current-buffer outb
   1358               (let ((inhibit-read-only t))
   1359                 (printit entry)))
   1360             (if invisible-p
   1361                 (forward-line)
   1362               (tablist-forward-entry)))))
   1363       (if display-p
   1364           (display-buffer outb))
   1365       outb)))
   1366 
   1367 ;;
   1368 
   1369 (defun tablist-enlarge-column (&optional column width)
   1370   "Enlarge column COLUMN by WIDTH.
   1371 
   1372 This function is lazy and therfore pretty slow."
   1373   (interactive
   1374    (list nil (* (prefix-numeric-value current-prefix-arg)
   1375                 3)))
   1376   (unless column (setq column (tablist-current-column)))
   1377   (unless column
   1378     (error "No column given and no entry at point"))
   1379   (unless width (setq width 1))
   1380   (when (or (not (numberp column))
   1381             (< column 0)
   1382             (>= column (length tabulated-list-format)))
   1383     (error "No such column: %d" column))
   1384   (when (= column (1- (length tabulated-list-format)))
   1385     (error "Can't resize last column"))
   1386 
   1387   (let* ((cur-width (cadr (elt tabulated-list-format column))))
   1388     (setcar (cdr (elt tabulated-list-format column))
   1389             (max 3 (+ cur-width width)))
   1390     (tablist-with-remembering-entry
   1391       (tablist-save-marks
   1392        (tabulated-list-init-header)
   1393        (tabulated-list-print)))))
   1394 
   1395 (defun tablist-shrink-column (&optional column width)
   1396   (interactive
   1397    (list nil (* (prefix-numeric-value current-prefix-arg)
   1398                 3)))
   1399   (tablist-enlarge-column column (- (or width 1))))
   1400 
   1401 ;; *Sorting
   1402 ;;
   1403 
   1404 (defun tablist-sort (&optional column)
   1405   "Sort the tabulated-list by COLUMN.
   1406 
   1407 COLUMN may be either a name or an index.  The default compare
   1408 function is given by the `tabulated-list-format', which see.
   1409 
   1410 This function saves the current sort column and the inverse
   1411 sort-direction in the variable `tabulated-list-sort-key', which
   1412 also determines the default COLUMN and direction.
   1413 
   1414 The main difference to `tabulated-list-sort' is, that this
   1415 function sorts the buffer in-place and it ignores a nil sort
   1416 entry in `tabulated-list-format' and sorts on the column
   1417 anyway (why not ?)."
   1418 
   1419   (interactive
   1420    (list
   1421     (if (null current-prefix-arg)
   1422         (tablist-column-name
   1423          (or (tablist-current-column)
   1424              (car (tablist-major-columns))
   1425              0))
   1426       (tablist-read-column-name
   1427        '(4) "Sort by column"
   1428        (tablist-column-name (car (tablist-major-columns)))))))
   1429 
   1430   (unless column
   1431     (setq column (or (car tabulated-list-sort-key)
   1432                      (tablist-column-name (car (tablist-major-columns)))
   1433                      (tablist-column-name 0))))
   1434   (when (numberp column)
   1435     (let ((column-name (tablist-column-name column)))
   1436       (unless column-name
   1437         (error "No such column: %d" column))
   1438       (setq column column-name)))
   1439 
   1440   (setq tabulated-list-sort-key
   1441         (cons column
   1442               (if (equal column (car tabulated-list-sort-key))
   1443                   (cdr tabulated-list-sort-key))))
   1444 
   1445   (let* ((entries (if (functionp tabulated-list-entries)
   1446                       (funcall tabulated-list-entries)
   1447                     tabulated-list-entries))
   1448          (reverse (cdr tabulated-list-sort-key))
   1449          (n (tabulated-list--column-number ;;errors if column is n/a
   1450              (car tabulated-list-sort-key)))
   1451          (compare-fn (nth 2 (aref tabulated-list-format n))))
   1452 
   1453     (when (or (null compare-fn)
   1454               (eq compare-fn t))
   1455       (setq compare-fn
   1456             (lambda (a b)
   1457               (setq a (aref (cadr a) n))
   1458               (setq b (aref (cadr b) n))
   1459               (string< (if (stringp a) a (car a))
   1460                        (if (stringp b) b (car b))))))
   1461 
   1462     (unless compare-fn
   1463       (error "This column cannot be sorted: %s" column))
   1464 
   1465     (setcdr tabulated-list-sort-key (not reverse))
   1466     ;; Presort the entries and hash the result and sort the buffer.
   1467     (setq entries (sort (copy-sequence entries) compare-fn))
   1468     (let ((hash (make-hash-table :test 'equal)))
   1469       (dotimes (i (length entries))
   1470         (puthash (caar entries) i hash)
   1471         (setq entries (cdr entries)))
   1472       (tablist-with-remembering-entry
   1473         (goto-char (point-min))
   1474         (tablist-skip-invisible-entries)
   1475         (let ((inhibit-read-only t))
   1476           (sort-subr
   1477            nil 'tablist-forward-entry 'end-of-line
   1478            (lambda ()
   1479              (gethash (tabulated-list-get-id) hash 0))
   1480            nil (if reverse '< '>))))
   1481       (tablist-move-to-column n)
   1482       ;; Make the sort arrows display.
   1483       (tabulated-list-init-header))))
   1484 
   1485 ;;
   1486 ;; *Filter
   1487 ;;
   1488 
   1489 (defun tablist-read-filter-name (prompt)
   1490   (let ((filter (cdr (assq major-mode tablist-named-filter))))
   1491     (unless filter
   1492       (error "No filter defined for %s mode" mode-name))
   1493     (let ((name (completing-read
   1494                  (format "%s: " prompt)
   1495                  filter
   1496                  nil t)))
   1497       (unless (> (length name) 0)
   1498         (error "No filter selected"))
   1499       name)))
   1500 
   1501 (defun tablist-apply-filter (&optional filter)
   1502   "Apply FILTER to the current tabulated list.
   1503 
   1504 FILTER defaults to `tablist-current-filter'."
   1505   (unless filter (setq filter tablist-current-filter))
   1506   (tablist-filter-unhide-buffer)
   1507   (when (and filter
   1508              (null tablist-filter-suspended))
   1509     (tablist-with-remembering-entry
   1510       (tablist-map-with-filter
   1511        (lambda nil
   1512          (if tablist-umark-filtered-entries
   1513              (save-excursion (tablist-unmark-forward)))
   1514          (tablist-filter-hide-entry))
   1515        (tablist-filter-negate filter))))
   1516   (force-mode-line-update))
   1517 
   1518 (defadvice tabulated-list-print (after tabulated-list activate)
   1519   "Reapply the filter."
   1520   (when (or tablist-minor-mode
   1521             (derived-mode-p 'tablist-mode))
   1522     (tablist-apply-filter)))
   1523 
   1524 (defun tablist-eval-filter (filter)
   1525   (tablist-filter-eval
   1526    filter
   1527    (tabulated-list-get-id)
   1528    (tabulated-list-get-entry)
   1529    (cdr (assq major-mode tablist-named-filter))))
   1530 
   1531 (defun tablist-map-with-filter (fn filter &optional show-progress
   1532                                    distinguish-one-marked)
   1533   "Call FN for every unfiltered entry matching FILTER."
   1534   (prog1
   1535       (cl-labels ((search ()
   1536                           (tablist-skip-invisible-entries)
   1537                           (while (and (not (eobp))
   1538                                       (not (tablist-eval-filter filter)))
   1539                             (tablist-forward-entry))
   1540                           (unless (eobp)
   1541                             (point-marker))))
   1542         (let (next-position results)
   1543           (save-excursion
   1544             (goto-char (point-min))
   1545             (setq next-position (search))
   1546             (while next-position
   1547               (goto-char next-position)
   1548               (if show-progress (sit-for 0))
   1549               (push (funcall fn) results)
   1550               ;; move after last match
   1551               (goto-char next-position)
   1552               (forward-line 1)
   1553               (set-marker next-position nil)
   1554               (setq next-position (search)))
   1555             (if (and distinguish-one-marked (= (length results) 1))
   1556                 (setq results (cons t results))))))))
   1557 
   1558 ;;
   1559 ;; **Filter Commands
   1560 ;;
   1561 (defun tablist-push-filter (filter &optional interactive or-p)
   1562   (setq tablist-current-filter
   1563         (tablist-filter-push
   1564          tablist-current-filter
   1565          filter or-p))
   1566   (tablist-apply-filter)
   1567   (when interactive
   1568     (tablist-display-filter-temporarily)))
   1569 
   1570 (defun tablist-pop-filter (&optional n interactive)
   1571   "Remove the first N filter components."
   1572   (interactive (list (prefix-numeric-value current-prefix-arg) t))
   1573   (while (and tablist-current-filter
   1574               (> n 0))
   1575     (setq tablist-current-filter
   1576           (tablist-filter-pop
   1577            tablist-current-filter))
   1578     (cl-decf n))
   1579   (tablist-apply-filter)
   1580   (when interactive
   1581     (when (> n 0)
   1582       (message "The filter is empty."))
   1583     (tablist-display-filter-temporarily))
   1584   n)
   1585 
   1586 (defun tablist-negate-filter (&optional interactive)
   1587   "Negate the current filter."
   1588   (interactive (list t))
   1589   (setq tablist-current-filter
   1590         (tablist-filter-negate
   1591          tablist-current-filter))
   1592   (tablist-apply-filter)
   1593   (when interactive
   1594     (tablist-display-filter-temporarily)))
   1595 
   1596 (defun tablist-toggle-first-filter-logic ()
   1597   "Toggle between and/or for the first filter operand."
   1598   (interactive)
   1599   (setq tablist-current-filter
   1600         (pcase tablist-current-filter
   1601           (`(or ,x1 ,x2)
   1602            `(and ,x1 ,x2))
   1603           (`(and ,x1 ,x2)
   1604            `(or ,x1 ,x2))
   1605           (`(not ,x) x)
   1606           (x `(not ,x))))
   1607   (tablist-apply-filter)
   1608   (tablist-display-filter-temporarily))
   1609 
   1610 (defun tablist-suspend-filter (&optional flag)
   1611   "Temporarily disable filtering according to FLAG.
   1612 
   1613 Interactively, this command toggles filtering."
   1614   (interactive
   1615    (list (not tablist-filter-suspended)))
   1616   (let ((state tablist-filter-suspended))
   1617     (unless (eq (not (not state))
   1618                 (not (not flag)))
   1619       (set (make-local-variable 'tablist-filter-suspended) flag)
   1620       (tablist-apply-filter))))
   1621 
   1622 (defun tablist-read-regexp-filter (operation arg)
   1623   (let ((column-name (tablist-read-column-name arg)))
   1624     (list
   1625      column-name
   1626      (let ((re
   1627             (read-regexp (format "%s where %s matches: " operation column-name))))
   1628        (unless (> (length re) 0)
   1629          (error "No regexp given"))
   1630        re))))
   1631 
   1632 (defun tablist-read-equal-filter (operation arg)
   1633   (let ((column-name (tablist-read-column-name arg)))
   1634     (list
   1635      column-name
   1636      (read-string (format "%s where %s equals: " operation column-name)))))
   1637 
   1638 (defun tablist-read-numeric-filter (operation arg)
   1639   (let* ((entry (tabulated-list-get-entry 1))
   1640          (default (cl-some
   1641                    (lambda (idx)
   1642                      (let ((value (tablist-nth-entry idx entry)))
   1643                        (when (or (not (eq 0 (string-to-number value)))
   1644                                  (equal "0" value))
   1645                          (tablist-column-name idx))))
   1646                    (number-sequence 0 (length entry))))
   1647          (column-name (tablist-read-column-name arg nil default))
   1648          (op (completing-read
   1649               (format "%s %s matching binary op: " operation column-name)
   1650               '("=" "<" ">" "<=" ">=") nil t))
   1651          oper)
   1652 
   1653     (when (equal "" op)
   1654       (error "No operation selected"))
   1655     (setq op (intern op))
   1656     (setq oper (number-to-string
   1657                 (read-number
   1658                  (format "%s where %s %s " operation column-name op))))
   1659 
   1660     (list op column-name oper)))
   1661 
   1662 (defun tablist-push-regexp-filter (column-name regexp)
   1663   "Add a new filter matching REGEXP in COLUMN-NAME.
   1664 
   1665 The filter is and'ed with the current filter.  Use
   1666 `tablist-toggle-first-filter-logic' to change this."
   1667   (interactive
   1668    (tablist-with-filter-displayed
   1669     (tablist-read-regexp-filter "Filter" current-prefix-arg)))
   1670   (tablist-push-filter
   1671    `(=~ ,column-name ,regexp)
   1672    (called-interactively-p 'any)))
   1673 
   1674 (defun tablist-push-equal-filter (column-name string)
   1675   "Add a new filter whre string equals COLUMN-NAME's value.
   1676 
   1677 The filter is and'ed with the current filter.  Use
   1678 `tablist-toggle-first-filter-logic' to change this."
   1679   (interactive
   1680    (tablist-with-filter-displayed
   1681     (tablist-read-equal-filter "Filter" current-prefix-arg)))
   1682   (tablist-push-filter
   1683    `(== ,column-name ,string)
   1684    (called-interactively-p 'any)))
   1685 
   1686 (defun tablist-push-numeric-filter (op column-name 2nd-arg)
   1687   "Add a new filter matching a numeric predicate.
   1688 
   1689 The filter is and'ed with the current filter.  Use
   1690 `tablist-toggle-first-filter-logic' to change this."
   1691   (interactive
   1692    (tablist-with-filter-displayed
   1693     (tablist-read-numeric-filter "Filter" current-prefix-arg)))
   1694   (tablist-push-filter
   1695    `(,op ,column-name ,2nd-arg)
   1696    (called-interactively-p 'any)))
   1697 
   1698 (defun tablist-push-named-filter (name)
   1699   "Add a named filter called NAME.
   1700 
   1701 Named filter are saved in the variable `tablist-named-filter'."
   1702   (interactive
   1703    (tablist-with-filter-displayed
   1704     (list
   1705      (tablist-read-filter-name "Add filter"))))
   1706   (when (and name (symbolp name))
   1707     (setq name (symbol-name name)))
   1708   (tablist-push-filter name (called-interactively-p 'any)))
   1709 
   1710 (defun tablist-delete-named-filter (name &optional mode)
   1711   (interactive
   1712    (tablist-with-filter-displayed
   1713     (list
   1714      (tablist-read-filter-name "Delete filter"))))
   1715   (setq tablist-current-filter
   1716         (tablist-filter-map
   1717          (lambda (f)
   1718            (when (equal f name)
   1719              (setq f (tablist-get-named-filter f)))
   1720            f)
   1721          tablist-current-filter))
   1722   (unless mode (setq mode major-mode))
   1723   (let ((mode-filter
   1724          (assq mode tablist-named-filter)))
   1725     (when mode-filter
   1726       (setcdr mode-filter
   1727               (cl-remove name (cdr mode-filter)
   1728                          :test 'equal :key 'car)))))
   1729 
   1730 (defun tablist-name-current-filter (name)
   1731   (interactive
   1732    (list (tablist-with-filter-displayed
   1733           (read-string
   1734            "Add name for current filter: "))))
   1735   (unless tablist-current-filter
   1736     (error "Filter is empty"))
   1737   (unless (> (length name) 0)
   1738     (error "No name given"))
   1739   (tablist-put-named-filter
   1740    name (if (stringp tablist-current-filter)
   1741             (tablist-get-named-filter
   1742              tablist-current-filter)
   1743           tablist-current-filter))
   1744   (setq tablist-current-filter name)
   1745   (force-mode-line-update))
   1746 
   1747 (defun tablist-deconstruct-named-filter ()
   1748   (interactive)
   1749   (let (found)
   1750     (setq tablist-current-filter
   1751           (tablist-filter-map
   1752            (lambda (f)
   1753              (when (and (not found)
   1754                         (stringp f))
   1755                (setq found t)
   1756                (let ((df (tablist-get-named-filter f)))
   1757                  (unless df
   1758                    (error "Filter is not defined: %s" f))
   1759                  (setq f df)))
   1760              f)
   1761            tablist-current-filter))
   1762     (unless found
   1763       (error "No named filter found"))
   1764     (force-mode-line-update)))
   1765 
   1766 (defun tablist-filter-names (&optional mode)
   1767   (mapcar 'car (cdr (assq (or mode major-mode)
   1768                           tablist-named-filter))))
   1769 
   1770 (defun tablist-get-named-filter (name &optional mode)
   1771   (cdr (assoc name
   1772               (cdr (assq (or mode major-mode)
   1773                          tablist-named-filter)))))
   1774 
   1775 (defun tablist-put-named-filter (name filter &optional mode)
   1776   (unless mode (setq mode major-mode))
   1777   (let ((mode-filter
   1778          (assq mode tablist-named-filter)))
   1779     (unless mode-filter
   1780       (setq mode-filter (cons mode nil))
   1781       (push mode-filter tablist-named-filter))
   1782     (let ((entry (assoc name mode-filter)))
   1783       (if entry
   1784           (setcdr entry filter)
   1785         (setcdr mode-filter
   1786                 (list (cons name filter)))))))
   1787 
   1788 (defun tablist-validate-named-filter (filter)
   1789   (tablist-filter-map
   1790    (lambda (f)
   1791      (when (and (stringp f)
   1792                 (null (tablist-get-named-filter f)))
   1793        (error "Undefined named filter: %s (defined: %s)" f
   1794               (mapconcat 'identity (tablist-filter-names) ","))))
   1795    filter))
   1796 
   1797 (defun tablist-edit-filter ()
   1798   (interactive)
   1799   (setq tablist-current-filter
   1800         (tablist-with-filter-displayed
   1801          (tablist-filter-edit-filter
   1802           "Edit filter: "
   1803           tablist-current-filter
   1804           nil
   1805           'tablist-validate-named-filter)))
   1806   (tablist-apply-filter))
   1807 
   1808 (defun tablist-clear-filter ()
   1809   (interactive)
   1810   (setq tablist-current-filter nil)
   1811   (tablist-apply-filter))
   1812 
   1813 ;; **Displaying filter
   1814 ;;
   1815 
   1816 (defconst tablist-display-filter-mode-line-tag nil)
   1817 
   1818 (defun tablist-display-filter (&optional flag)
   1819   "Display the current filter according to FLAG.
   1820 
   1821 If FLAG has the value 'toggle, toggle it's visibility.
   1822 If FLAG has the 'state, then do nothing but return the current
   1823 visibility."
   1824   (interactive (list 'toggle))
   1825   (let* ((tag 'tablist-display-filter-mode-line-tag)
   1826          (displayed-p (not (not (assq tag mode-line-format)))))
   1827     (if (eq flag 'state)
   1828         displayed-p
   1829       (let ((display-p (not (not (if (eq flag 'toggle)
   1830                                      (not displayed-p)
   1831                                    flag)))))
   1832         (unless (eq displayed-p display-p)
   1833           (setq mode-line-format
   1834                 (if display-p
   1835                     (list (cons tag mode-line-format)
   1836                           '(:eval
   1837                             (replace-regexp-in-string
   1838                              "%" "%%"
   1839                              (concat
   1840                               (propertize "Filter: " 'face 'minibuffer-prompt)
   1841                               (and tablist-filter-suspended
   1842                                    "[suspended] ")
   1843                               (if tablist-current-filter
   1844                                   (tablist-filter-unparse
   1845                                    tablist-current-filter t)
   1846                                 "[none]")))))
   1847                   (cdr (assq tag mode-line-format)))))
   1848         (force-mode-line-update)
   1849         display-p))))
   1850 
   1851 (defun tablist-display-filter-temporarily ()
   1852   (tablist-with-filter-displayed
   1853    (sit-for 9999)))
   1854 
   1855 ;;
   1856 ;; **Hiding/Unhiding Entries
   1857 ;;
   1858 (defun tablist-filter-set-entry-hidden (flag &optional pos)
   1859   (save-excursion
   1860     (when pos (goto-char pos))
   1861     (beginning-of-line)
   1862     (let ((inhibit-read-only t))
   1863       (add-text-properties
   1864        (point-at-bol)
   1865        (1+ (point-at-eol))
   1866        `(invisible ,flag)))))
   1867 
   1868 (defun tablist-filter-hide-entry (&optional pos)
   1869   (interactive)
   1870   (tablist-filter-set-entry-hidden t pos))
   1871 
   1872 (defun tablist-filter-unhide-entry (&optional pos)
   1873   (tablist-filter-set-entry-hidden nil pos))
   1874 
   1875 (defun tablist-filter-unhide-buffer ()
   1876   (let ((inhibit-read-only t))
   1877     (remove-text-properties
   1878      (point-min) (point-max)
   1879      '(invisible))))
   1880 
   1881 (defun tablist-window-attach (awindow &optional window)
   1882   "Attach AWINDOW to WINDOW.
   1883 
   1884 This has the following effect.  Whenever WINDOW, defaulting to
   1885 the selected window, stops displaying the buffer it currently
   1886 displays (e.g., by switching buffers or because it was deleted)
   1887 AWINDOW is deleted."
   1888   (unless window (setq window (selected-window)))
   1889   (let ((buffer (window-buffer window))
   1890         (hook (make-symbol "window-attach-hook")))
   1891     (fset hook
   1892           (lambda ()
   1893             (when (or (not (window-live-p window))
   1894                       (not (eq buffer (window-buffer window))))
   1895               (remove-hook 'window-configuration-change-hook
   1896                            hook)
   1897               ;; Deleting windows inside wcch may cause errors in
   1898               ;; windows.el .
   1899               (run-with-timer
   1900                0 nil (lambda (win)
   1901                        (when (and (window-live-p win)
   1902                                   (not (eq win (selected-window))))
   1903                          (delete-window win)))
   1904                awindow))))
   1905     (add-hook 'window-configuration-change-hook hook)))
   1906 
   1907 (defun tablist-display-buffer-split-below-and-attach (buf alist)
   1908   "Display buffer action using `tablist-window-attach'."
   1909   (let ((window (selected-window))
   1910         (height (cdr (assq 'window-height alist)))
   1911         newwin)
   1912     (when height
   1913       (when (floatp height)
   1914         (setq height (round (* height (frame-height)))))
   1915       (setq height (- (max height window-min-height))))
   1916     (setq newwin (window--display-buffer
   1917                   buf
   1918                   (split-window-below height)
   1919                   'window alist))
   1920     (tablist-window-attach newwin window)
   1921     newwin))
   1922 
   1923 (defun tablist-generate-sorter (column compare-fn &optional read-fn)
   1924   "Generate a sort function for `tabulated-list' entries.
   1925 
   1926 Example:
   1927 
   1928      \(tablist-generate-sorter 0 '< 'string-to-number\)
   1929 
   1930 would create a sort function sorting `tabulated-list-entries' on
   1931 the 0-th column as numbers by the less-than relation."
   1932 
   1933   (lambda (e1 e2)
   1934     (funcall compare-fn
   1935              (funcall (or read-fn 'identity)
   1936                       (aref (cadr e1) column))
   1937              (funcall read-fn
   1938                       (aref (cadr e2) column)))))
   1939 
   1940 (provide 'tablist)
   1941 ;;; tablist.el ends here
	dotemacs My Emacs configuration
	git clone git://git.entf.net/dotemacs
	Log \| Files \| Refs \| LICENSE