home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-18.59-bin.lha / lib / emacs / 18.59 / lisp / term / supdup.el < prev    next >
Lisp/Scheme  |  1987-01-21  |  3KB  |  82 lines
  1. ;;  Losing unix doesn't know about the -real- control bit
  2.  
  3. ;; there should be some way to conditionalize this on the basis
  4. ;; of %TOFCI -- except that the existing supdup server loses this information!
  5. ;; It isn't clear-cut what to do in the server, as %tofci means that the user
  6. ;; can generate full 9-bit MIT characters, which isn't what the `km' termcap
  7. ;; flag means.  On the other hand, being able to generate 8-bit characters
  8. ;; (which is sort of what `km' is) isn't the same as %tofci.
  9. ;; I think the problem is fundamental and cultural and irresolvable.
  10.  
  11. ;; unix supdup server uses 0237 as a control escape.
  12. ;; c-a        001
  13. ;; m-a        341
  14. ;; c-m-a    201
  15. ;; c-1        237 061
  16. ;; m-1        261
  17. ;; c-m-1    237 261
  18. ;; c-m-_    237 237
  19.  
  20. (defvar supdup-control-map (make-keymap))
  21. (fillarray supdup-control-map 'ascii-loses)
  22. (defvar supdup-control-meta-map (make-keymap))
  23. (fillarray supdup-control-meta-map 'ascii-loses)
  24. (define-key supdup-control-meta-map "\C-_" nil) ; this is c-m-_
  25. (define-key supdup-control-map "\e" supdup-control-meta-map)
  26. (define-key global-map "\e\C-_" supdup-control-map)
  27. (let ((n ?0))
  28.   (while (<= n ?9)
  29.     (define-key supdup-control-map (char-to-string n) 'supdup-digit-argument)
  30.     (define-key supdup-control-meta-map (char-to-string n) 'supdup-digit-argument)
  31.     (setq n (1+ n)))
  32.   (define-key supdup-control-map "-" 'supdup-digit-argument)
  33.   (define-key supdup-control-meta-map "-" 'supdup-digit-argument))
  34.  
  35. (defun ascii-loses ()
  36.   (interactive)
  37.   (if (= (aref (this-command-keys) 0) meta-prefix-char)
  38.       ;; loser typed <esc> c-_ <char>
  39.       (error "Undefined command: %s"
  40.          (mapconcat 'text-char-description (this-command-keys) " "))
  41.     ;; Get here from m-c-_ <char> for c-<char> or m-c-_ m-<char>
  42.     (error "Ascii loses: c-%s%c"
  43.        (if (> last-input-char ?\200) "m-" "")
  44.        (logand last-input-char ?\177))))
  45.  
  46.  
  47. (defun supdup-digit-argument (p)
  48.   (interactive "P")
  49.   (let ((n last-input-char))
  50.     (if (and (<= (+ ?\200 ?0) n) (<= n (+ ?\200 ?9)))
  51.     (setq n (- n ?\200)))
  52.     (cond ((or (= n ?-) (= n ?\M--))
  53.        (message "Arg: %s" (setq prefix-arg '-)))
  54.       ((or (< n ?0) (> n ?9))
  55.        (error "Lossage: %s" (this-command-keys)))
  56.       (t
  57.        (setq n (- n ?0))
  58.        (message "Arg: %d"
  59.             (setq prefix-arg
  60.               (cond ((listp p)
  61.                  n)
  62.                 ((eq p '-)
  63.                  (- n))
  64.                 ((>= p 0)
  65.                  (+ (* p 10) n))
  66.                 (t
  67.                  (- (* p 10) n)))))))))
  68.  
  69. ;; Attempt to detect slimebollix machine serving as terminal.
  70. (if (let ((termcap (getenv "TERMCAP")))
  71.       (and termcap
  72.        (string-match ":co#131:li#52:\\|:co#135:li#50:" termcap)))
  73.     (message "In doing business with Symbolics, you are rewarding a wrong."))
  74.  
  75.  
  76. ;; Mouse support works with Lambdas.
  77. ;(autoload 'sup-mouse-report "sup-mouse"
  78. ;  "This command is sent by a special version of Supdup on the LMI Lambda
  79. ;when the mouse is clicked." t)
  80. ;(global-set-key "\C-x\C-@" 'sup-mouse-report)
  81.  
  82.