home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / emacs-18.59src.lha / emacs-18.59 / amiga / contrib / lindgren / sas-c-emacs.lha / sas-c.el < prev    next >
Encoding:
Text File  |  1993-07-09  |  8.2 KB  |  262 lines
  1. ;;;
  2. ;;; FILE
  3. ;;;    sas-c.el V0.1
  4. ;;;
  5. ;;;    Copyright (C) 1993 by Anders Lindgren.
  6. ;;;
  7. ;;;    This file is NOT part of GNU Emacs.
  8. ;;;
  9. ;;; DISTRIBUTION
  10. ;;;    sas-c.el is free software; you can redistribute it and/or modify
  11. ;;;    it under the terms of the GNU General Public License as published 
  12. ;;;    by the Free Software Foundation; either version 1, or (at your 
  13. ;;;    option) any later version.
  14. ;;;
  15. ;;;    GNU Emacs is distributed in the hope that it will be useful,
  16. ;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;;    GNU General Public License for more details.
  19. ;;;
  20. ;;;    You should have received a copy of the GNU General Public
  21. ;;;    License along with GNU Emacs; see the file COPYING.  If not,
  22. ;;;    write to the Free Software Foundation, 675 Mass Ave, Cambridge,
  23. ;;;    MA 02139, USA.
  24. ;;;
  25. ;;; AUTHOR
  26. ;;;    Anders Lindgren, d91ali@csd.uu.se
  27. ;;;
  28. ;;; HISTORY
  29. ;;;    93-Mar-17 ALi * Created this file
  30. ;;;    93-Jun-09 ALi * Emacs now handles resultcodes from arexx-calls,
  31. ;;;            consequently, my old "bazoka" method were removed.
  32. ;;;    93-Jul-08 ALi * A typo in sas-c-scmsg-num fixed.
  33. ;;;            The delcomp-functions uncommented.
  34. ;;;
  35.  
  36. (defvar sas-c-mode nil
  37.   "Variable indicating if the sas-c-mode is active.")
  38.  
  39. (defvar sas-c-compile-command "sc:c/smake"
  40.   "The command to run when a sas-c-build is executed.")
  41.  
  42. (defun sas-c-mode (arg)
  43.   "Minor mode which enables Emacs to communicate with SCMSG,
  44. the error handler from SAS/C. If the function is called without args
  45. the mode is toggled, a positive integer switchen it on and a negative off.
  46.  
  47. The following keys are added to the current local map:
  48.  
  49. C-c C-a        Display the alternative file, if any.
  50. C-c C-c        Build a project (normally execute smake).
  51. C-c C-d        Delete the current message, and display next
  52. C-c C-h        Hide the SCMSG window.
  53. C-c C-l        Redisplay current message.
  54. C-c C-n        Display next error.
  55. C-c <down>    dito
  56. C-c C-p        Display previous error.
  57. C-c C-q        Remove all messages for a certain primary file.
  58. C-c C-s        Show the SCMSG window.
  59. C-c <up>    dito
  60. C-c <        Go to the first error message.
  61. C-c <sh. up>    dito
  62. C-c >        Go to the last error message.
  63. C-c <sh. down>    dito
  64.  
  65. When sas-c-mode is switched on, the hook sas-c-hook is called.
  66.  
  67. If a key shall be defined, the best way is to use a hook and the
  68. sas-c-define-key function. This way the keys are removed and the
  69. original values are restored when sas-c-mode is disabled.
  70.  
  71. For example:
  72.  (setq sas-c-mode-hook '(lambda ()
  73.             (sas-c-define-key \"\\C-ca\" 'your-favorite-fnk)
  74.             (sas-c-define-key \"\\C-cb\" 'another-function)
  75.             ))"
  76.   (interactive "P")
  77.   (make-local-variable 'sas-c-mode)
  78.   (make-local-variable 'sas-c-original-keys)
  79.   (let ((sas-c-mode-orig sas-c-mode))
  80.     (setq sas-c-mode
  81.       (if (null arg) (not sas-c-mode)
  82.         (> (prefix-numeric-value arg) 0)))
  83.     (or (assq 'sas-c-mode minor-mode-alist)
  84.     (setq minor-mode-alist
  85.           (cons '(sas-c-mode " SAS/C") minor-mode-alist)))
  86.     (cond ((and sas-c-mode (not sas-c-mode-orig))
  87.        ;; turning on sas-c-mode
  88.        (setq sas-c-original-keys '())
  89.        (sas-c-define-key "\C-c\C-a"      'sas-c-display-altfile)
  90.        (sas-c-define-key "\C-c\C-c"         'sas-c-build)
  91.        (sas-c-define-key "\C-c\C-d"      'sas-c-delete)
  92.        (sas-c-define-key "\C-c\C-h"      'sas-c-hide)
  93.        (sas-c-define-key "\C-c\C-l"      'sas-c-display-error)
  94.        (sas-c-define-key "\C-c\C-n"      'sas-c-next)
  95.        (sas-c-define-key "\C-c\C-x\C-^B" 'sas-c-next)
  96.        (sas-c-define-key "\C-c\C-p"      'sas-c-prev)
  97.        (sas-c-define-key "\C-c\C-x\C-^A" 'sas-c-prev)
  98.        (sas-c-define-key "\C-c\C-q"      'sas-c-delcomp)
  99.        (sas-c-define-key "\C-c\C-Q"         'sas-c-delfile)
  100.        (sas-c-define-key "\C-c\C-s"      'sas-c-show)
  101.        (sas-c-define-key "\C-c<"         'sas-c-top)
  102.        (sas-c-define-key "\C-c\C-x\C-^T" 'sas-c-top)
  103.        (sas-c-define-key "\C-c>"         'sas-c-bottom)
  104.        (sas-c-define-key "\C-c\C-x\C-^S" 'sas-c-bottom)
  105.        (run-hooks 'sas-c-mode-hook))
  106.       ((and (not sas-c-mode) sas-c-mode-orig)
  107.        ;; turning off sas-c-mode
  108.        (sas-c-undef-keys)))))
  109.  
  110. (defun sas-c-define-key (key fnk)
  111.   "Make a keybinding which can be undone."
  112.   (setq sas-c-original-keys (cons (cons key (local-key-binding key)) 
  113.                   sas-c-original-keys))
  114.   (local-set-key key fnk))
  115.  
  116. (defun sas-c-undef-keys ()
  117.   "Unmake the keybindings made by sas-c-mode
  118. and restore the keys previous values."
  119.   (while sas-c-original-keys
  120.     (let ((fnk (cdr (car sas-c-original-keys)))
  121.       (key (car (car sas-c-original-keys))))
  122.       (if (numberp fnk)
  123.       (local-unset-key key)
  124.     (local-set-key key fnk)))
  125.     (setq sas-c-original-keys (cdr sas-c-original-keys))))
  126.  
  127. (defun sas-c-delete ()
  128.   "Delete the current error message and move to the next."
  129.   (interactive)
  130.   (sas-c-scmsg "delete")
  131.   (sas-c-display-error))
  132.  
  133. (defun sas-c-next ()
  134.   "Move to the nest error message."
  135.   (interactive)
  136.   (sas-c-scmsg "next")
  137.   (sas-c-display-error))
  138.  
  139. (defun sas-c-prev ()
  140.   "Move to the prevous error message."
  141.   (interactive)
  142.   (sas-c-scmsg "prev")
  143.   (sas-c-display-error))
  144.  
  145. (defun sas-c-top ()
  146.   "Move to the first error message."
  147.   (interactive)
  148.   (sas-c-scmsg "top")
  149.   (sas-c-display-error))
  150.  
  151. (defun sas-c-bottom ()
  152.   "Move to the last error message."
  153.   (interactive)
  154.   (sas-c-scmsg "bottom")
  155.   (sas-c-display-error))
  156.  
  157. (defun sas-c-delcomp-current ()
  158.   "Delete all messages for the primary file of the current error."
  159.   (sas-c-scmsg "delcomp"))
  160.  
  161. (defun sas-c-delcomp (filename)
  162.   "Delete all messages with the specified filename as primary filename."
  163.   (interactive "fFilename (Press return for current file): ")
  164.   (sas-c-scmsg (format "delcomp \"%s\"" filename)))
  165.  
  166. (defun sas-c-delfile-current ()
  167.   "Delete all messages for the secondary file of the current error."
  168.   (sas-c-scmsg "delfile"))
  169.  
  170. (defun sas-c-delfile (filename)
  171.   "Delete all messages with the specified filename as secondary filename."
  172.   (interactive "fFilename (Press return for current file): ")
  173.   (sas-c-scmsg (format "delfile \"%\"s" filename)))
  174.  
  175. (defun sas-c-show (& optional arg)
  176.   "Show the scmsg window.
  177. If called with arguments the window gets unactivated."
  178.   (interactive "P")
  179.   (sas-c-scmsg (if arg "show" "show activate")))
  180.  
  181. (defun sas-c-hide ()
  182.   "Show the scmsg window."
  183.   (interactive)
  184.   (sas-c-scmsg "hide"))
  185.  
  186. (defun sas-c-build ()
  187.   "Build with SAS/C. The command sas-c-compile-command is executed
  188. and the output is places in the buffer *compilation*"
  189.   (interactive)
  190.   (compile sas-c-compile-command))
  191.  
  192. (defun sas-c-display-error ()
  193. "Display the current error in SCMSG."
  194.   (interactive)
  195.   (let ((file (sas-c-scmsg-str "file")))
  196.     (if (equal file "")
  197.     (message "No more errors")
  198.       (sas-c-view-message file 
  199.               (sas-c-scmsg-num "line")
  200.               (sas-c-scmsg-str "text")
  201.               (sas-c-scmsg-str "class")
  202.               (sas-c-scmsg-str "errnum")))))
  203.  
  204. (defun sas-c-display-altfile ()
  205. "Display the secondary file. (Same as C-u sas-c-display-error.)"
  206.   (interactive)
  207.   (let ((file (sas-c-scmsg-str "altfile")))
  208.     (if (equal file "")
  209.     (message "No alternate file")
  210.       (sas-c-view-message file 
  211.               (sas-c-scmsg-num "altline")
  212.               (sas-c-scmsg-str "text")
  213.               (sas-c-scmsg-str "class")
  214.               (sas-c-scmsg-str "errnum")))))
  215.  
  216. (defun sas-c-view-message (file line text class errnum)
  217.   (sas-c-get-file file)
  218.   (set-mark (point))
  219.   (goto-line line)
  220.   (let ((isalt (string-match "; See line [0-9]* file \".*\"" text)))
  221.     (if isalt (setq text (substring text 0 isalt)))
  222.     (message (format "%s %s%s: %s" class 
  223.                            errnum 
  224.                    (if isalt " (Alt)" "") 
  225.                    text))))
  226.  
  227. (defun sas-c-get-file (file)
  228.   "Get the file requested into a visiable buffer."
  229.   (let ((buf (get-file-buffer file)))
  230.     (if buf
  231.     (let ((win (get-buffer-window buf)))
  232.       (if win
  233.           (select-window win)
  234.         (switch-to-buffer buf)))
  235.       (find-file file))))
  236.  
  237. ;;;
  238. ;;; Low level ARexx communication routines.
  239. ;;;  
  240.  
  241. (defun sas-c-scmsg (command)
  242.   "Sends a command to SCMSG."
  243.   (amiga-arexx-do-command
  244.     (concat "address 'SC_SCMSG' '" command "'") 
  245.     t))
  246.  
  247. (defun sas-c-scmsg-str (command)
  248.   "Sends a command to SCMSG and returns the result string."
  249.   (amiga-arexx-do-command
  250.     (concat "options results; address 'SC_SCMSG' '"
  251.         command
  252.         "'; return result")
  253.     t))
  254.  
  255. (defun sas-c-scmsg-num (command)
  256.   "Sends a command to SCMSG and returns the resulting number."
  257.   (string-to-int (amiga-arexx-do-command
  258.           (concat "options results; address 'SC_SCMSG' '"
  259.               command
  260.               "'; return result")
  261.           t)))
  262.