/[emacs]/emacs/lisp/ibuffer.el
ViewVC logotype

Diff of /emacs/lisp/ibuffer.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by walters, Sat Feb 23 21:33:33 2002 UTC revision 1.10 by walters, Fri Mar 8 04:04:22 2002 UTC
# Line 1276  become unmarked." Line 1276  become unmarked."
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))
# Line 1297  become unmarked." Line 1302  become unmarked."
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
# Line 1311  become unmarked." Line 1319  become unmarked."
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
# Line 1324  become unmarked." Line 1333  become unmarked."
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)))
# Line 1334  become unmarked." Line 1363  become unmarked."
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))
# Line 1357  become unmarked." Line 1388  become unmarked."
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))
# Line 1397  become unmarked." Line 1436  become unmarked."
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!"))
# Line 1483  become unmarked." Line 1528  become unmarked."
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
# Line 1521  become unmarked." Line 1567  become unmarked."
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
# Line 1569  current mark symbol, and the beginning a Line 1618  current mark symbol, and the beginning a
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
# Line 1704  If optional argument INCLUDE-LINES is no Line 1754  If optional argument INCLUDE-LINES is no
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))
# Line 1718  If optional argument INCLUDE-LINES is no Line 1768  If optional argument INCLUDE-LINES is no
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
# Line 1732  If optional argument INCLUDE-LINES is no Line 1782  If optional argument INCLUDE-LINES is no
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
# Line 1754  If optional argument INCLUDE-LINES is no Line 1803  If optional argument INCLUDE-LINES is no
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)
# Line 1844  Do not display messages if SILENT is non Line 1927  Do not display messages if SILENT is non
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)
# Line 1871  Do not display messages if SILENT is non Line 1957  Do not display messages if SILENT is non
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)

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26