|
|
1.1 ! root 1: ;;; ! 2: ;;; Support (cleanly) for Sun function keys. Provides help facilities, ! 3: ;;; better diagnostics, etc. ! 4: ;;; ! 5: ;;; To use: make sure your .ttyswrc binds 'F1' to <ESC> * F1 <CR> and so on. ! 6: ;;; load this lot from your start_up ! 7: ;;; ! 8: ;;; ! 9: ;;; Copyright (C) 1986 Free Software Foundation, Inc. ! 10: ;;; ! 11: ;;; This file is part of GNU Emacs. ! 12: ;;; ! 13: ;;; GNU Emacs is distributed in the hope that it will be useful, ! 14: ;;; but without any warranty. No author or distributor ! 15: ;;; accepts responsibility to anyone for the consequences of using it ! 16: ;;; or for whether it serves any particular purpose or works at all, ! 17: ;;; unless he says so in writing. ! 18: ;;; ! 19: ;;; Everyone is granted permission to copy, modify and redistribute ! 20: ;;; GNU Emacs, but only under the conditions described in the ! 21: ;;; document "GNU Emacs copying permission notice". An exact copy ! 22: ;;; of the document is supposed to have been given to you along with ! 23: ;;; GNU Emacs so that you can know how you may redistribute it all. ! 24: ;;; It should be in a file named COPYING. Among other things, the ! 25: ;;; copyright notice and this notice must be preserved on all copies. ! 26: ;;; ! 27: ;;; [email protected] (Ian G. Batten) ! 28: ;;; ! 29: ! 30: (defun sun-function-keys-dispatch (arg) ! 31: "Dispatcher for function keys." ! 32: (interactive "p") ! 33: (let* ((key-stroke (read t)) ! 34: (command (assq key-stroke sun-function-keys-command-list))) ! 35: (cond (command (funcall (cdr command) arg)) ! 36: (t (error "Unbound function key %s" key-stroke))))) ! 37: ! 38: (defvar sun-function-keys-command-list ! 39: '((F1 . sun-function-keys-describe-bindings) ! 40: (R8 . previous-line) ; arrow keys ! 41: (R10 . backward-char) ! 42: (R12 . forward-char) ! 43: (R14 . next-line))) ! 44: ! 45: (defun sun-function-keys-bind-key (arg1 arg2) ! 46: "Bind a specified key." ! 47: (interactive "xFunction Key Cap Label: ! 48: CCommand To Use:") ! 49: (setq sun-function-keys-command-list ! 50: (cons (cons arg1 arg2) sun-function-keys-command-list))) ! 51: ! 52: (defun sun-function-keys-describe-bindings (arg) ! 53: "Describe the function key bindings we're running" ! 54: (interactive) ! 55: (with-output-to-temp-buffer "*Help*" ! 56: (sun-function-keys-write-bindings ! 57: (sort (copy-sequence sun-function-keys-command-list) ! 58: '(lambda (x y) (string-lessp (car x) (car y))))))) ! 59: ! 60: (defun sun-function-keys-write-bindings (list) ! 61: (cond ((null list) ! 62: t) ! 63: (t ! 64: (princ (format "%s: %s\n" ! 65: (car (car list)) ! 66: (cdr (car list)))) ! 67: (sun-function-keys-write-bindings (cdr list))))) ! 68: ! 69: (global-set-key "\e*" 'sun-function-keys-dispatch) ! 70: ! 71: (make-variable-buffer-local 'sun-function-keys-command-list)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.