Mercurial > hg > xemacs-beta
comparison lisp/hyperbole/hibtypes.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | 4103f0995bd7 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;!emacs | |
| 2 ;; | |
| 3 ;; FILE: hibtypes.el | |
| 4 ;; SUMMARY: Hyperbole System Implicit Button Types. | |
| 5 ;; USAGE: GNU Emacs Lisp Library | |
| 6 ;; KEYWORDS: extensions, hypermedia | |
| 7 ;; | |
| 8 ;; AUTHOR: Bob Weiner | |
| 9 ;; ORG: Brown U. | |
| 10 ;; | |
| 11 ;; ORIG-DATE: 19-Sep-91 at 20:45:31 | |
| 12 ;; LAST-MOD: 3-Nov-95 at 22:49:12 by Bob Weiner | |
| 13 ;;; ************************************************************************ | |
| 14 ;;; Other required Elisp libraries | |
| 15 ;;; ************************************************************************ | |
| 16 | |
| 17 (require 'hactypes) | |
| 18 | |
| 19 ;;; ************************************************************************ | |
| 20 ;;; Public implicit button types | |
| 21 ;;; ************************************************************************ | |
| 22 | |
| 23 (run-hooks 'hibtypes:begin-load-hook) | |
| 24 | |
| 25 ;;; ======================================================================== | |
| 26 ;;; Follows URLs by invoking a browser. | |
| 27 ;;; ======================================================================== | |
| 28 | |
| 29 (require 'hsys-w3) | |
| 30 | |
| 31 ;;; ======================================================================== | |
| 32 ;;; Handles internal references within an annotated bibliography, delimiters=[] | |
| 33 ;;; ======================================================================== | |
| 34 | |
| 35 (defib annot-bib () | |
| 36 "Displays annotated bibliography entries referenced internally. | |
| 37 References must be delimited by square brackets, must begin with a word | |
| 38 constituent character, and must not be in buffers whose names begin with a | |
| 39 ' ' or '*' character or which do not have an attached file." | |
| 40 (and (not (bolp)) | |
| 41 buffer-file-name | |
| 42 (let ((chr (aref (buffer-name) 0))) | |
| 43 (not (or (= chr ? ) (= chr ?*)))) | |
| 44 (let* ((ref-and-pos (hbut:label-p t "[" "]" t)) | |
| 45 (ref (car ref-and-pos))) | |
| 46 (and ref (= ?w (char-syntax (aref ref 0))) | |
| 47 (progn (ibut:label-set ref-and-pos) | |
| 48 (hact 'annot-bib ref)))))) | |
| 49 | |
| 50 ;;; ======================================================================== | |
| 51 ;;; Summarizes an Internet rfc for random access browsing by section. | |
| 52 ;;; ======================================================================== | |
| 53 | |
| 54 (defib rfc-toc () | |
| 55 "Summarizes contents of an Internet rfc from anywhere within rfc buffer. | |
| 56 Each line in summary may be selected to jump to section." | |
| 57 (let ((case-fold-search t) | |
| 58 (toc) | |
| 59 (opoint (point))) | |
| 60 (if (and (string-match "rfc" (buffer-name)) | |
| 61 (goto-char (point-min)) | |
| 62 (progn (setq toc (search-forward "Table of Contents" nil t)) | |
| 63 (re-search-forward "^[ \t]*1.0?[ \t]+[^ \t\n]" nil t | |
| 64 (and toc 2)))) | |
| 65 (progn (beginning-of-line) | |
| 66 (ibut:label-set (buffer-name)) | |
| 67 (hact 'rfc-toc (buffer-name) opoint)) | |
| 68 (goto-char opoint) | |
| 69 nil))) | |
| 70 | |
| 71 ;;; ======================================================================== | |
| 72 ;;; Jumps to C/C++ source line associated with Cscope C analyzer output line. | |
| 73 ;;; ======================================================================== | |
| 74 | |
| 75 (defib cscope () | |
| 76 "Jumps to C/C++ source line associated with Cscope C analyzer output line. | |
| 77 Requires pre-loading of the cscope.el Lisp library available from the Emacs | |
| 78 Lisp archives and the commercial cscope program available from UNIX System | |
| 79 Laboratories. Otherwise, does nothing." | |
| 80 (and (boundp 'cscope:bname-prefix) ;; (featurep 'cscope) | |
| 81 (stringp cscope:bname-prefix) | |
| 82 (string-match (regexp-quote cscope:bname-prefix) | |
| 83 (buffer-name)) | |
| 84 (= (match-beginning 0) 0) | |
| 85 (save-excursion | |
| 86 (beginning-of-line) | |
| 87 (looking-at cscope-output-line-regexp)) | |
| 88 (let (start end) | |
| 89 (skip-chars-backward "^\n\^M") | |
| 90 (setq start (point)) | |
| 91 (skip-chars-forward "^\n\^M") | |
| 92 (setq end (point)) | |
| 93 (ibut:label-set (buffer-substring start end) | |
| 94 start end) | |
| 95 (hact 'cscope-interpret-output-line)))) | |
| 96 | |
| 97 ;;; ======================================================================== | |
| 98 ;;; Makes README table of contents entries jump to associated sections. | |
| 99 ;;; ======================================================================== | |
| 100 | |
| 101 (defib text-toc () | |
| 102 "Jumps to the text file section referenced by a table of contents entry at point. | |
| 103 File name must contain README and there must be a `Table of Contents' or | |
| 104 `Contents' label on a line by itself (it may begin with an asterisk), | |
| 105 preceding the table of contents. Each toc entry must begin with some | |
| 106 whitespace followed by one or more asterisk characters. Each file section | |
| 107 name line must start with one or more asterisk characters at the very | |
| 108 beginning of the line." | |
| 109 (let (section) | |
| 110 (if (and (string-match "README" (buffer-name)) | |
| 111 (save-excursion | |
| 112 (beginning-of-line) | |
| 113 (if (looking-at | |
| 114 "[ \t]+\\*+[ \t]+\\(.*[^ \t]\\)[ \t]*$") | |
| 115 (setq section (buffer-substring (match-beginning 1) | |
| 116 (match-end 1))))) | |
| 117 (progn (ibut:label-set section (match-beginning 1) (match-end 1)) | |
| 118 t) | |
| 119 (save-excursion (re-search-backward | |
| 120 "^\\**[ \t]*\\(Table of \\)Contents[ \t]*$" | |
| 121 nil t))) | |
| 122 (hact 'text-toc section)))) | |
| 123 | |
| 124 ;;; ======================================================================== | |
| 125 ;;; Makes directory summaries into file list menus. | |
| 126 ;;; ======================================================================== | |
| 127 | |
| 128 (defib dir-summary () | |
| 129 "Detects filename buttons in files named \"MANIFEST\" or \"DIR\". | |
| 130 Displays selected files. Each file name must be at the beginning of the line | |
| 131 or may be preceded by some semicolons and must be followed by one or more | |
| 132 spaces and then another non-space, non-parenthesis, non-brace character." | |
| 133 (if buffer-file-name | |
| 134 (let ((file (file-name-nondirectory buffer-file-name)) | |
| 135 entry start end) | |
| 136 (if (or (string= file "DIR") (string= file "MANIFEST")) | |
| 137 (save-excursion | |
| 138 (beginning-of-line) | |
| 139 (if (looking-at | |
| 140 "\\(;+[ \t]*\\)?\\([^(){}* \t\n]+\\)[ \t]+[^(){}* \t\n]") | |
| 141 (progn | |
| 142 (setq entry (buffer-substring | |
| 143 (match-beginning 2) (match-end 2)) | |
| 144 start (match-beginning 2) | |
| 145 end (match-end 2)) | |
| 146 (if (file-exists-p entry) | |
| 147 (progn (ibut:label-set entry start end) | |
| 148 (hact 'link-to-file entry)))))))))) | |
| 149 | |
| 150 ;;; ======================================================================== | |
| 151 ;;; Executes or documents command bindings of brace delimited key sequences. | |
| 152 ;;; ======================================================================== | |
| 153 | |
| 154 (require 'hib-kbd) | |
| 155 | |
| 156 ;;; ======================================================================== | |
| 157 ;;; Makes Internet RFC references retrieve the RFC. | |
| 158 ;;; ======================================================================== | |
| 159 | |
| 160 (defib rfc () | |
| 161 "Retrieves and displays an Internet rfc referenced at point. | |
| 162 Requires ange-ftp or efs when needed for remote retrievals. The following | |
| 163 formats are recognized: RFC822, rfc-822, and RFC 822. The 'hpath:rfc' | |
| 164 variable specifies the location from which to retrieve RFCs." | |
| 165 (let ((case-fold-search t) | |
| 166 (rfc-num nil)) | |
| 167 (and (not (memq major-mode '(dired-mode monkey-mode))) | |
| 168 (boundp 'hpath:rfc) | |
| 169 (stringp hpath:rfc) | |
| 170 (save-excursion | |
| 171 (skip-chars-backward "-rRfFcC0-9") | |
| 172 (if (looking-at "rfc[- ]?\\([0-9]+\\)") | |
| 173 (progn | |
| 174 (setq rfc-num | |
| 175 (buffer-substring | |
| 176 (match-beginning 1) (match-end 1))) | |
| 177 (ibut:label-set | |
| 178 (buffer-substring (match-beginning 0) (match-end 0))) | |
| 179 t))) | |
| 180 ;; Ensure ange-ftp is available for retrieving a remote | |
| 181 ;; RFC, if need be. | |
| 182 (if (string-match "^/.+:" hpath:rfc) | |
| 183 ;; This is a remote path. | |
| 184 (hpath:ange-ftp-available-p) | |
| 185 ;; local path | |
| 186 t) | |
| 187 (hact 'link-to-rfc rfc-num)))) | |
| 188 | |
| 189 ;;; ======================================================================== | |
| 190 ;;; Makes Hyperbole mail addresses output Hyperbole envir info. | |
| 191 ;;; ======================================================================== | |
| 192 | |
| 193 (defib hyp-address () | |
| 194 "Turns a Hyperbole e-mail list address into an implicit button which inserts Hyperbole environment information. | |
| 195 Useful when sending mail to a Hyperbole mail list. | |
| 196 See also the documentation for `actypes::hyp-config'." | |
| 197 (if (memq major-mode (list hmail:composer hnews:composer)) | |
| 198 (let ((addr (find-tag-default))) | |
| 199 (cond ((set:member addr (list "hyperbole" "hyperbole@hub.ucsb.edu")) | |
| 200 (hact 'hyp-config)) | |
| 201 ((set:member addr | |
| 202 (list "hyperbole-request" | |
| 203 "hyperbole-request@hub.ucsb.edu")) | |
| 204 (hact 'hyp-request)) | |
| 205 )))) | |
| 206 | |
| 207 ;;; ======================================================================== | |
| 208 ;;; Makes source entries in Hyperbole reports selectable. | |
| 209 ;;; ======================================================================== | |
| 210 | |
| 211 (defib hyp-source () | |
| 212 "Turns source location entries in Hyperbole reports into buttons that jump to the associated location." | |
| 213 (save-excursion | |
| 214 (beginning-of-line) | |
| 215 (if (looking-at hbut:source-prefix) | |
| 216 (let ((src (hbut:source))) | |
| 217 (if src | |
| 218 (progn (if (not (stringp src)) (setq src (prin1-to-string src))) | |
| 219 (ibut:label-set src (point) (progn (end-of-line) (point))) | |
| 220 (hact 'hyp-source src))))))) | |
| 221 | |
| 222 ;;; ======================================================================== | |
| 223 ;;; Shows man page associated with a man apropos entry. | |
| 224 ;;; ======================================================================== | |
| 225 | |
| 226 (defib man-apropos () | |
| 227 "Makes man apropos entries display associated man pages when selected." | |
| 228 (save-excursion | |
| 229 (beginning-of-line) | |
| 230 (let ((nm "[^ \t\n!@,][^ \t\n,]*") | |
| 231 topic) | |
| 232 (and (looking-at | |
| 233 (concat | |
| 234 "^\\(\\*[ \t]+[!@]\\)?\\(" nm "[ \t]*,[ \t]*\\)*\\(" nm "\\)[ \t]*" | |
| 235 "\\(([-0-9a-zA-z]+)\\)\\(::\\)?[ \t]+-[ \t]+[^ \t\n]")) | |
| 236 (setq topic | |
| 237 (concat (buffer-substring (match-beginning 3) (match-end 3)) | |
| 238 (buffer-substring (match-beginning 4) (match-end 4)))) | |
| 239 (ibut:label-set topic (match-beginning 3) (match-end 4)) | |
| 240 (hact 'man-show topic))))) | |
| 241 | |
| 242 ;;; ======================================================================== | |
| 243 ;;; Follows links to Hyperbole outliner cells. | |
| 244 ;;; ======================================================================== | |
| 245 | |
| 246 (if hyperb:kotl-p (require 'klink)) | |
| 247 | |
| 248 ;;; ======================================================================== | |
| 249 ;;; Displays files and directories when double quoted pathname is activated. | |
| 250 ;;; ======================================================================== | |
| 251 | |
| 252 (defib pathname () | |
| 253 "Makes a delimited, valid pathname display the path entry. | |
| 254 Also works for delimited and non-delimited ange-ftp and efs pathnames. | |
| 255 See `hpath:at-p' function documentation for possible delimiters. | |
| 256 See `hpath:suffixes' variable documentation for suffixes that are added to or | |
| 257 removed from pathname when searching for a valid match. | |
| 258 See `hpath:find' function documentation and `hpath:display-alist' and | |
| 259 `hpath:find-alist' variable documentation for special file display options." | |
| 260 (let ((path (hpath:at-p))) | |
| 261 (if path | |
| 262 (progn (ibut:label-set path) | |
| 263 (hact 'link-to-file path))))) | |
| 264 | |
| 265 ;;; ======================================================================== | |
| 266 ;;; Jumps to source line associated with debugger stack frame or breakpoint | |
| 267 ;;; lines. Supports gdb, dbx, and xdb. | |
| 268 ;;; ======================================================================== | |
| 269 | |
| 270 (defib debugger-source () | |
| 271 "Jumps to source line associated with debugger stack frame or breakpoint lines. | |
| 272 This works with gdb, dbx, and xdb. Such lines are recognized in any buffer." | |
| 273 (save-excursion | |
| 274 (beginning-of-line) | |
| 275 (cond ((looking-at ".+ \\(at\\|file\\) \\([^ :]+\\):\\([0-9]+\\)\\.?$") | |
| 276 ;; GDB | |
| 277 (let* ((file (buffer-substring (match-beginning 2) | |
| 278 (match-end 2))) | |
| 279 (line-num (buffer-substring (match-beginning 3) | |
| 280 (match-end 3))) | |
| 281 (but-label (concat file ":" line-num))) | |
| 282 (setq line-num (string-to-int line-num)) | |
| 283 (ibut:label-set but-label) | |
| 284 (hact 'link-to-file-line file line-num))) | |
| 285 ((looking-at ".+ (file=[^\"\n]+\"\\([^\"\n]+\\)\", line=\\([0-9]+\\),") | |
| 286 ;; XEmacs assertion failure | |
| 287 (let* ((file (buffer-substring (match-beginning 1) | |
| 288 (match-end 1))) | |
| 289 (line-num (buffer-substring (match-beginning 2) | |
| 290 (match-end 2))) | |
| 291 (but-label (concat file ":" line-num))) | |
| 292 (setq line-num (string-to-int line-num)) | |
| 293 (ibut:label-set but-label) | |
| 294 (hact 'link-to-file-line file line-num))) | |
| 295 ((looking-at ".+ line \\([0-9]+\\) in \"\\([^\"]+\\)\"$") | |
| 296 ;; New DBX | |
| 297 (let* ((file (buffer-substring (match-beginning 2) | |
| 298 (match-end 2))) | |
| 299 (line-num (buffer-substring (match-beginning 1) | |
| 300 (match-end 1))) | |
| 301 (but-label (concat file ":" line-num))) | |
| 302 (setq line-num (string-to-int line-num)) | |
| 303 (ibut:label-set but-label) | |
| 304 (hact 'link-to-file-line file line-num))) | |
| 305 ((or (looking-at ".+ \\[\"\\([^\"]+\\)\":\\([0-9]+\\),") ;; Old DBX | |
| 306 (looking-at ".+ \\[\\([^: ]+\\): \\([0-9]+\\)\\]")) ;; HP-UX xdb | |
| 307 (let* ((file (buffer-substring (match-beginning 1) | |
| 308 (match-end 1))) | |
| 309 (line-num (buffer-substring (match-beginning 2) | |
| 310 (match-end 2))) | |
| 311 (but-label (concat file ":" line-num))) | |
| 312 (setq line-num (string-to-int line-num)) | |
| 313 (ibut:label-set but-label) | |
| 314 (hact 'link-to-file-line file line-num)))))) | |
| 315 | |
| 316 ;;; ======================================================================== | |
| 317 ;;; Jumps to source line associated with grep or compilation error messages. | |
| 318 ;;; With credit to Michael Lipp and Mike Williams for the idea. | |
| 319 ;;; ======================================================================== | |
| 320 | |
| 321 (defib grep-msg () | |
| 322 "Jumps to line associated with grep or compilation error msgs. | |
| 323 Messages are recognized in any buffer." | |
| 324 (progn | |
| 325 (if (equal (buffer-name) "*compilation*") | |
| 326 (progn | |
| 327 (require 'compile) | |
| 328 ;; Make sure we have a parsed error-list | |
| 329 (if (eq compilation-error-list t) | |
| 330 (progn (compilation-forget-errors) | |
| 331 (setq compilation-parsing-end 1))) | |
| 332 (if (not compilation-error-list) | |
| 333 (save-excursion | |
| 334 (set-buffer-modified-p nil) | |
| 335 (condition-case () | |
| 336 ;; Emacs V19 incompatibly adds two non-optional arguments | |
| 337 ;; over V18. | |
| 338 (compilation-parse-errors nil nil) | |
| 339 (error (compilation-parse-errors))))))) | |
| 340 ;; Locate and parse grep messages found in any buffer. | |
| 341 (save-excursion | |
| 342 (beginning-of-line) | |
| 343 (if (or | |
| 344 ;; UNIX C compiler and Introl 68HC11 C compiler errors | |
| 345 (looking-at "\\([^ \t\n\^M:]+\\): ?\\([0-9]+\\)[ :]") | |
| 346 ;; BSO/Tasking 68HC08 C compiler errors | |
| 347 (looking-at | |
| 348 "[a-zA-Z 0-9]+: \\([^ \t\n\^M]+\\) line \\([0-9]+\\)[ \t]*:") | |
| 349 ;; UNIX Lint errors | |
| 350 (looking-at "[^:]+: \\([^ \t\n\^M:]+\\): line \\([0-9]+\\):") | |
| 351 ;; SparcWorks C compiler errors (ends with :) | |
| 352 ;; IBM AIX xlc C compiler errors (ends with .) | |
| 353 (looking-at "\"\\([^\"]+\\)\", line \\([0-9]+\\)[:.]") | |
| 354 ;; Introl as11 assembler errors | |
| 355 (looking-at " \\*+ \\([^ \t\n\^M]+\\) - \\([0-9]+\\) ") | |
| 356 ;; perl5: ... at file.c line 10 | |
| 357 (looking-at ".+ at \\([^ \t\n]+\\) line +\\([0-9]+\\)") | |
| 358 ) | |
| 359 (let* ((file (buffer-substring (match-beginning 1) | |
| 360 (match-end 1))) | |
| 361 (line-num (buffer-substring (match-beginning 2) | |
| 362 (match-end 2))) | |
| 363 (but-label (concat file ":" line-num)) | |
| 364 (source-loc (hbut:key-src t))) | |
| 365 (if (stringp source-loc) | |
| 366 (setq file (expand-file-name | |
| 367 file (file-name-directory source-loc)))) | |
| 368 (setq line-num (string-to-int line-num)) | |
| 369 (ibut:label-set but-label) | |
| 370 (hact 'link-to-file-line file line-num)))))) | |
| 371 | |
| 372 ;;; ======================================================================== | |
| 373 ;;; Jumps to source of Emacs Lisp V19 byte-compiler error messages. | |
| 374 ;;; ======================================================================== | |
| 375 | |
| 376 (defib elisp-compiler-msg () | |
| 377 "Jumps to source code for definition associated with byte-compiler error message. | |
| 378 Works when activated anywhere within an error line." | |
| 379 (if (or (equal (buffer-name) "*Compile-Log*") | |
| 380 (equal (buffer-name) "*compilation*") | |
| 381 (save-excursion | |
| 382 (and (re-search-backward "^[^ \t\n\r]" nil t) | |
| 383 (looking-at "While compiling")))) | |
| 384 (let (src buffer-p label) | |
| 385 (and (save-excursion | |
| 386 (re-search-backward | |
| 387 "^While compiling [^\t\n]+ in \\(file\\|buffer\\) \\([^ \n]+\\):$" | |
| 388 nil t)) | |
| 389 (setq buffer-p | |
| 390 (equal (buffer-substring (match-beginning 1) (match-end 1)) | |
| 391 "buffer") | |
| 392 src (buffer-substring (match-beginning 2) (match-end 2))) | |
| 393 (save-excursion | |
| 394 (end-of-line) | |
| 395 (re-search-backward "^While compiling \\([^ \n]+\\)\\(:$\\| \\)" | |
| 396 nil t)) | |
| 397 (progn | |
| 398 (setq label (buffer-substring | |
| 399 (match-beginning 1) (match-end 1))) | |
| 400 (ibut:label-set label (match-beginning 1) (match-end 1)) | |
| 401 ;; Remove prefix generated by actype and ibtype definitions. | |
| 402 (setq label (hypb:replace-match-string "[^:]+::" label "" t)) | |
| 403 (hact 'link-to-regexp-match | |
| 404 (concat "^\(def[a-z \t]+" (regexp-quote label) | |
| 405 "[ \t\n\(]") | |
| 406 1 src buffer-p)))))) | |
| 407 | |
| 408 ;;; ======================================================================== | |
| 409 ;;; Jumps to source associated with a line of output from 'patch'. | |
| 410 ;;; ======================================================================== | |
| 411 | |
| 412 (defib patch-msg () | |
| 413 "Jumps to source code associated with output from the 'patch' program. | |
| 414 Patch applies diffs to source code." | |
| 415 (if (save-excursion | |
| 416 (beginning-of-line) | |
| 417 (looking-at "Patching \\|Hunk ")) | |
| 418 (let ((opoint (point)) | |
| 419 (file) line) | |
| 420 (beginning-of-line) | |
| 421 (cond ((looking-at "Hunk .+ at \\([0-9]+\\)") | |
| 422 (setq line (buffer-substring (match-beginning 1) | |
| 423 (match-end 1))) | |
| 424 (ibut:label-set line (match-beginning 1) (match-end 1)) | |
| 425 (if (re-search-backward "^Patching file \\(\\S +\\)" nil t) | |
| 426 (setq file (buffer-substring (match-beginning 1) | |
| 427 (match-end 1))))) | |
| 428 ((looking-at "Patching file \\(\\S +\\)") | |
| 429 (setq file (buffer-substring (match-beginning 1) | |
| 430 (match-end 1)) | |
| 431 line "1") | |
| 432 (ibut:label-set file (match-beginning 1) (match-end 1)))) | |
| 433 (goto-char opoint) | |
| 434 (if (null file) | |
| 435 nil | |
| 436 (setq line (string-to-int line)) | |
| 437 (hact 'link-to-file-line file line))))) | |
| 438 | |
| 439 ;;; ======================================================================== | |
| 440 ;;; Composes mail, in another window, to the e-mail address at point. | |
| 441 ;;; ======================================================================== | |
| 442 | |
| 443 (defib mail-address () | |
| 444 "If on an e-mail address in a specific buffer type, mail to that address in another window. | |
| 445 Applies to the rolodex match buffer, any buffer attached to a file in | |
| 446 'rolo-file-list', or any buffer with \"mail\" or \"rolo\" (case-insensitive) | |
| 447 within its name." | |
| 448 (if (or (and (let ((case-fold-search t)) | |
| 449 (string-match "mail\\|rolo" (buffer-name))) | |
| 450 ;; Don't want this to trigger in a mail/news summary buffer. | |
| 451 (not (or (hmail:lister-p) (hnews:lister-p)))) | |
| 452 (if (boundp 'rolo-display-buffer) | |
| 453 (equal (buffer-name) rolo-display-buffer)) | |
| 454 (and buffer-file-name | |
| 455 (boundp 'rolo-file-list) | |
| 456 (set:member (current-buffer) | |
| 457 (mapcar 'get-file-buffer rolo-file-list)))) | |
| 458 (let ((address (mail-address-at-p))) | |
| 459 (if address | |
| 460 (progn | |
| 461 (ibut:label-set address (match-beginning 1) (match-end 1)) | |
| 462 (hact 'mail-other-window nil address)))))) | |
| 463 | |
| 464 (defconst mail-address-regexp | |
| 465 "\\([_a-zA-Z][-_a-zA-Z0-9.!@+%]*@[-_a-zA-Z0-9.!@+%]+\\.[a-zA-Z][-_a-zA-Z][-_a-zA-Z]?\\|[a-zA-Z][-_a-zA-Z0-9.!+%]+@[-_a-zA-Z0-9@]+\\)\\($\\|[^a-zA-Z0-9.!@%]\\)" | |
| 466 "Regexp with group 1 matching an Internet email address.") | |
| 467 | |
| 468 (defun mail-address-at-p () | |
| 469 "Return e-mail address, a string, that point is within or nil." | |
| 470 (save-excursion | |
| 471 (skip-chars-backward "^ \t\n\^M\"\'(){}[];<>|") | |
| 472 (if (looking-at mail-address-regexp) | |
| 473 (buffer-substring (match-beginning 1) (match-end 1))))) | |
| 474 | |
| 475 ;;; ======================================================================== | |
| 476 ;;; Displays Info nodes when double quoted "(file)node" button is activated. | |
| 477 ;;; ======================================================================== | |
| 478 | |
| 479 (defib Info-node () | |
| 480 "Makes \"(file)node\" buttons display the associated Info node." | |
| 481 (let* ((node-ref-and-pos (hbut:label-p t "\"" "\"" t)) | |
| 482 (node-ref (hpath:is-p (car node-ref-and-pos) nil t))) | |
| 483 (and node-ref (string-match "([^\)]+)" node-ref) | |
| 484 (ibut:label-set node-ref-and-pos) | |
| 485 (hact 'link-to-Info-node node-ref)))) | |
| 486 | |
| 487 ;;; ======================================================================== | |
| 488 ;;; Inserts completion into minibuffer or other window. | |
| 489 ;;; ======================================================================== | |
| 490 | |
| 491 (defib completion () | |
| 492 "Inserts completion at point into minibuffer or other window." | |
| 493 (let ((completion (hargs:completion t))) | |
| 494 (and completion | |
| 495 (ibut:label-set completion) | |
| 496 (hact 'completion)))) | |
| 497 | |
| 498 | |
| 499 (run-hooks 'hibtypes:end-load-hook) | |
| 500 (provide 'hibtypes) | |
| 501 |