comparison lisp/progmodes/etags.el @ 36736:2eea125a1272

2001-03-12 Philippe Waroquiers <[e-mail]> * progmodes/etags.el (tags-compression-info-list): New variable. (find-tag-in-order): Use it to deal with compressed source files. (tag-file-name-match-p): New function. (etags-recognize-tags-table): Use it for better match of file names.

36735:e8c547e94600

To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
Use the `etags' program to make a tags table file."
  :group 'etags
  :type '(repeat file))

;;;###autoload
(defcustom tags-add-tables 'ask-user
  "*Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).

      (beginning-of-line)
      (setq tag-lines-already-matched (cons match-marker
					    tag-lines-already-matched))
      ;; Expand the filename, using the tags table buffer's default-directory.
      ;; We should be able to search for file-name backwards in file-of-tag:
      ;; the beginning-of-line is ok except when positionned on a "file-name" tag.
      (setq file (expand-file-name
                  (if (or (eq (car order) 'tag-exact-file-name-match-p)
                          (eq (car order) 'tag-partial-file-name-match-p))
                      (save-excursion (next-line 1)
                                      (file-of-tag))
                    (file-of-tag)))
	    tag-info (funcall snarf-tag-function))

      ;; Get the local value in the tags table buffer before switching buffers.
      (setq goto-func goto-tag-location-function)

      ;; Find the right line in the specified file.
      (set-buffer (find-file-noselect file))
      (widen)
      (push-mark)
      (funcall goto-func tag-info)

      ;; Return the buffer where the tag was found.

	       (find-tag-regexp-search-function . re-search-forward)
	       (find-tag-regexp-tag-order . (tag-re-match-p))
	       (find-tag-regexp-next-line-after-failure-p . t)
	       (find-tag-search-function . search-forward)
	       (find-tag-tag-order . (tag-exact-file-name-match-p
				      tag-exact-match-p
				      tag-symbol-match-p
				      tag-word-match-p
				      tag-partial-file-name-match-p
				      tag-any-match-p))

(defun tag-word-match-p (tag)
  (and (looking-at "\\b.*\177")
       (save-excursion (backward-char (length tag))
		       (looking-at "\\b"))))

(defun tag-exact-file-name-match-p (tag)
  (and (looking-at ",")
       (save-excursion (backward-char (+ 2 (length tag)))
		       (looking-at "\f\n"))))
(defun tag-partial-file-name-match-p (tag)
  (and (looking-at ".*,")
       (save-excursion (beginning-of-line)
                       (backward-char 2)
  		       (looking-at "\f\n"))))

`tags-case-fold-search'."
  (let ((case-fold-search (if (memq tags-case-fold-search '(t nil))
			      tags-case-fold-search
			    case-fold-search)))
    (eval form)))
  

;;;###autoload
(defun tags-loop-continue (&optional first-time)
  "Continue last \\[tags-search] or \\[tags-query-replace] command.
Used noninteractively with non-nil argument to begin such a command (the

36736:2eea125a1272

To switch to a new list of tags tables, setting this variable is sufficient.
If you set this variable, do not also set `tags-file-name'.
Use the `etags' program to make a tags table file."
  :group 'etags
  :type '(repeat file))

;;;###autoload
(defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz")
  "*List of extensions tried by etags when jka-compr is used.
An empty string means search the non-compressed file.
These extensions will be tried only if jka-compr was activated
(i.e. via customize of auto-compression-mode or by calling the function
auto-compression-mode)."
  :type  'sexp ;;; what should be put here to have a list of strings ?
  :group 'etags)

;;; !!! tags-compression-info-list should probably be replaced by access
;;; to directory list and matching jka-compr-compression-info-list. Currently,
;;; this implementation forces each modification of
;;; jka-compr-compression-info-list to be reflected in this var.
;;; An alternative could be to say that introducing a special
;;; element in this list (e.g. t) means : try at this point
;;; using directory listing and regexp matching using
;;; jka-compr-compression-info-list.


;;;###autoload
(defcustom tags-add-tables 'ask-user
  "*Control whether to add a new tags table to the current list.
t means do; nil means don't (always start a new list).

      (beginning-of-line)
      (setq tag-lines-already-matched (cons match-marker
					    tag-lines-already-matched))
      ;; Expand the filename, using the tags table buffer's default-directory.
      ;; We should be able to search for file-name backwards in file-of-tag:
      ;; the beginning-of-line is ok except when positioned on a "file-name" tag.
      (setq file (expand-file-name
		  (if (memq (car order) '(tag-exact-file-name-match-p
					  tag-file-name-match-p
					  tag-partial-file-name-match-p))
                      (save-excursion (next-line 1)
                                      (file-of-tag))
                    (file-of-tag)))
	    tag-info (funcall snarf-tag-function))

      ;; Get the local value in the tags table buffer before switching buffers.
      (setq goto-func goto-tag-location-function)

      ;; Find the right line in the specified file.
      ;; If we are interested in compressed-files,
      ;; we search files with extensions.
      ;; otherwise only the real file.
      (let* ((buffer-search-extensions (if (featurep 'jka-compr)
                                           tags-compression-info-list
                                         '("")))
             the-buffer
             (file-search-extensions buffer-search-extensions))
	;; search a buffer visiting the file with each possible extension
	;; Note: there is a small inefficiency in find-buffer-visiting :
	;;   truename is computed even if not needed. Not too sure about this
	;;   but I suspect truename computation accesses the disk.
	;;   It is maybe a good idea to optimise this find-buffer-visiting.
	;; An alternative would be to use only get-file-buffer
	;; but this looks less "sure" to find the buffer for the file.
	(while (and (not the-buffer) buffer-search-extensions)
	  (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions))))
	  (setq buffer-search-extensions (cdr buffer-search-extensions)))
	;; if found a buffer but file modified, ensure we re-read !
	(if (and the-buffer (not (verify-visited-file-modtime the-buffer)))
	    (find-file-noselect (buffer-file-name the-buffer)))
	;; if no buffer found, search for files with possible extensions on disk
	(while (and (not the-buffer) file-search-extensions)
	  (if (not (file-exists-p (concat file (car file-search-extensions))))
	      (setq file-search-extensions (cdr file-search-extensions))
	    (setq the-buffer (find-file-noselect (concat file (car file-search-extensions))))))
	(if (not the-buffer)
	    (if (featurep 'jka-compr)
		(error "File %s (with or without extensions %s) not found" file tags-compression-info-list)
	      (error "File %s not found" file))
	  (set-buffer the-buffer)))
      (widen)
      (push-mark)
      (funcall goto-func tag-info)

      ;; Return the buffer where the tag was found.

	       (find-tag-regexp-search-function . re-search-forward)
	       (find-tag-regexp-tag-order . (tag-re-match-p))
	       (find-tag-regexp-next-line-after-failure-p . t)
	       (find-tag-search-function . search-forward)
	       (find-tag-tag-order . (tag-exact-file-name-match-p
                                      tag-file-name-match-p
				      tag-exact-match-p
				      tag-symbol-match-p
				      tag-word-match-p
				      tag-partial-file-name-match-p
				      tag-any-match-p))

(defun tag-word-match-p (tag)
  (and (looking-at "\\b.*\177")
       (save-excursion (backward-char (length tag))
		       (looking-at "\\b"))))

;;; exact file name match, i.e. searched tag must match complete file
;;; name including directories parts if there are some.
(defun tag-exact-file-name-match-p (tag)
  (and (looking-at ",")
       (save-excursion (backward-char (+ 2 (length tag)))
		       (looking-at "\f\n"))))
;;; file name match as above, but searched tag must match the file
;;; name not including the directories if there are some.
(defun tag-file-name-match-p (tag)
  (and (looking-at ",")
       (save-excursion (backward-char (1+ (length tag)))
		       (looking-at "/"))))
;;; this / to detect we are after a directory separator is ok for unix,
;;; is there a variable that contains the regexp for directory separator
;;; on whatever operating system ?
;;; Looks like ms-win will lose here :).

;;; partial file name match, i.e. searched tag must match a substring
;;; of the file name (potentially including a directory separator).
(defun tag-partial-file-name-match-p (tag)
  (and (looking-at ".*,")
       (save-excursion (beginning-of-line)
                       (backward-char 2)
  		       (looking-at "\f\n"))))

`tags-case-fold-search'."
  (let ((case-fold-search (if (memq tags-case-fold-search '(t nil))
			      tags-case-fold-search
			    case-fold-search)))
    (eval form)))


;;;###autoload
(defun tags-loop-continue (&optional first-time)
  "Continue last \\[tags-search] or \\[tags-query-replace] command.
Used noninteractively with non-nil argument to begin such a command (the