Annotation of 43BSDReno/contrib/emacs-18.55/lisp/term/supdup.el, revision 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 (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: 

unix.superglobalmegacorp.com

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