Function: cperl-write-tags

cperl-write-tags is a byte-compiled function defined in cperl-mode.el.gz.

Signature

(cperl-write-tags &optional FILE ERASE RECURSE DIR INBUFFER NOXS TOPDIR)

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/cperl-mode.el.gz
(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
  ;; If INBUFFER, do not select buffer, and do not save
  ;; If ERASE is `ignore', do not erase, and do not try to delete old info.
  (require 'etags)
  (if file nil
    (setq file (if dir default-directory (buffer-file-name)))
    (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
  (or topdir
      (setq topdir default-directory))
  (let ((tags-file-name cperl-tags-file-name)
        (inhibit-read-only t)
	(case-fold-search nil)
	xs rel)
    (save-excursion
      (cond (inbuffer nil)		; Already there
	    ((file-exists-p tags-file-name)
	     (visit-tags-table-buffer tags-file-name))
	    (t
             (set-buffer (find-file-noselect tags-file-name))))
      (cond
       (dir
	(cond ((eq erase 'ignore))
	      (erase
	       (erase-buffer)
	       (setq erase 'ignore)))
	(let ((files
	       (condition-case nil
		   (directory-files file t
				    (if recurse nil cperl-scan-files-regexp)
				    t)
		 (error
		  (if cperl-unreadable-ok nil
		    (if (y-or-n-p
			 (format "Directory %s unreadable.  Continue? " file))
			(progn
                          (setq cperl-unreadable-ok t)
                          nil)	; Return empty list
		      (error "Aborting: unreadable directory %s" file)))))))
          (mapc (lambda (file)
                  (cond
                   ((string-match cperl-noscan-files-regexp file)
                    nil)
                   ((not (file-directory-p file))
                    (if (string-match cperl-scan-files-regexp file)
                        (cperl-write-tags file erase recurse nil t noxs topdir)))
                   ((not recurse) nil)
                   (t (cperl-write-tags file erase recurse t t noxs topdir))))
		files)))
       (t
	(setq xs (string-match "\\.xs$" file))
	(if (not (and xs noxs))
	    (progn
	      (cond ((eq erase 'ignore) (goto-char (point-max)))
		    (erase (erase-buffer))
		    (t
		     (goto-char 1)
		     (setq rel file)
		     ;; On case-preserving filesystems case might be encoded in properties
		     (set-text-properties 0 (length rel) nil rel)
		     (and (equal topdir (substring rel 0 (length topdir)))
			  (setq rel (substring file (length topdir))))
		     (if (search-forward (concat "\f\n" rel ",") nil t)
			 (progn
			   (search-backward "\f\n")
			   (delete-region (point)
					  (save-excursion
					    (forward-char 1)
					    (if (search-forward "\f\n"
								nil 'toend)
						(- (point) 2)
					      (point-max)))))
		       (goto-char (point-max)))))
	      (insert (cperl-find-tags file xs topdir))))))
      (if inbuffer nil			; Delegate to the caller
	(save-buffer 0)			; No backup
	(if (fboundp 'initialize-new-tags-table)
	    (initialize-new-tags-table))))))