home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / a2.0bemacs-src.lha / Emacs-19.25 / lisp / amiga-init.el < prev    next >
Encoding:
Text File  |  1995-01-05  |  8.8 KB  |  291 lines
  1. (global-set-key "\C-z" 'amiga-iconify)
  2. (setq amiga-map (make-keymap))
  3. (global-set-key "\C-x\C-^" amiga-map)
  4.  
  5. (load "amiga-mouse")
  6. ;; (load "amiga-menu")
  7.  
  8. ; these are directly mapped now
  9. ;(define-key amiga-map "A" [up])
  10. ;(define-key amiga-map "B" [down])
  11. ;(define-key amiga-map "D" [left])
  12. ;(define-key amiga-map "C" [right])
  13. ;(define-key amiga-map "0~" [f1])
  14. ;(define-key amiga-map "1~" [f2])
  15. ;(define-key amiga-map "2~" [f3])
  16. ;(define-key amiga-map "3~" [f4])
  17. ;(define-key amiga-map "4~" [f5])
  18. ;(define-key amiga-map "5~" [f6])
  19. ;(define-key amiga-map "6~" [f7])
  20. ;(define-key amiga-map "7~" [f8])
  21. ;(define-key amiga-map "8~" [f9])
  22. ;(define-key amiga-map "9~" [f10])
  23. ;(define-key amiga-map "10~" [S-f1])
  24. ;(define-key amiga-map "11~" [S-f2])
  25. ;(define-key amiga-map "12~" [S-f3])
  26. ;(define-key amiga-map "13~" [S-f4])
  27. ;(define-key amiga-map "14~" [S-f5])
  28. ;(define-key amiga-map "15~" [S-f6])
  29. ;(define-key amiga-map "16~" [S-f7])
  30. ;(define-key amiga-map "17~" [S-f8])
  31. ;(define-key amiga-map "18~" [S-f9])
  32. ;(define-key amiga-map "19~" [S-f10])
  33.  
  34. (define-key global-map [help] 'info)
  35.  
  36. (define-key global-map [S-left] [prior])
  37. (define-key global-map [S-right] [next])
  38. (define-key global-map [S-down] 'scroll-up)
  39. (define-key global-map [S-up] 'scroll-down)
  40. (define-key global-map [C-left] 'forward-sexp)
  41. (define-key global-map [C-right] 'backward-sexp)
  42. (define-key global-map [C-down] 'scroll-down-1)
  43. (define-key global-map [C-up] 'scroll-up-1)
  44.  
  45. ; CHFIXME: use default emacs binding? 
  46. (define-key global-map [M-up] [begin])
  47. (define-key global-map [M-down] [end])
  48. (define-key global-map [M-left] 'beginning-of-line)
  49. (define-key global-map [M-right] 'end-of-line)
  50.  
  51. ; Keypad sequences
  52. (setq amiga-keypad-map (make-sparse-keymap))
  53. (define-key amiga-map "K" amiga-keypad-map)
  54. (define-key amiga-keypad-map "[" "[")
  55. (define-key amiga-keypad-map "]" "]")
  56. (define-key amiga-keypad-map "{" "{")
  57. (define-key amiga-keypad-map "}" "}")
  58. (define-key amiga-keypad-map "/" [kp-divide])
  59. (define-key amiga-keypad-map "*" [kp-multiply])
  60. (define-key amiga-keypad-map "-" [kp-subtract])
  61. (define-key amiga-keypad-map "+" [kp-add])
  62. (define-key amiga-keypad-map "." [kp-decimal])
  63. (define-key amiga-keypad-map [RET] [kp-enter])
  64. (define-key amiga-keypad-map [0] [kp-0])
  65. (define-key amiga-keypad-map [1] [kp-1])
  66. (define-key amiga-keypad-map [2] [kp-2])
  67. (define-key amiga-keypad-map [3] [kp-3])
  68. (define-key amiga-keypad-map [4] [kp-4])
  69. (define-key amiga-keypad-map [5] [kp-5])
  70. (define-key amiga-keypad-map [6] [kp-6])
  71. (define-key amiga-keypad-map [7] [kp-7])
  72. (define-key amiga-keypad-map [8] [kp-8])
  73. (define-key amiga-keypad-map [9] [kp-9])
  74.  
  75. (defun scroll-down-1 ()
  76.   "Move up one line on screen."
  77.   (interactive)
  78.   (scroll-down 1))
  79.  
  80. (defun scroll-up-1 ()
  81.   "Move down one line on screen."
  82.   (interactive)
  83.   (scroll-up 1))
  84.  
  85. (defun unfocus-frame ()
  86.   "A dummy, used by general mouse.el."
  87.   (interactive))
  88.  
  89.  
  90. (defun window-frame (w)
  91.   "Return the frame object that window WINDOW is on."
  92.   (interactive)
  93.   (selected-frame))
  94.  
  95. ;; ARexx stuff
  96.  
  97. ;;; This function needs to be re-written to handle rexx returned results.
  98. ;;;
  99. (setq amiga-arexx-processing nil)
  100. (setq amiga-arexx-errors nil)
  101.  
  102. (defvar amiga-arexx-failat 5
  103.   "Return level from which arexx commands returns cause errors")
  104.  
  105. ;;
  106. ;; process incoming rexx messages
  107. ;;
  108. (defun amiga-arexx-process ()
  109.   (interactive)
  110.   (if (not amiga-arexx-processing)
  111.       (progn
  112.     (setq amiga-arexx-processing t)
  113.     (condition-case nil ; Avoid blocking of processing in case of bugs
  114.         (let (arexxcmd)
  115.           (while (setq arexxcmd (amiga-arexx-get-next-msg))
  116.         (let ((rc 0) result)
  117.           (condition-case err ; detect errors in arexx command
  118.               (let ((expr (car (read-from-string arexxcmd))))
  119.             (setq result (prin1-to-string (eval expr))))
  120.             (error (progn
  121.                  (setq rc 20)
  122.                  (setq result (prin1-to-string err)))))
  123.           (amiga-arexx-reply rc result))))
  124.       (error nil))
  125.     (setq amiga-arexx-processing nil))))
  126.  
  127. (defun amiga-arexx-wait-command (id)
  128.   "Waits for a pending ARexx commands (MSGID) to complete.
  129. Also processes any pending ARexx requests during this interval.
  130. returns the result list associated with this id, which takes the
  131. form: (msgid result-code error-or-string)
  132. ``error-or-string'' depends on ``result-code''.
  133. if ``result-code'' is 0 the command finished successfully and
  134. ``error-or-string'' will be a string or nil, otherwise the command
  135. returned with an error and ``error-or-string'' will be an interger
  136. that is the secondary error code of the arexx command."
  137.   (amiga-arexx-process)
  138.   (while (not (amiga-arexx-check-command id))
  139.     (amiga-arexx-wait)
  140.     (amiga-arexx-process))
  141.   (amiga-arexx-get-msg-results id))
  142.  
  143. (defconst amiga-arexx-error-messages
  144. ["No cause"
  145. "Program not found"
  146. "Execution halted"
  147. "Insufficient memory"
  148. "Invalid character"
  149. "Unmatched quote"
  150. "Unterminated comment"
  151. "Clause too long"
  152. "Invalid token"
  153. "Symbol or string too long"
  154. "Invalid message packet"
  155. "Command string error"
  156. "Error return from function"
  157. "Host environment not found"
  158. "Requested library not found"
  159. "Function not found"
  160. "Function did not return value"
  161. "Wrong number of arguments"
  162. "Invalid argument to function"
  163. "Invalid PROCEDURE"
  164. "Unexpected THEN or WHEN"
  165. "Unexpected ELSE or OTHERWISE"
  166. "Unexpected BREAK, LEAVE or ITERATE"
  167. "Invalid statement in SELECT"
  168. "Missing or multiple THEN"
  169. "Missing OTHERWISE"
  170. "Missing or unexpected END"
  171. "Symbol mismatch"
  172. "Invalid DO syntax"
  173. "Incomplete IF or SELECT"
  174. "Label not found"
  175. "Symbol expected"
  176. "Symbol or string expected"
  177. "Invalid keyword"
  178. "Required keyword missing"
  179. "Extraneous characters"
  180. "Keyword conflict"
  181. "Invalid template"
  182. "Invalid TRACE request"
  183. "Unitialized variable"
  184. "Invalid variable name"
  185. "Invalid expression"
  186. "Unbalanced parentheses"
  187. "Nesting limit exceeded"
  188. "Invalid expression result"
  189. "Expression required"
  190. "Boolean value not 0 or 1"
  191. "Arithmetic conversion error"
  192. "Invalid operand"
  193. ]
  194. "The arexx error messages, sorted by number")
  195.  
  196. (defun amiga-arexx-do-command (str as-file)
  197.   "Sends ARexx command STR (like amiga-arexx-send-command).
  198. If AS-FILE is true, STR is an arexx command, otherwise it is a file name.
  199. Waits for the command to return.  If the arexx command fails an error will
  200. be caused.
  201.  
  202. If you would like to get result strings and errors (ie. not cause
  203. a lisp error) use: (amiga-arexx-do-command-with-results)"
  204.   (interactive "sARexx command:
  205. P")
  206.   (let ((id (amiga-arexx-send-command str as-file)))
  207.     (if (not id)
  208.     (error "Failed to send arexx command.")
  209.       (let ((reslist (amiga-arexx-wait-command id)))
  210.     (let ((rc (nth 1 reslist)) (second (nth 2 reslist)))
  211.       (if (> rc 0)
  212.           (progn            ; error
  213.         (let ((error-message
  214.                (if (< second (length amiga-arexx-error-messages))
  215.              (aref amiga-arexx-error-messages second)
  216.              (format nil "Unknown error %d" second))))
  217.           (error "Arexx command failed, level %d, cause %s" rc error-message))
  218.         reslist)
  219.       second))))))
  220.  
  221. (defun amiga-arexx-do-command-with-results (str as-file)
  222.   "Sends ARexx command STR (like amiga-arexx-do-command).
  223. If AS-FILE is true, STR is an arexx command, otherwise it is a file name.
  224. Waits for the command to return.
  225.  
  226. The return value is one of three things:
  227.  - the command executed succesfully: nil or a result string.
  228.  - the command failed: a list of the form (RC ERROR-CODE)
  229.    where RC is the severity and ERROR-CODE is the secondary error."
  230.   (interactive "sARexx command:
  231. P")
  232.   (let ((id (amiga-arexx-send-command str as-file)))
  233.     (if (not id)
  234.     (error "Failed to send arexx command.")
  235.       (let ((reslist (amiga-arexx-wait-command id)))
  236.     (let ((rc (nth 1 reslist)) (second (nth 2 reslist)))
  237.       (if (and rc (> rc 0))
  238.           (list rc second)
  239.         second))))))
  240.  
  241. (define-key amiga-map "X" 'amiga-arexx-process)
  242. (setq amiga-arexx-initialized t) ;; ARexx commands can now be processed.
  243.  
  244. (defun amiga-wb-process ()
  245.   "Process all pending workbench events, ie load all files requested"
  246.   (interactive)
  247.   (let (file)
  248.     (condition-case nil
  249.     (while (setq file (amiga-get-wb-event t))
  250.       (condition-case nil
  251.           (find-file file)
  252.         (error nil)))
  253.       (error nil))))
  254.  
  255. (define-key amiga-map "W" 'amiga-wb-process)
  256. (setq amiga-wb-initialized t) ;; WB events can now be processed.
  257.  
  258. (setq completion-ignore-case t)
  259. ;; Default is no numbered versions on Amiga, because directory searches are too
  260. ;; slow.
  261. (setq version-control 'never)
  262.  
  263. (defun safe-amiga-paste ()
  264.   "Paste from the amiga clipboard, trapping any errors."
  265.   (if amiga-new-clip
  266.       nil)
  267.   (condition-case nil
  268.       (amiga-paste)
  269.     (error nil)))
  270.  
  271. (defun check-clipboard ()
  272.   "If there is anything new in the clipboard, add it to the emacs kill ring.
  273. Returns t if there was something added, nil otherwise."
  274.   (let (added)
  275.     (if amiga-new-clip
  276.         (let ((str (safe-amiga-paste)))
  277.           (setq amiga-new-clip nil)
  278.           (if str
  279.               (progn
  280.                 (kill-add str)
  281.                 (setq added t)
  282.                 (setq kill-ring-yank-pointer kill-ring)))))
  283.           added))
  284.  
  285. (defun update-clipboard (str &optional dummy)
  286.   (amiga-cut str)
  287.   (setq amiga-new-clip nil))
  288.  
  289. (setq interprogram-cut-function 'update-clipboard)
  290. (setq interprogram-paste-function 'safe-amiga-paste)
  291.