Mercurial > hg > xemacs-beta

comparison lisp/menubar-items.el @ 679:6b890cfde2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-11-29 18:39:21 by adrian] [PATCH APPROVE COMMIT RECOMMEND 21.4.6] xemacs-21.5: Fix COMMAND-history handling in menubar-items.el <snaxfmkf.fsf@mailto.t-online.de>
author adrian
date Thu, 29 Nov 2001 18:39:21 +0000
parents 51494923758b
children b9b8621c2439
comparison
equal deleted inserted replaced
678:8e8a7b205142 679:6b890cfde2b1
52 ;; This file is dumped with XEmacs (when window system and menubar support is 52 ;; This file is dumped with XEmacs (when window system and menubar support is
53 ;; compiled in). 53 ;; compiled in).
54 54
55 ;;; Code: 55 ;;; Code:
56 56
57 (defun Menubar-items-truncate-list (list n) 57 (defun Menubar-items-truncate-history (list count label-length)
58 "Truncate a history LIST to first COUNT items.
59 Return a list of (label value) lists with labels truncated to last
60 LABEL-LENGTH characters of value."
58 (mapcar #'(lambda (x) 61 (mapcar #'(lambda (x)
59 (if (<= (length x) 50) x (concat "..." (substring x -50)))) 62 (if (<= (length x) label-length)
60 (if (<= (length list) n) 63 (list x x)
64 (list
65 (concat "..." (substring x (- label-length))) x)))
66 (if (<= (length list) count)
61 list 67 list
62 (butlast list (- (length list) n))))) 68 (butlast list (- (length list) count)))))
63 69
64 (defun submenu-generate-accelerator-spec (list &optional omit-chars-list) 70 (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
65 "Add auto-generated accelerator specifications to a submenu. 71 "Add auto-generated accelerator specifications to a submenu.
66 This can be used to add accelerators to the return value of a menu filter 72 This can be used to add accelerators to the return value of a menu filter
67 function. It correctly ignores unselectable items. It will destructively 73 function. It correctly ignores unselectable items. It will destructively
445 (lambda (menu) 451 (lambda (menu)
446 (if (or (not (boundp 'grep-history)) (null grep-history)) 452 (if (or (not (boundp 'grep-history)) (null grep-history))
447 menu 453 menu
448 (let ((items 454 (let ((items
449 (submenu-generate-accelerator-spec 455 (submenu-generate-accelerator-spec
450 (mapcar #'(lambda (string) 456 (mapcar #'(lambda (label-value)
451 (vector string 457 (vector (first label-value)
452 (list 'grep string))) 458 (list 'grep (second label-value))))
453 (Menubar-items-truncate-list grep-history 10))))) 459 (Menubar-items-truncate-history
460 grep-history 10 50)))))
454 (append menu '("---") items)))) 461 (append menu '("---") items))))
455 ["%_Grep..." grep :active (fboundp 'grep)] 462 ["%_Grep..." grep :active (fboundp 'grep)]
456 ["%_Kill Grep" kill-compilation 463 ["%_Kill Grep" kill-compilation
457 :active (and (fboundp 'kill-compilation) 464 :active (and (fboundp 'kill-compilation)
458 (fboundp 'compilation-find-buffer) 465 (fboundp 'compilation-find-buffer)
553 (lambda (menu) 560 (lambda (menu)
554 (if (or (not (boundp 'compile-history)) (null compile-history)) 561 (if (or (not (boundp 'compile-history)) (null compile-history))
555 menu 562 menu
556 (let ((items 563 (let ((items
557 (submenu-generate-accelerator-spec 564 (submenu-generate-accelerator-spec
558 (mapcar #'(lambda (string) 565 (mapcar #'(lambda (label-value)
559 (vector string 566 (vector (first label-value)
560 (list 'compile string))) 567 (list 'compile (second label-value))))
561 (Menubar-items-truncate-list compile-history 10))))) 568 (Menubar-items-truncate-history
569 compile-history 10 50)))))
562 (append menu '("---") items)))) 570 (append menu '("---") items))))
563 ["%_Compile..." compile :active (fboundp 'compile)] 571 ["%_Compile..." compile :active (fboundp 'compile)]
564 ["%_Repeat Compilation" recompile :active (fboundp 'recompile)] 572 ["%_Repeat Compilation" recompile :active (fboundp 'recompile)]
565 ["%_Kill Compilation" kill-compilation 573 ["%_Kill Compilation" kill-compilation
566 :active (and (fboundp 'kill-compilation) 574 :active (and (fboundp 'kill-compilation)