/[emacs]/emacs/lisp/menu-bar.el
ViewVC logotype

Diff of /emacs/lisp/menu-bar.el

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

revision 1.206 by pj, Thu Apr 11 13:39:41 2002 UTC revision 1.207 by miles, Tue Apr 23 05:01:50 2002 UTC
# Line 1282  key (or menu-item)")) Line 1282  key (or menu-item)"))
1282             file))             file))
1283          (car elt)))          (car elt)))
1284    
 (defvar menu-bar-buffers-menu-list-buffers-entry nil)  
   
1285  (defun menu-bar-update-buffers (&optional force)  (defun menu-bar-update-buffers (&optional force)
1286    ;; If user discards the Buffers item, play along.    ;; If user discards the Buffers item, play along.
1287    (and (lookup-key (current-global-map) [menu-bar buffer])    (and (lookup-key (current-global-map) [menu-bar buffer])
1288         (or force (frame-or-buffer-changed-p))         (or force (frame-or-buffer-changed-p))
1289         (let ((buffers (buffer-list))         (let ((buffers (buffer-list))
1290               (frames (frame-list))               (frames (frame-list))
              (maxlen 0)  
1291               buffers-menu frames-menu)               buffers-menu frames-menu)
1292           ;; If requested, list only the N most recently selected buffers.           ;; If requested, list only the N most recently selected buffers.
1293           (if (and (integerp buffers-menu-max-size)           (if (and (integerp buffers-menu-max-size)
# Line 1300  key (or menu-item)")) Line 1297  key (or menu-item)"))
1297    
1298           ;; Make the menu of buffers proper.           ;; Make the menu of buffers proper.
1299           (setq buffers-menu           (setq buffers-menu
1300                 (cons "Select Buffer"                 (let* ((buffer-list
1301                       (let* ((buffer-list                         (mapcar 'list buffers))
1302                               (mapcar 'list buffers))                        (menu-bar-update-buffers-maxbuf 0)
1303                              tail                        alist)
1304                              (menu-bar-update-buffers-maxbuf 0)                   ;; Put into each element of buffer-list
1305                              alist                   ;; the name for actual display,
1306                              head)                   ;; perhaps truncated in the middle.
1307                         ;; Put into each element of buffer-list                   (dolist (buf buffer-list)
1308                         ;; the name for actual display,                     (let ((name (buffer-name (car buf))))
1309                         ;; perhaps truncated in the middle.                       (setcdr buf
1310                         (setq tail buffer-list)                               (if (> (length name) 27)
1311                         (while tail                                   (concat (substring name 0 12)
1312                           (let ((name (buffer-name (car (car tail)))))                                           "..."
1313                             (setcdr (car tail)                                           (substring name -12))
1314                                     (if (> (length name) 27)                                 name))))
1315                                         (concat (substring name 0 12)                   ;; Compute the maximum length of any name.
1316                                                 "..."                   (dolist (buf buffer-list)
1317                                                 (substring name -12))                     (unless (eq ?\  (aref (cdr buf) 0))
1318                                       name)))                       (setq menu-bar-update-buffers-maxbuf
1319                           (setq tail (cdr tail)))                             (max menu-bar-update-buffers-maxbuf
1320                         ;; Compute the maximum length of any name.                                  (length (cdr buf))))))
1321                         (setq tail buffer-list)                   ;; Set ALIST to an alist of the form
1322                         (while tail                   ;; ITEM-STRING . BUFFER
1323                           (or (eq ?\ (aref (cdr (car tail)) 0))                   (dolist (buf buffer-list)
1324                               (setq menu-bar-update-buffers-maxbuf                     (unless (eq ?\  (aref (cdr buf) 0))
1325                                     (max menu-bar-update-buffers-maxbuf                       (push (menu-bar-update-buffers-1 buf) alist)))
1326                                          (length (cdr (car tail))))))                   ;; Now make the actual list of items, and add
1327                           (setq tail (cdr tail)))                   ;; some miscellaneous buffer commands to the end.
1328                         ;; Set ALIST to an alist of the form                   (mapcar (lambda (pair)
1329                         ;; ITEM-STRING . BUFFER                             ;; This is somewhat risque, to use
1330                         (setq tail buffer-list)                             ;; the buffer name itself as the event
1331                         (while tail                             ;; type to define, but it works.
1332                           (let ((elt (car tail)))                             ;; It would not work to use the buffer
1333                             (or (eq ?\ (aref (cdr elt) 0))                             ;; since a buffer as an event has its
1334                                 (setq alist (cons                             ;; own meaning.
1335                                              (menu-bar-update-buffers-1 elt)                             (nconc (list (buffer-name (cdr pair))
1336                                              alist)))                                          (car pair)
1337                             (and alist (> (length (car (car alist))) maxlen)                                          (cons nil nil))
1338                                  (setq maxlen (length (car (car alist))))))                                    'menu-bar-select-buffer))
1339                           (setq tail (cdr tail)))                           (nreverse alist))))
                        (setq alist (nreverse alist))  
                        ;; Make the menu item for list-buffers  
                        ;; or reuse the one we already have.  
                        ;; The advantage in reusing one  
                        ;; is that it already has the keyboard equivalent  
                        ;; cached, so we save the time to look that up again.  
                        (or menu-bar-buffers-menu-list-buffers-entry  
                            (setq menu-bar-buffers-menu-list-buffers-entry  
                                  (cons  
                                   'list-buffers  
                                   (cons  
                                    ""  
                                    'list-buffers))))  
                        ;; Update the item string for menu's new width.  
                        (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)  
                                (concat (make-string (max (- (/ maxlen 2) 8) 0)  
                                                     ?\ )  
                                        "List All Buffers"))  
                        ;; Now make the actual list of items,  
                        ;; ending with the list-buffers item.  
                        (nconc (mapcar (lambda (pair)  
                                         ;; This is somewhat risque, to use  
                                         ;; the buffer name itself as the event  
                                         ;; type to define, but it works.  
                                         ;; It would not work to use the buffer  
                                         ;; since a buffer as an event has its  
                                         ;; own meaning.  
                                         (nconc (list (buffer-name (cdr pair))  
                                                      (car pair)  
                                                      (cons nil nil))  
                                                'menu-bar-select-buffer))  
                                       alist)  
                               (list menu-bar-buffers-menu-list-buffers-entry)))))  
   
1340    
1341           ;; Make a Frames menu if we have more than one frame.           ;; Make a Frames menu if we have more than one frame.
1342           (if (cdr frames)           (when (cdr frames)
1343               (let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0)             (let ((frames-menu
1344                                                ?\ )                    (cons 'keymap
1345                                   "Frames"))                          (cons "Select Frame"
1346                     (frames-menu                                (mapcar
1347                      (cons 'keymap                                 (lambda (frame)
1348                            (cons "Select Frame"                                   (nconc
1349                                  (mapcar                                    (list (frame-parameter frame 'name)
1350                                   (lambda (frame)                                          (frame-parameter frame 'name)
1351                                     (nconc                                          (cons nil nil))
1352                                      (list (frame-parameter frame 'name)                                    'menu-bar-select-frame))
1353                                            (frame-parameter frame 'name)                                 frames)))))
1354                                            (cons nil nil))               ;; Put it after the normal buffers
1355                                            'menu-bar-select-frame))               (setq buffers-menu
1356                                          frames)))))                     (nconc buffers-menu
1357                 ;; Put it underneath the Buffers menu.                            `((frames-separator "--")
1358                 (setq buffers-menu (cons (cons 'frames (cons name frames-menu))                              (frames menu-item "Frames" ,frames-menu))))))
1359                                          buffers-menu))))  
1360           (if buffers-menu           ;; Add in some normal commands at the end of the menu
1361               (setq buffers-menu (cons 'keymap buffers-menu)))           (setq buffers-menu
1362                   (nconc buffers-menu
1363                          '((command-separator "--")
1364                            (select-named-buffer
1365                             menu-item
1366                             "Select Named Buffer..."
1367                             switch-to-buffer
1368                             :help "Prompt for a buffer name, and select that buffer in the current window")
1369                            (list-all-buffers
1370                             menu-item
1371                             "List All Buffers"
1372                             list-buffers
1373                             :help "Pop up a window listing all emacs buffers"))))
1374    
1375             (setq buffers-menu (cons 'keymap (cons "Select Buffer" buffers-menu)))
1376           (define-key (current-global-map) [menu-bar buffer]           (define-key (current-global-map) [menu-bar buffer]
1377             (cons "Buffers" buffers-menu)))))             (cons "Buffers" buffers-menu)))))
1378    

Legend:
Removed from v.1.206  
changed lines
  Added in v.1.207

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