home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / dev / misc / FetchRefs1.3.lha / FetchRefs1.3 / Scripts / FetchRefs.el < prev    next >
Encoding:
Text File  |  1996-02-24  |  5.5 KB  |  183 lines
  1. ;;
  2. ;;  FILE
  3. ;;      fetchrefs.el    $VER: V1.00 fetchrefs.el
  4. ;;
  5. ;;  DESCRIPTION
  6. ;;      Script for integrating the 'FetchRefs' Utility, used for getting 
  7. ;;      quick online help for Autodocs and Includes, into EMACS 18.59.
  8. ;;      FetchRefs is written by Anders Melchiorsen and can be found on
  9. ;;      Aminet in 'dev/misc'.
  10. ;;
  11. ;;  FEATURES
  12. ;;      The main function to call is 'fetch-get-keyword', which fetches
  13. ;;      the word underneath the cursor (similar to find-tag call).
  14. ;;      'fetch-stop' stops 'FetchRefs'.
  15. ;;      Automatic invocation of 'FetchRefs' if 'FETCHREFS' ARexx port
  16. ;;      not found. Reference text is placed in a seperate buffer named
  17. ;;      *reference*. The text transfer is realised through the clipboard
  18. ;;      with (amiga-paste) so the text is also in the kill-ring and can
  19. ;;      be accessed through 'yank' or 'yank-pop'.
  20. ;;       
  21. ;;
  22. ;;  INSTALLATION
  23. ;;      Copy this file to a lisp-directory, for example Gnuemacs:lisp
  24. ;;
  25. ;;      Edit the following:
  26. ;;         (defconst fetch-index-file < "YOUR FETCHREFS INDEX FILE" >)
  27. ;;         
  28. ;;      Note: you may have several index files delimited by blanks.
  29. ;;      Make sure 'FetchRefs' is in your path, or edit
  30. ;;         (defconst fetch-run-command ...)
  31. ;;
  32. ;;      Put something like the following lines in your s:.emacs file
  33. ;;
  34. ;;       (autoload 'fetch-get-keyword "fetchrefs.el" nil t)
  35. ;;       (define-key global-map "\C-x\C-^1~" 'fetch-get-keyword) /* F2 */
  36. ;;       (define-key global-map "\C-x\C-^11~" 'fetch-stop)     /* SHIFT F2 */
  37. ;;
  38. ;;
  39. ;;
  40. ;;  This program is free software; you may redistribute it and/or modify it.
  41. ;;
  42. ;;  HOW TO CONTACT ME:
  43. ;;      email:   uhay@rz.uni-karlsruhe.de
  44. ;;      mail:    David Luebbren
  45. ;;               Zaehringerstr. 18
  46. ;;               76131 Karlsruhe
  47. ;;               Germany
  48. ;;
  49.  
  50.  
  51. (defconst fetch-index-file "s:FetchRefs.index"
  52.   "FetchRefs Index files")
  53.  
  54. (defconst fetch-run-command "Run FetchRefs"
  55.   "Command to invoke 'FetchRefs'")
  56.  
  57. (defvar fetch-started nil
  58.   "If t, FetchRefs is up and running.")
  59.  
  60. (defun fetch-running-p ()
  61.   "True if FetchRefs ready to execute commands"
  62.   (if (eq fetch-started nil)
  63.       (fetch-start))
  64.   (eq fetch-started t))
  65.  
  66. (defun fetch-get-keyword (keyword)
  67.   "Find documentation for KEYWORD and place in buffer in other window."
  68.   (interactive (find-tag-tag "Find Reference: "))
  69.   (if (eq (fetch-running-p) t)
  70.       (progn
  71.        (setq tagname keyword)
  72.        (setq tagname (fetch-filter-tags tagname))
  73.        (let ((gotoline (fetch-find-keyword tagname)))
  74.      (if (not (eq gotoline nil))
  75.          (progn
  76.            (setq doc-buf (get-buffer "*references*"))
  77.            (if (bufferp doc-buf)
  78.            (kill-buffer doc-buf))
  79.            (setq doc-buf (get-buffer-create "*references*"))
  80.            (switch-to-buffer-other-window doc-buf)
  81.            (insert (amiga-paste))
  82.            (beginning-of-buffer)
  83.            (goto-line gotoline)
  84.            (not-modified)
  85.            (message "")))))
  86.     (message "Unable to start FetchRefs")))
  87.  
  88. (defun fetch-filter-tags (keyword)
  89.   "If keyword ends in either 'TagList', 'Tags', or 'A', return 
  90. with end truncated"
  91.   (setq len (length keyword))
  92.   (cond ((and 
  93.       (> len 7) 
  94.       (string-equal "TagList" (substring keyword (- len 7) len)))
  95.      (substring keyword 0 (- len 7)))
  96.     ((and 
  97.       (> len 4) 
  98.       (string-equal "Tags" (substring keyword (- len 4) len)))
  99.      (substring keyword 0 (- len 4)))
  100.     ((and 
  101.       (> len 1) 
  102.       (string-equal "A" (substring keyword (- len 1) len)))
  103.      (substring keyword 0 (- len 1)))
  104.     (keyword)))
  105.  
  106. (defun find-tag-tag (string)
  107.   (let* ((default (find-tag-default))
  108.      (spec (read-string
  109.         (if default
  110.             (format "%s(default %s) " string default)
  111.           string))))
  112.     (list (if (equal spec "")
  113.           default
  114.         spec))))
  115.  
  116. (defun find-tag-default ()
  117.   (save-excursion
  118.     (while (looking-at "\\sw\\|\\s_")
  119.       (forward-char 1))
  120.     (if (re-search-backward "\\sw\\|\\s_" nil t)
  121.     (progn (forward-char 1)
  122.            (buffer-substring (point)
  123.                  (progn (forward-sexp -1)
  124.                     (while (looking-at "\\s'")
  125.                       (forward-char 1))
  126.                     (point))))
  127.       nil)))
  128.  
  129. (defun fetch-start ()
  130.   "Try to run FetchRefs"
  131.   (if (not (eq (fetch-check-port) 0))
  132.       (progn
  133.     (message " - Starting 'FetchRefs'") 
  134.     (if (> (fetch-arexx-command 
  135.         (concat "address command '"
  136.             fetch-run-command
  137.             " FILES "
  138.             fetch-index-file
  139.             "';return rc")) 0)
  140.         (message "Error executing 'FetchRefs'")
  141.       (if (eq (fetch-arexx-command 
  142.            "address command 'WaitForPort FETCHREFS';return rc") 0)
  143.           (setq fetch-started t)
  144.         (message "Could not find FETCHREFS port"))
  145.       (setq fetch-started t)))
  146.     (setq fetch-started t)))
  147.  
  148. (defun fetch-stop ()
  149.   "Terminate FetchRefs"
  150.   (interactive)
  151.   (if (eq fetch-started t)
  152.       (if (not (eq (fetch-arexx-command 
  153.             "address FETCHREFS FR_QUIT;return rc") 0))
  154.       (message "Error trying to quit FetchRefs")
  155.     (setq fetch-started nil))))
  156.  
  157. (defun fetch-check-port ()
  158.   "Check if FetchRefs Port is set up"
  159.   (fetch-arexx-command 
  160.    "if show('Ports', 'FETCHREFS') then return 0;else return 1"))
  161.  
  162. (defun fetch-arexx-command (command)
  163.   "Send a command to arexx and return rc"
  164.   (string-to-int (amiga-arexx-do-command 
  165.           (concat "options results;" command) t)))
  166.  
  167. (defun fetch-find-keyword (keyword)
  168.   "Awkward means of determining return value of arexx call"
  169.   (setq ret (amiga-arexx-do-command
  170.          (concat "options results;"
  171.              "address 'FETCHREFS' 'FR_GET' '"
  172.              keyword
  173.              "(%|Tags|TagList|A)' "
  174.              "CLIP0 FILEREF;"
  175.              "return rc2") t))
  176.   (let ((first (string-to-char ret)))
  177.     (if (and (> first 47) (< first 58))
  178.     (string-to-int ret)
  179.       (progn
  180.     (message ret)
  181.     nil))))
  182.   
  183.