/[emacs]/emacs/lisp/progmodes/etags.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/etags.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.188 by rfrancoise, Sat Sep 24 13:43:58 2005 UTC revision 1.189 by monnier, Mon Oct 10 17:49:12 2005 UTC
# Line 1887  directory specification." Line 1887  directory specification."
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.
# Line 1904  see the doc of that variable if you want Line 1904  see the doc of that variable if you want
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)
# Line 1935  see the doc of that variable if you want Line 1932  see the doc of that variable if you want
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))
# Line 1951  see the doc of that variable if you want Line 1947  see the doc of that variable if you want
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)
# Line 1960  see the doc of that variable if you want Line 1957  see the doc of that variable if you want
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)))
# Line 2043  for \\[find-tag] (which see)." Line 2033  for \\[find-tag] (which see)."
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

Legend:
Removed from v.1.188  
changed lines
  Added in v.1.189

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26