Return to supdup.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp / term

Annotation of 43BSD/contrib/emacs/lisp/term/supdup.el, revision 1.1.1.1

1.1       root        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 (string-match ":co#131:li#52:\\|:co#135:li#50:"
                     71:                  (getenv "TERMCAP"))
                     72:     (message "In doing business with Symbolics, you are rewarding a wrong."))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.