Article View: gnu.epoch.misc
Article #112Re: sun-4 function key binding ?
From: Ken Laprade
Date: Wed, 05 Aug 1992 14:45
Date: Wed, 05 Aug 1992 14:45
91 lines
5171 bytes
5171 bytes
I find this to be a very easy way to define function keys, and it lets
epoch rebind them appropriately. I also have a version for regular X
gnuemacs as well as for use with emacstool that sits in term/sun.el (these
versions do not rebind the keys). Thus, no matter what way I invoke
emacs/epoch, my .emacs uses the same define-function-key calls. This is
written for use with Sun3 and Sun4 keyboards; you will have to change it a
little for other keyboards.
Example usage:
(define-function-key "L1" 'select-previous-buffer)
(define-function-key "M-L1" 'select-previous-previous-buffer)
(define-function-key "L2" "\C-X\C-K")
(define-function-key "M-L2" "\C-X4\C-K")
(define-function-key "SC-L2" "\C-Xk")
(define-function-key "MC-L2" "\C-X4k")
(define-function-key "MSC-L2" 'kill-current-buffer-and-its-file)
(define-function-key "L3" 'find-file "\C-X\C-F")
(define-function-key "M-L3" 'find-file-other-window "\C-X4\C-F")
(define-function-key "C-L3" 'switch-to-buffer "\C-Xb")
(define-function-key "MC-L3" 'switch-to-buffer-other-window "\C-X4b")
;;; Support for generic function key binding (by Ken Laprade):
;;;
(defvar function-key-prefix-string "\C-X*"
"Prefix for function key definitions created by define-function-key.")
(defun define-function-key (key def &optional epoch-def)
"Globally define a generic function key for epoch. KEY is a string naming
the key (as known to X) with optional `M', `S', or `C' prefixes specifying
meta, shift and control qualifiers. Prefixes are separated from the key
name by a hyphen. DEF is the key definition. It may be any valid
definition for define-key. If it is a string, it will be directly bound
to the key using rebind-key. If the optional EPOCH-DEF is supplied, it
is used rather than def."
(interactive "sFunction key name: \nxDefinition: ")
(if epoch-def (setq def epoch-def))
(let* ((i (string-match "-" key))
(keyname (let ((name (substring key (if i (1+ i) 0))))
(or (cdr (assoc name '(("R8" . "Up") ("R10" . "Left") ("R12" . "Right") ("R14" . "Down")
;; For Sun 4 type keyboards:
("Pause" . "R1") ("Print" . "R2") ("Scroll_Lock" . "R3")
("KP_Equal" . "R4") ("KP_Divide" . "R5") ("KP_Multiply" . "R6")
("KP_7" . "R7") ("KP_8" . "Up") ("KP_9" . "R9")
("KP_4" . "Left") ("KP_5" . "R11") ("KP_6" . "Right")
("KP_1" . "R13") ("KP_2" . "Down") ("KP_3" . "R15"))))
name)))
;; For Sun 4 type keyboards:
(othername (cdr (assoc keyname '(("R1" . "Pause") ("R2" . "Print") ("R3" . "Scroll_Lock")
("R4" . "KP_Equal") ("R5" . "KP_Divide") ("R6" . "KP_Multiply")
("R7" . "KP_7") ("Up" . "KP_8") ("R9" . "KP_9")
("Left" . "KP_4") ("R11" . "KP_5") ("Right" . "KP_6")
("R13" . "KP_1") ("Down" . "KP_2") ("R15" . "KP_3")))))
(meta (string-match "M.*-" key))
(shift (string-match "S.*-" key))
(control (string-match "C.*-" key))
quals)
(if meta (setq quals (append '(meta) quals)))
(if control (setq quals (append '(control) quals)))
(if shift (setq quals (append '(shift) quals)))
(or quals (setq quals 0))
(if (stringp def)
(progn
(rebind-key keyname quals def)
;; On Sun 4 keyboards, bind the keypad versions as well:
(if othername (rebind-key othername quals def)))
;; Make an intermediate binding for the definition.
(let* ((funname (or (cdr (assoc keyname '(("Up" . "R8") ("Left" . "R10") ("Right" . "R12") ("Down" . "R14")
;; For Sun 4 type keyboards:
("Num_Lock" . "R16") ("KP_Subtract" . "R17") ("KP_Add" . "R18")
("KP_Enter" . "R19") ("KP_0" . "R20") ("KP_Decimal" . "R21"))))
keyname))
(keytype (if (string-match "\\([1-9][1-9]?\\)$" funname)
(substring funname 0 (match-beginning 1))
funname))
(keynum (and (match-beginning 1)
(string-to-int (substring funname (match-beginning 1) (match-end 1)))))
(binding (concat function-key-prefix-string
(if meta "M") (if shift "S") (if control "C")
keytype
(if keynum (format "%02d" keynum)))))
(rebind-key keyname quals binding)
;; On Sun 4 keyboards, bind the keypad versions as well:
(if othername (rebind-key othername quals binding))
(global-set-key binding def)))))
---
Ken Laprade INTERNET: laprade@trantor.harris-atd.com
Harris Corporation Usenet: ...!uunet!x102a!trantor!laprade
PO Box 37, MS 3A/1912 Voice: (407)727-4433
Melbourne, FL 32902 FAX: (407)729-3363
Technical Details
Message-ID:
<laprade.713025954@ringworld>Path:
arc1-ca.pugleaf.net!sparky!uunet!stanford.edu!ames!elroy.jpl.nasa.gov!swrinde!mips!darwin.sura.net!mlb.semi.harris.com!trantor.harris-atd.com!ringworld!lapradeReferences:
<1992Jul28.173529.23497@cbfsb.cb.att.com> <9207282126.AA11427@se33.wg2.waii.com>Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!sparky!uunet!stanford.edu!ames!elroy.jpl.nasa.gov!swrinde!mips!darwin.sura.net!mlb.semi.harris.com!trantor.harris-atd.com!ringworld!laprade From: laprade@ringworld.harris-atd.com (Ken Laprade) Newsgroups: gnu.epoch.misc Subject: Re: sun-4 function key binding ? Message-ID: <laprade.713025954@ringworld> Date: 5 Aug 92 14:45:54 GMT References: <1992Jul28.173529.23497@cbfsb.cb.att.com> <9207282126.AA11427@se33.wg2.waii.com> Sender: news@trantor.harris-atd.com (News stuff) Reply-To: laprade@trantor.harris-atd.com Distribution: gnu Organization: Advanced Technology Dept., Harris Corp., Melbourne, FL Lines: 91