(defun b-xref ()
  (interactive)
  (fundamental-mode)
  (save-excursion
    (save-restriction
      (widen)
      (mapcar
       'b-xref-do-jots
       (b-xref-buffer (current-buffer)))))
  nil)
(defvar b-xref-bin "perl")
(defvar b-xref-jot ">")
(defvar b-xref-fill "|")
(defvar b-xref-fill-space " ")

(require 'cl)
(defsubst min-list (list) (reduce 'min list))
(defsubst max-list (list) (reduce 'max list))
(defsubst line->point (line)
  (goto-line line)
  (point))
(defun b-xref-do-jots (pair)
  "Make space for jots and call `b-xref-jot-line' to place them."
  (string-rectangle (point-min)
 		    (progn (goto-char (point-max))
 			   (beginning-of-line)
 			   (point))
 		    b-xref-fill-space)
  (let ((lines (cdr pair)))
    (let ((min-line (min-list lines))
	  (max-line (max-list lines)))
      (delete-rectangle (line->point min-line)
			(+ 1 (line->point max-line)))
      (string-rectangle (line->point min-line)
			(line->point max-line)
			b-xref-fill)
      (mapcar 'b-xref-jot-line lines))))
(defun b-xref-jot-line (line)
  "Jot a note on LINE."
  (goto-char (line->point line))
  (delete-char 1)
  (insert b-xref-jot))



(defun b-xref-buffer (buffer)
  "Runs a buffer through 'perl -MO=Xref,-raw' and returns the parsed data."
  (save-excursion
    (save-restriction
      (set-buffer buffer)
      (widen)
      (goto-char (point-min))
      (let ((perl (if (looking-at auto-mode-interpreter-regexp)
		      (match-string 2)
		    (or b-xref-bin "perl")))
 	    (infile (if (buffer-modified-p)
 			(error "TODO: Copy modified buffer to temp file.")
 		      (buffer-file-name)))
 	    (buffer (generate-new-buffer "*b-xref-raw*")))
 	(let ((rc (call-process perl infile buffer nil "-MO=Xref,-raw")))
 	  (or (zerop rc)
 	      (error "%s exited with %d" perl rc)))
 	(let ((xref-output (b-xref-read-raw buffer "-")))
 	  (kill-buffer buffer)
 	  xref-output)))))

(defun b-xref-list-> (a b)
  "Sorts a list so larger numbers go first, then shorter lists."
  (if (and (numberp (car a))
	   (numberp (car b)))
      (or (> (car a) (car b))
	  (and (= (car a) (car b))
	       (b-xref-list-> (cdr a) (cdr b))))
    (and (null a)
 	 (not (null b)))))
(defun b-xref-alist-> (a b)
  "Sorts the elements of an alist with `b-xref-list->'"
  (b-xref-list-> (cdr a) (cdr b)))
(defun trim (str) (rtrim (ltrim str)))
(defun ltrim (str) (replace-regexp-in-string "^ +" "" str))
(defun rtrim (str) (replace-regexp-in-string " +$" "" str))
(defun b-xref-read-raw (buffer filename)
  "Reads the output from 'perl -MO=Xref,-raw'."
  (save-excursion
    (save-restriction
      (set-buffer buffer)
      (widen)
      (goto-char (point-min))
      (let ((xref-regexp (concat "^"
 				 (regexp-quote filename)
 				 (let ((pad (- 16 (length filename))))
 				   (if (> pad 0)
 				       (make-string pad ? )
 				     ""))
 				 " ............[^ \n]*"
 				 " \\(.....[^ \n]*\\)"
 				 " \\(............[^ \n]*\\)"
 				 " ....[^ \n]*"
 				 " \\(................[^ \n]*\\)"
 				 " \\([^\n]+\\)\n"))
 	    (xref-output ()))
 	(while (re-search-forward xref-regexp nil t)
 	  (or (bolp) (forward-line))
 	  (let ((line (string-to-number (trim (match-string 1))))
 		(pack (trim (match-string 2)))
 		(name (trim (match-string 3))))
 	    (if (zerop line)
 		nil
 	      (let ((key (list pack name)))
 		(let ((pair (assoc key xref-output)))
 		  (if pair
 		      (let ((lines (cdr pair)))
 			(or (member line lines) 
 			    (nconc lines (list line))))
 		    (push (cons key (list line)) xref-output)))))))
 	(sort xref-output 'b-xref-alist->)))))