Path: utzoo!utgpu!jarvis.csri.toronto.edu!rutgers!ucsd!tut.cis.ohio-state.edu!nsfnet-relay.ac.uk!rde%topexpress.co.uk From: rde%topexpress.co.uk@nsfnet-relay.ac.uk (Richard Evans) Newsgroups: gnu.emacs.bug Subject: keyboard input Message-ID: <7319.8909071656@igor.topexp.co.uk> Date: 7 Sep 89 16:56:49 GMT Sender: daemon@tut.cis.ohio-state.edu Distribution: gnu Organization: GNUs Not Usenet Lines: 303 In GNU Emacs 18.54.3 of Thu Sep 7 1989 on igor (berkeley-unix) I have found a minor problem in keyboard input in the version for Sun3s running OS 4.0 (probably 3.5 also). I have a microcomputer which I use as a terminal. The termulator has simple host <-> terminal file transfer facilities built in and I thought it would be fun to provide an emacs function to upload a file into an emacs buffer. It all works fine, except that occasionally the data is corrupted. I have tracked this down to timing problems in kbd_buffer_char in keyboard.c. There is a critical region near the end during which input interrupts can cause confusion: input_pending = --kbd_count > 0; c = *kbd_ptr; /* *kbd_ptr++ would have a timing error. */ kbd_ptr++; /* See kbd_buffer_store_char. */ I have changed this code to: #ifdef SIGIO { int mask; if (interrupt_input) mask = sigblock (sigmask (SIGIO)); input_pending = --kbd_count > 0; c = *kbd_ptr; /* *kbd_ptr++ would have a timing error. */ kbd_ptr++; /* See kbd_buffer_store_char. */ if (interrupt_input) sigsetmask (mask); } #else input_pending = --kbd_count > 0; c = *kbd_ptr; /* *kbd_ptr++ would have a timing error. */ kbd_ptr++; /* See kbd_buffer_store_char. */ #endif and the problem has gone away. Clearly there are only nasties if input is coming very quickly; it would probably never happen with ordinary typing speeds. ========================================================= The following is not a bug report, but a bit of lisp code which people may find useful. Apologies if this is the wrong mail address to send it to, but as I was sending a but report anyway, I thought I'd tack it on the end. When I started programming in emacs lisp, I found that the biggest problem was knowing the right function for a particular application. To this end, I wrote a little function which generates an alphabetical list of all the emacs functions and variables, together with their documentation strings. I can now scan through this list looking for useful keywords. The code follows; feel free to add it to the distribution if you think its useful. If 'make-bigdoc' is run with a prefix argument, it also loads all the optional lisp files from the search path to make a REALLY big document. (defun make-bigdoc (&optional noextra) (interactive "P") (let (zzz (maps (accessible-keymaps global-map)) (b (get-buffer-create "*bigdoc*")) (sdefun (symbol-function 'defun)) (sdefvar (symbol-function 'defvar)) (sdefconst (symbol-function 'defconst)) (sdefmacro (symbol-function 'defmacro)) (srequire (symbol-function 'require)) ;; Files loaded at startup and files not to be loaded ever. Cons ;; pairs used to allow assoc search. (initfiles '(("subr".0) ("loaddefs".0) ("simple".0) ("help".0) ("files".0) ("indent".0) ("window".0) ("paths".0) ("startup".0) ("lisp".0) ("page".0) ("register".0) ("paragraphs".0) ("lisp-mode".0) ("text-mode".0) ("fill".0) ("c-mode".0) ("isearch".0) ("replace".0) ("vmsproc".0) ("abbrev".0) ("buff-menu".0) ("vms-patch".0) ("site-load".0) ("version".0) ("site-init".0) ("loadup".0) ("default".0) ("inc-vers".0) ("grow-vers".0))) ;; Files NOT to autoload (list for assoc search) (noload '(("edt" . 0) ("edt-doc" . 0) ("medit" . 0) ("x-mouse" .0))) ;; Features to load before final load sequence (featurel '(('sun-fns . nil))) ;; String escape sequences (esc '((?\\ . "\\\\") (?\n . "\\n") (?\r . "\\r") (?\" . "\\\"") (?\t . "\\t") (?\f . "\\f"))) ;; Also taks copies of the global, C-x and ESC keymaps to hide any ;; global definitions in the loaded files. (sglob (copy-keymap global-map)) (sctlx (copy-keymap ctl-x-map)) (sescm (copy-keymap esc-map))) ;; Set up the result buffer (set-buffer b) (buffer-flush-undo b) (erase-buffer) ;; Load all autoloadable functions... ;; ;; Redefine defun, defvar, defconst and defmacro to add file name to ;; property list of symbol. (unwind-protect (let (file (loading t) (checked noextra) (noauto nil)) (fset 'defun '(macro lambda (&rest args) (make-bigdoc-add-file (car args) file) (nconc (list sdefun) args))) (fset 'defvar '(macro lambda (&rest args) (make-bigdoc-add-file (car args) file) (nconc (list sdefvar) args))) (fset 'defconst '(macro lambda (&rest args) (make-bigdoc-add-file (car args) file) (nconc (list sdefconst) args))) (fset 'defmacro '(macro lambda (&rest args) (make-bigdoc-add-file (car args) file) (nconc (list sdefmacro) args))) (fset 'require '(lambda (a &optional b) (let ((save file)) (setq file (or b (symbol-name a))) (nconc initfiles (list (cons file 0))) (if noauto (setq file (concat "*" file))) (funcall srequire a b) (setq file save)))) (while loading (message "Generating list...") (setq zzz (sort (all-completions "" obarray) 'string-lessp)) (message "Checking for autoloads....") (setq loading nil) (mapcar '(lambda (s) (let ((sy (intern s))) (if (fboundp sy) (let ((fn (symbol-function sy))) (if (and (listp fn) (eq (car fn) 'autoload)) (progn (setq file (car (cdr fn))) (nconc initfiles (list (cons file 0))) (if (assoc file noload) () (setq loading t) (load-library file)))))))) zzz) ;; If no autoloads in this loop, check for other files in load ;; path (once only). (if (and (not loading) (not checked)) (let (all (path load-path) need) (setq checked t) (setq loading t) (setq noauto t) ;; Load compulsory files (message "Loading special extra files...") (mapcar '(lambda (a) (require (eval (car a)) (cdr a))) featurel) (message "Checking path for unloaded files...") (nconc initfiles noload) (while path (setq all (append all (directory-files (car path) nil "\\.el$"))) (setq path (cdr path))) (while all (let ((f (substring (car all) 0 -3))) (if (not (assoc f initfiles)) (setq need (append need (list f))))) (setq all (cdr all))) ;; And load them.. (message "Loading all other files in path...") (mapcar '(lambda (a) (setq file (concat "*" a)) (if (not (assoc a initfiles)) (progn (load-library a) (nconc initfiles (list (cons a 0)))))) need))))) ;; Unwind forms to reset functions (fset 'defun sdefun) (fset 'defvar sdefvar) (fset 'defconst sdefconst) (fset 'defmacro sdefmacro) (fset 'require srequire) ;; And keymaps (note ctl-x and esc defined via functions) (fset 'Control-X-prefix sctlx) (fset 'ESC-prefix sescm) (use-global-map sglob)) ;; Scan names to match mode keymaps to functions. A map is recorded only ;; if the function occurs in one map only (and the map is not reachable from ;; the global definitions). (message "Scanning for keymaps...") (let ((scan-map '(lambda (sy map) (if (and (symbolp sy) (fboundp sy)) (setq sy (symbol-function sy))) (let* ((sparse (listp sy)) (list (if sparse (cdr sy))) (len (length sy)) (i 0)) (while (< i len) (let ((fn (if sparse (prog1 (cdr (car list)) (setq list (cdr list))) (aref sy i)))) (setq i (1+ i)) (if (keymapp fn) (funcall scan-map fn map) (if (and (symbolp fn) (fboundp fn)) (let ((p (get fn 'map))) (if (and p (not (eq p map))) (put fn 'map t) (put fn 'map map))))))))))) (mapcar '(lambda (s) (let ((sy (intern s))) (if (boundp sy) (setq sy (symbol-value sy))) (if (and (keymapp sy) (not (rassq sy maps))) (funcall scan-map sy sy)))) zzz)) ;; Generate document! (mapcar '(lambda (s) (let* ((sy (intern s))) (make-bigdoc-entry sy t) (make-bigdoc-entry sy nil) (if (get sy 'map) (put sy 'map nil)))) zzz))) ;; Internal file property adder (defun make-bigdoc-add-file (sy file) (let ((old (get sy 'loadprop))) (if (or (not old) (not (memq file old))) (put sy 'loadprop (append old (list file)))))) ;; Internal function/variable documenter (defun make-bigdoc-entry (sy func) (let (loadfile (x (if func (and (fboundp sy) (documentation sy)) (and (boundp sy) (documentation-property sy 'variable-documentation))))) (if (or (not x) (zerop (length x))) () (if (not (zerop (buffer-size))) (newline)) (message "%s" s) (insert s) (setq loadfile (get sy 'loadprop)) (if loadfile (insert " (" (mapconcat 'identity loadfile "/") ")")) (if (not func) (let ((z (symbol-value sy))) (insert " [v]") (cond ((null z) (insert " (nil)")) ((eq z t) (insert " (t)")) ((stringp z) (let ((len (length z)) (i 0)) (insert " (\"") ;; Check for escape chars! (while (< i len) (let* ((c (aref z i)) (e (assoc c esc))) (setq i (1+ i)) (if (>= (current-column) fill-column) (insert "\\\n")) (insert (cond (e (cdr e)) ((or (<= c 31) (>= c 127)) (format "\\x%02x" c)) (t c))))) (insert "\")"))) ((integerp z) (insert " (" (int-to-string z) ")")))) (insert " [f") (if (commandp sy) (insert "i")) (if (subrp (symbol-function sy)) (insert "s")) (insert "]") (if (commandp sy) (let ((map (get sy 'map)) k) (if (eq map t) (setq map nil)) (setq k (where-is-internal sy map)) (if k (insert (concat " (" (mapconcat 'key-description k ",") ")")))))) (insert ":\n") (insert x) (insert "\n---------\n")))) ------------------------------------------------------------------------------- Richard Evans Telephone : (+44) 223 462121 Topexpress Ltd Telex : 817911 Topexp G Poseidon House, Castle Park Fax : (+44) 223 315057 Cambridge, CB3 0RD, UK E-Mail : rde@uk.co.topexp -------------------------------------------------------------------------------