[gnu.emacs.sources] describe-perl-symbol for perl 4.000

jv@mh.nl (Johan Vromans) (04/05/91)

This is a GNU Emacs function that provides a context-sensitive
one-line help message while editing perl programs.

It tries to do its best to guess what the current perl symbol under
point is, however some of the more obscure perl symbols are not always
recognized correctly.

Based on 'describe-lisp-symbol' and others.
Hacked for Perl by Johan Vromans <jv@mh.nl>

This version has been updated for Perl 4.000 (USEnet release). It
contains the following files:

	perl-descr.el	version 1.6
	perl-descr.txt	version 1.7

----------------- Cut Here ---------------
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 04/05/1991 11:37 UTC by jv@largo
# Source directory /u1/users/jv/elisp/src/perldescr
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#    518 -rw-r--r-- README
#   2700 -r--r--r-- perl-descr.el
#   9718 -r--r--r-- perl-descr.txt
#
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
	echo 'x - skipping README (File already exists)'
else
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
This is a GNU Emacs function that provides a context-sensitive
one-line help message while editing perl programs.
X
It tries to do its best to guess what the current perl symbol under
point is, however some of the more obscure perl symbols are not always
recognized correctly.
X
Based on 'describe-lisp-symbol' and others.
Hacked for Perl by Johan Vromans <jv@mh.nl>
X
This version has been updated for Perl 4.000 (USEnet release). It
contains the following files:
X
X	perl-descr.el	version 1.6
X	perl-descr.txt	version 1.7
SHAR_EOF
chmod 0644 README ||
echo 'restore of README failed'
Wc_c="`wc -c < 'README'`"
test 518 -eq "$Wc_c" ||
	echo 'README: original size 518, current size' "$Wc_c"
fi
# ============= perl-descr.el ==============
if test -f 'perl-descr.el' -a X"$1" != X"-c"; then
	echo 'x - skipping perl-descr.el (File already exists)'
else
echo 'x - extracting perl-descr.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'perl-descr.el' &&
;; @(#)@ perl-descr.el	1.6 - describe-perl-symbol
X
;; This file defines the function 'describe-perl-symbol, which
;; displays a one-line information on a perl symbol.
X
;; Based on 'describe-lisp-symbol' and others.
;; Hacked for Perl by Johan Vromans <jv@mh.nl>
X
(defvar perl-doc-file "~/elisp/perl-descr.txt"
X  "*Where the documentation file can be found.")
X
(defun perl-symbol-at-point ()
X  "Get the closest Perl symbol to point, but don't change your
position. Has a preference for looking backward when not
directly on a symbol."
X
X  (let ((perl-wordchars "a-zA-Z0-9_") start end symbol)
X	      
X    (save-excursion
X
X      ;; first see if you're just past a symbol
X      (if (eobp)
X	  (if (not (bobp))
X	      (backward-char 1))
X	(if (looking-at "[] \t\n[{}()]")
X	    (progn
X	      (skip-chars-backward " \n\t\r({[]})")
X	      (if (not (bobp))
X		  (backward-char 1)))))
X
X      (if (looking-at (concat "[$%@]?[" perl-wordchars "]"))
X	  (progn
X	    (skip-chars-backward perl-wordchars)
X	    (setq start (point))
X	    ; Get identifier. Include leading $ % @ to find things like
X	    ; @ARGV and %ENV .
X	    (if (string-match "[$%@]" (char-to-string (preceding-char)))
X		(setq start (1- start))
X	      (forward-char 1))
X	    (skip-chars-forward perl-wordchars))
X
X	;; else a symbol?
X	  (progn
X	    (setq start (point))
X	    (if (looking-at "[$@][^ \n\t]") ; special variable
X		(forward-char 1)
X	      (if (string-match "[$@]" (char-to-string (preceding-char)))
X		  (setq start (1- start))))
X	    (forward-char 1)))
X      (buffer-substring start (point)))))
X
(defun describe-perl-symbol (symbol)
X  "Display the documentation of SYMBOL, a Perl operator."
X  (interactive
X    (let ((fn (perl-symbol-at-point))
X	  (enable-recursive-minibuffers t)
X	  (case-fold-search nil)	;require that case match for search
X	  val args-file regexp)
X      (setq val (read-from-minibuffer
X		  (if fn
X		      (format "Symbol (default %s): " fn)
X		    "Symbol: ")))
X      (if (string= val "")
X	  (setq val fn))
X      (setq regexp (concat "^" (regexp-quote val) "\\([ \t([/]\\|$\\)"))
X
X      ;; get the buffer with the documentation text
X      (if (not (get-file-buffer perl-doc-file))
X	  (progn
X	    (setq args-file
X	      (find-file-noselect perl-doc-file))
X	    (set-buffer args-file)
X	    (rename-buffer "*PERL-DOC*")
X	    (setq buffer-read-only t)))
X      (set-buffer (get-file-buffer perl-doc-file))
X
X      ;; lookup in the doc
X      (goto-char (point-min))
X      (list (if (re-search-forward regexp (point-max) t)
X		(save-excursion
X		  (beginning-of-line 1)
X		  (let ((lnstart (point)))
X		    (end-of-line)
X		    (message "%s" (buffer-substring lnstart (point)))))
X	      (error (format "No definition for %s" val)))))))
SHAR_EOF
chmod 0444 perl-descr.el ||
echo 'restore of perl-descr.el failed'
Wc_c="`wc -c < 'perl-descr.el'`"
test 2700 -eq "$Wc_c" ||
	echo 'perl-descr.el: original size 2700, current size' "$Wc_c"
fi
# ============= perl-descr.txt ==============
if test -f 'perl-descr.txt' -a X"$1" != X"-c"; then
	echo 'x - skipping perl-descr.txt (File already exists)'
else
echo 'x - extracting perl-descr.txt (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'perl-descr.txt' &&
# @(#)@ perl-descr.txt 1.7 - describe-perl-symbol [text] Perl 4.000
!=	Numeric inequality.
!~	Search pattern, substitution, or translation (negated).
$!	If used in a numeric context, yields the current value of errno. If used in a string context, yields the corresponding error string.
$"	The separator which joins elements of arrays interpolated in strings.
$#	The output format for printed numbers. Initial value is %.20g.
$$	The process number of the perl running this script. Altered (in the child process) by fork().
$%	The current page number of the currently selected output channel.
$&	The string matched by the last pattern match.
$'	The string following what was matched by the last pattern match.
$(	The real gid of this process.
$)	The effective gid of this process.
$*	Set to 1 to do multiline matching within a string, 0 to assume strings contain a single line. Default is 0.
$+	The last bracket matched by the last search pattern.
$,	The output field separator for the print operator.
$-	The number of lines left on the page.
$.	The current input line number of the last filehandle that was read.
$/	The input record separator, newline by default.
$0	The name of the file containing the perl script being executed. May be set
$1..	Contains the subpattern from the corresponding set of parentheses in the last pattern matched.
$:	The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format.
$;	The subscript separator for multi-dimensional array emulation. Default is "\034".
$<	The real uid of this process.
$=	The page length of the current output channel. Default is 60 lines.
$>	The effective uid of this process.
$?	The status returned by the last backtick (``) command, pipe close or system operator.
$@	The perl error message from the last eval or do @var{EXPR} command.
$ARGV	The name of the current file used with <> .
$[	The index of the first element in an array, and of the first character in a substring. Default is 0.
$\	The output record separator for the print operator.
$]	The perl version string as displayed with perl -v.
$^	The name of the current top-of-page format. See also $^D, $^I, $^P, $^T, $^W
$^D	The value of the perl debug (-D) flags.
$^I	The value of the in-place edit extension (perl -i option).
$^P	The name under which perl was invoked (argv[0]).
$^T	The time the script was started. Used by -A/-M/-C file tests.
$^W	True is warnings are requested (perl -w flag).
$_	The default input and pattern-searching space.
$`	The string preceding what was matched by the last pattern match.
$|	If set to nonzero, forces a flush after every write or print on the currently selected output channel. Default is 0. The following variables are always local to the current block:
$~	The name of the current report format.
%	Modulo division.
%ENV	Contains the current environment.
%INC	List of files that have been require-d or do-ne.
%SIG	Used to set signal handlers for various signals.
&	Bitwise and.	&& Logical and.
&&	Logical and.
*	Multiplication.	** Exponentiation,
**	Exponentiation.
*NAME	Refers to all objects represented by NAME. *NAM1 = *NAM2 makes NAM1 a reference to NAM2.
+	Addition.	++ Auto-increment
++	Auto-increment (magical on strings).
,	Comma operator.
-	Subtraction.	-- Auto-decrement.
--	Auto-decrement.
-A	Access time in days since script started.
-B	File is a non-text (binary) file.
-C	Creation time in days since script started.
-M	Age in days since script started.
-O	File is owned by real uid.
-R	File is readable by real uid.
-S	File is a socket .
-T	File is a text file.
-W	File is writable by real uid.
-X	File is executable by real uid.
-b	File is a block special file.
-c	File is a character special file.
-d	File is a directory.
-e	File exists .
-f	File is a plain file.
-g	File has setgid bit set.
-k	File has sticky bit set.
-l	File is a symbolic link.
-o	File is owned by effective uid.
-p	File is a named pipe (FIFO).
-r	File is readable by effective uid.
-s	File has non-zero size.
-t	Tests if filehandle (STDIN by default) is opened to a tty.
-u	File has setuid bit set.
-w	File is writable by effective uid.
-x	File is executable by effective uid.
-z	File has zero size.
.	Concatenate strings.	..	Alternation, also range operator.
..	Alternation, also range operator.
/	Division.	/PATTERN/io	Pattern match
/PATTERN/io	Pattern match.
<	Numeric less than.	<<	Bitwise shift left.
<<	Bitwise shift left.
<=	Numeric less than or equal to.	<=> Numeric compare.
<=>	Numeric compare.
==	Numeric equality.	=~	Search pattern, substitution, or translation
>	Numeric greater than.	>=	Numeric greater than or equal to.
>=	Numeric greater than or equal to.	>>	Bitwise shift right.
>>	Bitwise shift right.
? :	Alternation (if-then-else) operator.	?PATTERN?	Backwards pattern match
@ARGV	Contains the command line arguments for the script (not including the command name). See $0 for the command name.
@INC	Contains the list of places to look for perl scripts to be evaluated by the do EXPR command.
@_	Parameter array for subroutines. Also used by split if not in array context.
\0	Octal char, e.g. \033.
\E	Case modification terminator. See \L and \U .
\L	Lowercase until \E .
\U	Upcase until \E .
\a	Alarm character (octal 007).
\b	Backspace character (octal 010).
\c	Control character, e.g. \c[ .
\e	Escape character (octal 033).
\f	Formfeed character (octal 014).
\l	Lowercase of next character. See also \L and \u,
\n	Newline character (octal 012).
\r	Return character (octal 015).
\t	Tab character (octal 011).
\u	Upcase  of next character. See also \U and \l,
\x	Hex character, e.g. \x1b.
^	Bitwise exclusive or.
accept(NEWSOCKET,GENERICSOCKET)
alarm(SECONDS)
atan2(X,Y)
bind(SOCKET,NAME)
binmode(FILEHANDLE)
caller[(LEVEL)]
chdir(EXPR)
chmod(LIST)
chop[(LIST|VAR)]
chown(LIST)
chroot(FILENAME)
close(FILEHANDLE)
closedir(DIRHANDLE)
cmp	String compare.
connect(SOCKET,NAME)
cos(EXPR)
crypt(PLAINTEXT,SALT)
dbmclose(ASSOC_ARRAY)
dbmopen(ASSOC,DBNAME,MODE)
defined(EXPR)
delete($ASSOC{KEY})
die(LIST)
do { ... }|SUBR while|until EXPR	executes at least once
do(EXPR|SUBR([LIST]))
dump(LABEL)
each(ASSOC_ARRAY)
endgrent
endhostent
endnetent
endprotoent
endpwent
endservent
eof[([FILEHANDLE])]
eq	String equality.
eval(EXPR)
exec(LIST)
exit(EXPR)
exp(EXPR)
fcntl(FILEHANDLE,FUNCTION,SCALAR)
fileno(FILEHANDLE)
flock(FILEHANDLE,OPERATION)
for (EXPR;EXPR;EXPR) { ... }
foreach [VAR] (@ARRAY) { ... }
fork
ge	String greater than or equal.
getc[(FILEHANDLE)]
getgrent
getgrgid(GID)
getgrnam(NAME)
gethostbyaddr(ADDR,ADDRTYPE)
gethostbyname(NAME)
gethostent
getlogin
getnetbyaddr(ADDR,ADDRTYPE)
getnetbyname(NAME)
getnetent
getpeername(SOCKET)
getpgrp(PID)
getppid
getpriority(WHICH,WHO)
getprotobyname(NAME)
getprotobynumber(NUMBER)
getprotoent
getpwent
getpwnam(NAME)
getpwuid(UID)
getservbyname(NAME,PROTO)
getservbyport(PORT,PROTO)
getservent
getsockname(SOCKET)
getsockopt(SOCKET,LEVEL,OPTNAME)
gmtime(EXPR)
goto(LABEL)
grep(EXPR,LIST)
gt	String greater than.
hex(EXPR)
if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR
index(STR,SUBSTR[,OFFSET])
int(EXPR)
ioctl(FILEHANDLE,FUNCTION,SCALAR)
join(EXPR,LIST)
keys(ASSOC_ARRAY)
kill(LIST)
last[(LABEL)]
le	String less than or equal.
length(EXPR)
link(OLDFILE,NEWFILE)
listen(SOCKET,QUEUESIZE)
local(LIST)
localtime(EXPR)
log(EXPR)
lstat(EXPR|FILEHANDLE|VAR)
lt	String less than.
m/PATTERN/io
mkdir(FILENAME,MODE)
msgctl(ID,CMD,ARG)
msgget(KEY,FLAGS)
msgrcv(ID,VAR,SIZE,TYPE.FLAGS)
msgsnd(ID,MSG,FLAGS)
ne	String inequality.
next[(LABEL)]
oct(EXPR)
open(FILEHANDLE[,EXPR])
opendir(DIRHANDLE,EXPR)
ord(EXPR)
pack(TEMPLATE,LIST)
package	Introduces package context.
pipe(READHANDLE,WRITEHANDLE)
pop(ARRAY)
print[(FILEHANDLE [LIST])]
printf([FILEHANDLE] LIST)
push(ARRAY,LIST)
q/STRING/	Synonym for 'STRING'
qq/STRING/	Synonym for "STRING"
qx/STRING/	Synonym for `STRING`
rand[(EXPR)]
read(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
readdir(DIRHANDLE)
readlink(EXPR)
recv(SOCKET,SCALAR,LEN,FLAGS)
redo[(LABEL)]
rename(OLDNAME,NEWNAME)
require [FILENAME]
reset[(EXPR)]
return(LIST)
reverse(LIST)
rewinddir(DIRHANDLE)
rindex(STR,SUBSTR[,OFFSET])
rmdir(FILENAME)
s/PATTERN/REPLACEMENT/gieo
scalar(EXPR)
seek(FILEHANDLE,POSITION,WHENCE)
seekdir(DIRHANDLE,POS)
select(FILEHANDLE | RBITS,WBITS,EBITS,TIMEOUT)
semctl(ID,SEMNUM,CMD,ARG)
semget(KEY,NSEMS,SIZE,FLAGS)
semop(KEY,...)
send(SOCKET,MSG,FLAGS[,TO])
setgrent
sethostent(STAYOPEN)
setnetent(STAYOPEN)
setpgrp(PID,PGRP)
setpriority(WHICH,WHO,PRIORITY)
setprotoent(STAYOPEN)
setpwent
setservent(STAYOPEN)
setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)
shift[(ARRAY)]
shmctl(ID,CMD,ARG)
shmget(KEY,SIZE,FLAGS)
shmread(ID,VAR,POS,SIZE)
shmwrite(ID,STRING,POS,SIZE)
shutdown(SOCKET,HOW)
sin(EXPR)
sleep[(EXPR)]
socket(SOCKET,DOMAIN,TYPE,PROTOCOL)
socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)
sort([SUBROUTINE] LIST)
splice(ARRAY,OFFSET[,LENGTH[,LIST]])
split[(/PATTERN/[,EXPR[,LIMIT]])]
sprintf(FORMAT,LIST)
sqrt(EXPR)
srand(EXPR)
stat(EXPR|FILEHANDLE|VAR)
study[(SCALAR)]
substr(EXPR,OFFSET[,LEN])
symlink(OLDFILE,NEWFILE)
syscall(LIST)
sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
system(LIST)
syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
tell[(FILEHANDLE)]
telldir(DIRHANDLE)
time
times
tr/SEARCHLIST/REPLACEMENTLIST/cds
truncate(FILE|EXPR,LENGTH)
umask[(EXPR)]
undef[(EXPR)]
unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR
unlink(LIST)
unpack(TEMPLATE,EXPR)
unshift(ARRAY,LIST)
until (EXPR) { ... } or EXPR until EXPR
utime(LIST)
values(ASSOC_ARRAY)
vec(EXPR,OFFSET,BITS)
wait
waitpid(PID,FLAGS)
wantarray
warn(LIST)
while  (EXPR) { ... } or EXPR while EXPR
write[(EXPR|FILEHANDLE)]
x	Repeat string or array.
y/SEARCHLIST/REPLACEMENTLIST/
|	Bitwise or.	||	Logical or.
||	Logical or.
SHAR_EOF
chmod 0444 perl-descr.txt ||
echo 'restore of perl-descr.txt failed'
Wc_c="`wc -c < 'perl-descr.txt'`"
test 9718 -eq "$Wc_c" ||
	echo 'perl-descr.txt: original size 9718, current size' "$Wc_c"
fi
exit 0
-- 
Johan Vromans				       jv@mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62911/62500
------------------------ "Arms are made for hugging" -------------------------