1890 |
|
|
1891 |
;; XXX Kludge interface. |
;; XXX Kludge interface. |
1892 |
|
|
1893 |
|
(define-button-type 'tags-select-tags-table |
1894 |
|
'action (lambda (button) (select-tags-table-select)) |
1895 |
|
'help-echo "RET, t or mouse-2: select tags table") |
1896 |
|
|
1897 |
;; 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. |
1898 |
;;;###autoload |
;;;###autoload |
1899 |
(defun select-tags-table () |
(defun select-tags-table () |
1905 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
1906 |
(erase-buffer) |
(erase-buffer) |
1907 |
(let ((set-list tags-table-set-list) |
(let ((set-list tags-table-set-list) |
1908 |
(desired-point nil)) |
(desired-point nil) |
1909 |
|
b) |
1910 |
(when tags-table-list |
(when tags-table-list |
1911 |
(setq desired-point (point-marker)) |
(setq desired-point (point-marker)) |
1912 |
|
(setq b (point)) |
1913 |
(princ tags-table-list (current-buffer)) |
(princ tags-table-list (current-buffer)) |
1914 |
|
(make-text-button b (point) 'type 'tags-select-tags-table) |
1915 |
(insert "\C-m") |
(insert "\C-m") |
1916 |
(prin1 (car tags-table-list) (current-buffer)) ;invisible |
(prin1 (car tags-table-list) (current-buffer)) ;invisible |
1917 |
(insert "\n")) |
(insert "\n")) |
1918 |
(while set-list |
(while set-list |
1919 |
(unless (eq (car set-list) tags-table-list) |
(unless (eq (car set-list) tags-table-list) |
1920 |
|
(setq b (point)) |
1921 |
(princ (car set-list) (current-buffer)) |
(princ (car set-list) (current-buffer)) |
1922 |
|
(make-text-button b (point) 'type 'tags-select-tags-table) |
1923 |
(insert "\C-m") |
(insert "\C-m") |
1924 |
(prin1 (car (car set-list)) (current-buffer)) ;invisible |
(prin1 (car (car set-list)) (current-buffer)) ;invisible |
1925 |
(insert "\n")) |
(insert "\n")) |
1927 |
(when tags-file-name |
(when tags-file-name |
1928 |
(or desired-point |
(or desired-point |
1929 |
(setq desired-point (point-marker))) |
(setq desired-point (point-marker))) |
1930 |
(insert tags-file-name "\C-m") |
(setq b (point)) |
1931 |
|
(insert tags-file-name) |
1932 |
|
(make-text-button b (point) 'type 'tags-select-tags-table) |
1933 |
|
(insert "\C-m") |
1934 |
(prin1 tags-file-name (current-buffer)) ;invisible |
(prin1 tags-file-name (current-buffer)) ;invisible |
1935 |
(insert "\n")) |
(insert "\n")) |
1936 |
(setq set-list (delete tags-file-name |
(setq set-list (delete tags-file-name |
1938 |
(mapcar 'copy-sequence |
(mapcar 'copy-sequence |
1939 |
tags-table-set-list))))) |
tags-table-set-list))))) |
1940 |
(while set-list |
(while set-list |
1941 |
(insert (car set-list) "\C-m") |
(setq b (point)) |
1942 |
|
(insert (car set-list)) |
1943 |
|
(make-text-button b (point) 'type 'tags-select-tags-table) |
1944 |
|
(insert "\C-m") |
1945 |
(prin1 (car set-list) (current-buffer)) ;invisible |
(prin1 (car set-list) (current-buffer)) ;invisible |
1946 |
(insert "\n") |
(insert "\n") |
1947 |
(setq set-list (delete (car set-list) set-list))) |
(setq set-list (delete (car set-list) set-list))) |
1954 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
1955 |
(select-tags-table-mode)) |
(select-tags-table-mode)) |
1956 |
|
|
1957 |
(defvar select-tags-table-mode-map) |
(defvar select-tags-table-mode-map |
1958 |
(let ((map (make-sparse-keymap))) |
(let ((map (copy-keymap button-buffer-map))) |
1959 |
(define-key map "t" 'select-tags-table-select) |
(define-key map "t" 'push-button) |
1960 |
(define-key map " " 'next-line) |
(define-key map " " 'next-line) |
1961 |
(define-key map "\^?" 'previous-line) |
(define-key map "\^?" 'previous-line) |
1962 |
(define-key map "n" 'next-line) |
(define-key map "n" 'next-line) |
1963 |
(define-key map "p" 'previous-line) |
(define-key map "p" 'previous-line) |
1964 |
(define-key map "q" 'select-tags-table-quit) |
(define-key map "q" 'select-tags-table-quit) |
1965 |
(setq select-tags-table-mode-map map)) |
map)) |
1966 |
|
|
1967 |
(defun select-tags-table-mode () |
(defun select-tags-table-mode () |
1968 |
"Major mode for choosing a current tags table among those already loaded. |
"Major mode for choosing a current tags table among those already loaded. |