1276 |
|
|
1277 |
(defun ibuffer-compile-format (format) |
(defun ibuffer-compile-format (format) |
1278 |
(let ((result nil) |
(let ((result nil) |
1279 |
str-used |
;; We use these variables to keep track of which variables |
1280 |
tmp1-used tmp2-used global-strlen-used) |
;; inside the generated function we need to bind, since |
1281 |
|
;; binding variables in Emacs takes time. |
1282 |
|
str-used tmp1-used tmp2-used global-strlen-used) |
1283 |
(dolist (form format) |
(dolist (form format) |
1284 |
(push |
(push |
1285 |
|
;; Generate a form based on a particular format entry, like |
1286 |
|
;; " ", mark, or (mode 16 16 :right). |
1287 |
(if (stringp form) |
(if (stringp form) |
1288 |
|
;; It's a string; all we need to do is insert it. |
1289 |
`(insert ,form) |
`(insert ,form) |
1290 |
(let* ((form (ibuffer-expand-format-entry form)) |
(let* ((form (ibuffer-expand-format-entry form)) |
1291 |
(sym (nth 0 form)) |
(sym (nth 0 form)) |
1302 |
maxform |
maxform |
1303 |
min-used max-used strlen-used) |
min-used max-used strlen-used) |
1304 |
(when (or (not (integerp min)) (>= min 0)) |
(when (or (not (integerp min)) (>= min 0)) |
1305 |
|
;; This is a complex case; they want it limited to a |
1306 |
|
;; minimum size. |
1307 |
(setq min-used t) |
(setq min-used t) |
1308 |
(setq str-used t strlen-used t global-strlen-used t |
(setq str-used t strlen-used t global-strlen-used t |
1309 |
tmp1-used t tmp2-used t) |
tmp1-used t tmp2-used t) |
1310 |
|
;; Generate code to limit the string to a minimum size. |
1311 |
(setq minform `(progn |
(setq minform `(progn |
1312 |
(setq str |
(setq str |
1313 |
,(ibuffer-compile-make-format-form |
,(ibuffer-compile-make-format-form |
1319 |
align))))) |
align))))) |
1320 |
(when (or (not (integerp max)) (> max 0)) |
(when (or (not (integerp max)) (> max 0)) |
1321 |
(setq str-used t max-used t) |
(setq str-used t max-used t) |
1322 |
|
;; Generate code to limit the string to a maximum size. |
1323 |
(setq maxform `(progn |
(setq maxform `(progn |
1324 |
(setq str |
(setq str |
1325 |
,(ibuffer-compile-make-substring-form |
,(ibuffer-compile-make-substring-form |
1333 |
,(ibuffer-compile-make-eliding-form 'str |
,(ibuffer-compile-make-eliding-form 'str |
1334 |
elide |
elide |
1335 |
from-end-p))))) |
from-end-p))))) |
1336 |
(let ((callform (ibuffer-aif (assq sym ibuffer-inline-columns) |
;; Now, put these forms together with the rest of the code. |
1337 |
(nth 1 it) |
(let ((callform |
1338 |
`(,sym buffer mark))) |
;; Is this an "inline" column? This means we have |
1339 |
|
;; to get the code from the |
1340 |
|
;; `ibuffer-inline-columns' alist and insert it |
1341 |
|
;; into our generated code. Otherwise, we just |
1342 |
|
;; generate a call to the column function. |
1343 |
|
(ibuffer-aif (assq sym ibuffer-inline-columns) |
1344 |
|
(nth 1 it) |
1345 |
|
`(,sym buffer mark))) |
1346 |
|
;; You're not expected to understand this. Hell, I |
1347 |
|
;; don't even understand it, and I wrote it five |
1348 |
|
;; minutes ago. |
1349 |
|
(insertgenfn (ibuffer-aif (get sym 'ibuffer-column-summarizer) |
1350 |
|
;; I really, really wish Emacs Lisp had closures. |
1351 |
|
(lambda (arg sym) |
1352 |
|
`(insert |
1353 |
|
(let ((ret ,arg)) |
1354 |
|
(put ',sym 'ibuffer-column-summary |
1355 |
|
(cons ret (get ',sym 'ibuffer-column-summary))) |
1356 |
|
ret))) |
1357 |
|
(lambda (arg sym) |
1358 |
|
`(insert ,arg)))) |
1359 |
(mincompform `(< strlen ,(if (integerp min) |
(mincompform `(< strlen ,(if (integerp min) |
1360 |
min |
min |
1361 |
'min))) |
'min))) |
1363 |
max |
max |
1364 |
'max)))) |
'max)))) |
1365 |
(if (or min-used max-used) |
(if (or min-used max-used) |
1366 |
|
;; The complex case, where we have to limit the |
1367 |
|
;; form to a maximum or minimum size. |
1368 |
(progn |
(progn |
1369 |
(when (and min-used (not (integerp min))) |
(when (and min-used (not (integerp min))) |
1370 |
(push `(min ,min) letbindings)) |
(push `(min ,min) letbindings)) |
1388 |
`(strlen (length str)))) |
`(strlen (length str)))) |
1389 |
outforms) |
outforms) |
1390 |
(setq outforms |
(setq outforms |
1391 |
(append outforms `((insert str))))) |
(append outforms (list (funcall insertgenfn 'str sym))))) |
1392 |
(push `(insert ,callform) outforms)) |
;; The simple case; just insert the string. |
1393 |
|
(push (funcall insertgenfn callform sym) outforms)) |
1394 |
|
;; Finally, return a `let' form which binds the |
1395 |
|
;; variables in `letbindings', and contains all the |
1396 |
|
;; code in `outforms'. |
1397 |
`(let ,letbindings |
`(let ,letbindings |
1398 |
,@outforms))))) |
,@outforms))))) |
1399 |
result)) |
result)) |
1400 |
(setq result |
(setq result |
1401 |
|
;; We don't want to unconditionally load the byte-compiler. |
1402 |
(funcall (if (or ibuffer-always-compile-formats |
(funcall (if (or ibuffer-always-compile-formats |
1403 |
(featurep 'bytecomp)) |
(featurep 'bytecomp)) |
1404 |
#'byte-compile |
#'byte-compile |
1405 |
#'identity) |
#'identity) |
1406 |
|
;; Here, we actually create a lambda form which |
1407 |
|
;; inserts all the generated forms for each entry |
1408 |
|
;; in the format string. |
1409 |
(nconc (list 'lambda '(buffer mark)) |
(nconc (list 'lambda '(buffer mark)) |
1410 |
`((let ,(append (when str-used |
`((let ,(append (when str-used |
1411 |
'(str)) |
'(str)) |
1436 |
(cdr entry)))) |
(cdr entry)))) |
1437 |
ibuffer-filter-format-alist)))) |
ibuffer-filter-format-alist)))) |
1438 |
|
|
1439 |
|
(defun ibuffer-clear-summary-columns (format) |
1440 |
|
(dolist (form format) |
1441 |
|
(ibuffer-awhen (and (consp form) |
1442 |
|
(get (car form) 'ibuffer-column-summarizer)) |
1443 |
|
(put (car form) 'ibuffer-column-summary nil)))) |
1444 |
|
|
1445 |
(defun ibuffer-check-formats () |
(defun ibuffer-check-formats () |
1446 |
(when (null ibuffer-formats) |
(when (null ibuffer-formats) |
1447 |
(error "No formats!")) |
(error "No formats!")) |
1528 |
(while (< (point) end) |
(while (< (point) end) |
1529 |
(if (get-text-property (point) 'ibuffer-title-header) |
(if (get-text-property (point) 'ibuffer-title-header) |
1530 |
(put-text-property (point) (line-end-position) 'face ibuffer-title-face) |
(put-text-property (point) (line-end-position) 'face ibuffer-title-face) |
1531 |
(unless (get-text-property (point) 'ibuffer-title) |
(unless (or (get-text-property (point) 'ibuffer-title) |
1532 |
|
(get-text-property (point) 'ibuffer-summary)) |
1533 |
(multiple-value-bind (buf mark) |
(multiple-value-bind (buf mark) |
1534 |
(get-text-property (point) 'ibuffer-properties) |
(get-text-property (point) 'ibuffer-properties) |
1535 |
(let* ((namebeg (next-single-property-change (point) 'ibuffer-name-column |
(let* ((namebeg (next-single-property-change (point) 'ibuffer-name-column |
1567 |
"Insert a line describing BUFFER and MARK using FORMAT." |
"Insert a line describing BUFFER and MARK using FORMAT." |
1568 |
(assert (eq major-mode 'ibuffer-mode)) |
(assert (eq major-mode 'ibuffer-mode)) |
1569 |
(let ((beg (point))) |
(let ((beg (point))) |
|
;; Here we inhibit `syntax-ppss-after-change-function' and other |
|
|
;; things font-lock uses. Otherwise, updating is slowed down dramatically. |
|
1570 |
(funcall format buffer mark) |
(funcall format buffer mark) |
1571 |
(put-text-property beg (point) 'ibuffer-properties (list buffer mark)) |
(put-text-property beg (point) 'ibuffer-properties (list buffer mark))) |
1572 |
(insert "\n") |
(insert "\n")) |
|
(goto-char beg))) |
|
1573 |
|
|
1574 |
|
;; This function knows a bit too much of the internals. It would be |
1575 |
|
;; nice if it was all abstracted away into |
1576 |
|
;; `ibuffer-insert-buffers-and-marks'. |
1577 |
(defun ibuffer-redisplay-current () |
(defun ibuffer-redisplay-current () |
1578 |
(assert (eq major-mode 'ibuffer-mode)) |
(assert (eq major-mode 'ibuffer-mode)) |
1579 |
(when (eobp) |
(when (eobp) |
1580 |
(forward-line -1)) |
(forward-line -1)) |
1581 |
(beginning-of-line) |
(beginning-of-line) |
1582 |
(let ((buf (ibuffer-current-buffer))) |
(let ((curformat (mapcar #'ibuffer-expand-format-entry |
1583 |
(when buf |
(ibuffer-current-format t)))) |
1584 |
(let ((mark (ibuffer-current-mark))) |
(ibuffer-clear-summary-columns curformat) |
1585 |
(delete-region (point) (1+ (line-end-position))) |
(let ((buf (ibuffer-current-buffer))) |
1586 |
(ibuffer-insert-buffer-line |
(when buf |
1587 |
buf mark |
(let ((mark (ibuffer-current-mark))) |
1588 |
(ibuffer-current-format)) |
(delete-region (point) (1+ (line-end-position))) |
1589 |
(when ibuffer-shrink-to-minimum-size |
(ibuffer-insert-buffer-line |
1590 |
(ibuffer-shrink-to-fit)))))) |
buf mark |
1591 |
|
(ibuffer-current-format)) |
1592 |
|
(when ibuffer-shrink-to-minimum-size |
1593 |
|
(ibuffer-shrink-to-fit))))))) |
1594 |
|
|
1595 |
(defun ibuffer-map-on-mark (mark func) |
(defun ibuffer-map-on-mark (mark func) |
1596 |
(ibuffer-map-lines |
(ibuffer-map-lines |
1618 |
(while (and (get-text-property (point) 'ibuffer-title) |
(while (and (get-text-property (point) 'ibuffer-title) |
1619 |
(not (eobp))) |
(not (eobp))) |
1620 |
(forward-line 1)) |
(forward-line 1)) |
1621 |
(while (not (eobp)) |
(while (and (not (eobp)) |
1622 |
|
(not (get-text-property (point) 'ibuffer-summary))) |
1623 |
(let ((result |
(let ((result |
1624 |
(if (buffer-live-p (ibuffer-current-buffer)) |
(if (buffer-live-p (ibuffer-current-buffer)) |
1625 |
(save-excursion |
(save-excursion |
1754 |
(ibuffer-update-format) |
(ibuffer-update-format) |
1755 |
(ibuffer-redisplay t)) |
(ibuffer-redisplay t)) |
1756 |
|
|
1757 |
(defun ibuffer-update-title (format) |
(defun ibuffer-update-title-and-summary (format) |
1758 |
(assert (eq major-mode 'ibuffer-mode)) |
(assert (eq major-mode 'ibuffer-mode)) |
1759 |
;; Don't do funky font-lock stuff here |
;; Don't do funky font-lock stuff here |
1760 |
(let ((after-change-functions nil)) |
(let ((after-change-functions nil)) |
1768 |
(progn |
(progn |
1769 |
(let ((opos (point))) |
(let ((opos (point))) |
1770 |
;; Insert the title names. |
;; Insert the title names. |
1771 |
(dolist (element (mapcar #'ibuffer-expand-format-entry format)) |
(dolist (element format) |
1772 |
(insert |
(insert |
1773 |
(if (stringp element) |
(if (stringp element) |
1774 |
element |
element |
1782 |
(let* ((name (or (get sym 'ibuffer-column-name) |
(let* ((name (or (get sym 'ibuffer-column-name) |
1783 |
(error "Unknown column %s in ibuffer-formats" sym))) |
(error "Unknown column %s in ibuffer-formats" sym))) |
1784 |
(len (length name))) |
(len (length name))) |
1785 |
(prog1 |
(if (< len min) |
1786 |
(if (< len min) |
(ibuffer-format-column name |
1787 |
(ibuffer-format-column name |
(- min len) |
1788 |
(- min len) |
align) |
1789 |
align) |
name)))))) |
|
name))))))) |
|
1790 |
(put-text-property opos (point) 'ibuffer-title-header t) |
(put-text-property opos (point) 'ibuffer-title-header t) |
1791 |
(insert "\n") |
(insert "\n") |
1792 |
;; Add the underlines |
;; Add the underlines |
1803 |
str))) |
str))) |
1804 |
(insert "\n")) |
(insert "\n")) |
1805 |
(point)) |
(point)) |
1806 |
'ibuffer-title t))) |
'ibuffer-title t) |
1807 |
|
;; Now, insert the summary columns. |
1808 |
|
(goto-char (point-max)) |
1809 |
|
(if (get-text-property (1- (point-max)) 'ibuffer-summary) |
1810 |
|
(delete-region (previous-single-property-change |
1811 |
|
(point-max) 'ibuffer-summary) |
1812 |
|
(point-max))) |
1813 |
|
(put-text-property |
1814 |
|
(point) |
1815 |
|
(progn |
1816 |
|
(insert "\n") |
1817 |
|
(dolist (element format) |
1818 |
|
(insert |
1819 |
|
(if (stringp element) |
1820 |
|
(make-string (length element) ? ) |
1821 |
|
(let ((sym (car element))) |
1822 |
|
(let ((min (cadr element)) |
1823 |
|
;; (max (caddr element)) |
1824 |
|
(align (cadddr element))) |
1825 |
|
;; Ignore a negative min when we're inserting the title |
1826 |
|
(when (minusp min) |
1827 |
|
(setq min (- min))) |
1828 |
|
(let* ((summary (if (get sym 'ibuffer-column-summarizer) |
1829 |
|
(funcall (get sym 'ibuffer-column-summarizer) |
1830 |
|
(get sym 'ibuffer-column-summary)) |
1831 |
|
(make-string (length (get sym 'ibuffer-column-name)) |
1832 |
|
? ))) |
1833 |
|
(len (length summary))) |
1834 |
|
(if (< len min) |
1835 |
|
(ibuffer-format-column summary |
1836 |
|
(- min len) |
1837 |
|
align) |
1838 |
|
summary))))))) |
1839 |
|
(point)) |
1840 |
|
'ibuffer-summary t))) |
1841 |
|
|
1842 |
(defun ibuffer-update-mode-name () |
(defun ibuffer-update-mode-name () |
1843 |
(setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode |
(setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode |
1844 |
ibuffer-sorting-mode |
ibuffer-sorting-mode |
1845 |
"recency"))) |
"view time"))) |
1846 |
(when ibuffer-sorting-reversep |
(when ibuffer-sorting-reversep |
1847 |
(setq mode-name (concat mode-name " [rev]"))) |
(setq mode-name (concat mode-name " [rev]"))) |
1848 |
(when (and (featurep 'ibuf-ext) |
(when (and (featurep 'ibuf-ext) |
1927 |
(assert (eq major-mode 'ibuffer-mode)) |
(assert (eq major-mode 'ibuffer-mode)) |
1928 |
(let ((--ibuffer-insert-buffers-and-marks-format |
(let ((--ibuffer-insert-buffers-and-marks-format |
1929 |
(ibuffer-current-format)) |
(ibuffer-current-format)) |
1930 |
|
(--ibuffer-expanded-format (mapcar #'ibuffer-expand-format-entry |
1931 |
|
(ibuffer-current-format t))) |
1932 |
(orig (count-lines (point-min) (point))) |
(orig (count-lines (point-min) (point))) |
1933 |
;; Inhibit font-lock caching tricks, since we're modifying the |
;; Inhibit font-lock caching tricks, since we're modifying the |
1934 |
;; entire buffer at once |
;; entire buffer at once |
1935 |
(after-change-functions nil)) |
(after-change-functions nil)) |
1936 |
|
(ibuffer-clear-summary-columns --ibuffer-expanded-format) |
1937 |
(unwind-protect |
(unwind-protect |
1938 |
(progn |
(progn |
1939 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
1957 |
(car entry) |
(car entry) |
1958 |
(cdr entry) |
(cdr entry) |
1959 |
--ibuffer-insert-buffers-and-marks-format))) |
--ibuffer-insert-buffers-and-marks-format))) |
1960 |
(ibuffer-update-title (ibuffer-current-format t))) |
(ibuffer-update-title-and-summary --ibuffer-expanded-format)) |
1961 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
1962 |
(set-buffer-modified-p ibuffer-did-modification) |
(set-buffer-modified-p ibuffer-did-modification) |
1963 |
(setq ibuffer-did-modification nil) |
(setq ibuffer-did-modification nil) |