🚀 go-pugleaf

|> Message  3:
|> From epoch-m@cs.uiuc.edu Wed Feb 24 15:55:24 1993
|> To: epoch@cs.uiuc.edu
|> Date: Wed, 24 Feb 1993 21:44:20 GMT
|> Organization: University of Twente, Enschede, The Netherlands
|> Subject: keybindings
|>
|> Hello,
|>
|> Can anyone tell me how I can define the keys of Epoch in such a way
|> that it recognises the 'insert', 'delete', 'page-up' and 'page-down'
|> keys of my keyboard.
|>
|> I am running epoch on a HP 9000/710 system with X11R4.
|>
|> My keyboard is a 101 keys PC keyboard.
|>

We are running Epoch on a Sun and use the following routine to define
keys.  I think it will work for your HP system as well.

;;
;; Support for generic function key binding (by Ken Laprade):
;;
;; Example usage:
;;   (define-function-key "L1" 'select-previous-buffer)
;;   (define-function-key "M-L1" 'select-previous-previous-buffer)
;;   (define-function-key "SC-L2" "\C-Xk")
;;   (define-function-key "MSC-L2" 'kill-current-buffer-and-its-file)

(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)))))

========================

Here are some examples from our Epoch startup file.  Note that the
shifted arrow keys have different names on the MIT (Motif) and XNEWS
(Openwindows) server.  It seems to work just fine to assign them
twice.  If these names don't work, use the XKEYCAPS program to see
what the key names are on your system.

;;
;; Left Function Keys
;;
(define-function-key "L4"          ;; Undo
  'undo)

(define-function-key "L6"          ;; Copy to X selection
  '(lambda () (interactive)
     (message "%d lines copied to clipboard" (count-lines
					      (epoch::zone-start drag-zone)
					      (epoch::zone-end   drag-zone)))
     (mouse::copy-zone drag-zone)))

(define-function-key "L8"          ;; Paste
  '(lambda () (interactive)
     ;; Get text from selection PRIMARY and insert it
     (let
	 ((text
	   (epoch::convert-selection mouse::selection-atom
	        		     "STRING" "PROPERTY"))
	  (b))
       (setq b (point))
       (if (stringp text)
	   (insert text)            ; Selection is owned and has a value
	 (insert (get-cut-buffer))) ; Grab cut-buffer instead
       (message "%d lines pasted from clipboard" (count-lines (point) b)))))

(define-function-key "L9"          ;; Find text
  'isearch-forward)

(define-function-key "S-L9"        ;; Search and replace text
  'query-replace)

(define-function-key "L10"         ;; Cut to X clipboard
  '(lambda () (interactive)
     (message "%d lines cut to clipboard" (count-lines
					   (epoch::zone-start drag-zone)
					   (epoch::zone-end   drag-zone)))
     (mouse::copy-zone drag-zone t)))

;;
;; Right Function Keys
;;
(define-function-key "R7"          ;; Beginning of line & trim trailing spaces
  '(lambda () (interactive)
     (end-of-line)
     (setq eol (point))
     (skip-chars-backward "     ")
     (delete-region (point) eol)
     (beginning-of-line)))

(define-function-key "S-R7"        ;; Top of window
  '(lambda () (interactive)
     (move-to-window-line 0)))

(define-function-key "S-R8"        ;; Scroll window up one line (MIT Server)
  '(lambda () (interactive)
     (scroll-down 1)))

(define-function-key "S-F28"       ;; Scroll window up one line (xnews Server)
  '(lambda () (interactive)
     (scroll-down 1)))

(define-function-key "R9"          ;; PgUp - stays in same column if possibl
  '(lambda () (interactive)
     (let ((col (current-column)))
       (previous-line (- (window-height) 1))
       (move-to-column col))))

(define-function-key "S-R9"        ;; Beginning of file
  'beginning-of-buffer)

(define-function-key "S-R10"       ;; Scroll window left one column (MIT)
  '(lambda () (interactive)
     (scroll-right 1)))

(define-function-key "S-F30"       ;; Scroll window left one column (xnews)
  '(lambda () (interactive)
     (scroll-right 1)))

(define-function-key "R11"         ;; Goto line number
  'goto-line)

(define-function-key "S-R12"       ;; Scroll window right one column (MIT)
  '(lambda () (interactive)
     (scroll-left 1)))

(define-function-key "S-F32"       ;; Scroll window right one column (xnews)
  '(lambda () (interactive)
     (scroll-left 1)))

(define-function-key "R13"         ;; End of line & trim trailing spaces
  '(lambda () (interactive)
     (end-of-line)
     (setq eol (point))
     (skip-chars-backward "     ")
     (delete-region (point) eol)))

(define-function-key "S-R13"       ;; Bottom of window
  '(lambda () (interactive)
     (move-to-window-line -1)))

(define-function-key "S-R14"       ;; Scroll window down one line (MIT)
  '(lambda () (interactive)
     (scroll-up 1)))

(define-function-key "S-F34"       ;; Scroll window down one line (xnews)
  '(lambda () (interactive)
     (scroll-up 1)))

(define-function-key "R15"          ;; PgDn - stays in same column if possible
  '(lambda () (interactive)
     (let ((col (current-column)))
       (next-line (- (window-height) 1))
       (move-to-column col))))

(define-function-key "S-R15"       ;; End of file
  'end-of-buffer)

===============================================

Good luck!

--------------------------------------
Gerd Hoeren
  Integrated Measurement Systems, Inc.
  Beaverton, Oregon  (USA)
  Voice: (503) 626-7117
  Fax:   (503) 644-6969
  Email: gerdh@ims.com
--------------------------------------