1887 |
;; XXX Kludge interface. |
;; XXX Kludge interface. |
1888 |
|
|
1889 |
(define-button-type 'tags-select-tags-table |
(define-button-type 'tags-select-tags-table |
1890 |
'action (lambda (button) (select-tags-table-select)) |
'action 'select-tags-table-select |
1891 |
'help-echo "RET, t or mouse-2: select tags table") |
'help-echo "RET, t or mouse-2: select tags table") |
1892 |
|
|
1893 |
;; XXX If a file is in multiple tables, selection may get the wrong one. |
;; XXX If a file is in multiple tables, selection may get the wrong one. |
1904 |
(desired-point nil) |
(desired-point nil) |
1905 |
b) |
b) |
1906 |
(when tags-table-list |
(when tags-table-list |
1907 |
(setq desired-point (point-marker)) |
(setq desired-point (point-marker)) |
1908 |
(setq b (point)) |
(setq b (point)) |
1909 |
(princ tags-table-list (current-buffer)) |
(princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) |
1910 |
(make-text-button b (point) 'type 'tags-select-tags-table) |
(make-text-button b (point) 'type 'tags-select-tags-table |
1911 |
(insert "\C-m") |
'etags-table (car tags-table-list)) |
|
(prin1 (car tags-table-list) (current-buffer)) ;invisible |
|
1912 |
(insert "\n")) |
(insert "\n")) |
1913 |
(while set-list |
(while set-list |
1914 |
(unless (eq (car set-list) tags-table-list) |
(unless (eq (car set-list) tags-table-list) |
1915 |
(setq b (point)) |
(setq b (point)) |
1916 |
(princ (car set-list) (current-buffer)) |
(princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) |
1917 |
(make-text-button b (point) 'type 'tags-select-tags-table) |
(make-text-button b (point) 'type 'tags-select-tags-table |
1918 |
(insert "\C-m") |
'etags-table (car (car set-list))) |
|
(prin1 (car (car set-list)) (current-buffer)) ;invisible |
|
1919 |
(insert "\n")) |
(insert "\n")) |
1920 |
(setq set-list (cdr set-list))) |
(setq set-list (cdr set-list))) |
1921 |
(when tags-file-name |
(when tags-file-name |
1922 |
(or desired-point |
(or desired-point |
1923 |
(setq desired-point (point-marker))) |
(setq desired-point (point-marker))) |
1924 |
(setq b (point)) |
(setq b (point)) |
1925 |
(insert tags-file-name) |
(insert (abbreviate-file-name tags-file-name)) |
1926 |
(make-text-button b (point) 'type 'tags-select-tags-table) |
(make-text-button b (point) 'type 'tags-select-tags-table |
1927 |
(insert "\C-m") |
'etags-table tags-file-name) |
|
(prin1 tags-file-name (current-buffer)) ;invisible |
|
1928 |
(insert "\n")) |
(insert "\n")) |
1929 |
(setq set-list (delete tags-file-name |
(setq set-list (delete tags-file-name |
1930 |
(apply 'nconc (cons (copy-sequence tags-table-list) |
(apply 'nconc (cons (copy-sequence tags-table-list) |
1932 |
tags-table-set-list))))) |
tags-table-set-list))))) |
1933 |
(while set-list |
(while set-list |
1934 |
(setq b (point)) |
(setq b (point)) |
1935 |
(insert (car set-list)) |
(insert (abbreviate-file-name (car set-list))) |
1936 |
(make-text-button b (point) 'type 'tags-select-tags-table) |
(make-text-button b (point) 'type 'tags-select-tags-table |
1937 |
(insert "\C-m") |
'etags-table (car set-list)) |
|
(prin1 (car set-list) (current-buffer)) ;invisible |
|
1938 |
(insert "\n") |
(insert "\n") |
1939 |
(setq set-list (delete (car set-list) set-list))) |
(setq set-list (delete (car set-list) set-list))) |
1940 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1947 |
(select-tags-table-mode)) |
(select-tags-table-mode)) |
1948 |
|
|
1949 |
(defvar select-tags-table-mode-map |
(defvar select-tags-table-mode-map |
1950 |
(let ((map (copy-keymap button-buffer-map))) |
(let ((map (make-sparse-keymap))) |
1951 |
|
(set-keymap-parent map button-buffer-map) |
1952 |
(define-key map "t" 'push-button) |
(define-key map "t" 'push-button) |
1953 |
(define-key map " " 'next-line) |
(define-key map " " 'next-line) |
1954 |
(define-key map "\^?" 'previous-line) |
(define-key map "\^?" 'previous-line) |
1957 |
(define-key map "q" 'select-tags-table-quit) |
(define-key map "q" 'select-tags-table-quit) |
1958 |
map)) |
map)) |
1959 |
|
|
1960 |
(defun select-tags-table-mode () |
(define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table" |
1961 |
"Major mode for choosing a current tags table among those already loaded. |
"Major mode for choosing a current tags table among those already loaded. |
1962 |
|
|
1963 |
\\{select-tags-table-mode-map}" |
\\{select-tags-table-mode-map}" |
1964 |
(interactive) |
(setq buffer-read-only t)) |
|
(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)) |
|
1965 |
|
|
1966 |
(defun select-tags-table-select () |
(defun select-tags-table-select (button) |
1967 |
"Select the tags table named on this line." |
"Select the tags table named on this line." |
1968 |
(interactive) |
(interactive (list (or (button-at (line-beginning-position)) |
1969 |
(search-forward "\C-m") |
(error "No tags table on current line")))) |
1970 |
(let ((name (read (current-buffer)))) |
(let ((name (button-get button 'etags-table))) |
1971 |
(visit-tags-table name) |
(visit-tags-table name) |
1972 |
(select-tags-table-quit) |
(select-tags-table-quit) |
1973 |
(message "Tags table now %s" name))) |
(message "Tags table now %s" name))) |
2033 |
|
|
2034 |
(provide 'etags) |
(provide 'etags) |
2035 |
|
|
2036 |
;;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e |
;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e |
2037 |
;;; etags.el ends here |
;;; etags.el ends here |