⟦ffe1fdec9⟧

TextFile

;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ada-tag.el --- Online ada documentation lookup, environment independent
;; Author          : Lynn Slater
;; Created On      : Tue Mar 22 15:27:04 1988
;; Last Modified By: Lynn Slater
;; Last Modified On: Tue Oct 18 07:03:17 1988
;; Update Count    : 54
;; Status          : General Public Release 1.05
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file is part of GNU Emacs.
;; Copyright (C) 1988 Lynn Randolph Slater, Jr.
;; Copyright (C) 1988 Free Software Foundation, Inc.
;;
;; This file is distributed in the hope that it will be useful,
;; but without any warranty.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.
;;
;; Everyone is granted permission to copy, modify and redistribute
;; this file, but only under the conditions described in the
;; document "GNU Emacs copying permission notice".   An exact copy
;; of the document is supposed to have been given to you along with
;; this file so that you can know how you may redistribute it all.
;; It should be in a file named COPYING.  Among other things, the
;; copyright notice and this notice must be preserved on all copies.

;; Make this file ada-tag.el, byte-compile it in your path

;; History 		
;; 7-Oct-1988		Lynn Slater	
;;    Totally rewrote ada-lookup-last-error to not need special support by
;;    next-error. It now displays the compiler error message in the
;;    online manual buffer rather than troi-splitting the screen.
;; 5-Oct-1988		Lynn Slater	
;;    Removed redefinition of next-error, etc as the new emacs will have this

(provide 'ada-tag)
(require 'location)
(if (not (fboundp 'file-of-tag))
    (load "tags" t nil))

;; experimental grep command
;; (grep "\"^ *[1-9][0-9]*\\.[0-9]* *[A-Z][a-z]\" chap*.doc.1")

;; Below are the functions that were used to make the tag file
;; To make the tags data, run the below on each of the
;; chap*.doc.1 files
;;->(defun what-line-number ()
;;->  "Print the current line number (in the buffer) of point."
;;->  (interactive)
;;->  (save-restriction
;;->    (widen)
;;->    (save-excursion
;;->      (beginning-of-line)
;;->      (1+ (count-lines 1 (point))))))
;;->
;;->(defun tag-file ()
;;->  "Turns a Ada manual file into a tag file format"
;;->  (interactive)
;;->  (beginning-of-buffer)
;;->  (with-output-to-temp-buffer "*temp*"
;;->    (princ (format "\f

\n%s,<here>\n" (buffer-file-name)))
;;->    (while (re-search-forward
;;->	     "^\n\\([ \t]+[0-9]+\\.[ \t]+[A-Z]\\|[0-9]+\\.[0-9\\.]+[ \t]+[A-Z]\\)"
;;->	     nil t)
;;->      (beginning-of-line)
;;->      (princ (concat (buffer-substring (point)
;;->				       (save-excursion (end-of-line) (point)))
;;->		     "▶7f◀"
;;->		     (format "%d,%d" (what-line-number) (1+ (match-beginning 0)))
;;->		     "\n"))
;;->      ;;(sit-for 1)
;;->      )
;;->    (save-excursion
;;->      (switch-to-buffer "*temp*")
;;->      (re-search-backward "<here>")
;;->      (goto-char (match-beginning 0))
;;->      (kill-line 1)
;;->      (insert
;;->	(format "%d\n" (- (save-excursion
;;->			    (replace-string "\r" "" nil)
;;->			    (end-of-buffer) (point)) (point))))
;;->      )))

;; (defun back-to-whitespace ()
;;   (while (or (= (char-syntax (preceding-char)) ?w)
;; 	     (= (preceding-char) ?.)
;; 	     )
;;     (backward-char 1)))
;; 
;; (defun forward-to-whitespace ()
;;   (while (or (= (char-syntax (following-char)) ?w)
;; 	     (= (following-char) ?.))
;;     (forward-char 1)))
;; 

(defun find-ada-tag (tagname &optional interactive)
  "Finds the current or next reference to a chapter/section number in the
   current buffer."  
  (if (and interactive
	   (or (not tagname) (equal tagname "")))
      (setq tagname (read-string interactive)))
  (if (equal tagname "")
      (setq tagname (ada-get-section-tag)))
  (if interactive (list tagname) tagname))

(defun ada-get-section-tag ()
  ;;(interactive)
  "Returns a string that is the current or next usage of an ada
       section number."
  ;; go back to start of this entry
  (while (or (= (char-syntax (preceding-char)) ?w)
	     (= (preceding-char) ?.)
	     )
    (backward-char 1))
  (re-search-forward "[0-9]+\\(\\.[0-9]+\\)*")
  (forward-char 1)
  (buffer-substring (match-beginning 0) (match-end 0)))

(defun visit-adaman-table-buffer ()
  "Select the buffer containing the current tag table.
This is a file whose name found by (adaman-tags-file-name)."
  (set-buffer (or (get-file-buffer (adaman-tags-file-name))
		  (progn
		    (setq tag-table-files nil)
		    (find-file-noselect (adaman-tags-file-name))))))

(defun adaman-tags-file-name ()
  "Name of the file containing tag info on the online ada language reference.
   Uses variable ada-online-manual-directory."
  (expand-file-name "TAGS" ada-online-manual-directory))

(defun adaman-index-file-name ()
  "This is the name of the file searched by the index command.
   Uses variable ada-online-manual-directory."
  (expand-file-name "index.doc.1" ada-online-manual-directory))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User visible fcns
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar ada-online-manual-directory "/tools/ada-source/ansi-lrm"
  "Name of the directory containing  the online ada language reference.
   This directory is expected to contain the files TAGS and index.doc.1")

;;-18.49-> (defun adaman (tagname &optional next other-window) ;; end user command
;;-18.49->   "Find chapter/section in ADA language-reference whose number
;;-18.49->        contains TAGNAME. Selects the buffer that the tag is contained in 
;;-18.49->        and puts point at its definition.
;;-18.49->    If called interactively, or TAGNAME is a null string, the buffer is
;;-18.49->        searched for the next numeric sequence that might be a section number.
;;-18.49->    Also searches for strings, and uses \\[tags-loop-continue]
;;-18.49-> 
;;-18.49->    See documentation of function (adaman-tags-file-name)."
;;-18.49->   (interactive (if current-prefix-arg
;;-18.49-> 		   '(nil t)
;;-18.49-> 		   (find-ada-tag nil "Find Ada manual chapter.section: ")))
;;-18.49->   (setq tagname (find-tag-tag tagname))
;;-18.49->   (let (buffer file linebeg startpos)
;;-18.49->     (save-excursion
;;-18.49->      (visit-adaman-table-buffer)
;;-18.49->      (if (not next)
;;-18.49-> 	 (goto-char (point-min))
;;-18.49->        (setq tagname last-tag))
;;-18.49->      (setq last-tag tagname)
;;-18.49->      (while (progn
;;-18.49-> 	      (if (and (>= (aref tagname 0) ?0) (<= (aref tagname 0) ?9))
;;-18.49-> 		  (re-search-forward (concat "^[ \t]*" (regexp-quote tagname)))
;;-18.49-> 		(search-forward tagname))
;;-18.49-> 	      (not (looking-at "[^\n\177]*\177"))))
;;-18.49->      (search-forward "\177")
;;-18.49->      (setq file (expand-file-name (file-of-tag)
;;-18.49-> 				  ada-online-manual-directory
;;-18.49-> 				  ))
;;-18.49->      (setq linebeg
;;-18.49-> 	   (buffer-substring (1- (point))
;;-18.49-> 			     (save-excursion (beginning-of-line) (point))))
;;-18.49->      (search-forward ",")
;;-18.49->      (setq startpos (read (current-buffer))))
;;-18.49->     (if (not next) (record-user-location)) ;; lrs
;;-18.49->     
;;-18.49->   ;; shadow some mode and file variable definitions
;;-18.49->   (let ((default-major-mode 'ada-mode)
;;-18.49-> 	(inhibit-local-variables t)
;;-18.49-> 	(auto-mode-alist nil))
;;-18.49->     (if other-window
;;-18.49-> 	(find-file-other-window file)
;;-18.49->       (find-file file))
;;-18.49->     (setq buffer-read-only t))
;;-18.49->     
;;-18.49->     (widen)
;;-18.49->     (push-mark)
;;-18.49->     (let ((offset 1000)
;;-18.49-> 	  found
;;-18.49-> 	  (pat (concat "^" (regexp-quote linebeg))))
;;-18.49->       (or startpos (setq startpos (point-min)))
;;-18.49->       (while (and (not found)
;;-18.49-> 		  (progn
;;-18.49-> 		   (goto-char (- startpos offset))
;;-18.49-> 		   (not (bobp))))
;;-18.49-> 	(setq found
;;-18.49-> 	      (re-search-forward pat (+ startpos offset) t))
;;-18.49-> 	(setq offset (* 3 offset)))
;;-18.49->       (or found
;;-18.49-> 	  (re-search-forward pat)))
;;-18.49->     (beginning-of-line))
;;-18.49->   (setq tags-loop-form '(adaman nil t))
;;-18.49->   ;; Return t in case used as the tags-loop-form.
;;-18.49->   t)

(defun adaman (tagname &optional next other-window) ;; 18.51 version
  "Find tag (in current tag table) whose name contains TAGNAME.
 Selects the buffer that the tag is contained in
and puts point at its definition.
 If TAGNAME is a null string, the expression in the buffer
around or before point is used as the tag name.
 If second arg NEXT is non-nil (interactively, with prefix arg),
searches for the next tag in the tag table
that matches the tagname used in the previous find-tag.

See documentation of variable tags-file-name."
  (interactive (if current-prefix-arg
		   '(nil t)
		 ;; changed for adaman by lrs
		 (find-ada-tag nil "Find Ada manual chapter.section: ")))
  ;;(setq tagname (find-tag-tag tagname))
  (let (buffer file linebeg startpos)
    (save-excursion
     (visit-adaman-table-buffer) ;; changed for adaman by lrs
     (if (not next)
	 (goto-char (point-min))
       (setq tagname last-tag))
     (setq last-tag tagname)
     (while (progn
	      ;; changed for adaman by lrs
	      (if (and (>= (aref tagname 0) ?0) (<= (aref tagname 0) ?9))
		  ;; numeric tag
		  (re-search-forward (concat "^[ \t]*" (regexp-quote tagname)))
		(if (not (search-forward tagname nil t))
		    (error "No %sentries containing %s"
			   (if next "more " "") tagname)))
	      (not (looking-at "[^\n\177]*\177"))))
     (search-forward "\177")
     (setq file (expand-file-name (file-of-tag)
				  ada-online-manual-directory
				  ))
     (setq linebeg
	   (buffer-substring (1- (point))
			     (save-excursion (beginning-of-line) (point))))
     (search-forward ",")
     (setq startpos (read (current-buffer))))
    (if (not next) (record-user-location)) ;; lrs

  ;; shadow some mode and file variable definitions
  (let ((default-major-mode 'ada-mode) ;; changed for adaman by lrs
	(inhibit-local-variables t)
	(auto-mode-alist nil))
    (if other-window
	(find-file-other-window file)
      (find-file file))
    (setq buffer-read-only t))

    (widen)
    (push-mark)
    (let ((offset 1000)
	  found
	  (pat (concat "^" (regexp-quote linebeg))))
      (or startpos (setq startpos (point-min)))
      (while (and (not found)
		  (progn
		   (goto-char (- startpos offset))
		   (not (bobp))))
	(setq found
	      (re-search-forward pat (+ startpos offset) t))
	(setq offset (* 3 offset)))
      (or found
	  (re-search-forward pat nil t)
	  (error "%s not found in %s" pat file)))
    (beginning-of-line))
  (setq tags-loop-form '(adaman nil t)) ;; changed for adaman by lrs
  ;; Return t in case used as the tags-loop-form.
  t)


(defun index (keyphrase)  ;; end user command
  "Looks in the Ada language manual index for the keyphrase.
   Uses the file found by (adaman-index-file-name).
   You can look at each entry with the \\[next-error] command.
   If you then want to look at the source, use the \\[adaman] command."
  (interactive "sKeyphrase: ")
  (record-user-location)
  (grep (format "-i \"%s\" %s" keyphrase (adaman-index-file-name)))
  (sit-for 2)
  (next-error))

(defun search-adaman (command);; end user command
  "Run grep on all Ada language reference documentation. This is more
     powerful than index in that this function searches the entire
     language reference.
   While grep runs asynchronously, you can use the \\[next-error] command
   to find the text that grep hits refer to."
  (interactive "sSearch Ada online reference for which pattern?: ")
  (require 'dired-ada);; for defn of compile1-silent
  (compile1 (concat "grep -n -i  \"" command "\" "
		    ada-online-manual-directory "/*.doc.* /dev/null")
	    "No more grep hits" "grep"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following changes are compatable with these are now going to be in
;; standard emacs.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-last-error-message ()
  "Returns a string holding the last error message"
  (if (or (null (car compilation-last-error))
	  (null (marker-buffer (car compilation-last-error))))
      nil
    (save-excursion
      (set-buffer (marker-buffer (car compilation-last-error)))
      (save-excursion
	(goto-char (marker-position (car compilation-last-error)))
	(beginning-of-line);; start of error
	;; now, find the end of the error message
	(buffer-substring (point)
			  (if (not (car (car compilation-error-list)));; the next error
			      compilation-parsing-end
			    (marker-position (car (car compilation-error-list)))))))))

(defun get-last-referenced-manual-section ()
  (save-excursion
    (set-buffer (marker-buffer (car compilation-last-error)))
    ;; save-excursion?
    (goto-char (marker-position (car compilation-last-error)))
    (let ((case-fold-search nil))
 	(if (re-search-forward "RM \\([^(:]+\\)"
 			       (save-excursion (end-of-line))
 			       t)
	    (buffer-substring (match-beginning 1) (match-end 1))))))

;;(get-last-error-message)	
;;(get-last-referenced-manual-section)  

(defvar ada-inserted-errors (cons (make-marker) (make-marker)))

(defun ada-remove-last-inserted-error ()
  (if (marker-buffer (car ada-inserted-errors))
      (save-excursion
	(set-buffer (marker-buffer (car ada-inserted-errors)))
	(let ((buffer-read-only nil)
	      (modified-p (buffer-modified-p)))
	  (delete-region (marker-position (car ada-inserted-errors))
			 (marker-position (cdr ada-inserted-errors)))
	  (set-marker (car ada-inserted-errors) nil)
	  (set-marker (cdr ada-inserted-errors) nil)
	  (if (null modified-p) (set-buffer-modified-p nil))
	))))

(defun ada-lookup-last-error ()
  "Looks at the last error found by next-error, and tries to find the
   appropiate  Ada manual section on the assumption that the error is in VADS
   format.
This function makes some strong presumptions on how your windows will look. 
   I will try to think of a better way, but for now this must remain."
  (interactive)
  (ada-remove-last-inserted-error)
  (let ((message (get-last-error-message))
	section)
    (if (null message) (error "There is no last error message to lookup!"))

    (setq section (get-last-referenced-manual-section))
    (if (null section) (error "There was no reference to the Ada manual in the last error"))

    ;; bring up the error, in the same window as the last error message, or
    ;; in the other window
    (if (get-buffer-window "*compilation*")
	(select-window (get-buffer-window "*compilation*"))
      (delete-other-windows)
      (split-window)
      (other-window 1))
    (adaman section)
    ;; Ok, we are in the reference manual. Insert the message
    (let ((buffer-read-only nil)
	  (modified-p (buffer-modified-p)))
      (setq buffer-auto-save-file-name nil)
      (set-marker (car ada-inserted-errors) (point) (current-buffer))
      (insert "\n                                        -*-\n"
	      message
	      "                                        -*-\n")
      (set-marker (cdr ada-inserted-errors) (point) (current-buffer))
      (if (null modified-p) (set-buffer-modified-p nil))
      )))
 
(global-set-key "\e`" 'ada-lookup-last-error)
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦ffe1fdec9⟧ TextFile

Derivation

TextFile
