# HG changeset patch # User Stefan Monnier # Date 1128966552 0 # Node ID 8851b98e9a29b0fedc4a979adbacf4398110801a # Parent 8fa0c8ff23c920f462a88a13c63caa8148530951 (select-tags-table-mode): Don't use selective-display. (tags-select-tags-table): Pass `button' to the action function. (select-tags-table): Place the side-info on button properties rather than in hidden text. Abbreviate file names. (select-tags-table-mode-map): Inherit rather than copy buttom-map. (select-tags-table-select): Add `button' argument. Get side-info from the button property rather than from hidden text. diff -r 8fa0c8ff23c9 -r 8851b98e9a29 lisp/progmodes/etags.el --- a/lisp/progmodes/etags.el Mon Oct 10 17:32:57 2005 +0000 +++ b/lisp/progmodes/etags.el Mon Oct 10 17:49:12 2005 +0000 @@ -1887,7 +1887,7 @@ ;; XXX Kludge interface. (define-button-type 'tags-select-tags-table - 'action (lambda (button) (select-tags-table-select)) + 'action 'select-tags-table-select 'help-echo "RET, t or mouse-2: select tags table") ;; XXX If a file is in multiple tables, selection may get the wrong one. @@ -1904,30 +1904,27 @@ (desired-point nil) b) (when tags-table-list - (setq desired-point (point-marker)) - (setq b (point)) - (princ tags-table-list (current-buffer)) - (make-text-button b (point) 'type 'tags-select-tags-table) - (insert "\C-m") - (prin1 (car tags-table-list) (current-buffer)) ;invisible + (setq desired-point (point-marker)) + (setq b (point)) + (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) + (make-text-button b (point) 'type 'tags-select-tags-table + 'etags-table (car tags-table-list)) (insert "\n")) (while set-list (unless (eq (car set-list) tags-table-list) (setq b (point)) - (princ (car set-list) (current-buffer)) - (make-text-button b (point) 'type 'tags-select-tags-table) - (insert "\C-m") - (prin1 (car (car set-list)) (current-buffer)) ;invisible + (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) + (make-text-button b (point) 'type 'tags-select-tags-table + 'etags-table (car (car set-list))) (insert "\n")) (setq set-list (cdr set-list))) (when tags-file-name - (or desired-point - (setq desired-point (point-marker))) - (setq b (point)) - (insert tags-file-name) - (make-text-button b (point) 'type 'tags-select-tags-table) - (insert "\C-m") - (prin1 tags-file-name (current-buffer)) ;invisible + (or desired-point + (setq desired-point (point-marker))) + (setq b (point)) + (insert (abbreviate-file-name tags-file-name)) + (make-text-button b (point) 'type 'tags-select-tags-table + 'etags-table tags-file-name) (insert "\n")) (setq set-list (delete tags-file-name (apply 'nconc (cons (copy-sequence tags-table-list) @@ -1935,10 +1932,9 @@ tags-table-set-list))))) (while set-list (setq b (point)) - (insert (car set-list)) - (make-text-button b (point) 'type 'tags-select-tags-table) - (insert "\C-m") - (prin1 (car set-list) (current-buffer)) ;invisible + (insert (abbreviate-file-name (car set-list))) + (make-text-button b (point) 'type 'tags-select-tags-table + 'etags-table (car set-list)) (insert "\n") (setq set-list (delete (car set-list) set-list))) (goto-char (point-min)) @@ -1951,7 +1947,8 @@ (select-tags-table-mode)) (defvar select-tags-table-mode-map - (let ((map (copy-keymap button-buffer-map))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map button-buffer-map) (define-key map "t" 'push-button) (define-key map " " 'next-line) (define-key map "\^?" 'previous-line) @@ -1960,24 +1957,17 @@ (define-key map "q" 'select-tags-table-quit) map)) -(defun select-tags-table-mode () +(define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table" "Major mode for choosing a current tags table among those already loaded. \\{select-tags-table-mode-map}" - (interactive) - (kill-all-local-variables) - (setq buffer-read-only t - major-mode 'select-tags-table-mode - mode-name "Select Tags Table") - (use-local-map select-tags-table-mode-map) - (setq selective-display t - selective-display-ellipses nil)) + (setq buffer-read-only t)) -(defun select-tags-table-select () +(defun select-tags-table-select (button) "Select the tags table named on this line." - (interactive) - (search-forward "\C-m") - (let ((name (read (current-buffer)))) + (interactive (list (or (button-at (line-beginning-position)) + (error "No tags table on current line")))) + (let ((name (button-get button 'etags-table))) (visit-tags-table name) (select-tags-table-quit) (message "Tags table now %s" name))) @@ -2043,5 +2033,5 @@ (provide 'etags) -;;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e +;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e ;;; etags.el ends here