home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-fixes.el < prev    next >
Lisp/Scheme  |  1995-02-17  |  1KB  |  44 lines
  1. ;;;
  2. ;;; Define a fixed version of ADD-HOOK here so that the CL-19 package
  3. ;;; sees ADD-HOOK as FBOUNDP and doesn't install its broken version.
  4. ;;; 
  5.  
  6. (defun add-hook (hook func &optional append)
  7.   "Add to hook variable HOOK the function FUNC.
  8. FUNC is not added if it already appears on the list stored in HOOK."
  9.   (let ((old (and (boundp hook) (symbol-value hook))))
  10.     (if (or (not (listp old))
  11.         (eq (car old) 'lambda))
  12.     (setq old (list old)))
  13.     (if (not (member func old))
  14.     (set hook (if append (nconc old (list func)) (cons func old))))))
  15.  
  16.  
  17. ;;;
  18. ;;; There are bugs in the internal functions FILE-WRITABLE-P and
  19. ;;; FILE-READABLE-P in DEmacs for DOS.  The following provides new function
  20. ;;; definitions that work.
  21. ;;; 
  22.  
  23. (if (eq system-type 'ms-dos)
  24.     (progn
  25.       (defun browse-file-readable-p (file)
  26.     (let ((attributes (file-attributes file)))
  27.       (and attributes
  28.            (string= (substring (nth 8 attributes) 1 2) "r"))))
  29.  
  30.       (fset 'file-readable-p (symbol-function 'browse-file-readable-p))
  31.  
  32.       (defun browse-file-writable-p (file)
  33.     (let ((attributes (file-attributes file)))
  34.       (or (null attributes)
  35.           (string= (substring (nth 8 attributes) 2 3) "w"))))
  36.  
  37.       (fset 'file-writable-p (symbol-function 'browse-file-writable-p))
  38.  
  39.       (defun browse-file-exists-p (file)
  40.     (not (null (file-attributes file))))
  41.  
  42.       (fset 'file-exists-p (symbol-function 'browse-file-exists-p))))
  43.  
  44. (provide 'br-fixes)