aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2005-10-10 17:49:12 +0000
committerStefan Monnier2005-10-10 17:49:12 +0000
commit29878150b2f8783a607a70de0e34d313dafffdd6 (patch)
tree4d22dfb831f92ef0ad400e60c81a82ff02a3ddd7
parente61d3a566185a12109ddab559718ebbd457a7815 (diff)
downloademacs-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.el66
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