rde%topexpress.co.uk@nsfnet-relay.ac.uk (Richard Evans) (09/07/89)
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
-------------------------------------------------------------------------------