;; -*- mode: emacs-lisp; unibyte: t; -*- ;; ekapropo.el --- Apropos for all kind of Emacs symbols ;; Copyright (C) 1992-2000 Ehud karni ;; This file is NOT part of GNU Emacs, distribution conditions below. ;; ;; EHUD KARNI ינרק דוהא ;; Ben Gurion st' 14 ןוירוג ןב 'חר ;; Kfar - Sava 44 257 אבס - רפכ ;; =================================== ;; 972-(0)9-7659599 ;; =================================== ;; RCS: $Id: ekapropo.el,v 1.104 2000/03/05 14:54:00 ehud Exp ehud $ ;; ;; LOG: $Log: ekapropo.el,v $ ;; Revision 1.104 2000/03/05 14:54:00 ehud ;; Comment headers changes (NOT GNU) + very minor changes ;; ;; Revision 1.103 1998/11/11 13:12:18 ehud ;; Technically modified only. Really last revision for 19.34. ;; ;; Revision 1.102 1998/03/15 16:54:00 ehud ;; Last revision for 19.34 ;; ;; Revision 1.101 1996/02/19 10:21:39 ehud ;; Emacs 19.30 version ;; ;; Revision 1.100 1995/01/19 17:15:19 ehud ;; SW initial version control for all el's ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (defcustom ek-apropos-buffer-name "*Ehuds-Help*" "Buffer name for ek-apropos output, set to *Help* if you want it to be the same as other help (e.g. describe-variable) functions." :type 'string :group 'Ehuds ) (defun ek-apropos (arg type) "Lists all symbols that are names of functions or variables and contain REG-EXP, and matches optional TYPE. If TYPE is given it must be a string, allowable values are: f - function of any type fa - function - aliases only fb - function - built in only fc - function - command (interactive) fl - function - lisp (compiled) v - variable of any type va - variable of type array ve - variable of type event vf - variable of type floating point vk - variable of type key map vl - variable of type list vm - variable of type marker vn - variable of type number vs - variable of type string vv - variable of type vector n - non symbols - un assigned function names, others ?" (interactive "sApropos for symbol (regexp): \nsType of apropos (spc-all, f[a,b,c,l]=functions, v[a,e,f,k,l,m,n,s,v]=variables: ") (require 'ekapropo) (ek-apropos-inter arg type)) (defun ek-apropos-ptp (position length face &optional object) "Internal ek-apropos function. Set face property only for X / pseudo X" ;; (if faces-on (put-text-property position length 'face face object)) ;; ) (defun ek-apropos-inter (arg type) "Internal ek-apropos function. Do real work" (autoload 'swhelp-make-fonts "swhelp") ;; (if faces-on (swhelp-make-fonts) ;; ) (setq type (downcase (substring (concat type " ") 0 2))) (let (buf (get-buffer ek-apropos-buffer-name)) (if buf (kill-buffer buf))) (with-output-to-temp-buffer ek-apropos-buffer-name (let* ((svbuf (buffer-name)) fc-vr fcdoc (pred (cond ((string-equal type "f ") 'true) ((string-equal type "fa") 'symbolp) ((string-equal type "fb") 'subrp) ((string-equal type "fc") 'commandp) ((string-equal type "fl") 'byte-code-function-p) ((string-equal type "v ") 'true) ((string-equal type "va") 'arrayp) ((string-equal type "ve") 'eventp) ((string-equal type "vf") 'floatp) ((string-equal type "vk") 'keymapp) ((string-equal type "vl") 'listp) ((string-equal type "vm") 'markerp) ((string-equal type "vn") 'numberp) ((string-equal type "vs") 'stringp) ((string-equal type "vv") 'vectorp) (t 'true))) (fc-vr-list (apropos-internal arg)) p1) (set-buffer standard-output) (setq type (substring type 0 1)) (while fc-vr-list (setq fc-vr (car fc-vr-list)) (and (fboundp fc-vr) (string-match type " f") (funcall pred (symbol-function fc-vr)) (progn (setq fcdoc nil) (setq p1 (+ (point) 2)) (princ "\n\nFunction: ") (ek-apropos-ptp p1 (- (point) 3) 'swhelp-font-02) (setq p1 (point)) (prin1 fc-vr) (princ " ") (ek-apropos-ptp p1 (1- (point)) 'swhelp-font-01) (let ((fvt (symbol-function fc-vr)) ;; function type (fva) (fvd)) ;; arguments, documentation / value (cond ((or (stringp fvt) (vectorp fvt)) (setq fva (concat " definition: " (prin1-to-string fvt))) (ek-apropos-ptp 12 (length fva) 'swhelp-font-09 fva)) ((eq (car-safe fvt) 'autoload) (setq fva " (Autoloaded).") (ek-apropos-ptp 1 (length fva) 'swhelp-font-06 fva)) ((eq (car-safe fvt) 'lambda) (setq fvd t) (setq fva (nth 1 fvt))) ((eq (car-safe fvt) 'macro) (setq fva " (Lisp macro).") (ek-apropos-ptp 1 (length fva) 'swhelp-font-06 fva)) ((subrp fvt) (setq fva " (built-in).") (ek-apropos-ptp 1 (length fva) 'swhelp-font-06 fva)) ((byte-code-function-p fvt) (setq fvd t) (setq fva (car (append fvt nil)))) ((symbolp fvt) (setq fcdoc "") (setq fva (format "alias for `%s'." fvt)) (ek-apropos-ptp 11 (- (length fva) 2) 'swhelp-font-06 fva)) ) (and fvd (setq fva (prin1-to-string (or (mapcar (lambda (arg) (if (memq arg '(&optional &rest)) arg (intern (upcase (symbol-name arg))))) fva) "no arguments") 'NOescape)) (ek-apropos-ptp 0 (length fva) 'swhelp-font-09 fva)) (if fva (progn (princ " ") (insert fva)))) (princ "\n") (and fc-vr (not (string-equal fcdoc "")) (setq fcdoc (documentation fc-vr))) (princ (or fcdoc "not documented !!")))) (and (boundp fc-vr) (string-match type " v") (funcall pred (symbol-value fc-vr)) (progn (setq fcdoc nil) (setq p1 (+ (point) 2)) (princ "\n\nVariable: ") (ek-apropos-ptp p1 (- (point) 3) 'swhelp-font-02) (setq p1 (point)) (prin1 fc-vr) (ek-apropos-ptp p1 (point) 'swhelp-font-05) (princ ". Its value is: ") (setq p1 (point)) (prin1 (symbol-value fc-vr)) (princ "\n") (ek-apropos-ptp p1 (1- (point)) 'swhelp-font-09) (setq fcdoc (documentation-property fc-vr 'variable-documentation)) (princ (or fcdoc "not documented !!")))) (and (not (fboundp fc-vr)) (not (boundp fc-vr)) (string-match type " n") (progn (setq p1 (+ (point) 2)) (princ "\n\nNon-Symbol: ") (ek-apropos-ptp p1 (- (point) 2) 'swhelp-font-07) (setq p1 (point)) (prin1 fc-vr) (ek-apropos-ptp p1 (point) 'swhelp-font-01))) (setq fc-vr-list (cdr fc-vr-list))) (help-make-xrefs) (help-mode) (pop-to-buffer svbuf)))) (provide 'ekapropo) ;;============================== ekapropo.el ends here ==============================