diff options
| author | Stefan Monnier | 2005-10-10 17:49:12 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2005-10-10 17:49:12 +0000 |
| commit | 29878150b2f8783a607a70de0e34d313dafffdd6 (patch) | |
| tree | 4d22dfb831f92ef0ad400e60c81a82ff02a3ddd7 | |
| parent | e61d3a566185a12109ddab559718ebbd457a7815 (diff) | |
| download | emacs-29878150b2f8783a607a70de0e34d313dafffdd6.tar.gz emacs-29878150b2f8783a607a70de0e34d313dafffdd6.zip | |
(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.
| -rw-r--r-- | lisp/progmodes/etags.el | 66 |
1 files changed, 28 insertions, 38 deletions
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index ea87dce591f..f6e8697543f 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el | |||
| @@ -1887,7 +1887,7 @@ directory specification." | |||
| 1887 | ;; XXX Kludge interface. | 1887 | ;; XXX Kludge interface. |
| 1888 | 1888 | ||
| 1889 | (define-button-type 'tags-select-tags-table | 1889 | (define-button-type 'tags-select-tags-table |
| 1890 | 'action (lambda (button) (select-tags-table-select)) | 1890 | 'action 'select-tags-table-select |
| 1891 | 'help-echo "RET, t or mouse-2: select tags table") | 1891 | 'help-echo "RET, t or mouse-2: select tags table") |
| 1892 | 1892 | ||
| 1893 | ;; XXX If a file is in multiple tables, selection may get the wrong one. | 1893 | ;; XXX If a file is in multiple tables, selection may get the wrong one. |
| @@ -1904,30 +1904,27 @@ see the doc of that variable if you want to add names to the list." | |||
| 1904 | (desired-point nil) | 1904 | (desired-point nil) |
| 1905 | b) | 1905 | b) |
| 1906 | (when tags-table-list | 1906 | (when tags-table-list |
| 1907 | (setq desired-point (point-marker)) | 1907 | (setq desired-point (point-marker)) |
| 1908 | (setq b (point)) | 1908 | (setq b (point)) |
| 1909 | (princ tags-table-list (current-buffer)) | 1909 | (princ (mapcar 'abbreviate-file-name tags-table-list) (current-buffer)) |
| 1910 | (make-text-button b (point) 'type 'tags-select-tags-table) | 1910 | (make-text-button b (point) 'type 'tags-select-tags-table |
| 1911 | (insert "\C-m") | 1911 | 'etags-table (car tags-table-list)) |
| 1912 | (prin1 (car tags-table-list) (current-buffer)) ;invisible | ||
| 1913 | (insert "\n")) | 1912 | (insert "\n")) |
| 1914 | (while set-list | 1913 | (while set-list |
| 1915 | (unless (eq (car set-list) tags-table-list) | 1914 | (unless (eq (car set-list) tags-table-list) |
| 1916 | (setq b (point)) | 1915 | (setq b (point)) |
| 1917 | (princ (car set-list) (current-buffer)) | 1916 | (princ (mapcar 'abbreviate-file-name (car set-list)) (current-buffer)) |
| 1918 | (make-text-button b (point) 'type 'tags-select-tags-table) | 1917 | (make-text-button b (point) 'type 'tags-select-tags-table |
| 1919 | (insert "\C-m") | 1918 | 'etags-table (car (car set-list))) |
| 1920 | (prin1 (car (car set-list)) (current-buffer)) ;invisible | ||
| 1921 | (insert "\n")) | 1919 | (insert "\n")) |
| 1922 | (setq set-list (cdr set-list))) | 1920 | (setq set-list (cdr set-list))) |
| 1923 | (when tags-file-name | 1921 | (when tags-file-name |
| 1924 | (or desired-point | 1922 | (or desired-point |
| 1925 | (setq desired-point (point-marker))) | 1923 | (setq desired-point (point-marker))) |
| 1926 | (setq b (point)) | 1924 | (setq b (point)) |
| 1927 | (insert tags-file-name) | 1925 | (insert (abbreviate-file-name tags-file-name)) |
| 1928 | (make-text-button b (point) 'type 'tags-select-tags-table) | 1926 | (make-text-button b (point) 'type 'tags-select-tags-table |
| 1929 | (insert "\C-m") | 1927 | 'etags-table tags-file-name) |
| 1930 | (prin1 tags-file-name (current-buffer)) ;invisible | ||
| 1931 | (insert "\n")) | 1928 | (insert "\n")) |
| 1932 | (setq set-list (delete tags-file-name | 1929 | (setq set-list (delete tags-file-name |
| 1933 | (apply 'nconc (cons (copy-sequence tags-table-list) | 1930 | (apply 'nconc (cons (copy-sequence tags-table-list) |
| @@ -1935,10 +1932,9 @@ see the doc of that variable if you want to add names to the list." | |||
| 1935 | tags-table-set-list))))) | 1932 | tags-table-set-list))))) |
| 1936 | (while set-list | 1933 | (while set-list |
| 1937 | (setq b (point)) | 1934 | (setq b (point)) |
| 1938 | (insert (car set-list)) | 1935 | (insert (abbreviate-file-name (car set-list))) |
| 1939 | (make-text-button b (point) 'type 'tags-select-tags-table) | 1936 | (make-text-button b (point) 'type 'tags-select-tags-table |
| 1940 | (insert "\C-m") | 1937 | 'etags-table (car set-list)) |
| 1941 | (prin1 (car set-list) (current-buffer)) ;invisible | ||
| 1942 | (insert "\n") | 1938 | (insert "\n") |
| 1943 | (setq set-list (delete (car set-list) set-list))) | 1939 | (setq set-list (delete (car set-list) set-list))) |
| 1944 | (goto-char (point-min)) | 1940 | (goto-char (point-min)) |
| @@ -1951,7 +1947,8 @@ see the doc of that variable if you want to add names to the list." | |||
| 1951 | (select-tags-table-mode)) | 1947 | (select-tags-table-mode)) |
| 1952 | 1948 | ||
| 1953 | (defvar select-tags-table-mode-map | 1949 | (defvar select-tags-table-mode-map |
| 1954 | (let ((map (copy-keymap button-buffer-map))) | 1950 | (let ((map (make-sparse-keymap))) |
| 1951 | (set-keymap-parent map button-buffer-map) | ||
| 1955 | (define-key map "t" 'push-button) | 1952 | (define-key map "t" 'push-button) |
| 1956 | (define-key map " " 'next-line) | 1953 | (define-key map " " 'next-line) |
| 1957 | (define-key map "\^?" 'previous-line) | 1954 | (define-key map "\^?" 'previous-line) |
| @@ -1960,24 +1957,17 @@ see the doc of that variable if you want to add names to the list." | |||
| 1960 | (define-key map "q" 'select-tags-table-quit) | 1957 | (define-key map "q" 'select-tags-table-quit) |
| 1961 | map)) | 1958 | map)) |
| 1962 | 1959 | ||
| 1963 | (defun select-tags-table-mode () | 1960 | (define-derived-mode select-tags-table-mode fundamental-mode "Select Tags Table" |
| 1964 | "Major mode for choosing a current tags table among those already loaded. | 1961 | "Major mode for choosing a current tags table among those already loaded. |
| 1965 | 1962 | ||
| 1966 | \\{select-tags-table-mode-map}" | 1963 | \\{select-tags-table-mode-map}" |
| 1967 | (interactive) | 1964 | (setq buffer-read-only t)) |
| 1968 | (kill-all-local-variables) | 1965 | |
| 1969 | (setq buffer-read-only t | 1966 | (defun select-tags-table-select (button) |
| 1970 | major-mode 'select-tags-table-mode | ||
| 1971 | mode-name "Select Tags Table") | ||
| 1972 | (use-local-map select-tags-table-mode-map) | ||
| 1973 | (setq selective-display t | ||
| 1974 | selective-display-ellipses nil)) | ||
| 1975 | |||
| 1976 | (defun select-tags-table-select () | ||
| 1977 | "Select the tags table named on this line." | 1967 | "Select the tags table named on this line." |
| 1978 | (interactive) | 1968 | (interactive (list (or (button-at (line-beginning-position)) |
| 1979 | (search-forward "\C-m") | 1969 | (error "No tags table on current line")))) |
| 1980 | (let ((name (read (current-buffer)))) | 1970 | (let ((name (button-get button 'etags-table))) |
| 1981 | (visit-tags-table name) | 1971 | (visit-tags-table name) |
| 1982 | (select-tags-table-quit) | 1972 | (select-tags-table-quit) |
| 1983 | (message "Tags table now %s" name))) | 1973 | (message "Tags table now %s" name))) |
| @@ -2043,5 +2033,5 @@ for \\[find-tag] (which see)." | |||
| 2043 | 2033 | ||
| 2044 | (provide 'etags) | 2034 | (provide 'etags) |
| 2045 | 2035 | ||
| 2046 | ;;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e | 2036 | ;; arch-tag: b897c2b5-08f3-4837-b2d3-0e7d6db1b63e |
| 2047 | ;;; etags.el ends here | 2037 | ;;; etags.el ends here |