🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.epoch.misc
Article #112

Re: sun-4 function key binding ?

#112
From: Ken Laprade
Date: Wed, 05 Aug 1992 14:45
91 lines
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!laprade
References: <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