1;;; woman.el --- browse UN*X manual pages `wo (without) man' 2 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk> 7;; Maintainer: FSF 8;; Keywords: help, unix 9;; Adapted-By: Eli Zaretskii <eliz@gnu.org> 10;; Version: see `woman-version' 11;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/ 12 13;; This file is part of GNU Emacs. 14 15;; GNU Emacs is free software; you can redistribute it and/or modify 16;; it under the terms of the GNU General Public License as published by 17;; the Free Software Foundation; either version 2, or (at your option) 18;; any later version. 19 20;; GNU Emacs is distributed in the hope that it will be useful, 21;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23;; GNU General Public License for more details. 24 25;; You should have received a copy of the GNU General Public License 26;; along with GNU Emacs; see the file COPYING. If not, write to the 27;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 28;; Boston, MA 02110-1301, USA. 29 30;;; Commentary: 31 32;; WoMan implements a subset of the formatting performed by the Emacs 33;; `man' (or `manual-entry') command to format a UN*X manual `page' 34;; for display, but without calling any external programs. It is 35;; intended to emulate the whole of the -man macro package, plus those 36;; ?roff requests that are most commonly used in man pages. However, 37;; the emulation is modified to include the reformatting done by the 38;; Emacs `man' command. No hyphenation is performed. 39 40;; Advantages 41 42;; Much more direct, does not require any external programs. 43;; Supports completion on man page names. 44 45;; Disadvantages 46 47;; Not a complete emulation. Currently no support for eqn or tbl. 48;; Slightly slower for large man pages (but usually faster for 49;; small- and medium-size pages). 50 51;; This browser works quite well on simple well-written man files. It 52;; works less well on idiosyncratic files that `break the rules' or 53;; use the more obscure ?roff requests directly. Current test results 54;; are available in the file woman.status. 55 56;; WoMan supports the use of compressed man files via 57;; `auto-compression-mode' by turning it on if necessary. But you may 58;; need to adjust the user option `woman-file-compression-regexp'. 59 60;; Read on for (currently) the only documentation for WoMan! 61 62;; See also the documentation for the WoMan interactive commands and 63;; user option variables, all of which begin with the prefix `woman-'. 64;; This can be done most easily by loading WoMan and then running the 65;; command `woman-mini-help', or selecting the WoMan menu option `Mini 66;; Help' when WoMan is running. 67 68;; WoMan is still under development! Please let me know what doesn't 69;; work -- I am adding and improving functionality as testing shows 70;; that it is necessary. See below for guidance on reporting bugs. 71 72;; Recommended use 73;; =============== 74 75;; Put this in your .emacs: 76;; (autoload 'woman "woman" 77;; "Decode and browse a UN*X man page." t) 78;; (autoload 'woman-find-file "woman" 79;; "Find, decode and browse a specific UN*X man-page file." t) 80 81;; Then either (1 -- *RECOMMENDED*): If the `MANPATH' environment 82;; variable is set then WoMan will use it; otherwise you may need to 83;; reset the Lisp variable `woman-manpath', and you may also want to 84;; set the Lisp variable `woman-path'. Please see the online 85;; documentation for these variables. Now you can execute the 86;; extended command `woman', enter or select a manual entry topic, 87;; using completion, and if necessary select a filename, using 88;; completion. By default, WoMan suggests the word nearest to the 89;; cursor in the current buffer as the topic. 90 91;; Or (2): Execute the extended command `woman-find-file' and enter a 92;; filename, using completion. This mode of execution may be useful 93;; for temporary files outside the standard UN*X manual directory 94;; structure. 95 96;; Or (3): Put the next two sexpr's in your .emacs: 97;; (autoload 'woman-dired-find-file "woman" 98;; "In dired, run the WoMan man-page browser on this file." t) 99;; (add-hook 'dired-mode-hook 100;; (lambda () 101;; (define-key dired-mode-map "W" 'woman-dired-find-file))) 102;; and open the directory containing the man page file using dired, 103;; put the cursor on the file, and press `W'. 104 105;; In each case, the result should (!) be a buffer in Man mode showing 106;; a formatted manual entry. When called from WoMan, Man mode should 107;; work as advertised, but modified where necessary in the context of 108;; WoMan. (However, `Man' will still invoke the standard Emacs 109;; manual-browsing facility rather than `WoMan' -- this is 110;; intentional!) 111 112;; (By default, WoMan will automatically define the dired keys "W" and 113;; "w" when it loads, but only if they are not already defined. This 114;; behaviour is controlled by the user option `woman-dired-keys'. 115;; Note that the `dired-x' (dired extra) package binds 116;; `dired-copy-filename-as-kill' to the key "w" (as pointed out by Jim 117;; Davidson), although "W" appears to be really unused. The `dired-x' 118;; package will over-write the WoMan binding to "w", whereas (by 119;; default) WoMan will not overwrite the `dired-x' binding.) 120 121;; The following is based on suggestions by Guy Gascoigne-Piggford and 122;; Juanma Barranquero. If you really want to square the man-woman 123;; circle then you might care to define the following bash function in 124;; .bashrc: 125 126;; man() { gnudoit -q '(raise-frame (selected-frame)) (woman' \"$1\" ')' ; } 127 128;; If you use Microsoft COMMAND.COM then you can create a file called 129;; man.bat somewhere in your path containing the two lines: 130 131;; @echo off 132;; gnudoit -q (raise-frame (selected-frame)) (woman \"%1\") 133 134;; and then (e.g. from a command prompt or the Run... option in the 135;; Start menu) just execute 136 137;; man man_page_name 138 139 140;; Using the word at point as the default topic 141;; ============================================ 142 143;; The `woman' command uses the word nearest to point in the current 144;; buffer as the default topic to look up if it matches the name of a 145;; manual page installed on the system. The default topic can also be 146;; used without confirmation by setting the user-option 147;; `woman-use-topic-at-point' to t; thanks to Benjamin Riefenstahl for 148;; suggesting this functionality. 149 150;; The variable `woman-use-topic-at-point' can be rebound locally, 151;; which may be useful to provide special private key bindings, e.g. 152 153;; (global-set-key "\C-cw" 154;; (lambda () 155;; (interactive) 156;; (let ((woman-use-topic-at-point t)) 157;; (woman))))) 158 159 160;; Customization, Hooks and Imenu 161;; ============================== 162 163;; WoMan supports the GNU Emacs 20+ customization facility, and puts 164;; a customization group called `WoMan' in the `Help' group under the 165;; top-level `Emacs' group. In order to be able to customize WoMan 166;; without first loading it, add the following sexp to your .emacs: 167 168;; (defgroup woman nil 169;; "Browse UNIX manual pages `wo (without) man'." 170;; :tag "WoMan" :group 'help :load "woman") 171 172 173;; WoMan currently runs two hooks: `woman-pre-format-hook' immediately 174;; before formatting a buffer and `woman-post-format-hook' immediately 175;; after formatting a buffer. These hooks can be used for special 176;; customizations that require code to be executed, etc., although 177;; most customization should be possible by setting WoMan user option 178;; variables, e.g. in `.emacs' and should NOT require the use of the 179;; hooks. `woman-pre-format-hook' might be appropriate for face 180;; customization, whereas `woman-post-format-hook' might be 181;; appropriate for installing a dynamic menu using `imenu' (although 182;; it is better to use the built-in WoMan imenu support). 183 184;; The WoMan menu provides an option to make a contents menu for the 185;; current man page (using imenu). Alternatively, if you set the 186;; variable `woman-imenu' to `t' then WoMan will do it automatically 187;; for every man page. The menu title is the value of the variable 188;; `woman-imenu-title', which is "CONTENTS" by default. By default, 189;; the menu shows manual sections and subsections, but you can change 190;; this by changing the value of `woman-imenu-generic-expression'. 191;; This facility is not yet widely tested and may be fooled by obscure 192;; man pages that `break the rules'. 193 194;; WoMan is configured not to replace spaces in an imenu *Completion* 195;; buffer. For further documentation of the use of imenu, such as 196;; menu sorting, see the source file imenu.el, which is distributed 197;; with GNU Emacs. 198 199;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 200 201;; Howard Melman made (essentially) the following suggestions, which 202;; are slightly different from the expression that I currently use. 203;; You may prefer one of Howard's suggestions, which I think assume 204;; that `case-fold-search' is `t' (which it is by default): 205 206;; (setq woman-imenu-generic-expression 207;; '((nil "^\\( \\)?\\([A-Z][A-Z ]+[A-Z]\\)[ \t]*$" 2))) 208 209;; will give support for .SH and .SS, though it won't show the heading 210;; name hierarchy. If you just want .SH in the imenu then use: 211 212;; (setq woman-imenu-generic-expression 213;; '((nil "^\\([A-Z][A-Z ]+[A-Z]\\)[ \t]*$" 1))) 214 215;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 216 217 218;; Vertical spacing and blank lines 219;; ================================ 220 221;; The number of consecutive blank lines in the formatted buffer 222;; should be either 0 or 1. A blank line should leave a space like 223;; .sp 1 (p. 14). Current policy is to output vertical space only 224;; immediately before text is output. 225 226 227;; Horizontal and vertical spacing and resolution 228;; ============================================== 229 230;; WoMan currently assumes 10 characters per inch horizontally, hence 231;; a horizontal resolution of 24 basic units, and 5 lines per inch 232;; vertically, hence a vertical resolution of 48 basic units. (nroff 233;; uses 240 per inch). 234 235 236;; The *WoMan-Log* buffer 237;; ====================== 238 239;; This is modelled on the byte-compiler. It logs all files formatted 240;; by WoMan, and if WoMan finds anything that it cannot handle then it 241;; writes a warning to this buffer. If the variable `woman-show-log' 242;; is non-nil (by default it is `nil') then WoMan automatically 243;; displays this buffer. Many WoMan warnings can be completely 244;; ignored, because they are reporting the fact that WoMan has ignored 245;; requests that it is correct to ignore. In some future version this 246;; level of paranoia will be reduced, but not until WoMan is more 247;; reliable. At present, all warnings should be treated with some 248;; suspicion. Uninterpreted escape sequences are also logged (in some 249;; cases). 250 251;; Uninterpreted ?roff requests can optionally be left in the 252;; formatted buffer to indicate precisely where they occur by 253;; resetting the variable `woman-ignore' to `nil' (by default it is 254;; `t'). 255 256;; Automatic initiation of woman decoding 257 258;; (Probably not a good idea. If you use it, be careful!) 259 260;; Put something like this in your .emacs. The call to 261;; set-visited-file-name is to avoid font-locking triggered by 262;; automatic major mode selection. 263 264;; (autoload 'woman-decode-region "woman") 265 266;; (setq format-alist 267;; (cons 268;; '(man "UN*X man-page source format" "\\.\\(TH\\|ig\\) " 269;; woman-decode-region nil nil 270;; (lambda (arg) 271;; set-visited-file-name 272;; (file-name-sans-extension buffer-file-name))))) 273;; format-alist)) 274 275 276;; Reporting Bugs 277;; ============== 278 279;; If WoMan fails completely, or formats a file incorrectly 280;; (i.e. obviously wrongly or significantly differently from man) or 281;; inelegantly, then please 282 283;; (a) check that you are running the latest version of woman.el 284;; available from my web site (see above), 285 286;; (b) check that the problem is not already described in the file 287;; woman.status, also available from my web site. 288 289;; If both of the above are true then please email me the entry from 290;; the *WoMan-Log* buffer relating to the problem file, together with 291;; a brief description of the problem. Please indicate where you got 292;; the source file from, but do not send it to me unless I ask you to! 293;; Thanks. (There is at present no automated bug-reporting facility 294;; for WoMan.) 295 296;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 297 298;; NOTE: 299 300;; CASE-DEPENDENCE OF FILENAMES. By default, WoMan ignores case in 301;; file pathnames only when it seems appropriate. MS-Windows users 302;; who want complete case independence should set the NTEmacs variable 303;; `w32-downcase-file-names' to `t' and use all lower case when 304;; setting WoMan file paths. 305 306;; (1) INCOMPATIBLE CHANGE! WoMan no longer uses a persistent topic 307;; cache by default. (It caused too much confusion!) Explicitly set 308;; the variable `woman-cache-filename' to save the cache between Emacs 309;; sessions. This is recommended only if the command `woman' is too 310;; slow the first time that it is run in an Emacs session, while it 311;; builds its cache in main memory, which MAY be VERY slow. 312 313;; (2) The user option `woman-cache-level' controls the amount of 314;; information cached (in main memory and, optionally, saved to disc). 315 316;; (3) UPDATING THE CACHE. A prefix argument always causes the 317;; `woman' command (only) to rebuild its topic cache, and to re-save 318;; it to `woman-cache-filename' if this variable has a non-nil value. 319;; This is necessary if the NAMES (not contents) of any of the 320;; directories or files in the paths specified by `woman-manpath' or 321;; `woman-path' change. If WoMan user options that affect the cache 322;; are changed then WoMan will automatically update its cache file on 323;; disc (if one is in use) the next time it is run in a new Emacs 324;; session. 325 326;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 327 328 329;; TO DO 330;; ===== 331 332;; Reconsider case sensitivity of file names. 333;; MUST PROCESS .if, .nr IN ORDER ENCOUNTERED IN FILE! (rcsfile, mf). 334;; Allow general delimiter in `\v', cf. `\h'. 335;; Improve major-mode documentation. 336;; Pre-process conditionals in macro bodies if possible for speed? 337;; Emulate more complete preprocessor support for tbl (.TS/.TE) 338;; Emulate some preprocessor support for eqn (.EQ/.EN) 339;; Re-write filling and adjusting code! 340;; Allow word wrap at comma (for long option lists)? 341;; Buffer list handling not quite right. 342;; Make 10 or 12 pitch (cpi) optional -- 12 => ll = 78 343;; Use unpaddable space for tabbing? 344;; Tidy up handling of fonts when filling and adjusting 345;; -- see text/text properties? 346;; Improve speed 347;; Add font-lock support (for quoted strings, etc.)? 348;; Optionally save large files in enriched format? 349;; Add apropos facility by searching NAME (?) entry in man files? 350;; Documentation -- optional auto-display of formatted WoMan man page? 351;; Implement a bug reporter? 352;; Support diversion and traps (to some extent) - for Tcl/tk pages? 353;; Add a menu of WoMan buffers? 354;; Fix .fc properly? 355 356 357;; Implementation strategy [this description is now well out of date!] 358;; -- three main passes, each to process respectively: 359 360;; 1) non-breaking `.' requests including font macros 361;; 2) \ escape sequences, mainly special characters and font changes 362;; 3) breaking `.' requests, mainly filling and justification 363 364;; For each pass, a control function finds and pre-processes the 365;; escape or request and then calls the appropriate function to 366;; perform the required formatting. Based originally on enriched.el 367;; and format.el. 368 369;; The background information that made this project possible is 370;; freely available courtesy of Bell Labs from 371;; http://cm.bell-labs.com/7thEdMan/ 372 373 374;; Acknowledgements 375;; ================ 376 377;; For Heather, Kathryn and Madelyn, the women in my life 378;; (although they will probably never use it)! 379 380;; I also thank the following for helpful suggestions, bug reports, 381;; code fragments, general interest, etc.: 382;; Jari Aalto <jari.aalto@cs.tpu.fi> 383;; Dean Andrews <dean@dra.com> 384;; Juanma Barranquero <lekktu@gmail.com> 385;; Karl Berry <kb@cs.umb.edu> 386;; Jim Chapman <jchapman@netcomuk.co.uk> 387;; Kin Cho <kin@neoscale.com> 388;; Frederic Corne <frederic.corne@erli.fr> 389;; Peter Craft <craft@alacritech.com> 390;; Charles Curley <ccurley@trib.com> 391;; Jim Davidson <jdavidso@teknowledge.com> 392;; Kevin D'Elia <Kevin.DElia@mci.com> 393;; John Fitch <jpff@maths.bath.ac.uk> 394;; Hans Frosch <jwfrosch@rish.b17c.ingr.com> 395;; Guy Gascoigne-Piggford <ggp@informix.com> 396;; Brian Gorka <gorkab@sanchez.com> 397;; Nicolai Henriksen <nhe@lyngso-industri.dk> 398;; Thomas Herchenroeder <the@software-ag.de> 399;; Alexander Hinds <ahinds@thegrid.net> 400;; Stefan Hornburg <sth@hacon.de> 401;; Theodore Jump <tjump@cais.com> 402;; David Kastrup <dak@gnu.org> 403;; Paul Kinnucan <paulk@mathworks.com> 404;; Jonas Linde <jonas@init.se> 405;; Andrew McRae <andrewm@optimation.co.nz> 406;; Howard Melman <howard@silverstream.com> 407;; Dennis Pixton <dennis@math.binghamton.edu> 408;; T. V. Raman <raman@Adobe.COM> 409;; Bruce Ravel <bruce.ravel@nist.gov> 410;; Benjamin Riefenstahl <benny@crocodial.de> 411;; Kevin Ruland <kruland@seistl.com> 412;; Tom Schutter <tom@platte.com> 413;; Wei-Xue Shi <wxshi@ma.neweb.ne.jp> 414;; Fabio Somenzi <fabio@joplin.colorado.edu> 415;; Karel Sprenger <ks@ic.uva.nl> 416;; Chris Szurgot <szurgot@itribe.net> 417;; Paul A. Thompson <pat@po.cwru.edu> 418;; Arrigo Triulzi <arrigo@maths.qmw.ac.uk> 419;; Geoff Voelker <voelker@cs.washington.edu> 420;; Eli Zaretskii <eliz@gnu.org> 421 422 423;;; Code: 424 425(defvar woman-version "0.551 (beta)" "WoMan version information.") 426 427(require 'man) 428(require 'button) 429(define-button-type 'WoMan-xref-man-page 430 :supertype 'Man-abstract-xref-man-page 431 'func (lambda (arg) 432 (woman 433 ;; `woman' cannot deal with arguments that contain a 434 ;; section name, like close(2), so strip the section name. 435 (if (string-match Man-reference-regexp arg) 436 (substring arg 0 (match-end 1)) 437 arg)))) 438 439(eval-when-compile ; to avoid compiler warnings 440 (require 'dired) 441 (require 'cl) 442 (require 'apropos)) 443 444(defun woman-mapcan (fn x) 445 "Return concatenated list of FN applied to successive `car' elements of X. 446FN must return a list, cons or nil. Useful for splicing into a list." 447 ;; Based on the Standard Lisp function MAPCAN but with args swapped! 448 ;; More concise implementation than the recursive one. -- dak 449 (apply #'nconc (mapcar fn x))) 450 451(defun woman-parse-colon-path (paths) 452 "Explode search path string PATHS into a list of directory names. 453Allow Cygwin colon-separated search paths on Microsoft platforms. 454Replace null components by calling `woman-parse-man.conf'. 455As a special case, if PATHS is nil then replace it by calling 456`woman-parse-man.conf'." 457 ;; Based on suggestions by Jari Aalto and Eli Zaretskii. 458 ;; parse-colon-path returns nil for a null path component and 459 ;; an empty substring of MANPATH denotes the default list. 460 (if (memq system-type '(windows-nt ms-dos)) 461 (cond ((null paths) 462 (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))) 463 ((string-match ";" paths) 464 ;; Assume DOS-style path-list... 465 (woman-mapcan ; splice list into list 466 (lambda (x) 467 (if x 468 (list x) 469 (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))) 470 (parse-colon-path paths))) 471 ((string-match "\\`[a-zA-Z]:" paths) 472 ;; Assume single DOS-style path... 473 paths) 474 (t 475 ;; Assume UNIX/Cygwin-style path-list... 476 (woman-mapcan ; splice list into list 477 (lambda (x) 478 (mapcar 'woman-Cyg-to-Win 479 (if x (list x) (woman-parse-man.conf)))) 480 (let ((path-separator ":")) 481 (parse-colon-path paths))))) 482 ;; Assume host-default-style path-list... 483 (woman-mapcan ; splice list into list 484 (lambda (x) (if x (list x) (woman-parse-man.conf))) 485 (parse-colon-path (or paths ""))))) 486 487(defun woman-Cyg-to-Win (file) 488 "Convert an absolute filename FILE from Cygwin to Windows form." 489 ;; MANPATH_MAP conses are not converted since they presumably map 490 ;; Cygwin to Cygwin form. 491 (if (consp file) 492 file 493 ;; Code taken from w32-symlinks.el 494 (if (eq (aref file 0) ?/) 495 ;; Try to use Cygwin mount table via `cygpath.exe'. 496 (condition-case nil 497 (with-temp-buffer 498 ;; cygpath -m file 499 (call-process "cygpath" nil t nil "-m" file) 500 (buffer-substring 1 (buffer-size))) 501 (error 502 ;; Assume no `cygpath' program available. 503 ;; Hack /cygdrive/x/ or /x/ or (obsolete) //x/ to x:/ 504 (when (string-match "\\`\\(/cygdrive\\|/\\)?/./" file) 505 (if (match-string 1) ; /cygdrive/x/ or //x/ -> /x/ 506 (setq file (substring file (match-end 1)))) 507 (aset file 0 (aref file 1)) ; /x/ -> xx/ 508 (aset file 1 ?:)) ; xx/ -> x:/ 509 file)) 510 file))) 511 512 513;;; User options: 514 515;; NB: Group identifiers must be lowercase! 516 517(defgroup woman nil 518 "Browse UNIX manual pages `wo (without) man'." 519 :tag "WoMan" 520 :group 'help) 521 522(defcustom woman-show-log nil 523 "*If non-nil then show the *WoMan-Log* buffer if appropriate. 524I.e. if any warning messages are written to it. Default is nil." 525 :type 'boolean 526 :group 'woman) 527 528(defcustom woman-pre-format-hook nil 529 "*Hook run by WoMan immediately before formatting a buffer. 530Change only via `Customization' or the function `add-hook'." 531 :type 'hook 532 :group 'woman) 533 534(defcustom woman-post-format-hook nil 535 "*Hook run by WoMan immediately after formatting a buffer. 536Change only via `Customization' or the function `add-hook'." 537 :type 'hook 538 :group 'woman) 539 540 541;; Interface options 542 543(defgroup woman-interface nil 544 "Interface options for browsing UNIX manual pages `wo (without) man'." 545 :tag "WoMan Interface" 546 :group 'woman) 547 548(defcustom woman-man.conf-path 549 (let ((path '("/usr/lib" "/etc"))) 550 (if (eq system-type 'windows-nt) 551 (mapcar 'woman-Cyg-to-Win path) 552 path)) 553 "*List of dirs to search and/or files to try for man config file. 554A trailing separator (`/' for UNIX etc.) on directories is 555optional, and the filename is used if a directory specified is 556the first to start with \"man\" and has an extension starting 557with \".conf\". If MANPATH is not set but a config file is found 558then it is parsed instead to provide a default value for 559`woman-manpath'." 560 :type '(repeat string) 561 :group 'woman-interface) 562 563(defun woman-parse-man.conf () 564 "Parse if possible configuration file for man command. 565Used only if MANPATH is not set or contains null components. 566Look in `woman-man.conf-path' and return a value for `woman-manpath'. 567Concatenate data from all lines in the config file of the form 568 MANPATH /usr/man 569or 570 MANDATORY_MANPATH /usr/man 571or 572 OPTIONAL_MANPATH /usr/man 573or 574 MANPATH_MAP /opt/bin /opt/man" 575 ;; Functionality suggested by Charles Curley. 576 (let ((path woman-man.conf-path) 577 file manpath) 578 (while (and 579 path 580 (not (and 581 (file-readable-p (setq file (car path))) 582 ;; If not a file then find the file: 583 (or (not (file-directory-p file)) 584 (and 585 (setq file 586 (directory-files file t "\\`man.*\\.conf[a-z]*\\'" t)) 587 (file-readable-p (setq file (car file))))) 588 ;; Parse the file -- if no MANPATH data ignore it: 589 (with-temp-buffer 590 (insert-file-contents file) 591 (while (re-search-forward 592 ;; `\(?: ... \)' is a "shy group" 593 "\ 594^[ \t]*\\(?:\\(?:MANDATORY_\\|OPTIONAL_\\)?MANPATH[ \t]+\\(\\S-+\\)\\|\ 595MANPATH_MAP[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\)" nil t) 596 (add-to-list 'manpath 597 (if (match-beginning 1) 598 (match-string 1) 599 (cons (match-string 2) 600 (match-string 3))))) 601 manpath)) 602 )) 603 (setq path (cdr path))) 604 (nreverse manpath))) 605 606(defcustom woman-manpath 607 (or (woman-parse-colon-path (getenv "MANPATH")) 608 '("/usr/man" "/usr/share/man" "/usr/local/man")) 609 "*List of DIRECTORY TREES to search for UN*X manual files. 610Each element should be the name of a directory that contains 611subdirectories of the form `man?', or more precisely subdirectories 612selected by the value of `woman-manpath-man-regexp'. Non-directory 613and unreadable files are ignored. 614 615Elements can also be a cons cell indicating a mapping from PATH 616to manual trees: if such an element's car is equal to a path 617element of the environment variable PATH, the cdr of the cons 618cell is included in the directory tree search. 619 620If not set then the environment variable MANPATH is used. If no such 621environment variable is found, the default list is determined by 622consulting the man configuration file if found, which is determined by 623the user option `woman-man.conf-path'. An empty substring of MANPATH 624denotes the default list. 625 626Any environment variables (names must have the UN*X-style form $NAME, 627e.g. $HOME, $EMACSDATA, $emacs_dir) are evaluated first but each 628element must evaluate to a SINGLE directory name. Trailing `/'s are 629ignored. (Specific directories in `woman-path' are also searched.) 630 631Microsoft platforms: 632I recommend including drive letters explicitly, e.g. 633 634 (\"C:/Cygwin/usr/man/\" \"C:/Cygwin/usr/local/man\"). 635 636The MANPATH environment variable may be set using DOS semi-colon- 637separated or UN*X/Cygwin colon-separated syntax (but not mixed)." 638 :type '(repeat (choice string (cons string string))) 639 :group 'woman-interface) 640 641(defcustom woman-manpath-man-regexp "[Mm][Aa][Nn]" 642 "Regexp to match man directories UNDER `woman-manpath' directories. 643These normally have names of the form `man?'. Its default value is 644\"[Mm][Aa][Nn]\", which is case-insensitive mainly for the benefit of 645Microsoft platforms. Its purpose is to avoid `cat?', `.', `..', etc." 646 ;; Based on a suggestion by Wei-Xue Shi. 647 :type 'string 648 :group 'woman-interface) 649 650(defcustom woman-path 651 (if (eq system-type 'ms-dos) '("$DJDIR/info" "$DJDIR/man/cat[1-9onlp]")) 652 "*List of SPECIFIC DIRECTORIES to search for UN*X manual files. 653For example 654 655 (\"/emacs/etc\"). 656 657These directories are searched in addition to the directory trees 658specified in `woman-manpath'. Each element should be a directory 659string or nil, which represents the current directory when the path is 660expanded and cached. However, the last component (only) of each 661directory string is treated as a regexp \(Emacs, not shell) and the 662string is expanded into a list of matching directories. Non-directory 663and unreadable files are ignored. The default value is nil. 664 665Any environment variables (which must have the UN*X-style form $NAME, 666e.g. $HOME, $EMACSDATA, $emacs_dir) are evaluated first but each 667element must evaluate to a SINGLE directory name (regexp, see above). 668For example 669 670 (\"$EMACSDATA\") [or equivalently (\"$emacs_dir/etc\")]. 671 672Trailing `/'s are discarded. (The directory trees in `woman-manpath' 673are also searched.) On Microsoft platforms I recommend including 674drive letters explicitly." 675 :type '(repeat (choice string (const nil))) 676 :group 'woman-interface) 677 678(defcustom woman-cache-level 2 679 "*The level of topic caching. 6801 - cache only the topic and directory lists 681 (the only level before version 0.34 - only for compatibility); 6822 - cache also the directories for each topic 683 (faster, without using much more memory); 6843 - cache also the actual filenames for each topic 685 (fastest, but uses twice as much memory). 686The default value is currently 2, a good general compromise. 687If the `woman' command is slow to find files then try 3, which may be 688particularly beneficial with large remote-mounted man directories. 689Run the `woman' command with a prefix argument or delete the cache 690file `woman-cache-filename' for a change to take effect. 691\(Values < 1 behave like 1; values > 3 behave like 3.)" 692 :type '(choice (const :tag "Minimal" 1) 693 (const :tag "Default" 2) 694 (const :tag "Maximal" 3)) 695 :group 'woman-interface) 696 697(defcustom woman-cache-filename nil 698 "*The full pathname of the WoMan directory and topic cache file. 699It is used to save and restore the cache between sessions. This is 700especially useful with remote-mounted man page files! The default 701value of nil suppresses this action. The `standard' non-nil 702filename is \"~/.wmncach.el\". Remember that a prefix argument forces 703the `woman' command to update and re-write the cache." 704 :type '(choice (const :tag "None" nil) 705 (const :tag "~/.wmncach.el" "~/.wmncach.el") 706 file) 707 :group 'woman-interface) 708 709(defcustom woman-dired-keys t 710 "*List of `dired' mode keys to define to run WoMan on current file. 711E.g. '(\"w\" \"W\"), or any non-null atom to automatically define 712\"w\" and \"W\" if they are unbound, or nil to do nothing. 713Default is t." 714 :type '(choice (const :tag "None" nil) 715 (repeat string) 716 (other :tag "Auto" t)) 717 :group 'woman-interface) 718 719(defcustom woman-imenu-generic-expression 720 '((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE 721 ("*Subsections*" "^ \\([A-Z].*\\)" 1)) 722 "*Imenu support for Sections and Subsections. 723An alist with elements of the form (MENU-TITLE REGEXP INDEX) -- 724see the documentation for `imenu-generic-expression'." 725 :type 'sexp 726 :group 'woman-interface) 727 728(defcustom woman-imenu nil 729 "*If non-nil then WoMan adds a Contents menu to the menubar. 730It does this by calling `imenu-add-to-menubar'. Default is nil." 731 :type 'boolean 732 :group 'woman-interface) 733 734(defcustom woman-imenu-title "CONTENTS" 735 "*The title to use if WoMan adds a Contents menu to the menubar. 736Default is \"CONTENTS\"." 737 :type 'string 738 :group 'woman-interface) 739 740(defcustom woman-use-topic-at-point-default nil 741 ;; `woman-use-topic-at-point' may be let-bound when woman is loaded, 742 ;; in which case its global value does not get defined. 743 ;; `woman-file-name' sets it to this value if it is unbound. 744 "*Default value for `woman-use-topic-at-point'." 745 :type '(choice (const :tag "Yes" t) 746 (const :tag "No" nil)) 747 :group 'woman-interface) 748 749(defcustom woman-use-topic-at-point woman-use-topic-at-point-default 750 "*Control use of the word at point as the default topic. 751If non-nil the `woman' command uses the word at point automatically, 752without interactive confirmation, if it exists as a topic." 753 :type '(choice (const :tag "Yes" t) 754 (const :tag "No" nil)) 755 :group 'woman-interface) 756 757(defvar woman-file-regexp nil 758 "Regexp used to select (possibly compressed) man source files, e.g. 759\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\)\\)?\\'\". 760Built automatically from the customizable user options 761`woman-uncompressed-file-regexp' and `woman-file-compression-regexp'.") 762 763(defvar woman-uncompressed-file-regexp) ; for the compiler 764(defvar woman-file-compression-regexp) ; for the compiler 765 766(defun set-woman-file-regexp (symbol value) 767 "Bind SYMBOL to VALUE and set `woman-file-regexp' as per user customizations. 768Used as :set cookie by Customize when customizing the user options 769`woman-uncompressed-file-regexp' and `woman-file-compression-regexp'." 770 (set-default symbol value) 771 (and (boundp 'woman-uncompressed-file-regexp) 772 (boundp 'woman-file-compression-regexp) 773 (setq woman-file-regexp 774 (concat woman-uncompressed-file-regexp 775 "\\(" 776 (substring woman-file-compression-regexp 0 -2) 777 "\\)?\\'")))) 778 779(defcustom woman-uncompressed-file-regexp 780 "\\.\\([0-9lmnt]\\w*\\)" ; disallow no extension 781 "*Do not change this unless you are sure you know what you are doing! 782Regexp used to select man source files (ignoring any compression extension). 783 784The SysV standard man pages use two character suffixes, and this is 785becoming more common in the GNU world. For example, the man pages 786in the ncurses package include `toe.1m', `form.3x', etc. 787 788Note: an optional compression regexp will be appended, so this regexp 789MUST NOT end with any kind of string terminator such as $ or \\'." 790 :type 'regexp 791 :set 'set-woman-file-regexp 792 :group 'woman-interface) 793 794(defcustom woman-file-compression-regexp 795 "\\.\\(g?z\\|bz2\\)\\'" 796 "*Do not change this unless you are sure you know what you are doing! 797Regexp used to match compressed man file extensions for which 798decompressors are available and handled by auto-compression mode, 799e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'. 800Should begin with \\. and end with \\' and MUST NOT be optional." 801 ;; Should be compatible with car of 802 ;; `jka-compr-file-name-handler-entry', but that is unduly 803 ;; complicated, includes an inappropriate extension (.tgz) and is 804 ;; not loaded by default! 805 :type 'regexp 806 :set 'set-woman-file-regexp 807 :group 'woman-interface) 808 809(defcustom woman-use-own-frame ; window-system 810 (or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21 811 (memq window-system '(x w32))) ; Emacs 20 812 "*If non-nil then use a dedicated frame for displaying WoMan windows. 813Only useful when run on a graphic display such as X or MS-Windows." 814 :type 'boolean 815 :group 'woman-interface) 816 817 818;; Formatting options 819 820(defgroup woman-formatting nil 821 "Formatting options for browsing UNIX manual pages `wo (without) man'." 822 :tag "WoMan Formatting" 823 :group 'woman) 824 825(defcustom woman-fill-column 65 826 "*Right margin for formatted text -- default is 65." 827 :type 'integer 828 :group 'woman-formatting) 829 830(defcustom woman-fill-frame nil 831 ;; Based loosely on a suggestion by Theodore Jump: 832 "*If non-nil then most of the window width is used." 833 :type 'boolean 834 :group 'woman-formatting) 835 836(defcustom woman-default-indent 5 837 "*Default prevailing indent set by -man macros -- default is 5. 838Set this variable to 7 to emulate GNU man formatting." 839 :type 'integer 840 :group 'woman-formatting) 841 842(defcustom woman-bold-headings t 843 "*If non-nil then embolden section and subsection headings. Default is t. 844Heading emboldening is NOT standard `man' behavior." 845 :type 'boolean 846 :group 'woman-formatting) 847 848(defcustom woman-ignore t 849 "*If non-nil then unrecognized requests etc. are ignored. Default is t. 850This gives the standard ?roff behavior. If nil then they are left in 851the buffer, which may aid debugging." 852 :type 'boolean 853 :group 'woman-formatting) 854 855(defcustom woman-preserve-ascii t 856 "*If non-nil, preserve ASCII characters in the WoMan buffer. 857Otherwise, to save time, some backslashes and spaces may be 858represented differently (as the values of the variables 859`woman-escaped-escape-char' and `woman-unpadded-space-char' 860respectively) so that the buffer content is strictly wrong even though 861it should display correctly. This should be irrelevant unless the 862buffer text is searched, copied or saved to a file." 863 ;; This option should probably be removed! 864 :type 'boolean 865 :group 'woman-formatting) 866 867(defcustom woman-emulation 'nroff 868 "*WoMan emulation, currently either nroff or troff. Default is nroff. 869Troff emulation is experimental and largely untested. 870\(Add groff later?)" 871 :type '(choice (const nroff) (const troff)) 872 :group 'woman-formatting) 873 874 875;; Faces: 876 877(defgroup woman-faces nil 878 "Face options for browsing UNIX manual pages `wo (without) man'." 879 :tag "WoMan Faces" 880 :group 'woman 881 :group 'faces) 882 883(defcustom woman-fontify 884 (or (and (fboundp 'display-color-p) (display-color-p)) 885 (and (fboundp 'display-graphic-p) (display-graphic-p)) 886 (x-display-color-p)) 887 "*If non-nil then WoMan assumes that face support is available. 888It defaults to a non-nil value if the display supports either colors 889or different fonts." 890 :type 'boolean 891 :group 'woman-faces) 892 893;; This is overkill! Troff uses just italic; Nroff uses just underline. 894;; You should probably select either italic or underline as you prefer, but 895;; not both, although italic and underline work together perfectly well! 896(defface woman-italic 897 `((((min-colors 88) (background light)) 898 (:slant italic :underline t :foreground "red1")) 899 (((background light)) (:slant italic :underline t :foreground "red")) 900 (((background dark)) (:slant italic :underline t))) 901 "Face for italic font in man pages." 902 :group 'woman-faces) 903;; backward-compatibility alias 904(put 'woman-italic-face 'face-alias 'woman-italic) 905 906(defface woman-bold 907 '((((min-colors 88) (background light)) (:weight bold :foreground "blue1")) 908 (((background light)) (:weight bold :foreground "blue")) 909 (((background dark)) (:weight bold :foreground "green2"))) 910 "Face for bold font in man pages." 911 :group 'woman-faces) 912;; backward-compatibility alias 913(put 'woman-bold-face 'face-alias 'woman-bold) 914 915;; Brown is a good compromise: it is distinguishable from the default 916;; but not enough so to make font errors look terrible. (Files that use 917;; non-standard fonts seem to do so badly or in idiosyncratic ways!) 918(defface woman-unknown 919 '((((background light)) (:foreground "brown")) 920 (((min-colors 88) (background dark)) (:foreground "cyan1")) 921 (((background dark)) (:foreground "cyan"))) 922 "Face for all unknown fonts in man pages." 923 :group 'woman-faces) 924;; backward-compatibility alias 925(put 'woman-unknown-face 'face-alias 'woman-unknown) 926 927(defface woman-addition 928 '((t (:foreground "orange"))) 929 "Face for all WoMan additions to man pages." 930 :group 'woman-faces) 931;; backward-compatibility alias 932(put 'woman-addition-face 'face-alias 'woman-addition) 933 934(defun woman-default-faces () 935 "Set foreground colors of italic and bold faces to their default values." 936 (interactive) 937 (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic)) 938 (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold))) 939 940(defun woman-monochrome-faces () 941 "Set foreground colors of italic and bold faces to that of the default face. 942This is usually either black or white." 943 (interactive) 944 (set-face-foreground 'woman-italic 'unspecified) 945 (set-face-foreground 'woman-bold 'unspecified)) 946 947;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 948;; Experimental font support, initially only for MS-Windows. 949(defconst woman-font-support 950 (eq window-system 'w32) ; Support X later! 951 "If non-nil then non-ASCII characters and symbol font supported.") 952 953(defun woman-select-symbol-fonts (fonts) 954 "Select symbol fonts from a list FONTS of font name strings." 955 (let (symbol-fonts) 956 ;; With NTEmacs 20.5, the PATTERN option to `x-list-fonts' does 957 ;; not seem to work and fonts may be repeated, so ... 958 (while fonts 959 (and (string-match "-Symbol-" (car fonts)) 960 (not (member (car fonts) symbol-fonts)) 961 (setq symbol-fonts (cons (car fonts) symbol-fonts))) 962 (setq fonts (cdr fonts))) 963 symbol-fonts)) 964 965(when woman-font-support 966 (make-face 'woman-symbol) 967 968 ;; Set the symbol font only if `woman-use-symbol-font' is true, to 969 ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5! 970 971 (defcustom woman-use-extended-font t 972 "*If non-nil then may use non-ASCII characters from the default font." 973 :type 'boolean 974 :group 'woman-faces) 975 976 (defcustom woman-use-symbol-font nil 977 "*If non-nil then may use the symbol font. 978It is off by default, mainly because it may change the line spacing 979\(in NTEmacs 20.5)." 980 :type 'boolean 981 :group 'woman-faces) 982 983 (defconst woman-symbol-font-list 984 (or (woman-select-symbol-fonts (x-list-fonts "*" 'default)) 985 (woman-select-symbol-fonts (x-list-fonts "*"))) 986 "Symbol font(s), preferably same size as default when WoMan was loaded.") 987 988 (defcustom woman-symbol-font (car woman-symbol-font-list) 989 "*A string describing the symbol font to use for special characters. 990It should be compatible with, and the same size as, the default text font. 991Under MS-Windows, the default is 992 \"-*-Symbol-normal-r-*-*-*-*-96-96-p-*-ms-symbol\"." 993 :type `(choice 994 ,@(mapcar (lambda (x) (list 'const x)) 995 woman-symbol-font-list) 996 string) 997 :group 'woman-faces) 998 999 ) 1000 1001;; For non windows-nt ... 1002(defvar woman-use-extended-font nil) 1003(defvar woman-use-symbol-font nil) 1004(defvar woman-symbol-font nil) 1005;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1006 1007 1008;;; Internal variables: 1009 1010(defconst woman-justify-list 1011 '(left right center full) 1012 "Justify styles for `fill-region-as-paragraph'.") 1013(defconst woman-adjust-left 0 ; == adjust off, noadjust 1014 "Adjustment indicator `l' -- adjust left margin only.") 1015(defconst woman-adjust-right 1 1016 "Adjustment indicator `r' -- adjust right margin only.") 1017(defconst woman-adjust-center 2 1018 "Adjustment indicator `c' -- center.") 1019(defconst woman-adjust-both 3 ; default -- adj,both 1020 "Adjustment indicator `b' or `n' -- adjust both margins.") 1021 1022(defvar woman-adjust woman-adjust-both 1023 "Current adjustment number-register value.") 1024(defvar woman-adjust-previous woman-adjust 1025 "Previous adjustment number-register value.") 1026(defvar woman-justify 1027 (nth woman-adjust woman-justify-list) ; use vector? 1028 "Current justification style for `fill-region-as-paragraph'.") 1029(defvar woman-justify-previous woman-justify 1030 "Previous justification style for `fill-region-as-paragraph'.") 1031 1032(defvar woman-left-margin woman-default-indent 1033 "Current left margin.") 1034(defvar woman-prevailing-indent woman-default-indent 1035 "Current prevailing indent.") 1036(defvar woman-interparagraph-distance 1 1037 "Interparagraph distance in lines. 1038Set by .PD; used by .SH, .SS, .TP, .LP, .PP, .P, .IP, .HP.") 1039(defvar woman-leave-blank-lines nil 1040 "Blank lines to leave as vertical space.") 1041(defconst woman-tab-width 5 1042 "Default tab width set by -man macros.") 1043(defvar woman-nofill nil 1044 "Current fill mode: nil for filling.") 1045(defvar woman-RS-left-margin nil 1046 "Left margin stack for nested use of `.RS/.RE'.") 1047(defvar woman-RS-prevailing-indent nil 1048 "Prevailing indent stack for nested use of `.RS/.RE'.") 1049(defvar woman-nospace nil 1050 "Current no-space mode: nil for normal spacing. 1051Set by `.ns' request; reset by any output or `.rs' request") 1052 1053(defsubst woman-reset-nospace () 1054 "Set `woman-nospace' to nil." 1055 (setq woman-nospace nil)) 1056 1057(defconst woman-request-regexp "^[.'][ \t]*\\(\\S +\\) *" 1058 ;; Was "^\\.[ \t]*\\([a-z0-9]+\\) *" but cvs.1 uses a macro named 1059 ;; "`" and CGI.man uses a macro named "''"! 1060 ;; CGI.man uses ' as control character in places -- it *should* 1061 ;; suppress breaks! 1062 ;; Could end with "\\( +\\|$\\)" instead of " *" 1063 "Regexp to match a ?roff request plus trailing white space.") 1064 1065(defvar woman-imenu-done nil 1066 "Buffer-local: set to true if function `woman-imenu' has been called.") 1067(make-variable-buffer-local 'woman-imenu-done) 1068 1069;; From imenu.el -- needed when reformatting a file in its old buffer. 1070;; The latest buffer index used to update the menu bar menu. 1071(eval-when-compile 1072 (require 'imenu)) 1073(make-variable-buffer-local 'imenu--last-menubar-index-alist) 1074 1075(defvar woman-buffer-alist nil 1076 "An alist representing WoMan buffers that are already decoded. 1077Each element is of the form (FILE-NAME . BUFFER-NAME).") 1078 1079(defvar woman-buffer-number 0 1080 "Ordinal number of current buffer entry in `woman-buffer-alist'. 1081The ordinal numbers start from 0.") 1082 1083(defvar woman-if-conditions-true '(?n ?e ?o) 1084 "List of one-character built-in condition names that are true. 1085Should include ?e, ?o (page even/odd) and either ?n (nroff) or ?t (troff). 1086Default is '(?n ?e ?o). Set via `woman-emulation'.") 1087 1088 1089;;; Specialized utility functions: 1090 1091;;; Fast deletion without saving on the kill ring (cf. simple.el): 1092 1093(defun woman-delete-line (&optional arg) 1094 "Delete rest of current line; if all blank then delete thru newline. 1095With a numeric argument ARG, delete that many lines from point. 1096Negative arguments delete lines backward." 1097 ;; This is a non-interactive version of kill-line in simple.el that 1098 ;; deletes instead of killing and assumes kill-whole-line is nil, 1099 ;; which is essential! 1100 (delete-region (point) 1101 (progn 1102 (if arg 1103 (forward-line arg) 1104 (if (eobp) 1105 (signal 'end-of-buffer nil)) 1106 (if (looking-at "[ \t]*$") 1107 (forward-line 1) 1108 (end-of-line))) 1109 (point)))) 1110 1111(defsubst woman-delete-whole-line () 1112 "Delete current line from beginning including eol." 1113 (beginning-of-line) 1114 (woman-delete-line 1)) 1115 1116(defsubst woman-delete-following-space () 1117 "Delete all spaces and tabs FOLLOWING point (cf. `delete-horizontal-space')." 1118 ;; cf. delete-horizontal-space in simple.el: 1119 (delete-region (point) (progn (skip-chars-forward " \t") (point)))) 1120 1121(defsubst woman-delete-match (subexp) 1122 "Delete subexpression SUBEXP of buffer text matched by last search." 1123 (delete-region (match-beginning subexp) (match-end subexp))) 1124 1125;; delete-char does not kill by default 1126;; delete-backward-char does not kill by default 1127;; delete-horizontal-space does not kill 1128;; delete-blank-lines does not kill 1129 1130 1131;;; File handling: 1132 1133(defvar woman-expanded-directory-path nil 1134 "Expanded directory list cache. Resetting to nil forces update.") 1135 1136(defvar woman-topic-all-completions nil 1137 "Expanded topic alist cache. Resetting to nil forces update.") 1138 1139;;;###autoload 1140(defun woman (&optional topic re-cache) 1141 "Browse UN*X man page for TOPIC (Without using external Man program). 1142The major browsing mode used is essentially the standard Man mode. 1143Choose the filename for the man page using completion, based on the 1144topic selected from the directories specified in `woman-manpath' and 1145`woman-path'. The directory expansions and topics are cached for 1146speed, but a non-nil interactive argument forces the caches to be 1147updated (e.g. to re-interpret the current directory). 1148 1149Used non-interactively, arguments are optional: if given then TOPIC 1150should be a topic string and non-nil RE-CACHE forces re-caching." 1151 (interactive (list nil current-prefix-arg)) 1152 ;; The following test is for non-interactive calls via gnudoit etc. 1153 (if (or (not (stringp topic)) (string-match "\\S " topic)) 1154 (let ((file-name (woman-file-name topic re-cache))) 1155 (if file-name 1156 (woman-find-file file-name) 1157 (message 1158 "WoMan Error: No matching manual files found in search path") 1159 (ding)) 1160 ) 1161 (message "WoMan Error: No topic specified in non-interactive call") 1162 (ding)) 1163 ) 1164 1165;; Allow WoMan to be called via the standard Help menu: 1166(define-key-after menu-bar-manuals-menu [woman] 1167 '(menu-item "Read Man Page (WoMan)..." woman 1168 :help "Man-page documentation Without Man") t) 1169 1170(defvar woman-cached-data nil 1171 "A list of cached data used to determine cache validity. 1172Set from the cache by `woman-read-directory-cache'.") 1173 1174(defun woman-cached-data () 1175 "Generate a list of data used to determine cache validity. 1176Called both to generate and to check the cache!" 1177 ;; Must use substituted paths because values of env vars may change! 1178 (list woman-cache-level 1179 (let (lst path) 1180 (dolist (dir woman-manpath (nreverse lst)) 1181 (when (consp dir) 1182 (unless path 1183 (setq path 1184 (split-string (getenv "PATH") path-separator t))) 1185 (setq dir (and (member (car dir) path) (cdr dir)))) 1186 (when dir (add-to-list 'lst (substitute-in-file-name dir))))) 1187 (mapcar 'substitute-in-file-name woman-path))) 1188 1189(defun woman-read-directory-cache () 1190 "Load the directory and topic cache. 1191It is loaded from the file named by the variable `woman-cache-filename'. 1192Return t if the file exists, nil otherwise." 1193 (and 1194 woman-cache-filename 1195 (load woman-cache-filename t nil t) ; file exists 1196 (equal woman-cached-data (woman-cached-data)))) ; cache valid 1197 1198(defun woman-write-directory-cache () 1199 "Save the directory and topic cache. 1200It is saved to the file named by the variable `woman-cache-filename'." 1201 (if woman-cache-filename 1202 (save-excursion ; to restore current buffer 1203 ;; Make a temporary buffer; name starting with space "hides" it. 1204 (let ((standard-output 1205 (set-buffer (generate-new-buffer "WoMan tmp buffer"))) 1206 (backup-inhibited t)) 1207 ;; (switch-to-buffer standard-output t) ; only for debugging 1208 (buffer-disable-undo standard-output) 1209 (princ 1210 ";;; WoMan directory and topic cache -- generated automatically\n") 1211 (print 1212 ;; For data validity check: 1213 `(setq woman-cached-data ',(woman-cached-data))) 1214 (print 1215 `(setq woman-expanded-directory-path 1216 ',woman-expanded-directory-path)) 1217 (print 1218 `(setq woman-topic-all-completions 1219 ',woman-topic-all-completions)) 1220 (write-file woman-cache-filename) ; write CURRENT buffer 1221 (kill-buffer standard-output) 1222 )))) 1223 1224(defvaralias 'woman-topic-history 'Man-topic-history) 1225(defvar woman-file-history nil "File-name read history.") 1226 1227(defun woman-file-name (topic &optional re-cache) 1228 "Get the name of the UN*X man-page file describing a chosen TOPIC. 1229When `woman' is called interactively, the word at point may be 1230automatically used as the topic, if the value of the user option 1231`woman-use-topic-at-point' is non-nil. Return nil if no file can 1232be found. Optional argument RE-CACHE, if non-nil, forces the 1233cache to be re-read." 1234 ;; Handle the caching of the directory and topic lists: 1235 (if (and (not re-cache) 1236 (or 1237 (and woman-expanded-directory-path woman-topic-all-completions) 1238 (woman-read-directory-cache))) 1239 () 1240 (message "Building list of manual directory expansions...") 1241 (setq woman-expanded-directory-path 1242 (woman-expand-directory-path woman-manpath woman-path)) 1243 (message "Building completion list of all manual topics...") 1244 (setq woman-topic-all-completions 1245 (woman-topic-all-completions woman-expanded-directory-path)) 1246 (woman-write-directory-cache)) 1247 ;; There is a problem in that I want to offer case-insensitive 1248 ;; completions, but to return only a case-sensitive match. This 1249 ;; does not seem to work properly by default, so I re-do the 1250 ;; completion if necessary. 1251 (let (files 1252 (default (current-word))) 1253 (or (stringp topic) 1254 (and (if (boundp 'woman-use-topic-at-point) 1255 woman-use-topic-at-point 1256 ;; Was let-bound when file loaded, so ... 1257 (setq woman-use-topic-at-point woman-use-topic-at-point-default)) 1258 (setq topic (or (current-word t) "")) ; only within or adjacent to word 1259 (test-completion topic woman-topic-all-completions)) 1260 (setq topic 1261 (let* ((word-at-point (current-word)) 1262 (default 1263 (when (and word-at-point 1264 (test-completion 1265 word-at-point woman-topic-all-completions)) 1266 word-at-point))) 1267 (completing-read 1268 (if default 1269 (format "Manual entry (default %s): " default) 1270 "Manual entry: ") 1271 woman-topic-all-completions nil 1 1272 nil 1273 'woman-topic-history 1274 default)))) 1275 ;; Note that completing-read always returns a string. 1276 (if (= (length topic) 0) 1277 nil ; no topic, so no file! 1278 (cond 1279 ((setq files (woman-file-name-all-completions topic))) 1280 ;; Complete topic more carefully, i.e. use the completion 1281 ;; rather than the string entered by the user: 1282 ((setq files (all-completions topic woman-topic-all-completions)) 1283 (while (/= (length topic) (length (car files))) 1284 (setq files (cdr files))) 1285 (setq files (woman-file-name-all-completions (car files))))) 1286 (cond 1287 ((null files) nil) ; no file found for topic. 1288 ((null (cdr files)) (car (car files))) ; only 1 file for topic. 1289 (t 1290 ;; Multiple files for topic, so must select 1. 1291 ;; Unread the command event (TAB = ?\t = 9) that runs the command 1292 ;; `minibuffer-complete' in order to automatically complete the 1293 ;; minibuffer contents as far as possible. 1294 (setq unread-command-events '(9)) ; and delete any type-ahead! 1295 (completing-read "Manual file: " files nil 1 1296 (try-completion "" files) 'woman-file-history)))))) 1297 1298(defun woman-select (predicate list) 1299 "Select unique elements for which PREDICATE is true in LIST. 1300\(Note that this function changes the value of LIST.)" 1301 ;; Intended to be fast by avoiding recursion and list copying. 1302 (while (and list 1303 (or 1304 (member (car list) (cdr list)) 1305 (not (funcall predicate (car list))))) 1306 (setq list (cdr list))) 1307 (if list 1308 (let ((newlist list) cdr_list) 1309 (while (setq cdr_list (cdr list)) 1310 (if (and 1311 (not (member (car cdr_list) (cdr cdr_list))) 1312 (funcall predicate (car cdr_list))) 1313 (setq list cdr_list) 1314 (setcdr list (cdr cdr_list))) 1315 ) 1316 newlist))) 1317 1318(defun woman-file-readable-p (dir) 1319 "Return t if DIR is readable, otherwise log a warning." 1320 (or (file-readable-p dir) 1321 (WoMan-warn "Ignoring unreadable `manpath' directory tree `%s'!" dir))) 1322 1323(defun woman-directory-files (head dir) 1324 "Return a sorted list of files in directory HEAD matching regexp in DIR. 1325Value is a sorted list of the absolute pathnames of all the files in 1326directory HEAD, or the current directory if HEAD is nil, that match the 1327regexp that is the final component of DIR. Log a warning if list is empty." 1328 (or (directory-files 1329 (or head (directory-file-name default-directory)) ; was "." 1330 t 1331 (file-name-nondirectory dir)) 1332 (WoMan-warn "No directories match `woman-path' entry `%s'!" dir))) 1333 1334(defun woman-file-accessible-directory-p (dir) 1335 "Return t if DIR is accessible, otherwise log a warning." 1336 (or (file-accessible-directory-p dir) 1337 (WoMan-warn "Ignoring inaccessible `man-page' directory `%s'!" dir))) 1338 1339(defun woman-expand-directory-path (woman-manpath woman-path) 1340 "Expand the manual directories in WOMAN-MANPATH and WOMAN-PATH. 1341WOMAN-MANPATH should be a list of general manual directories, while 1342WOMAN-PATH should be a list of specific manual directory regexps. 1343Ignore any paths that are unreadable or not directories." 1344 ;; Allow each path to be a single string or a list of strings: 1345 (if (not (listp woman-manpath)) (setq woman-manpath (list woman-manpath))) 1346 (if (not (listp woman-path)) (setq woman-path (list woman-path))) 1347 (let (dir head dirs path) 1348 (while woman-manpath 1349 (setq dir (car woman-manpath) 1350 woman-manpath (cdr woman-manpath)) 1351 (when (consp dir) 1352 (unless path 1353 (setq path (split-string (getenv "PATH") path-separator t))) 1354 (setq dir (and (member (car dir) path) 1355 (cdr dir)))) 1356 (if (and dir (woman-file-readable-p dir)) 1357 ;; NB: `parse-colon-path' creates null elements for 1358 ;; redundant (semi-)colons and trailing `/'s! 1359 ;; If does not actually matter here if dir ends with `/'. 1360 ;; Need regexp "man" here to avoid "cat?", `.', `..', etc. 1361 (setq dir (woman-canonicalize-dir dir) 1362 dirs (nconc dirs (directory-files 1363 dir t woman-manpath-man-regexp))))) 1364 (while woman-path 1365 (setq dir (car woman-path) 1366 woman-path (cdr woman-path)) 1367 (if (or (null dir) 1368 (null (setq dir (woman-canonicalize-dir dir) 1369 head (file-name-directory dir))) 1370 (woman-file-readable-p head)) 1371 (setq dirs 1372 (if dir 1373 (nconc dirs (woman-directory-files head dir)) 1374 (cons (directory-file-name default-directory) dirs)) 1375 ;; was "." -- at head of list for later filtering 1376 ))) 1377 (woman-select 'woman-file-accessible-directory-p dirs))) 1378 1379(defun woman-canonicalize-dir (dir) 1380 "Canonicalize the directory name DIR. 1381Any UN*X-style environment variables are evaluated first." 1382 (setq dir (expand-file-name (substitute-in-file-name dir))) 1383 ;; A path that ends with / matches all directories in it, 1384 ;; including `.' and `..', so remove any trailing / !!! 1385 (if (string= (substring dir -1) "/") 1386 (setq dir (substring dir 0 -1))) 1387 (if (memq system-type '(windows-nt ms-dos cygwin)) ; what else? 1388 ;; Match capitalization used by `file-name-directory': 1389 (setq dir (concat (file-name-directory dir) 1390 (file-name-nondirectory dir)))) 1391 dir) 1392 1393(defsubst woman-not-member (dir path) 1394 "Return t if DIR is not a member of the list PATH, nil otherwise. 1395If DIR is `.' it is first replaced by the current directory." 1396 (not (member dir path))) 1397 1398(defun woman-topic-all-completions (path) 1399 "Return an alist of the man files in all man directories in the list PATH. 1400The cdr of each alist element is the path-index / filename." 1401 ;; Support 3 levels of caching: each element of the alist `files' 1402 ;; will be a list of the first `woman-cache-level' elements of the 1403 ;; following list: (topic path-index filename). This alist `files' 1404 ;; is re-processed by `woman-topic-all-completions-merge'. 1405 (let (dir files (path-index 0)) ; indexing starts at zero 1406 (while path 1407 (setq dir (pop path)) 1408 (if (woman-not-member dir path) ; use each directory only once! 1409 (push (woman-topic-all-completions-1 dir path-index) 1410 files)) 1411 (setq path-index (1+ path-index))) 1412 ;; Uniquefy topics: 1413 ;; Concate all lists with a single nconc call to 1414 ;; avoid retraversing the first lists repeatedly -- dak 1415 (woman-topic-all-completions-merge 1416 (apply #'nconc files)))) 1417 1418(defun woman-topic-all-completions-1 (dir path-index) 1419 "Return an alist of the man topics in directory DIR with index PATH-INDEX. 1420A topic is a filename sans type-related extensions. 1421Support 3 levels of caching: each element of the alist will be a list 1422of the first `woman-cache-level' elements from the following list: 1423\(topic path-index filename)." 1424 ;; This function used to check that each file in the directory was 1425 ;; not itself a directory, but this is very slow and should be 1426 ;; unnecessary. So let us assume that `woman-file-regexp' will 1427 ;; filter out any directories, which probably should not be there 1428 ;; anyway, i.e. it is a user error! 1429 ;; 1430 ;; Don't sort files: we do that when merging, anyway. -- dak 1431 (let (newlst (lst (directory-files dir nil woman-file-regexp t)) 1432 ;; Make an explicit regexp for stripping extension and 1433 ;; compression extension: file-name-sans-extension is a 1434 ;; far too costly function. -- dak 1435 (ext (format "\\(\\.[^.\\/]*\\)?\\(%s\\)?\\'" 1436 woman-file-compression-regexp))) 1437 ;; Use a loop instead of mapcar in order to avoid the speed 1438 ;; penalty of binding function arguments. -- dak 1439 (dolist (file lst newlst) 1440 (push 1441 (cons 1442 (if (string-match ext file) 1443 (substring file 0 (match-beginning 0)) 1444 file) 1445 (and (> woman-cache-level 1) 1446 (cons 1447 path-index 1448 (and (> woman-cache-level 2) 1449 (list file))))) 1450 newlst)))) 1451 1452(defun woman-topic-all-completions-merge (alist) 1453 "Merge the alist ALIST so that the keys are unique. 1454Also make each path-info component into a list. 1455\(Note that this function changes the value of ALIST.)" 1456 ;; Replaces unreadably "optimized" O(n^2) implementation. 1457 ;; Instead we use sorting to merge stuff efficiently. -- dak 1458 (let (elt newalist) 1459 ;; Sort list into reverse order 1460 (setq alist (sort alist (lambda(x y) (string< (car y) (car x))))) 1461 ;; merge duplicate keys. 1462 (if (> woman-cache-level 1) 1463 (while alist 1464 (setq elt (pop alist)) 1465 (if (equal (car elt) (caar newalist)) 1466 (unless (member (cdr elt) (cdar newalist)) 1467 (setcdr (car newalist) (cons (cdr elt) 1468 (cdar newalist)))) 1469 (setcdr elt (list (cdr elt))) 1470 (push elt newalist))) 1471 ;; woman-cache-level = 1 => elements are single-element lists ... 1472 (while alist 1473 (setq elt (pop alist)) 1474 (unless (equal (car elt) (caar newalist)) 1475 (push elt newalist)))) 1476 newalist)) 1477 1478(defun woman-file-name-all-completions (topic) 1479 "Return an alist of the files in all man directories that match TOPIC." 1480 ;; Support 3 levels of caching: each element of 1481 ;; woman-topic-all-completions is a list of one of the forms: 1482 ;; (topic) 1483 ;; (topic (path-index) (path-index) ... ) 1484 ;; (topic (path-index filename) (path-index filename) ... ) 1485 ;; where the are no duplicates in the value lists. 1486 ;; Topic must match first `word' of filename, so ... 1487 (let ((topic-regexp 1488 (concat 1489 "\\`" (regexp-quote topic) ; first `word' 1490 "\\(\\..+\\)*" ; optional subsequent `words' 1491 woman-file-regexp)) ; extension 1492 (topics woman-topic-all-completions) 1493 (path woman-expanded-directory-path) 1494 dir files) 1495 (if (cdr (car topics)) 1496 ;; Use cached path-info to locate files for each topic: 1497 (let ((path-info (cdr (assoc topic topics))) 1498 filename) 1499 (while path-info 1500 (setq dir (nth (car (car path-info)) path) 1501 filename (car (cdr (car path-info))) 1502 path-info (cdr path-info) 1503 files (nconc files 1504 ;; Find the actual file name: 1505 (if filename 1506 (list (concat dir "/" filename)) 1507 (directory-files dir t topic-regexp) 1508 ))))) 1509 ;; Search path for the files for each topic: 1510 (while path 1511 (setq dir (car path) 1512 path (cdr path)) 1513 (if (woman-not-member dir path) ; use each directory only once! 1514 (setq files (nconc files 1515 (directory-files dir t topic-regexp)))) 1516 )) 1517 (mapcar 'list files) 1518 )) 1519 1520 1521;;; dired support 1522 1523(defun woman-dired-define-key (key) 1524 "Bind the argument KEY to the command `woman-dired-find-file'." 1525 (define-key dired-mode-map key 'woman-dired-find-file)) 1526 1527(defsubst woman-dired-define-key-maybe (key) 1528 "If KEY is undefined in Dired, bind it to command `woman-dired-find-file'." 1529 (if (or (eq (lookup-key dired-mode-map key) 'undefined) 1530 (null (lookup-key dired-mode-map key))) 1531 (woman-dired-define-key key))) 1532 1533(defun woman-dired-define-keys () 1534 "Define dired keys to run WoMan according to `woman-dired-keys'." 1535 (if woman-dired-keys 1536 (if (listp woman-dired-keys) 1537 (mapcar 'woman-dired-define-key woman-dired-keys) 1538 (woman-dired-define-key-maybe "w") 1539 (woman-dired-define-key-maybe "W"))) 1540 (define-key-after (lookup-key dired-mode-map [menu-bar immediate]) 1541 [woman] '("Read Man Page (WoMan)" . woman-dired-find-file) 'view)) 1542 1543(if (featurep 'dired) 1544 (woman-dired-define-keys) 1545 (add-hook 'dired-mode-hook 'woman-dired-define-keys)) 1546 1547;;;###autoload 1548(defun woman-dired-find-file () 1549 "In dired, run the WoMan man-page browser on this file." 1550 (interactive) 1551 ;; dired-get-filename is defined in dired.el 1552 (woman-find-file (dired-get-filename))) 1553 1554 1555;;; tar-mode support 1556 1557(defun woman-tar-extract-file () 1558 "In tar mode, run the WoMan man-page browser on this file." 1559 (interactive) 1560 (or (eq major-mode 'tar-mode) 1561 (error "`woman-tar-extract-file' can be used only in `tar-mode'")) 1562 (buffer-disable-undo) 1563 (let (global-font-lock-mode) 1564 (funcall (symbol-function 'tar-extract)) ; defined in tar-mode 1565 (let ((WoMan-current-file buffer-file-name)) ; used for message logging 1566 (rename-buffer 1567 (woman-make-bufname (file-name-nondirectory buffer-file-name))) 1568 (woman-process-buffer) 1569 (goto-char (point-min))))) 1570 1571;; There is currently no `tar-mode-hook' so use ... 1572(eval-after-load "tar-mode" 1573 '(progn 1574 (define-key tar-mode-map "w" 'woman-tar-extract-file) 1575 (define-key-after (lookup-key tar-mode-map [menu-bar immediate]) 1576 [woman] '("Read Man Page (WoMan)" . woman-tar-extract-file) 'view))) 1577 1578 1579(defvar woman-last-file-name nil 1580 "The full pathname of the last file formatted by WoMan.") 1581 1582(defun woman-reformat-last-file () 1583 "Reformat last file, e.g. after changing fill column." 1584 (interactive) 1585 (if woman-last-file-name 1586 (woman-find-file woman-last-file-name t) 1587 (call-interactively 'woman-find-file))) 1588 1589;;;###autoload 1590(defun woman-find-file (file-name &optional reformat) 1591 "Find, decode and browse a specific UN*X man-page source file FILE-NAME. 1592Use existing buffer if possible; reformat only if prefix arg given. 1593When called interactively, optional argument REFORMAT forces reformatting 1594of an existing WoMan buffer formatted earlier. 1595No external programs are used, except that `gunzip' will be used to 1596decompress the file if appropriate. See the documentation for the 1597`woman' command for further details." 1598 (interactive "fBrowse UN*X manual file: \nP") 1599 (setq woman-last-file-name 1600 (setq file-name (expand-file-name file-name))) ; to canonicalize 1601 (let ((alist-tail woman-buffer-alist) exists) 1602 (setq woman-buffer-number 0) 1603 (while (and alist-tail (not (string= file-name (car (car alist-tail))))) 1604 (setq alist-tail (cdr alist-tail) 1605 woman-buffer-number (1+ woman-buffer-number))) 1606 (or (and (setq exists 1607 (and alist-tail (WoMan-find-buffer))) ; buffer exists 1608 (not reformat)) 1609 ;; Format new buffer or reformat current buffer: 1610 (let* ((bufname (file-name-nondirectory file-name)) 1611 (case-fold-search t) 1612 (compressed 1613 (not (not (string-match woman-file-compression-regexp bufname))))) 1614 (if compressed 1615 (setq bufname (file-name-sans-extension bufname))) 1616 (setq bufname (if exists 1617 (buffer-name) 1618 (woman-make-bufname bufname))) 1619 (woman-really-find-file file-name compressed bufname) 1620 (or exists 1621 (setq woman-buffer-alist 1622 (cons (cons file-name bufname) woman-buffer-alist) 1623 woman-buffer-number 0)) 1624 ))) 1625 (Man-build-section-alist) 1626 (Man-build-references-alist) 1627 (goto-char (point-min))) 1628 1629(defun woman-make-bufname (bufname) 1630 "Create an unambiguous buffer name from BUFNAME." 1631 (let ((dot (string-match "\\." bufname))) 1632 (if dot (setq bufname (concat 1633 (substring bufname (1+ dot)) " " 1634 (substring bufname 0 dot)))) 1635 (generate-new-buffer-name ; ensure uniqueness 1636 (concat "*WoMan " bufname "*")))) 1637 1638(defvar woman-frame nil 1639 "Dedicated frame used for displaying WoMan windows.") 1640 1641(defun woman-really-find-file (filename compressed bufname) 1642 "Find, decompress, and decode a UN*X man page FILENAME. 1643If COMPRESSED is non-nil, turn on auto-compression mode to decompress 1644the file if necessary. Set buffer name BUFNAME and major mode. 1645Do not call directly!" 1646 (let ((WoMan-current-file filename)) ; used for message logging 1647 (if woman-use-own-frame 1648 (select-frame 1649 (or (and (frame-live-p woman-frame) woman-frame) 1650 (setq woman-frame (make-frame))))) 1651 (switch-to-buffer (get-buffer-create bufname)) 1652 (buffer-disable-undo) 1653 (setq buffer-read-only nil) 1654 (erase-buffer) ; NEEDED for reformat 1655 (woman-insert-file-contents filename compressed) 1656 ;; Set buffer's default directory to that of the file. 1657 (setq default-directory (file-name-directory filename)) 1658 (set (make-local-variable 'backup-inhibited) t) 1659 (set-visited-file-name "") 1660 (woman-process-buffer))) 1661 1662(defun woman-process-buffer () 1663 "The second half of `woman-really-find-file'!" 1664 (interactive) 1665 ;; Check (crudely) that this really is likely to be in UN*X 1666 ;; man-page source format, assuming we are at point-min: 1667 (goto-char (point-min)) 1668 (if (re-search-forward "^[.']" 1000 t) 1669 (woman-decode-buffer) 1670 (message 1671 "File appears to be pre-formatted -- using source file may be better.") 1672 (woman-man-buffer)) 1673 (woman-mode)) 1674 1675(defun woman-man-buffer () 1676 "Post-process an nroff-preformatted man buffer." 1677 ;; Kill all leading whitespace: 1678 (if (looking-at "\\s-+") (woman-delete-match 0)) 1679 ;; Delete all page footer/header pairs: 1680 (re-search-forward ".*") ; match header 1681 ;; Footer conventionally has page number at right, so ... 1682 (let ((regex (concat 1683 "^.*[0-9]\n\\s-*" ; footer and following blank lines 1684 (regexp-quote (match-string 0)) ; header 1685 "\\s-*\n"))) ; following blank lines 1686 (while (re-search-forward regex nil 1) ; finish at eob 1687 (woman-delete-match 0))) 1688 ;; Delete last text line (footer) and all following blank lines: 1689 (re-search-backward "\\S-") 1690 (beginning-of-line) 1691 (if (looking-at ".*[0-9]$") 1692 (delete-region (point) (point-max))) 1693 1694 ;; Squeeze multiple blank lines: 1695 (goto-char (point-min)) 1696 (while (re-search-forward "^[ \t]*\n\\([ \t]*\n\\)+" nil t) 1697 (replace-match "\n" t t)) 1698 1699 ;; CJK characters are underlined by double-sized "__". 1700 ;; (Code lifted from man.el, with trivial changes.) 1701 (if (< (buffer-size) (position-bytes (point-max))) 1702 ;; Multibyte characters exist. 1703 (progn 1704 (goto-char (point-min)) 1705 (while (search-forward "__\b\b" nil t) 1706 (backward-delete-char 4) 1707 (woman-set-face (point) (1+ (point)) 'woman-italic)) 1708 (goto-char (point-min)) 1709 (while (search-forward "\b\b__" nil t) 1710 (backward-delete-char 4) 1711 (woman-set-face (1- (point)) (point) 'woman-italic)))) 1712 1713 ;; Interpret overprinting to indicate bold face: 1714 (goto-char (point-min)) 1715 (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t) 1716 (woman-delete-match 2) 1717 (woman-set-face (1- (point)) (point) 'woman-bold)) 1718 1719 ;; Interpret underlining to indicate italic face: 1720 ;; (Must be AFTER emboldening to interpret bold _ correctly!) 1721 (goto-char (point-min)) 1722 (while (search-forward "_" nil t) 1723 (delete-char -2) 1724 (woman-set-face (point) (1+ (point)) 'woman-italic)) 1725 1726 ;; Leave any other uninterpreted ^H's in the buffer for now! (They 1727 ;; might indicate composite special characters, which could be 1728 ;; interpreted if I knew what to expect.) 1729 1730 ;; Optionally embolden section and subsection headings 1731 ;; (cf. `woman-imenu-generic-expression'): 1732 (cond 1733 (woman-bold-headings 1734 (goto-char (point-min)) 1735 (forward-line) 1736 (while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t) 1737 (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold)))) 1738 ) 1739 1740(defun woman-insert-file-contents (filename compressed) 1741 "Insert file FILENAME into the current buffer. 1742If COMPRESSED is t, or is non-nil and the filename implies compression, 1743then turn on auto-compression mode to decompress the file. 1744Leave point at end of new text. Return length of inserted text." 1745 ;; Leaves point at end of inserted text in GNU Emacs 20.3, but at 1746 ;; start in 19.34! 1747 (save-excursion 1748 (let ((case-fold-search t)) 1749 ;; Co-operate with auto-compression mode: 1750 (if (and compressed 1751 (or (eq compressed t) 1752 (string-match woman-file-compression-regexp filename)) 1753 ;; (not auto-compression-mode) 1754 (not (rassq 'jka-compr-handler file-name-handler-alist)) ) 1755 ;; (error "Compressed file requires Auto File Decompression turned on") 1756 (auto-compression-mode 1)) 1757 (nth 1 1758 (condition-case () 1759 (insert-file-contents filename nil) 1760 (file-error 1761 ;; Run find-file-not-found-hooks until one returns non-nil. 1762 ;; (run-hook-with-args-until-success 'find-file-not-found-hooks) 1763 (insert "\n***** File " filename " not found! *****\n\n") 1764 ))) 1765 ))) 1766 1767 1768;;; Major mode (Man) interface: 1769 1770(defvar woman-mode-map nil "Keymap for woman mode.") 1771 1772(unless woman-mode-map 1773 (setq woman-mode-map (make-sparse-keymap)) 1774 (set-keymap-parent woman-mode-map Man-mode-map) 1775 1776 (define-key woman-mode-map "R" 'woman-reformat-last-file) 1777 (define-key woman-mode-map "w" 'woman) 1778 (define-key woman-mode-map "\en" 'WoMan-next-manpage) 1779 (define-key woman-mode-map "\ep" 'WoMan-previous-manpage) 1780 (define-key woman-mode-map [M-mouse-2] 'woman-follow-word) 1781 1782 ;; We don't need to call `man' when we are in `woman-mode'. 1783 (define-key woman-mode-map [remap man] 'woman) 1784 (define-key woman-mode-map [remap man-follow] 'woman-follow)) 1785 1786(defun woman-follow (topic) 1787 "Get a Un*x manual page of the item under point and put it in a buffer." 1788 (interactive (list (Man-default-man-entry))) 1789 (if (or (not topic) 1790 (string= topic "")) 1791 (error "No item under point") 1792 (woman (if (string-match Man-reference-regexp topic) 1793 (substring topic 0 (match-end 1)) 1794 topic)))) 1795 1796(defun woman-follow-word (event) 1797 "Run WoMan with word under mouse as topic. 1798Argument EVENT is the invoking mouse event." 1799 (interactive "e") ; mouse event 1800 (goto-char (posn-point (event-start event))) 1801 (woman (or (current-word t) ""))) 1802 1803;; WoMan menu bar and pop-up menu: 1804(easy-menu-define 1805 woman-menu ; (SYMBOL MAPS DOC MENU) 1806 ;; That comment was moved after the symbol `woman-menu' to make 1807 ;; find-function-search-for-symbol work. -- rost 1808 woman-mode-map 1809 "WoMan Menu" 1810 `("WoMan" 1811 ["WoMan..." woman t] ; [NAME CALLBACK ENABLE] 1812 "--" 1813 ["Next Section" Man-next-section t] 1814 ["Previous Section" Man-previous-section t] 1815 ["Goto Section..." Man-goto-section t] 1816 ["Goto See-Also Section" Man-goto-see-also-section t] 1817 ["Follow Reference..." Man-follow-manual-reference t] 1818 "--" 1819 ["Previous WoMan Buffer" WoMan-previous-manpage t] 1820 ["Next WoMan Buffer" WoMan-next-manpage t] 1821 ["Bury WoMan Buffer" Man-quit t] 1822 ["Kill WoMan Buffer" Man-kill t] 1823 "--" 1824 ;; ["Toggle Fill Frame Width" woman-toggle-fill-frame t] 1825 ["Use Full Frame Width" woman-toggle-fill-frame 1826 :active t :style toggle :selected woman-fill-frame] 1827 ["Reformat Last Man Page" woman-reformat-last-file t] 1828 ["Use Monochrome Main Faces" woman-monochrome-faces t] 1829 ["Use Default Main Faces" woman-default-faces t] 1830 ["Make Contents Menu" (woman-imenu t) (not woman-imenu-done)] 1831 "--" 1832 ["Describe (Wo)Man Mode" describe-mode t] 1833 ["Mini Help" woman-mini-help t] 1834 ,@(if (fboundp 'customize-group) 1835 '(["Customize..." (customize-group 'woman) t])) 1836 ["Show Version" (message "WoMan %s" woman-version) t] 1837 "--" 1838 ("Advanced" 1839 ["View Source" (view-file woman-last-file-name) woman-last-file-name] 1840 ["Show Log" (switch-to-buffer-other-window "*WoMan-Log*" t) t] 1841 ["Extended Font" woman-toggle-use-extended-font 1842 :included woman-font-support 1843 :active t :style toggle :selected woman-use-extended-font] 1844 ["Symbol Font" woman-toggle-use-symbol-font 1845 :included woman-font-support 1846 :active t :style toggle :selected woman-use-symbol-font] 1847 ["Font Map" woman-display-extended-fonts 1848 :included woman-font-support 1849 :active woman-use-symbol-font] 1850 "--" 1851 "Emulation" 1852 ["nroff" (woman-reset-emulation 'nroff) 1853 :active t :style radio :selected (eq woman-emulation 'nroff)] 1854 ["troff" (woman-reset-emulation 'troff) 1855 :active t :style radio :selected (eq woman-emulation 'troff)] 1856 ) 1857 )) 1858 1859(defun woman-toggle-use-extended-font () 1860 "Toggle `woman-use-extended-font' and reformat, for menu use." 1861 (interactive) 1862 (setq woman-use-extended-font (not woman-use-extended-font)) 1863 (woman-reformat-last-file)) 1864 1865(defun woman-toggle-use-symbol-font () 1866 "Toggle `woman-use-symbol-font' and reformat, for menu use." 1867 (interactive) 1868 (setq woman-use-symbol-font (not woman-use-symbol-font)) 1869 (woman-reformat-last-file)) 1870 1871(defun woman-reset-emulation (value) 1872 "Reset `woman-emulation' to VALUE and reformat, for menu use." 1873 (interactive) 1874 (setq woman-emulation value) 1875 (woman-reformat-last-file)) 1876 1877(put 'woman-mode 'mode-class 'special) 1878 1879(defun woman-mode () 1880 "Turn on (most of) Man mode to browse a buffer formatted by WoMan. 1881WoMan is an ELisp emulation of much of the functionality of the Emacs 1882`man' command running the standard UN*X man and ?roff programs. 1883WoMan author: F.J.Wright@Maths.QMW.ac.uk 1884WoMan version: see `woman-version'. 1885See `Man-mode' for additional details." 1886 (let ((Man-build-page-list (symbol-function 'Man-build-page-list)) 1887 (Man-strip-page-headers (symbol-function 'Man-strip-page-headers)) 1888 (Man-unindent (symbol-function 'Man-unindent)) 1889 (Man-goto-page (symbol-function 'Man-goto-page))) 1890 ;; Prevent inappropriate operations: 1891 (fset 'Man-build-page-list 'ignore) 1892 (fset 'Man-strip-page-headers 'ignore) 1893 (fset 'Man-unindent 'ignore) 1894 (fset 'Man-goto-page 'ignore) 1895 (unwind-protect 1896 (delay-mode-hooks (Man-mode)) 1897 ;; Restore the status quo: 1898 (fset 'Man-build-page-list Man-build-page-list) 1899 (fset 'Man-strip-page-headers Man-strip-page-headers) 1900 (fset 'Man-unindent Man-unindent) 1901 (fset 'Man-goto-page Man-goto-page))) 1902 (setq major-mode 'woman-mode 1903 mode-name "WoMan") 1904 ;; Don't show page numbers like Man-mode does. (Online documents do 1905 ;; not have pages) 1906 (kill-local-variable 'mode-line-buffer-identification) 1907 (use-local-map woman-mode-map) 1908 ;; Imenu support: 1909 (set (make-local-variable 'imenu-generic-expression) 1910 ;; `make-local-variable' in case imenu not yet loaded! 1911 woman-imenu-generic-expression) 1912 (set (make-local-variable 'imenu-space-replacement) " ") 1913 ;; For reformat ... 1914 ;; necessary when reformatting a file in its old buffer: 1915 (setq imenu--last-menubar-index-alist nil) 1916 ;; necessary to avoid re-installing the same imenu: 1917 (setq woman-imenu-done nil) 1918 (if woman-imenu (woman-imenu)) 1919 (let (buffer-read-only) 1920 (Man-highlight-references 'WoMan-xref-man-page)) 1921 (set-buffer-modified-p nil) 1922 (run-mode-hooks 'woman-mode-hook)) 1923 1924(defun woman-imenu (&optional redraw) 1925 "Add a \"Contents\" menu to the menubar. 1926Optional argument REDRAW, if non-nil, forces mode line to be updated." 1927 (interactive) 1928 (if woman-imenu-done 1929 ;; This is PRIMARILY to avoid a bug in imenu-add-to-menubar that 1930 ;; causes it to corrupt the menu bar if it is run more than once 1931 ;; in the same buffer. 1932 () 1933 (setq woman-imenu-done t) 1934 (imenu-add-to-menubar woman-imenu-title) 1935 (if redraw (force-mode-line-update)))) 1936 1937(defun woman-toggle-fill-frame () 1938 "Toggle formatting to fill (most of) the width of the current frame." 1939 (interactive) 1940 (setq woman-fill-frame (not woman-fill-frame)) 1941 (message "Woman fill column set to %s." 1942 (if woman-fill-frame "frame width" woman-fill-column) 1943 )) 1944 1945(defun woman-mini-help () 1946 "Display WoMan commands and user options in an `apropos' buffer." 1947 ;; Based on apropos-command in apropos.el 1948 (interactive) 1949 (require 'apropos) 1950 (let ((message 1951 (let ((standard-output (get-buffer-create "*Apropos*"))) 1952 (print-help-return-message 'identity)))) 1953 (setq apropos-accumulator 1954 (apropos-internal "woman" 1955 (lambda (symbol) 1956 (or (commandp symbol) 1957 (user-variable-p symbol))))) 1958 ;; Filter out any inhibited symbols: 1959 (let ((tem apropos-accumulator)) 1960 (while tem 1961 (if (get (car tem) 'apropos-inhibit) 1962 (setq apropos-accumulator (delq (car tem) apropos-accumulator))) 1963 (setq tem (cdr tem)))) 1964 ;; Find documentation strings: 1965 (let ((p apropos-accumulator) 1966 doc symbol) 1967 (while p 1968 (setcar p (list ; must have 3 elements: 1969 (setq symbol (car p)) ; 1. name 1970 (if (functionp symbol) ; 2. command doc 1971 (if (setq doc (documentation symbol t)) 1972 (substring doc 0 (string-match "\n" doc)) 1973 "(not documented)")) 1974 (if (user-variable-p symbol) ; 3. variable doc 1975 (if (setq doc (documentation-property 1976 symbol 'variable-documentation t)) 1977 (substring doc 0 (string-match "\n" doc)))))) 1978 (setq p (cdr p)))) 1979 ;; Output the result: 1980 (and (apropos-print t nil) 1981 message 1982 (message "%s" message)))) 1983 1984 1985(defun WoMan-getpage-in-background (topic) 1986 "Use TOPIC to start WoMan from `Man-follow-manual-reference'." 1987 ;; topic is a string, generally of the form "section topic" 1988 (let ((s (string-match " " topic))) 1989 (if s (setq topic (substring topic (1+ s)))) 1990 (woman topic))) 1991 1992(defvar WoMan-Man-start-time nil 1993 "Used to record formatting time used by the `man' command.") 1994 1995;; Both advices are disabled because "a file in Emacs should not put 1996;; advice on a function in Emacs" (see Info node "(elisp)Advising 1997;; Functions"). Counting the formatting time is useful for 1998;; developping, but less applicable for daily use. The advice for 1999;; `Man-getpage-in-background' can be discarded, because the 2000;; key-binding in `woman-mode-map' has been remapped to call `woman' 2001;; but `man'. Michael Albinus <michael.albinus@gmx.de> 2002 2003;; (defadvice Man-getpage-in-background 2004;; (around Man-getpage-in-background-advice (topic) activate) 2005;; "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly. 2006;; Otherwise use Man and record start of formatting time." 2007;; (if (and (eq major-mode 'woman-mode) 2008;; (not (eq (caar command-history) 'man))) 2009;; (WoMan-getpage-in-background topic) 2010;; ;; Initiates man processing 2011;; (setq WoMan-Man-start-time (current-time)) 2012;; ad-do-it)) 2013 2014;; (defadvice Man-bgproc-sentinel 2015;; (after Man-bgproc-sentinel-advice activate) 2016;; ;; Terminates man processing 2017;; "Report formatting time." 2018;; (let* ((time (current-time)) 2019;; (time (+ (* (- (car time) (car WoMan-Man-start-time)) 65536) 2020;; (- (cadr time) (cadr WoMan-Man-start-time))))) 2021;; (message "Man formatting done in %d seconds" time))) 2022 2023 2024;;; Buffer handling: 2025 2026(defun WoMan-previous-manpage () 2027 "Find the previous WoMan buffer." 2028 ;; Assumes currently in a WoMan buffer! 2029 (interactive) 2030 (WoMan-find-buffer) ; find current existing buffer 2031 (if (null (cdr woman-buffer-alist)) 2032 (error "No previous WoMan buffer")) 2033 (if (>= (setq woman-buffer-number (1+ woman-buffer-number)) 2034 (length woman-buffer-alist)) 2035 (setq woman-buffer-number 0)) 2036 (if (WoMan-find-buffer) 2037 () 2038 (if (< (setq woman-buffer-number (1- woman-buffer-number)) 0) 2039 (setq woman-buffer-number (1- (length woman-buffer-alist)))) 2040 (WoMan-previous-manpage))) 2041 2042(defun WoMan-next-manpage () 2043 "Find the next WoMan buffer." 2044 ;; Assumes currently in a WoMan buffer! 2045 (interactive) 2046 (WoMan-find-buffer) ; find current existing buffer 2047 (if (null (cdr woman-buffer-alist)) 2048 (error "No next WoMan buffer")) 2049 (if (< (setq woman-buffer-number (1- woman-buffer-number)) 0) 2050 (setq woman-buffer-number (1- (length woman-buffer-alist)))) 2051 (if (WoMan-find-buffer) 2052 () 2053 (WoMan-next-manpage))) 2054 2055(defun WoMan-find-buffer () 2056 "Switch to buffer corresponding to `woman-buffer-number' and return it. 2057If such a buffer does not exist then remove its association from the 2058alist in `woman-buffer-alist' and return nil." 2059 (if (zerop woman-buffer-number) 2060 (let ((buffer (get-buffer (cdr (car woman-buffer-alist))))) 2061 (if buffer 2062 (switch-to-buffer buffer) 2063 ;; Delete alist element: 2064 (setq woman-buffer-alist (cdr woman-buffer-alist)) 2065 nil)) 2066 (let* ((prev-ptr (nthcdr (1- woman-buffer-number) woman-buffer-alist)) 2067 (buffer (get-buffer (cdr (car (cdr prev-ptr)))))) 2068 (if buffer 2069 (switch-to-buffer buffer) 2070 ;; Delete alist element: 2071 (setcdr prev-ptr (cdr (cdr prev-ptr))) 2072 (if (>= woman-buffer-number (length woman-buffer-alist)) 2073 (setq woman-buffer-number 0)) 2074 nil) 2075 ))) 2076 2077 2078;;; Syntax and display tables: 2079 2080(defconst woman-escaped-escape-char ? 2081 ;; An arbitrary unused control character 2082 "Internal character representation of escaped escape characters.") 2083(defconst woman-escaped-escape-string 2084 (char-to-string woman-escaped-escape-char) 2085 "Internal string representation of escaped escape characters.") 2086 2087(defconst woman-unpadded-space-char ? 2088 ;; An arbitrary unused control character 2089 "Internal character representation of unpadded space characters.") 2090(defconst woman-unpadded-space-string 2091 (char-to-string woman-unpadded-space-char) 2092 "Internal string representation of unpadded space characters.") 2093 2094(defvar woman-syntax-table nil 2095 "Syntax table to support special characters used internally by WoMan.") 2096 2097(if woman-syntax-table 2098 () 2099 (setq woman-syntax-table (make-syntax-table)) 2100 ;; The following internal chars must NOT have whitespace syntax: 2101 (modify-syntax-entry woman-unpadded-space-char "." woman-syntax-table) 2102 (modify-syntax-entry woman-escaped-escape-char "." woman-syntax-table) 2103 ) 2104 2105(defun woman-set-buffer-display-table () 2106 "Set up a display table for a WoMan buffer. 2107This display table is used for displaying internal special characters, but 2108does not interfere with any existing display table, e.g. for displaying 2109European characters." 2110 (setq buffer-display-table 2111 ;; The following test appears to be necessary on some 2112 ;; non-Windows platforms, e.g. Solaris 2.6 when running on a 2113 ;; tty. Thanks to T. V. Raman <raman@Adobe.COM>. 2114 ;; The MS-DOS terminal also sets standard-display-table to 2115 ;; a non-nil value. 2116 (if standard-display-table ; default is nil !!! 2117 (copy-sequence standard-display-table) 2118 (make-display-table))) 2119 ;; Display the following internal chars correctly: 2120 (aset buffer-display-table woman-unpadded-space-char [?\ ]) 2121 (aset buffer-display-table woman-escaped-escape-char [?\\])) 2122 2123 2124;;; The main decoding driver: 2125 2126(defvar font-lock-mode) ; for the compiler 2127 2128(defun woman-decode-buffer () 2129 "Decode a buffer in UN*X man-page source format. 2130No external programs are used." 2131 (interactive) ; mainly for testing 2132 (WoMan-log-begin) 2133 (run-hooks 'woman-pre-format-hook) 2134 (and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1)) 2135 ;; (fundamental-mode) 2136 (let ((start-time (current-time)) ; (HIGH LOW MICROSEC) 2137 time) ; HIGH * 2**16 + LOW seconds 2138 (message "WoMan formatting buffer...") 2139; (goto-char (point-min)) 2140; (cond 2141; ((re-search-forward "^\\.[ \t]*TH" nil t) ; wrong format if not found? 2142; (beginning-of-line) 2143; (delete-region (point-min) (point))) ; potentially dangerous! 2144; (t (message "WARNING: .TH request not found -- not man-page format?"))) 2145 (woman-decode-region (point-min) (point-max)) 2146 (setq time (current-time) 2147 time (+ (* (- (car time) (car start-time)) 65536) 2148 (- (cadr time) (cadr start-time)))) 2149 (message "WoMan formatting buffer...done in %d seconds" time) 2150 (WoMan-log-end time)) 2151 (run-hooks 'woman-post-format-hook)) 2152 2153(defvar woman-string-alist ; rebound in woman-decode-region 2154 '(("S" . "") ("R" . "(Reg.)") ("Tm" . "(TM)") 2155 ("lq" . "\"") ("rq" . "\"") 2156 ("''" . "\"") ; needed for gcc.1 2157 (".T" . "") ; output device from -T option? 2158 ) 2159 "Alist of strings predefined in the -man macro package `tmac.an'.") 2160 2161(defvar woman-negative-vertical-space nil ; rebound in woman-decode-region 2162 "Set to t if .sp N with N < 0 encountered.") 2163 2164(defun woman-pre-process-region (from to) 2165 "Pre-process escapes and comments in the region of text between FROM and TO. 2166To be called on original buffer and any .so insertions." 2167 ;; Hide escaped escapes \\ and printable escapes \e very early 2168 ;; (to be re-instated as just \ very late!): 2169 (goto-char from) 2170 ;; .eo turns off escape character processing 2171 (while (re-search-forward "\\(\\\\[\\e]\\)\\|^\\.eo" to t) ; \\ 2172 (if (match-string 1) 2173 (replace-match woman-escaped-escape-string t t) 2174 (woman-delete-whole-line) 2175 ;; .ec turns on escape character processing (and sets the 2176 ;; escape character to its argument, if any, which I'm ignoring 2177 ;; for now!) 2178 (while (and (re-search-forward "\\(\\\\\\)\\|^\\.ec" to t) ; \ 2179 (match-string 1)) 2180 (replace-match woman-escaped-escape-string t t)) 2181 ;; ***** Need test for .ec arg and warning here! ***** 2182 (woman-delete-whole-line))) 2183 2184 ;; Delete comments .\"<anything>, \"<anything> and null requests. 2185 ;; (However, should null . requests cause a break?) 2186 (goto-char from) 2187 (while (re-search-forward "^[.'][ \t]*\\(\\\\\".*\\)?\n\\|\\\\\".*" to t) 2188 (woman-delete-match 0))) 2189 2190(defun woman-non-underline-faces () 2191 "Prepare non-underlined versions of underlined faces." 2192 (let ((face-list (face-list))) 2193 (while face-list 2194 (let* ((face (car face-list)) 2195 (face-name (symbol-name face))) 2196 (if (and (string-match "\\`woman-" face-name) 2197 (face-underline-p face)) 2198 (let ((face-no-ul (intern (concat face-name "-no-ul")))) 2199 (copy-face face face-no-ul) 2200 (set-face-underline-p face-no-ul nil)))) 2201 (setq face-list (cdr face-list))))) 2202 2203;; Preprocessors 2204;; ============= 2205 2206;; This information is based on documentation for the man command by 2207;; Graeme W. Wilford <G.Wilford@ee.surrey.ac.uk> 2208 2209;; First, the environment variable $MANROFFSEQ is interrogated, and if 2210;; not set then the initial line of the nroff file is parsed for a 2211;; preprocessor string. To contain a valid preprocessor string, the 2212;; first line must resemble 2213;; 2214;; '\" <string> 2215;; 2216;; where string can be any combination of the following letters that 2217;; specify the sequence of preprocessors to run before nroff or 2218;; troff/groff. Not all installations will have a full set of 2219;; preprocessors. Some of the preprocessors and the letters used to 2220;; designate them are: eqn (e), grap (g), pic (p), tbl (t), vgrind 2221;; (v), refer (r). This option overrides the $MANROFFSEQ environment 2222;; variable. zsoelim is always run as the very first preprocessor. 2223 2224(defvar woman-emulate-tbl nil 2225 "True if WoMan should emulate the tbl preprocessor. 2226This applies to text between .TE and .TS directives. 2227Currently set only from '\" t in the first line of the source file.") 2228 2229(defun woman-decode-region (from to) 2230 "Decode the region between FROM and TO in UN*X man-page source format." 2231 ;; Suitable for use in format-alist. 2232 ;; But this requires care to control major mode implied font locking. 2233 ;; Must return the new end of file. See format.el for details. 2234 ;; NB: The `to' argument is bogus: it is not currently used, and if 2235 ;; it were it would need to be a marker rather than a position! 2236 ;; First force the correct environment: 2237 (let ((case-fold-search nil) ; This is necessary! 2238 (woman-string-alist woman-string-alist) 2239 (woman-fill-column woman-fill-column) 2240 woman-negative-vertical-space) 2241 (setq woman-left-margin woman-default-indent 2242 woman-prevailing-indent woman-default-indent 2243 woman-interparagraph-distance 1 2244 woman-leave-blank-lines nil 2245 woman-RS-left-margin nil 2246 woman-RS-prevailing-indent nil 2247 woman-adjust woman-adjust-both 2248 woman-justify (nth woman-adjust woman-justify-list) 2249 woman-nofill nil) 2250 2251 (setq woman-if-conditions-true 2252 (cons (string-to-char (symbol-name woman-emulation)) '(?e ?o))) 2253 2254 ;; Prepare non-underlined versions of underlined faces: 2255 (woman-non-underline-faces) 2256 ;; Set font of `woman-symbol' face to `woman-symbol-font' if 2257 ;; `woman-symbol-font' is well defined. 2258 (and woman-use-symbol-font 2259 (stringp woman-symbol-font) 2260 (set-face-font 'woman-symbol woman-symbol-font 2261 (and (frame-live-p woman-frame) woman-frame))) 2262 2263 ;; Set syntax and display tables: 2264 (set-syntax-table woman-syntax-table) 2265 (woman-set-buffer-display-table) 2266 2267 ;; Based loosely on a suggestion by Theodore Jump: 2268 (if (or woman-fill-frame 2269 (not (and (integerp woman-fill-column) (> woman-fill-column 0)))) 2270 (setq woman-fill-column (- (window-width) woman-default-indent))) 2271 2272 ;; Check for preprocessor requests: 2273 (goto-char from) 2274 (if (looking-at "'\\\\\"[ \t]*\\([a-z]+\\)") 2275 (let ((letters (append (match-string 1) nil))) 2276 (if (memq ?t letters) 2277 (setq woman-emulate-tbl t 2278 letters (delete ?t letters))) 2279 (if letters 2280 (WoMan-warn "Unhandled preprocessor request letters %s" 2281 (concat letters))) 2282 (woman-delete-line 1))) 2283 2284 (woman-pre-process-region from nil) 2285 ;; Process ignore requests, macro definitions, 2286 ;; conditionals and switch source requests: 2287 (woman0-roff-buffer from) 2288 2289 ;; Check for macro sets that woman cannot handle. We can only 2290 ;; because do this after processing source-switch directives. 2291 (goto-char (point-min)) 2292 (let ((case-fold-search nil)) 2293 (unless (and (re-search-forward "^\\.SH[ \n]" (point-max) t) 2294 (progn (goto-char (point-min)) 2295 (re-search-forward "^\\.TH[ \n]" (point-max) t)) 2296 (progn (goto-char (point-min)) 2297 (not (re-search-forward "^\\.\\([pnil]p\\|sh\\)[ \n]" 2298 (point-max) t)))) 2299 (error "WoMan can only format man pages written with the usual `-man' macros"))) 2300 2301 ;; Process \k escapes BEFORE changing tab width (?): 2302 (goto-char from) 2303 (woman-mark-horizonal-position) 2304 2305 ;; Set buffer-local variables: 2306 (setq fill-column woman-fill-column 2307 tab-width woman-tab-width) 2308 2309 ;; Hide unpaddable and digit-width spaces \(space) and \0: 2310 (goto-char from) 2311 (while (re-search-forward "\\\\[ 0]" nil t) 2312 (replace-match woman-unpadded-space-string t t)) 2313 2314 ;; Discard optional hyphen \%; concealed newlines \<newline>; 2315 ;; point-size change function \sN,\s+N, \s-N: 2316 (goto-char from) 2317 (while (re-search-forward "\\\\\\([%\n]\\|s[-+]?[0-9]+\\)" nil t) 2318 (woman-delete-match 0)) 2319 2320 ;; BEWARE: THIS SHOULD PROBABLY ALL BE DONE MUCH LATER!!!!! 2321 ;; Process trivial escapes \-, \`, \. 2322 ;; (\' must be done after tab processing!): 2323 (goto-char from) 2324 (while (re-search-forward "\\\\\\([-`.]\\)" nil t) 2325 (replace-match "\\1")) 2326 ;; NB: Must keep ALL zero-width characters \&, \|, and \^ until 2327 ;; ALL requests processed! 2328 2329 ;; Process no-break requests and macros (including font-change macros): 2330 (goto-char from) 2331 (woman1-roff-buffer) 2332 2333 ;; Process strings and special character escapes \(xx: 2334 ;; (Must do this BEFORE fontifying!) 2335 (goto-char from) 2336 (woman-strings) 2337 ;; Special chars moved after translation in 2338 ;; `woman2-process-escapes' (for pic.1): 2339; (goto-char from) 2340; (woman-special-characters) 2341 2342 ;; Process standard font-change requests and escapes: 2343 (goto-char from) 2344 (woman-change-fonts) 2345 2346 ;; 1/2 em vertical motion \d, \u and general local vertical motion 2347 ;; \v'+/-N' simulated using TeX ^ and _ symbols for now. 2348 (goto-char from) 2349 (let ((first t)) ; assume no nesting! 2350 (while (re-search-forward "\\\\\\([du]\\|v'[^']*'\\)" nil t) 2351 (let* ((esc (match-string 1)) 2352 (repl (if (or (= (aref esc 0) ?u) 2353 (and (>= (length esc) 2) (= (aref esc 2) ?-))) 2354 "^" "_"))) 2355 (cond (first 2356 (replace-match repl nil t) 2357 (put-text-property (1- (point)) (point) 'face 'woman-addition) 2358 (WoMan-warn 2359 "Initial vertical motion escape \\%s simulated" esc) 2360 (WoMan-log 2361 " by TeX `%s' in woman-addition-face!" repl)) 2362 (t 2363 (woman-delete-match 0) 2364 (WoMan-warn 2365 "Terminal vertical motion escape \\%s ignored!" esc))) 2366 (setq first (not first)) 2367 ))) 2368 2369; ;; \h'+/-N' local horizontal motion. 2370; ;; N may include width escape \w'...' 2371; ;; Implement arbitrary forward motion and non-overlapping backward 2372; ;; motion. 2373; (goto-char from) 2374; (while (re-search-forward 2375; ;; Delimiter can be a special char escape sequence \(.. or 2376; ;; a single normal char (usually '): 2377; "\\\\h\\(\\\\(..\\|.\\)\\(|\\)?" 2378; nil t) 2379; (let ((from (match-beginning 0)) 2380; (delim (regexp-quote (match-string 1))) 2381; (absolute (match-string 2)) ; absolute position? 2382; (N (woman-parse-numeric-arg)) ; distance 2383; to 2384; msg) ; for warning 2385; (if (not (looking-at delim)) 2386; ;; Warn but leave escape in buffer unprocessed: 2387; (WoMan-warn 2388; "Local horizontal motion (%s) delimiter error!" 2389; (buffer-substring from (1+ (point)))) ; point at end of arg 2390; (setq to (match-end 0) 2391; ;; For possible warning -- save before deleting: 2392; msg (buffer-substring from to)) 2393; (delete-region from to) 2394; (if absolute ; make relative 2395; (setq N (- N (current-column)))) 2396; (if (>= N 0) 2397; ;; Move forward by inserting hard spaces: 2398; (insert-char woman-unpadded-space-char N) 2399; ;; Move backwards by deleting space, 2400; ;; first backwards then forwards: 2401; (while (and 2402; (<= (setq N (1+ N)) 0) 2403; (cond ((memq (preceding-char) '(?\ ?\t)) 2404; (delete-backward-char 1) t) 2405; ((memq (following-char) '(?\ ?\t)) 2406; (delete-char 1) t) 2407; (t nil)))) 2408; (if (<= N 0) 2409; (WoMan-warn 2410; "Negative horizontal motion (%s) would overwrite!" msg)))) 2411; )) 2412 2413 ;; Process formatting macros 2414 (goto-char from) 2415 (woman2-roff-buffer) 2416 2417 ;; Go back and process negative vertical space if necessary: 2418 (if woman-negative-vertical-space 2419 (woman-negative-vertical-space from)) 2420 2421 (if woman-preserve-ascii 2422 ;; Re-instate escaped escapes to just `\' and unpaddable 2423 ;; spaces to just `space', without inheriting any text 2424 ;; properties. This is not necessary, UNLESS the buffer is to 2425 ;; be saved as ASCII. 2426 (progn 2427 (goto-char from) 2428 (while (search-forward woman-escaped-escape-string nil t) 2429 (delete-char -1) (insert ?\\)) 2430 (goto-char from) 2431 (while (search-forward woman-unpadded-space-string nil t) 2432 (delete-char -1) (insert ?\ )) 2433 )) 2434 2435 ;; Must return the new end of file if used in format-alist. 2436 (point-max))) 2437 2438(defun woman-horizontal-escapes (to) 2439 "Process \\h'+/-N' local horizontal motion escapes upto TO. 2440Implements arbitrary forward and non-overlapping backward motion. 2441Preserves location of `point'." 2442 ;; Moved from `woman-decode-region' for version 0.50. 2443 ;; N may include width escape \w'...' (but may already be processed! 2444 (let ((from (point))) 2445 (while (re-search-forward 2446 ;; Delimiter can be a special char escape sequence \(.. or 2447 ;; a single normal char (usually '): 2448 "\\\\h\\(\\\\(..\\|.\\)\\(|\\)?" 2449 to t) 2450 (let ((from (match-beginning 0)) 2451 (delim (regexp-quote (match-string 1))) 2452 (absolute (match-string 2)) ; absolute position? 2453 (N (woman-parse-numeric-arg)) ; distance 2454 to 2455 msg) ; for warning 2456 (if (not (looking-at delim)) 2457 ;; Warn but leave escape in buffer unprocessed: 2458 (WoMan-warn 2459 "Local horizontal motion (%s) delimiter error!" 2460 (buffer-substring from (1+ (point)))) ; point at end of arg 2461 (setq to (match-end 0) 2462 ;; For possible warning -- save before deleting: 2463 msg (buffer-substring from to)) 2464 (delete-region from to) 2465 (if absolute ; make relative 2466 (setq N (- N (current-column)))) 2467 (if (>= N 0) 2468 ;; Move forward by inserting hard spaces: 2469 (insert-char woman-unpadded-space-char N) 2470 ;; Move backwards by deleting space, 2471 ;; first backwards then forwards: 2472 (while (and 2473 (<= (setq N (1+ N)) 0) 2474 (cond ((memq (preceding-char) '(?\ ?\t)) 2475 (delete-backward-char 1) t) 2476 ((memq (following-char) '(?\ ?\t)) 2477 (delete-char 1) t) 2478 (t nil)))) 2479 (if (<= N 0) 2480 (WoMan-warn 2481 "Negative horizontal motion (%s) would overwrite!" msg)))) 2482 )) 2483 (goto-char from))) 2484 2485 2486 2487;; Process ignore requests (.ig), conditionals (.if etc.), 2488;; source-switch (.so), macro definitions (.de etc.) and macro 2489;; expansions. 2490 2491(defvar woman0-if-to) ; marker bound in woman0-roff-buffer 2492(defvar woman0-macro-alist) ; bound in woman0-roff-buffer 2493(defvar woman0-search-regex) ; bound in woman0-roff-buffer 2494(defvar woman0-search-regex-start ; bound in woman0-roff-buffer 2495 "^[.'][ \t]*\\(ig\\|if\\|ie\\|el\\|so\\|rn\\|de\\|am") 2496(defconst woman0-search-regex-end "\\)\\([ \t]+\\|$\\)") 2497;; May need other terminal characters, e.g. \, but NOT \n! 2498;; Alternatively, force maximal match (Posix?) 2499 2500(defvar woman0-rename-alist) ; bound in woman0-roff-buffer 2501 2502(defun woman0-roff-buffer (from) 2503 "Process conditional-type requests and user-defined macros. 2504Start at FROM and re-scan new text as appropriate." 2505 (goto-char from) 2506 (let ((woman0-if-to (make-marker)) 2507 request woman0-macro-alist 2508 (woman0-search-regex-start woman0-search-regex-start) 2509 (woman0-search-regex 2510 (concat woman0-search-regex-start woman0-search-regex-end)) 2511 woman0-rename-alist) 2512 (set-marker-insertion-type woman0-if-to t) 2513 (while (re-search-forward woman0-search-regex nil t) 2514 (setq request (match-string 1)) 2515 (cond ((string= request "ig") (woman0-ig)) 2516 ((string= request "if") (woman0-if "if")) 2517 ((string= request "ie") (woman0-if "ie")) 2518 ((string= request "el") (woman0-el)) 2519 ((string= request "so") (woman0-so)) 2520 ((string= request "rn") (woman0-rn)) 2521 ((string= request "de") (woman0-de)) 2522 ((string= request "am") (woman0-de 'append)) 2523 (t (woman0-macro request)))) 2524 (set-marker woman0-if-to nil) 2525 (woman0-rename) 2526 ;; Should now re-run `woman0-roff-buffer' if any renaming was 2527 ;; done, but let's just hope this is not necessary for now! 2528 )) 2529 2530(defun woman0-ig () 2531 ".ig yy -- Discard input up to `.yy', which defaults to `..')." 2532 ;; The terminal request MUST begin with . (not ')! 2533 (looking-at "\\(\\S +\\)?") 2534 (beginning-of-line) 2535 (let ((yy (or (match-string 1) ".")) 2536 (from (point))) 2537 (if (re-search-forward 2538 (concat "^\\.[ \t]*" (regexp-quote yy) ".*\n") nil t) 2539 (delete-region from (point)) 2540 (WoMan-warn 2541 "ig request ignored -- terminator `.%s' not found!" yy) 2542 (woman-delete-line 1)) 2543 )) 2544 2545(defsubst woman0-process-escapes (from to) 2546 "Process escapes within an if/ie condition between FROM and TO." 2547 (woman-strings to) 2548 (goto-char from) ; necessary! 2549 ;; Strip font-change escapes: 2550 (while (re-search-forward "\\\\f\\(\\[[^]]+\\]\\|(..\\|.\\)" to t) 2551 (woman-delete-match 0)) 2552 (goto-char from) ; necessary! 2553 (woman2-process-escapes to 'numeric)) 2554 2555(defun woman0-if (request) 2556 ".if/ie c anything -- Discard unless c evaluates to true. 2557Remember condition for use by a subsequent `.el'. 2558REQUEST is the invoking directive without the leading dot." 2559 ;; c evaluates to a one-character built-in condition name or 2560 ;; 'string1'string2' or a number > 0, prefix ! negates. 2561 ;; \{ ... \} for multi-line use. 2562 ;; Leaves point at start of new text. 2563 (woman-delete-match 0) 2564 ;; (delete-horizontal-space) 2565 ;; Process escapes in condition: 2566 (let ((from (point)) negated n (c 0)) 2567 (set-marker woman0-if-to 2568 (save-excursion (skip-syntax-forward "^ ") (point))) 2569 ;; Process condition: 2570 (if (setq negated (= (following-char) ?!)) (delete-char 1)) 2571 (cond 2572 ;; ((looking-at "[no]") (setq c t)) ; accept n(roff) and o(dd page) 2573 ;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page) 2574 ((looking-at "[ntoe]") 2575 (setq c (memq (following-char) woman-if-conditions-true))) 2576 ;; Unrecognised letter so reject: 2577 ((looking-at "[A-Za-z]") (setq c nil) 2578 (WoMan-warn "%s %s -- unrecognized condition name rejected!" 2579 request (match-string 0))) 2580 ;; Accept strings if identical: 2581 ((save-restriction 2582 (narrow-to-region from woman0-if-to) 2583 ;; String delimiter can be any non-numeric character, 2584 ;; including a special character escape: 2585 (looking-at "\\(\\\\(..\\|[^0-9]\\)\\(.*\\)\\1\\(.*\\)\\1\\'")) 2586 (let ((end1 (copy-marker (match-end 2) t))) ; End of first string. 2587 ;; Delete 2nd and 3rd delimiters to avoid processing them: 2588 (delete-region (match-end 3) woman0-if-to) 2589 (delete-region (match-end 2) (match-beginning 3)) 2590 (goto-char (match-end 1)) 2591 (woman0-process-escapes (point) woman0-if-to) 2592 (setq c (string= (buffer-substring (point) end1) 2593 (buffer-substring end1 woman0-if-to))) 2594 (set-marker end1 nil) 2595 (goto-char from))) 2596 ;; Accept numeric value if > 0: 2597 ((numberp (setq n (progn 2598 (woman0-process-escapes from woman0-if-to) 2599 (woman-parse-numeric-arg)))) 2600 (setq c (> n 0)) 2601 (goto-char from)) 2602 ) 2603 (if (eq c 0) 2604 (woman-if-ignore woman0-if-to request) ; ERROR! 2605 (woman-if-body request woman0-if-to (eq c negated))) 2606 )) 2607 2608(defun woman-if-body (request to delete) ; should be reversed as `accept'? 2609 "Process if-body, including \\{ ... \\}. 2610REQUEST is the invoking directive without the leading dot. 2611If TO is non-nil then delete the if-body. 2612If DELETE is non-nil then delete from point." 2613 ;; Assume concealed newlines already processed. 2614 (let ((from (point))) 2615 (if to (delete-region (point) to)) 2616 (delete-horizontal-space) 2617 (cond (;;(looking-at "[^{\n]*\\\\{\\s *") ; multi-line 2618 ;; allow escaped newlines: 2619 (looking-at "[^{\n]*\\(\\\\\n\\)*\\\\{\\s *\\(\\\\\n\\)*") ; multi-line 2620 ;; including preceding .if(s) and following newline 2621 (let ((from (point))) 2622 (woman-delete-match 0) 2623 ;; Allow for nested \{ ... \} -- BUT BEWARE that this 2624 ;; algorithm only supports one level of nesting! 2625 (while 2626 (and (re-search-forward 2627 ;; "\\(\\\\{\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*" 2628 ;; Interpret bogus `el \}' as `el \{', 2629 ;; especially for Tcl/Tk man pages: 2630 "\\(\\\\{\\|el[ \t]*\\\\}\\)\\|\\(\n[.']\\)?[ \t]*\\\\}[ \t]*") 2631 (match-string 1)) 2632 (re-search-forward "\\\\}")) 2633 (delete-region (if delete from (match-beginning 0)) (point)) 2634 (if (looking-at "^$") (delete-char 1)) 2635 )) 2636 (delete (woman-delete-line 1)) ; single-line 2637 ) 2638 ;; Process matching .el anything: 2639 (cond ((string= request "ie") 2640 ;; Discard unless previous .ie c `evaluated to false'. 2641 (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t) 2642 (woman-delete-match 0) 2643 (woman-if-body "el" nil (not delete))))) 2644 ;; Got here after processing a single-line `.ie' as a body 2645 ;; clause to be discarded: 2646 ((string= request "el") 2647 (cond ((re-search-forward "^[.'][ \t]*el[ \t]*" nil t) 2648 (woman-delete-match 0) 2649 (woman-if-body "el" nil t)))) 2650 ) 2651 (goto-char from) 2652 )) 2653 2654(defun woman0-el () 2655 "Isolated .el request -- should not happen!" 2656 (WoMan-warn "el request without matching `ie' rejected!") 2657 (cond (woman-ignore 2658 (woman-delete-match 0) 2659 (delete-horizontal-space) 2660 (woman-if-body "el" nil t)) 2661 (t ; Ignore -- leave in buffer 2662 ;; This does not work too well, but it's only for debugging! 2663 (skip-chars-forward "^ \t") 2664 (if (looking-at "[ \t]*\\{") (search-forward "\\}")) 2665 (forward-line 1)))) 2666 2667(defun woman-if-ignore (to request) 2668 "Ignore but warn about an if request ending at TO, named REQUEST." 2669 (WoMan-warn-ignored request "ignored -- condition not handled!") 2670 (if woman-ignore 2671 (woman-if-body request to t) 2672 ;; Ignore -- leave in buffer 2673 ;; This does not work too well, but it's only for debugging! 2674 (skip-chars-forward "^ \t") 2675 (if (looking-at "[ \t]*\\{") (search-forward "\\}")) 2676 (forward-line 1))) 2677 2678(defun woman0-so () 2679 ".so filename -- Switch source file. `.so' requests may be nested." 2680 ;; Leaves point at start of new text. 2681 ;; (skip-chars-forward " \t") 2682 (let* ((beg (point)) 2683 (end (progn (woman-forward-arg 'unquote) (point))) 2684 (name (buffer-substring beg end)) 2685 (filename name)) 2686 ;; If the specified file does not exist in this ... 2687 (or (file-exists-p filename) 2688 ;; or the parent directory ... 2689 (file-exists-p 2690 (setq filename (concat "../" name))) 2691 ;; then use the WoMan search mechanism to find the filename ... 2692 (setq filename 2693 (woman-file-name 2694 (file-name-sans-extension 2695 (file-name-nondirectory name)))) 2696 ;; Cannot find the file, so ... 2697 (kill-buffer (current-buffer)) 2698 (error "File `%s' not found" name)) 2699 (beginning-of-line) 2700 (woman-delete-line 1) 2701 (let* ((from (point)) 2702 (length (woman-insert-file-contents filename 0)) 2703 (to (copy-marker (+ from length) t))) 2704 (woman-pre-process-region from to) 2705 (set-marker to nil) 2706 (goto-char from) 2707 ))) 2708 2709 2710;;; Process macro definitions: 2711 2712(defun woman0-rn () 2713 "Process .rn xx yy -- rename macro xx to yy." 2714 ;; For now, done backwards AFTER all macro expansion. 2715 ;; Should also allow requests and strings to be renamed! 2716 (if (eolp) ; ignore if no argument 2717 () 2718 (let* ((beg (point)) 2719 (end (progn (woman-forward-arg 'unquote 'concat) (point))) 2720 (old (buffer-substring beg end)) 2721 new) 2722 (if (eolp) ; ignore if no argument 2723 () 2724 (setq beg (point) 2725 end (progn (woman-forward-arg 'unquote) (point)) 2726 new (buffer-substring beg end) 2727 woman0-rename-alist (cons (cons new old) woman0-rename-alist))) 2728 )) 2729 (woman-delete-whole-line)) 2730 2731(defun woman0-rename () 2732 "Effect renaming required by .rn requests." 2733 ;; For now, do this backwards AFTER all macro expansion. 2734 (while woman0-rename-alist 2735 (let* ((new (car woman0-rename-alist)) 2736 (old (cdr new)) 2737 (new (car new))) 2738 (setq woman0-rename-alist (cdr woman0-rename-alist)) 2739 (goto-char (point-min)) 2740 (setq new (concat "^[.'][ \t]*" (regexp-quote new))) 2741 (setq old (concat "." old)) 2742 (while (re-search-forward new nil t) 2743 (replace-match old nil t))))) 2744 2745(defconst woman-unescape-regex 2746 (concat woman-escaped-escape-string 2747 "\\(" woman-escaped-escape-string "\\)?")) 2748 2749(defsubst woman-unescape (macro) 2750 "Replace escape sequences in the body of MACRO. 2751Replaces || by |, but | by \, where | denotes the internal escape." 2752 (let (start) 2753 (while (setq start (string-match woman-unescape-regex macro start)) 2754 (setq macro 2755 (if (match-string 1 macro) 2756 (replace-match "" t t macro 1) 2757 (replace-match "\\" t t macro)) 2758 start (1+ start))) 2759 macro)) 2760 2761(defun woman0-de (&optional append) 2762 "Process .de/am xx yy -- (re)define/append macro xx; end at `..'. 2763\(Should be up to call of yy, which defaults to `.') 2764Optional argument APPEND, if non-nil, means append macro." 2765 ;; Modelled on woman-strings. BEWARE: Processing of .am is a hack! 2766 ;; Add support for .rm? 2767 ;; (skip-chars-forward " \t") 2768 (if (eolp) ; ignore if no argument 2769 () 2770 (looking-at "[^ \t\n]+") ; macro name 2771 (let* ((macro (match-string 0)) from 2772 (previous (assoc macro woman0-macro-alist))) 2773 (if (not previous) 2774 (setq woman0-search-regex-start 2775 (concat woman0-search-regex-start "\\|" (regexp-quote macro)) 2776 woman0-search-regex 2777 (concat woman0-search-regex-start woman0-search-regex-end) 2778 )) 2779 ;; Macro body runs from start of next line to line 2780 ;; beginning with `..'." 2781 ;; The terminal request MUST begin with `.' (not ')! 2782 (forward-line) 2783 (setq from (point)) 2784 (re-search-forward "^\\.[ \t]*\\.") 2785 (beginning-of-line) 2786 (let ((body (woman-unescape (buffer-substring from (point))))) 2787 (if (and append previous) 2788 (setq previous (cdr previous) 2789 body (concat body (cdr previous)) 2790 append (car previous) 2791 )) 2792 (setq macro (cons macro (cons append body)))) 2793 ;; This should be an update, but consing a new string 2794 ;; onto the front of the alist has the same effect: 2795 (setq woman0-macro-alist (cons macro woman0-macro-alist)) 2796 (forward-line) 2797 (delete-region from (point)) 2798 (backward-char) ; return to end of .de/am line 2799 )) 2800 (beginning-of-line) ; delete .de/am line 2801 (woman-delete-line 1)) 2802 2803(defun woman0-macro (request) 2804 "Process the macro call named REQUEST." 2805 ;; Leaves point at start of new text. 2806 (let ((macro (assoc request woman0-macro-alist))) 2807 (if macro 2808 (woman-interpolate-macro (cdr macro)) 2809 ;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!! 2810 ;; Output this message once only per call (cf. strings)? 2811 (WoMan-warn "Undefined macro %s not interpolated!" request)))) 2812 2813(defun woman-interpolate-macro (macro) 2814 "Interpolate (.de) or append (.am) expansion of MACRO into the buffer." 2815 ;; Could make this more efficient by checking which arguments are 2816 ;; actually used in the expansion! 2817 (skip-chars-forward " \t") 2818 ;; Process arguments: 2819 (let ((argno 0) (append (car macro)) 2820 argno-string formal-arg from actual-arg start) 2821 (setq macro (cdr macro)) 2822 (while (not (eolp)) 2823 ;; Get next actual arg: 2824 (setq argno (1+ argno)) 2825 (setq argno-string (format "%d" argno)) 2826 (setq formal-arg (concat "\\\\\\$" argno-string)) ; regexp 2827 (setq from (point)) 2828 (woman-forward-arg 'unquote 'noskip) 2829 (setq actual-arg (buffer-substring from (point))) 2830 (skip-chars-forward " \t") ; now skip following whitespace! 2831 ;; Replace formal arg with actual arg: 2832 (setq start nil) 2833 (while (setq start (string-match formal-arg macro start)) 2834 (setq macro (replace-match actual-arg t t macro))) 2835 ) 2836 ;; Delete any remaining formal arguments: 2837 (setq start nil) 2838 (while 2839 (setq start (string-match "\\\\\\$." macro start)) 2840 (setq macro (replace-match "" t t macro))) 2841 ;; Replace .$ number register with actual arg: 2842 ;; (Do this properly via register mechanism later!) 2843 (setq start nil) 2844 (while 2845 (setq start (string-match "\\\\n(\\.\\$" macro start)) ; regexp 2846 (setq macro (replace-match argno-string t t macro))) 2847 (if append 2848 (forward-char) 2849 (beginning-of-line) 2850 (woman-delete-line 1)) 2851 (save-excursion ; leave point at start of new text 2852 (insert macro)))) 2853 2854 2855;;; Process strings: 2856 2857(defun woman-match-name () 2858 "Match and move over name of form: x, (xx or [xxx...]. 2859Applies to number registers, fonts, strings/macros/diversions, and 2860special characters." 2861 (cond ((= (following-char) ?\[ ) 2862 (forward-char) 2863 (re-search-forward "[^]]+") 2864 (forward-char)) ; skip closing ] 2865 ((= (following-char) ?\( ) 2866 (forward-char) 2867 (re-search-forward "..")) 2868 (t (re-search-forward ".")))) 2869 2870(defun woman-strings (&optional to) 2871 "Process ?roff string requests and escape sequences up to buffer position TO. 2872Strings are defined/updated by `.ds xx string' requests and 2873interpolated by `\*x' and `\*(xx' escapes." 2874 ;; Add support for .as and .rm? 2875 (while 2876 ;; Find .ds requests and \* escapes: 2877 (re-search-forward "\\(^[.'][ \t]*ds\\)\\|\\\\\\*" to t) 2878 (cond ((match-string 1) ; .ds 2879 (skip-chars-forward " \t") 2880 (if (eolp) ; ignore if no argument 2881 () 2882 (re-search-forward "[^ \t\n]+") 2883 (let ((string (match-string 0))) 2884 (skip-chars-forward " \t") 2885; (setq string 2886; (cons string 2887; ;; hack (?) for CGI.man! 2888; (cond ((looking-at "\"\"") "\"") 2889; ((looking-at ".*") (match-string 0))) 2890; )) 2891 ;; Above hack causes trouble in arguments! 2892 (looking-at ".*") 2893 (setq string (cons string (match-string 0))) 2894 ;; This should be an update, but consing a new string 2895 ;; onto the front of the alist has the same effect: 2896 (setq woman-string-alist (cons string woman-string-alist)) 2897 )) 2898 (beginning-of-line) 2899 (woman-delete-line 1)) 2900 (t ; \* 2901 (let ((beg (match-beginning 0))) 2902 (woman-match-name) 2903 (let* ((stringname (match-string 0)) 2904 (string (assoc stringname woman-string-alist))) 2905 (cond (string 2906 (delete-region beg (point)) 2907 ;; Temporary hack in case string starts with a 2908 ;; control character: 2909 (if (bolp) (insert-before-markers "\\&")) 2910 (insert-before-markers (cdr string))) 2911 (t 2912 (WoMan-warn "Undefined string %s not interpolated!" 2913 stringname) 2914 (cond (woman-ignore 2915 ;; Output above message once only per call 2916 (delete-region beg (point)) 2917 (setq woman-string-alist 2918 (cons (cons stringname "") 2919 woman-string-alist)))) 2920 )) 2921 )) 2922 )) 2923 )) 2924 2925 2926;;; Process special character escapes \(xx: 2927 2928(defconst woman-special-characters 2929 ;; To be built heuristically as required! 2930 ;; MUST insert all characters as strings for correct conversion to 2931 ;; multibyte representation! 2932 '(("em" "--" "\276" . t) ; 3/4 Em dash 2933 ("bu" "*" "\267" . t) ; bullet 2934 ("fm" "'") ; foot mark 2935 ("co" "(C)" "\251") ; copyright 2936 2937 ("pl" "+" "+" . t) ; math plus 2938 ("mi" "-" "-" . t) ; math minus 2939 ("**" "*" "*" . t) ; math star 2940 ("aa" "'" "\242" . t) ; acute accent 2941 ("ul" "_") ; underrule 2942 2943 ("*S" "Sigma" "S" . t) ; Sigma 2944 2945 (">=" ">=" "\263" . t) ; >= 2946 ("<=" "<=" "\243" . t) ; <= 2947 ("->" "->" "\256" . t) ; right arrow 2948 ("<-" "<-" "\254" . t) ; left arrow 2949 ("mu" " x " "\264" . t) ; multiply 2950 ("+-" "+/-" "\261" . t) ; plus-minus 2951 ("bv" "|") ; bold vertical 2952 2953 ;; groff etc. extensions: 2954 ("lq" "\"") 2955 ("rq" "\"") 2956 ("aq" "'") 2957 ("ha" "^") 2958 ("ti" "~") 2959 ) 2960 "Alist of special character codes with ASCII and extended-font equivalents. 2961Each alist elements has the form 2962 (input-string ascii-string extended-font-string . use-symbol-font) 2963where 2964 * `\\(input-string' is the ?roff encoding, 2965 * `ascii-string' is the (multi-character) ASCII simulation, 2966 * `extended-font-string' is the single-character string representing 2967 the character position in the extended 256-character font, and 2968 * `use-symbol-font' is t to indicate use of the symbol font or nil, 2969 i.e. omitted, to indicate use of the default font. 2970Any element may be nil. Avoid control character codes (0 to \\37, \\180 2971to \\237) in `extended-font-string' for now, since they can be 2972displayed only with a modified display table. 2973 2974Use the WoMan command `woman-display-extended-fonts' or a character 2975map accessory to help construct this alist.") 2976 2977(defsubst woman-replace-match (newtext &optional face) 2978 "Replace text matched by last search with NEWTEXT and return t. 2979Set NEWTEXT in face FACE if specified." 2980 (woman-delete-match 0) 2981 (insert-before-markers newtext) 2982 (if face (put-text-property (1- (point)) (point) 'face 'woman-symbol)) 2983 t) 2984 2985(defun woman-special-characters (to) 2986 "Process special character escapes \\(xx, \\[xxx] up to buffer position TO. 2987\(This must be done AFTER translation, which may use special characters.)" 2988 (while (re-search-forward "\\\\\\(?:(\\(..\\)\\|\\[\\([[^]]+\\)\\]\\)" to t) 2989 (let* ((name (or (match-string-no-properties 1) 2990 (match-string-no-properties 2))) 2991 (replacement (assoc name woman-special-characters))) 2992 (unless 2993 (and 2994 replacement 2995 (cond ((and (cddr replacement) 2996 (if (nthcdr 3 replacement) 2997 ;; Need symbol font: 2998 (if woman-use-symbol-font 2999 (woman-replace-match (nth 2 replacement) 3000 'woman-symbol)) 3001 ;; Need extended font: 3002 (if woman-use-extended-font 3003 (woman-replace-match (nth 2 replacement)))))) 3004 ((cadr replacement) ; Use ASCII simulation 3005 (woman-replace-match (cadr replacement))))) 3006 (WoMan-warn (concat "Special character " 3007 (if (match-string 1) "\\(%s" "\\[%s]") 3008 " not interpolated!") name) 3009 (if woman-ignore (woman-delete-match 0)))) 3010 )) 3011 3012(defun woman-display-extended-fonts () 3013 "Display table of glyphs of graphic characters and their octal codes. 3014All the octal codes in the ranges [32..127] and [160..255] are displayed 3015together with the corresponding glyphs from the default and symbol fonts. 3016Useful for constructing the alist variable `woman-special-characters'." 3017 (interactive) 3018 (with-output-to-temp-buffer "*WoMan Extended Font Map*" 3019 (save-excursion 3020 (set-buffer standard-output) 3021 (let ((i 32)) 3022 (while (< i 256) 3023 (insert (format "\\%03o " i) (string i) " " (string i)) 3024 (put-text-property (1- (point)) (point) 3025 'face 'woman-symbol) 3026 (insert " ") 3027 (setq i (1+ i)) 3028 (when (= i 128) (setq i 160) (insert "\n")) 3029 (if (zerop (% i 8)) (insert "\n"))) 3030 )) 3031 (print-help-return-message))) 3032 3033 3034;;; Formatting macros that do not cause a break: 3035 3036(defvar request) ; Bound locally by woman1-roff-buffer 3037(defvar unquote) ; Bound locally by woman1-roff-buffer 3038 3039(defun woman-unquote (to) 3040 "Delete any double-quote characters between point and TO. 3041Leave point at TO (which should be a marker)." 3042 (let (in-quote) 3043 (while (search-forward "\"" to 1) 3044 (if (and in-quote (looking-at "\"")) 3045 ;; Repeated double-quote represents single double-quote 3046 (delete-char 1) 3047 (if (or in-quote (looking-at ".*\"")) ; paired 3048 (delete-char -1)) 3049 (setq in-quote (not in-quote)) 3050 )) 3051 (if in-quote 3052 (WoMan-warn "Unpaired \" in .%s arguments." request)) 3053 )) 3054 3055(defsubst woman-unquote-args () 3056 "Delete any double-quote characters up to the end of the line." 3057 (woman-unquote (save-excursion (end-of-line) (point-marker)))) 3058 3059(defun woman1-roff-buffer () 3060 "Process non-breaking requests." 3061 (let ((case-fold-search t) 3062 request fn unquote) 3063 (while 3064 ;; Find next control line: 3065 (re-search-forward woman-request-regexp nil t) 3066 (cond 3067 ;; Construct woman function to call: 3068 ((setq fn (intern-soft 3069 (concat "woman1-" 3070 (setq request (match-string 1))))) 3071 (if (get fn 'notfont) ; not a font-change request 3072 (funcall fn) 3073 ;; Delete request or macro name: 3074 (woman-delete-match 0) 3075 ;; If no args then apply to next line else unquote args 3076 ;; (unquote is used by called function): 3077 (setq unquote (not (eolp))) 3078 (if (eolp) (delete-char 1)) 3079; ;; Hide leading control character in unquoted argument: 3080; (cond ((memq (following-char) '(?. ?')) 3081; (insert "\\&") 3082; (beginning-of-line))) 3083 ;; Call the appropriate function: 3084 (funcall fn) 3085 ;; Hide leading control character in quoted argument (only): 3086 (if (and unquote (memq (following-char) '(?. ?'))) 3087 (insert "\\&")) 3088 ) 3089 ))))) 3090 3091;;; Font-changing macros: 3092 3093(defun woman1-B () 3094 ".B -- Set words of current line in bold font." 3095 (woman1-B-or-I ".ft B\n")) 3096 3097(defun woman1-I () 3098 ".I -- Set words of current line in italic font." 3099 (woman1-B-or-I ".ft I\n")) 3100 3101(defun woman1-B-or-I (B-or-I) 3102 ".B/I -- Set words of current line in bold/italic font. 3103B-OR-I is the appropriate complete control line." 3104 ;; Should NOT concatenate the arguments! 3105 (insert B-or-I) ; because it might be a control line 3106 ;; Return to bol to process .SM/.B, .B/.if etc. 3107 ;; or start of first arg to hide leading control char. 3108 (save-excursion 3109 (if unquote 3110 (woman-unquote-args) 3111 (while (looking-at "^[.']") (forward-line)) 3112 (end-of-line) 3113 (delete-horizontal-space)) 3114 (insert "\\fR"))) 3115 3116(defun woman1-SM () 3117 ".SM -- Set the current line in small font, i.e. IGNORE!" 3118 nil) 3119 3120(defalias 'woman1-SB 'woman1-B) 3121;; .SB -- Set the current line in small bold font, i.e. just embolden! 3122;; (This is what /usr/local/share/groff/tmac/tmac.an does. The 3123;; Linux man.7 is wrong about this!) 3124 3125(defun woman1-BI () 3126 ".BI -- Join words of current line alternating bold and italic fonts." 3127 (woman1-alt-fonts (list "\\fB" "\\fI"))) 3128 3129(defun woman1-BR () 3130 ".BR -- Join words of current line alternating bold and Roman fonts." 3131 (woman1-alt-fonts (list "\\fB" "\\fR"))) 3132 3133(defun woman1-IB () 3134 ".IB -- Join words of current line alternating italic and bold fonts." 3135 (woman1-alt-fonts (list "\\fI" "\\fB"))) 3136 3137(defun woman1-IR () 3138 ".IR -- Join words of current line alternating italic and Roman fonts." 3139 (woman1-alt-fonts (list "\\fI" "\\fR"))) 3140 3141(defun woman1-RB () 3142 ".RB -- Join words of current line alternating Roman and bold fonts." 3143 (woman1-alt-fonts (list "\\fR" "\\fB"))) 3144 3145(defun woman1-RI () 3146 ".RI -- Join words of current line alternating Roman and italic fonts." 3147 (woman1-alt-fonts (list "\\fR" "\\fI"))) 3148 3149(defun woman1-alt-fonts (fonts) 3150 "Join words using alternating fonts in FONTS, which MUST be a dynamic list." 3151 (nconc fonts fonts) ; circular list! 3152 (insert (car fonts)) 3153 ;; Return to start of first arg to hide leading control char: 3154 (save-excursion 3155 (setq fonts (cdr fonts)) 3156 (woman-forward-arg unquote 'concat) ; unquote is bound above 3157 (while (not (eolp)) 3158 (insert (car fonts)) 3159 (setq fonts (cdr fonts)) 3160 (woman-forward-arg unquote 'concat)) ; unquote is bound above 3161 (insert "\\fR") 3162 )) 3163 3164(defun woman-forward-arg (&optional unquote concat) 3165 "Move forward over one ?roff argument, optionally unquoting and/or joining. 3166If optional arg UNQUOTE is non-nil then delete any argument quotes. 3167If optional arg CONCAT is non-nil then join arguments." 3168 (if (eq (following-char) ?\") 3169 (progn 3170 (if unquote (delete-char 1) (forward-char)) 3171 (re-search-forward "\"\\|$") 3172 ;; Repeated double-quote represents single double-quote 3173 (while (eq (following-char) ?\") ; paired 3174 (if unquote (delete-char 1) (forward-char)) 3175 (re-search-forward "\"\\|$")) 3176 (if (eq (preceding-char) ?\") 3177 (if unquote (delete-backward-char 1)) 3178 (WoMan-warn "Unpaired \" in .%s arguments." request) 3179 )) 3180 ;; (re-search-forward "[^\\\n] \\|$") ; inconsistent 3181 (skip-syntax-forward "^ ")) 3182 (cond ((null concat) (skip-chars-forward " \t")) ; don't skip eol! 3183 ((eq concat 'noskip)) ; do not skip following whitespace 3184 (t (woman-delete-following-space))) 3185 ) 3186 3187 3188;; The following requests are not explicit font-change requests and 3189;; so are flagged `notfont' to turn off automatic request deletion 3190;; and further processing. 3191 3192(put 'woman1-TP 'notfont t) 3193(defun woman1-TP () 3194 ".TP -- After tag line, reset font to Roman for paragraph body." 3195 ;; Same for .IP, but forward only 1 line? 3196 (save-excursion 3197 ;; May be an `irrelevant' control line in the way, so ... 3198 (forward-line) 3199 (forward-line (if (looking-at "\\.\\S-+[ \t]*$") 2 1)) 3200 ;; May be looking at control line, so ... 3201 (insert ".ft R\n"))) 3202 3203(put 'woman1-ul 'notfont t) 3204(defun woman1-ul () 3205 ".ul N -- Underline (italicize) the next N input lines, default N = 1." 3206 (let ((N (if (eolp) 1 (woman-parse-numeric-arg)))) ; woman-get-numeric-arg ? 3207 (woman-delete-whole-line) 3208 (insert ".ft I\n") 3209 (forward-line N) 3210 (insert ".ft R\n") 3211 )) 3212 3213;;; Other non-breaking requests: 3214 3215;; Hyphenation 3216;; Warnings commented out. 3217 3218(put 'woman1-nh 'notfont t) 3219(defun woman1-nh () 3220 ".nh -- No hyphenation, i.e. IGNORE!" 3221 ;; Must be handled here to avoid breaking! 3222 ;; (WoMan-log-1 ".nh request ignored -- hyphenation not supported!") 3223 (woman-delete-whole-line)) 3224 3225(put 'woman1-hy 'notfont t) 3226(defun woman1-hy () 3227 ".hy N -- Set hyphenation mode to N, i.e. IGNORE!" 3228 ;; (WoMan-log-1 ".hy request ignored -- hyphenation not supported!") 3229 (woman-delete-whole-line)) 3230 3231(put 'woman1-hc 'notfont t) 3232(defun woman1-hc () 3233 ".hc c -- Set hyphenation character to c, i.e. delete it!" 3234 (let ((c (char-to-string (following-char)))) 3235 ;; (WoMan-log 3236 ;; "Hyphenation character %s deleted -- hyphenation not supported!" c) 3237 (woman-delete-whole-line) 3238 (setq c (concat "\\(" c "\\)\\|^[.'][ \t]*hc")) 3239 (save-excursion 3240 (while (and (re-search-forward c nil t) 3241 (match-string 1)) 3242 (delete-char -1))) 3243 )) 3244 3245(put 'woman1-hw 'notfont t) 3246(defun woman1-hw () 3247 ".hw words -- Set hyphenation exception words, i.e. IGNORE!" 3248 ;; (WoMan-log-1 ".hw request ignored -- hyphenation not supported!") 3249 (woman-delete-whole-line)) 3250 3251;;; Other non-breaking requests correctly ignored by nroff: 3252 3253(put 'woman1-ps 'notfont t) 3254(defalias 'woman1-ps 'woman-delete-whole-line) 3255 ;; .ps -- Point size -- IGNORE! 3256 3257(put 'woman1-ss 'notfont t) 3258(defalias 'woman1-ss 'woman-delete-whole-line) 3259 ;; .ss -- Space-character size -- IGNORE! 3260 3261(put 'woman1-cs 'notfont t) 3262(defalias 'woman1-cs 'woman-delete-whole-line) 3263 ;; .cs -- Constant character space (width) mode -- IGNORE! 3264 3265(put 'woman1-ne 'notfont t) 3266(defalias 'woman1-ne 'woman-delete-whole-line) 3267 ;; .ne -- Need vertical space -- IGNORE! 3268 3269(put 'woman1-vs 'notfont t) 3270(defalias 'woman1-vs 'woman-delete-whole-line) 3271 ;; .vs -- Vertical base line spacing -- IGNORE! 3272 3273(put 'woman1-bd 'notfont t) 3274(defalias 'woman1-bd 'woman-delete-whole-line) 3275 ;; .bd -- Embolden font -- IGNORE! 3276 3277;;; Non-breaking SunOS-specific macros: 3278 3279(defun woman1-TX () 3280 ".TX t p -- Resolve SunOS abbrev t and join to p (usually punctuation)." 3281 (insert "SunOS ") 3282 (woman-forward-arg 'unquote 'concat)) 3283 3284(put 'woman1-IX 'notfont t) 3285(defalias 'woman1-IX 'woman-delete-whole-line) 3286 ;; .IX -- Index macro, for Sun internal use -- IGNORE! 3287 3288 3289;;; Direct font selection: 3290 3291(defconst woman-font-alist 3292 '(("R" . default) 3293 ("I" . woman-italic) 3294 ("B" . woman-bold) 3295 ("P" . previous) 3296 ("1" . default) 3297 ("2" . woman-italic) 3298 ("3" . woman-bold) ; used in bash.1 3299 ) 3300 "Alist of ?roff font indicators and woman font variables and names.") 3301 3302(defun woman-change-fonts () 3303 "Process font changes." 3304 ;; ***** NEEDS REVISING IF IT WORKS OK ***** 3305 ;; Paragraph .LP/PP/HP/IP/TP and font .B/.BI etc. macros reset font. 3306 ;; Should .SH/.SS reset font? 3307 ;; Font size setting macros (?) should reset font. 3308 (let ((font-alist woman-font-alist) ; for local updating 3309 (previous-pos (point)) 3310 (previous-font 'default) 3311 (current-font 'default)) 3312 (while 3313 ;; Find font requests, paragraph macros and font escapes: 3314 (re-search-forward 3315 "^[.'][ \t]*\\(\\(\\ft\\)\\|\\(.P\\)\\)\\|\\(\\\\f\\)" nil 1) 3316 (let (font beg notfont fescape) 3317 ;; Match font indicator and leave point at end of sequence: 3318 (cond ((match-string 2) 3319 ;; .ft request found 3320 (setq beg (match-beginning 0)) 3321 (skip-chars-forward " \t") 3322 (if (eolp) ; default is previous font 3323 (setq font previous-font) 3324 (looking-at "[^ \t\n]+")) 3325 (forward-line)) ; end of control line and \n 3326 ((match-string 3) 3327 ;; Macro that resets font found 3328 (setq font 'default)) 3329 ((match-string 4) 3330 ;; \f escape found 3331 (setq beg (match-beginning 0) 3332 fescape t) 3333 (woman-match-name)) 3334 (t (setq notfont t))) 3335 (if notfont 3336 () 3337 ;; Get font name: 3338 (or font 3339 (let ((fontstring (match-string 0))) 3340 (setq font (assoc fontstring font-alist) 3341 ;; NB: font-alist contains VARIABLE NAMES. 3342 font (if font 3343 (cdr font) 3344 (WoMan-warn "Unknown font %s." fontstring) 3345 ;; Output this message once only per call ... 3346 (setq font-alist 3347 (cons (cons fontstring 'woman-unknown) 3348 font-alist)) 3349 'woman-unknown) 3350 ))) 3351 ;; Delete font control line or escape sequence: 3352 (cond (beg (delete-region beg (point)) 3353 (if (eq font 'previous) (setq font previous-font)))) 3354 ;; Deal with things like \fB.cvsrc\fR at the start of a line. 3355 ;; After removing the font control codes, this would 3356 ;; otherwise match woman-request-regexp. The "\\&" which is 3357 ;; inserted to prevent this is removed by woman2-process-escapes. 3358 (and fescape 3359 (looking-at woman-request-regexp) 3360 (insert "\\&")) 3361 (woman-set-face previous-pos (point) current-font) 3362 (if beg 3363 ;; Explicit font control 3364 (setq previous-pos (point) 3365 previous-font current-font) 3366 ;; Macro that resets font 3367 ;; (forward-line) ; DOES NOT WORK! but unnecessary? 3368 ;; Must process font changes in any paragraph tag! 3369 (setq previous-pos (point) 3370 previous-font 'default)) 3371 (setq current-font font) 3372 ))) 3373 ;; Set font after last request up to eob: 3374 (woman-set-face previous-pos (point) current-font) 3375 )) 3376 3377(defun woman-set-face (from to face) 3378 "Set the face of the text from FROM to TO to face FACE. 3379Ignore the default face and underline only word characters." 3380 (or (eq face 'default) ; ignore 3381 (not woman-fontify) 3382 (if (face-underline-p face) 3383 (save-excursion 3384 (let ((face-no-ul (intern (concat (symbol-name face) "-no-ul")))) 3385 (goto-char from) 3386 (while (< (point) to) 3387 (skip-syntax-forward "w" to) 3388 (put-text-property from (point) 'face face) 3389 (setq from (point)) 3390 (skip-syntax-forward "^w" to) 3391 (put-text-property from (point) 'face face-no-ul) 3392 (setq from (point)) 3393 ))) 3394 (put-text-property from to 'face face)) 3395 )) 3396 3397 3398;;; Output translation: 3399 3400(defvar translations nil) ; Also bound locally by woman2-roff-buffer 3401;; A list of the form (\"[ace]\" (a . b) (c . d) (e . ?\ )) or nil. 3402 3403(defun woman-get-next-char () 3404 "Return and delete next char in buffer, including special chars." 3405 (if ;;(looking-at "\\\\(\\(..\\)") 3406 ;; Match special \(xx and strings \*[xxx], \*(xx, \*x: 3407 (looking-at "\\\\\\((..\\|\\*\\(\\[[^]]+\\]\\|(..\\|.\\)\\)") 3408 (prog1 (match-string 0) 3409 (woman-delete-match 0)) 3410 (prog1 (char-to-string (following-char)) 3411 (delete-char 1)))) 3412 3413(defun woman2-tr (to) 3414 ".tr abcde -- Translate a -> b, c -> d, ..., e -> space. 3415Format paragraphs upto TO. Supports special chars. 3416\(Breaks, but should not.)" 3417 ;; This should be an update, but consing onto the front of the alist 3418 ;; has the same effect and match duplicates should not matter. 3419 ;; Initialize translation data structures: 3420 (let ((matches (car translations)) 3421 (alist (cdr translations)) 3422 a b) 3423 ;; `matches' must be a string: 3424 (setq matches 3425 (concat (if matches (substring matches 1 -1)) "]")) 3426 ;; Process .tr arguments: 3427 (while (not (eolp)) ; (looking-at "[ \t]*$") ??? 3428 (setq a (woman-get-next-char)) 3429 (if (eolp) 3430 (setq b " ") 3431 (setq b (woman-get-next-char))) 3432 (setq matches 3433 (if (= (length a) 1) 3434 (concat a matches) 3435 (concat matches "\\|\\" a)) 3436 alist (cons (cons a b) alist))) 3437 (delete-char 1) ; no blank line 3438 ;; Rebuild translations list: 3439 (setq matches 3440 (if (= (string-to-char matches) ?\]) 3441 (substring matches 3) 3442 (concat "[" matches)) 3443 translations (cons matches alist)) 3444 ;; Format any following text: 3445 (woman2-format-paragraphs to) 3446 )) 3447 3448(defsubst woman-translate (to) 3449 "Translate up to marker TO. Do this last of all transformations." 3450 (if translations 3451 (let ((matches (car translations)) 3452 (alist (cdr translations))) 3453 (while (re-search-forward matches to t) 3454 ;; Done like this to retain text properties and 3455 ;; support translation of special characters: 3456 (insert-before-markers-and-inherit 3457 (cdr (assoc 3458 (buffer-substring-no-properties 3459 (match-beginning 0) (match-end 0)) 3460 alist))) 3461 (woman-delete-match 0)) 3462 ))) 3463 3464 3465;;; Registers: 3466 3467(defvar woman-registers ; these are all read-only 3468 '((".H" 24) (".V" 48) ; resolution in basic units 3469 (".g" 0) ; not groff 3470 ;; (Iff emulating groff need to implement groff italic correction 3471 ;; \/, e.g. for pic.1) 3472 (".i" left-margin) ; current indent 3473 (".j" woman-adjust) ; current adjustment 3474 (".l" fill-column) ; current line length 3475 (".s" 12) ; current point size 3476 (".u" (if woman-nofill 0 1)) ; 1/0 in fill/nofill mode 3477 (".v" 48) ; current vertical line spacing 3478 ) 3479 "Register alist: the key is the register name as a string. 3480Each element has the form (KEY VALUE . INC) -- inc may be nil. 3481Also bound locally in `woman2-roff-buffer'.") 3482 3483(defun woman-mark-horizonal-position () 3484 "\\kx -- Store current horizontal position in INPUT LINE in register x." 3485 (while (re-search-forward "\\\\k\\(.\\)" nil t) 3486 (goto-char (match-beginning 0)) 3487 (setq woman-registers 3488 (cons (list (match-string 1) (current-column)) 3489 woman-registers)) 3490 (woman-delete-match 0))) 3491 3492(defsubst woman2-process-escapes-to-eol (&optional numeric) 3493 "Process remaining escape sequences up to eol. 3494Handle numeric arguments specially if optional argument NUMERIC is non-nil." 3495 (woman2-process-escapes (copy-marker (line-end-position) t) numeric)) 3496 3497(defun woman2-nr (to) 3498 ".nr R +/-N M -- Assign +/-N (wrt to previous value, if any) to register R. 3499The increment for auto-incrementing is set to M. 3500Format paragraphs upto TO. (Breaks, but should not!)" 3501 (let* ((name (buffer-substring 3502 (point) 3503 (progn (skip-syntax-forward "^ ") (point)))) 3504 (pm (progn ; increment 3505 (skip-chars-forward " \t") 3506 (when (memq (char-after) '(?+ ?-)) 3507 (forward-char) (char-before)))) 3508 (value (if (eolp) ; no value 3509 nil ; to be interpreted as zero 3510 (woman2-process-escapes-to-eol 'numeric) 3511 (woman-parse-numeric-arg))) 3512 (inc (progn ; auto-increment 3513 (skip-chars-forward " \t") 3514 (if (eolp) ; no value 3515 nil ; to be interpreted as zero ??? 3516 (woman-parse-numeric-arg)))) 3517 (oldvalue (assoc name woman-registers))) 3518 (when oldvalue 3519 (setq oldvalue (cdr oldvalue)) ; (value . inc) 3520 (unless inc (setq inc (cdr oldvalue)))) 3521 (cond ((null value) 3522 (setq value 0) ; correct? 3523 (WoMan-warn "nr %s -- null value assigned as zero!" name)) 3524 ((symbolp value) 3525 (setq value (list 'quote value)))) 3526 (if pm ; increment old value 3527 (setq oldvalue (if oldvalue (car oldvalue) 0) 3528 value (if (eq pm ?+) 3529 (+ oldvalue value) 3530 (- oldvalue value)))) 3531 (setq woman-registers 3532 (cons (cons name (cons value inc)) woman-registers)) 3533 (woman-delete-whole-line) 3534 (woman2-format-paragraphs to))) 3535 3536 3537;;; Numeric (and "non-text") request arguments: 3538 3539(defsubst woman-get-numeric-arg () 3540 "Get the value of a numeric argument at or after point. 3541The argument can include the width function and scale indicators. 3542Assumes 10 characters per inch. Does not move point." 3543 (woman2-process-escapes-to-eol 'numeric) 3544 (save-excursion (woman-parse-numeric-arg))) 3545 3546(defun woman-parse-numeric-arg () 3547 "Get the value of a numeric expression at or after point. 3548Unlike `woman-get-numeric-arg', leaves point after the argument. 3549The expression may be an argument in quotes." 3550 (if (= (following-char) ?\") (forward-char)) 3551 ;; Allow leading +/-: 3552 (let ((value (if (looking-at "[+-]") 0 (woman-parse-numeric-value))) 3553 op) 3554 (while (cond 3555 ((looking-at "[+-/*%]") ; arithmetic operators 3556 (forward-char) 3557 (setq op (intern-soft (match-string 0))) 3558 (setq value (funcall op value (woman-parse-numeric-value)))) 3559 ((looking-at "[<=>]=?") ; relational operators 3560 (goto-char (match-end 0)) 3561 (setq op (or (intern-soft (match-string 0)) 3562 (intern-soft "="))) 3563 (setq value (if (funcall op value (woman-parse-numeric-value)) 3564 1 0))) 3565 ((memq (setq op (following-char)) '(?& ?:)) ; Boolean and / or 3566 (forward-char) 3567 (setq value 3568 ;; and / or are special forms, not functions, in ELisp 3569 (if (eq op ?&) 3570 ;; and 3571 (if (> value 0) 3572 (if (> (woman-parse-numeric-value) 0) 1 0) 3573 ;; skip second operand 3574 (prog1 0 (woman-parse-numeric-value))) 3575 ;; or 3576 (if (> value 0) 3577 ;; skip second operand 3578 (prog1 1 (woman-parse-numeric-value)) 3579 (if (> (woman-parse-numeric-value) 0) 1 0)) 3580 ))) 3581 )) 3582; (if (looking-at "[ \t\nRC\)\"]") ; R, C are tab types 3583; () 3584; (WoMan-warn "Unimplemented numerical operator `%c' in %s" 3585; (following-char) 3586; (buffer-substring 3587; (save-excursion (beginning-of-line) (point)) 3588; (save-excursion (end-of-line) (point)))) 3589; (skip-syntax-forward "^ ")) 3590 value 3591 )) 3592 3593(defun woman-parse-numeric-value () 3594 "Get a single numeric value at or after point. 3595The value can be a number register or width function (which assumes 10 3596characters per inch) and can include scale indicators. It may be an 3597expression in parentheses. Leaves point after the value." 3598 ;; Must replace every \' by some different single character first 3599 ;; before calling this function by calling 3600 ;; (woman2-process-escapes-to-eol 'numeric) 3601 (if (eq (following-char) ?\() 3602 ;; Treat parenthesized expression as a single value. 3603 (let (n) 3604 (forward-char) 3605 (setq n (woman-parse-numeric-arg)) 3606 (skip-syntax-forward " ") 3607 (if (eq (following-char) ?\)) 3608 (forward-char) 3609 (WoMan-warn "Parenthesis confusion in numeric expression!")) 3610 n) 3611 (let ((n (cond ((looking-at "[-+]?[.0-9]+") ; single number 3612 ;; currently needed to set match-end, even though 3613 ;; string-to-number returns 0 if number not parsed. 3614 (string-to-number (match-string 0))) 3615 ((looking-at "\\\\n\\([-+]\\)?\\(?:\ 3616\\[\\([^]]+\\)\\]\\|\(\\(..\\)\\|\\(.\\)\\)") 3617 ;; interpolate number register, maybe auto-incremented 3618 (let* ((pm (match-string-no-properties 1)) 3619 (name (or (match-string-no-properties 2) 3620 (match-string-no-properties 3) 3621 (match-string-no-properties 4))) 3622 (value (assoc name woman-registers))) 3623 (if value 3624 (let (inc) 3625 (setq value (cdr value) ; (value . inc) 3626 inc (cdr value) 3627 ;; eval internal (.X) registers 3628 ;; stored as lisp variable names: 3629 value (eval (car value))) 3630 (if (and pm inc) ; auto-increment 3631 (setq value 3632 (funcall (intern-soft pm) value inc) 3633 woman-registers 3634 (cons (cons name (cons value inc)) 3635 woman-registers))) 3636 value) 3637 (WoMan-warn "Undefined register %s defaulted to 0." 3638 name) 3639 0) ; default to zero 3640 )) 3641 ((re-search-forward 3642 ;; Delimiter can be special char escape \[xxx], 3643 ;; \(xx or single normal char (usually '): 3644 "\\=\\\\w\\(\\\\\\[[^]]+\\]\\|\\\\(..\\|.\\)" nil t) 3645 (let ((from (match-end 0)) 3646 (delim (regexp-quote (match-string 1)))) 3647 (if (re-search-forward delim nil t) 3648 ;; Return width of string: 3649 (- (match-beginning 0) from) 3650 (WoMan-warn "Width escape delimiter error!")))) 3651 ))) 3652 (if (null n) 3653 ;; ERROR -- should handle this better! 3654 (progn 3655 (WoMan-warn "Numeric/register argument error: %s" 3656 (buffer-substring 3657 (point) 3658 (save-excursion (end-of-line) (point)))) 3659 (skip-syntax-forward "^ ") 3660 0) 3661 (goto-char (match-end 0)) 3662 ;; Check for scale factor: 3663 (if 3664 (cond 3665 ((looking-at "\\s ") nil) ; stay put! 3666 ((looking-at "[mnuv]")) ; ignore for now 3667 ((looking-at "i") (setq n (* n 10))) ; inch 3668 ((looking-at "c") (setq n (* n 3.9))) ; cm 3669 ((looking-at "P") (setq n (* n 1.7))) ; Pica 3670 ((looking-at "p") (setq n (* n 0.14))) ; point 3671 ;; NB: May be immediately followed by + or -, etc., 3672 ;; in which case do nothing and return nil. 3673 ) 3674 (goto-char (match-end 0))) 3675 (if (numberp n) (round n) n)) 3676 ))) 3677 3678 3679;;; VERTICAL FORMATTING -- Formatting macros that cause a break: 3680 3681;; Vertical spacing philosophy: 3682;; Delete all vertical space as it is encountered. Then insert 3683;; vertical space only before text, as required. 3684 3685(defun woman2-roff-buffer () 3686 "Process breaks. Format paragraphs and headings." 3687 (let ((case-fold-search t) 3688 (to (make-marker)) 3689 (canonically-space-region 3690 (symbol-function 'canonically-space-region)) 3691 (insert-and-inherit (symbol-function 'insert-and-inherit)) 3692 (set-text-properties (symbol-function 'set-text-properties)) 3693 (woman-registers woman-registers) 3694 fn request translations 3695 tab-stop-list) 3696 (set-marker-insertion-type to t) 3697 ;; ?roff does not squeeze multiple spaces, but does fill, so... 3698 (fset 'canonically-space-region 'ignore) 3699 ;; Try to avoid spaces inheriting underlines from preceding text! 3700 (fset 'insert-and-inherit (symbol-function 'insert)) 3701 (fset 'set-text-properties 'ignore) 3702 (unwind-protect 3703 (while 3704 ;; Find next control line: 3705 (re-search-forward woman-request-regexp nil t) 3706 (cond 3707 ;; Construct woman function to call: 3708 ((setq fn (intern-soft 3709 (concat "woman2-" 3710 (setq request (match-string 1))))) 3711 ;; Delete request or macro name: 3712 (woman-delete-match 0)) 3713 ;; Unrecognised request: 3714 ((prog1 nil 3715 ;; (WoMan-warn ".%s request ignored!" request) 3716 (WoMan-warn-ignored request "ignored!") 3717 ;; (setq fn 'woman2-LP) 3718 ;; AVOID LEAVING A BLANK LINE! 3719 ;; (setq fn 'woman2-format-paragraphs) 3720 )) 3721 ;; .LP assumes it is at eol and leaves a (blank) line, 3722 ;; so leave point at end of line before paragraph: 3723 ((or (looking-at "[ \t]*$") ; no argument 3724 woman-ignore) ; ignore all 3725 ;; (beginning-of-line) (kill-line) 3726 ;; AVOID LEAVING A BLANK LINE! 3727 (beginning-of-line) (woman-delete-line 1)) 3728 (t (end-of-line) (insert ?\n)) 3729 ) 3730 (if (not (or fn 3731 (and (not (memq (following-char) '(?. ?'))) 3732 (setq fn 'woman2-format-paragraphs)))) 3733 () 3734 ;; Find next control line: 3735 (set-marker to (woman-find-next-control-line)) 3736 ;; Call the appropriate function: 3737 (funcall fn to))) 3738 (if (not (eobp)) ; This should not happen, but ... 3739 (woman2-format-paragraphs (copy-marker (point-max) t) 3740 woman-left-margin)) 3741 (fset 'canonically-space-region canonically-space-region) 3742 (fset 'set-text-properties set-text-properties) 3743 (fset 'insert-and-inherit insert-and-inherit) 3744 (set-marker to nil)))) 3745 3746(defun woman-find-next-control-line () 3747 "Find and return start of next control line." 3748; (let ((to (save-excursion 3749; (re-search-forward "^\\." nil t)))) 3750; (if to (1- to) (point-max))) 3751 (let (to) 3752 (save-excursion 3753 ;; Must handle 3754 ;; ...\c 3755 ;; .br (and other requests?) 3756 ;; by deleting both the \c and the following request. 3757 ;; BEWARE THAT THIS CODE MAY BE UNRELIABLE!!!!! 3758 (while 3759 (and 3760 (setq to (re-search-forward "\\(\\\\c\\)?\n[.']" nil t)) 3761 (match-string 1) 3762 (looking-at "br")) 3763 (goto-char (match-beginning 0)) 3764 (woman-delete-line 2))) 3765 (if to (1- to) (point-max)))) 3766 3767(defun woman2-PD (to) 3768 ".PD d -- Set the interparagraph distance to d. 3769Round to whole lines, default 1 line. Format paragraphs upto TO. 3770\(Breaks, but should not.)" 3771 ;; .ie \\n[.$] .nr PD (v;\\$1) 3772 ;; .el .nr PD .4v>?\n[.V] 3773 (woman-set-interparagraph-distance) 3774 (woman2-format-paragraphs to)) 3775 3776(defun woman-set-interparagraph-distance () 3777 "Set the interparagraph distance from a .PD request at point." 3778 (setq woman-interparagraph-distance 3779 (if (eolp) 1 (woman-get-numeric-arg))) 3780 ;; Should allow .PD 0 to set zero line spacing 3781 (woman-delete-line 1)) ; ignore remaining args 3782 3783(defsubst woman-interparagraph-space () 3784 "Set variable `woman-leave-blank-lines' from `woman-interparagraph-distance'." 3785; (if (> woman-interparagraph-distance 0) 3786; (forward-line 1) ; leave 1 blank line 3787; (woman-delete-line 1)) ; do not leave blank line 3788 (setq woman-leave-blank-lines woman-interparagraph-distance) 3789 ) 3790 3791(defun woman2-TH (to) 3792 ".TH n c x v m -- Begin a man page. Format paragraphs upto TO. 3793n is the name of the page in chapter c\; x is extra commentary\; 3794v alters page foot left; m alters page head center. 3795\(Should set prevailing indent and tabs to 5.)" 3796 (woman-forward-arg 'unquote 'concat) 3797 (insert ?\() 3798 (woman-forward-arg 'unquote 'concat) 3799 (insert ?\)) 3800 (let ((start (point)) here) 3801 (while (not (eolp)) 3802 (cond ((looking-at "\"\"[ \t]") 3803 (delete-char 2) 3804 ;; (delete-horizontal-space) 3805 )) 3806 (delete-horizontal-space) 3807 (setq here (point)) 3808 (insert " -- ") 3809 (woman-forward-arg 'unquote 'concat) 3810 ;; Delete repeated arguments: 3811 (if (string-match (buffer-substring here (point)) 3812 (buffer-substring start here)) 3813 (delete-region here (point))) 3814 )) 3815 ;; Embolden heading (point is at end of heading): 3816 (woman-set-face 3817 (save-excursion (beginning-of-line) (point)) (point) 'woman-bold) 3818 (forward-line) 3819 (delete-blank-lines) 3820 (setq woman-left-margin woman-default-indent) 3821 (setq woman-prevailing-indent woman-default-indent) 3822 (woman2-format-paragraphs to woman-left-margin)) 3823 3824(defun woman2-SH (to) 3825 ".SH -- Sub-head. Leave blank line and subhead. 3826Format paragraphs upto TO. Set prevailing indent to 5." 3827 (if (eolp) ; If no args then 3828 (delete-char 1) ; apply to next line 3829 (woman-unquote-args) ; else unquote to end of heading 3830 (beginning-of-line)) 3831 (woman2-process-escapes-to-eol) 3832 (woman-leave-blank-lines woman-interparagraph-distance) 3833 (setq woman-leave-blank-lines nil) 3834 ;; Optionally embolden heading (point is at beginning of heading): 3835 (if woman-bold-headings 3836 (woman-set-face 3837 (point) (save-excursion (end-of-line) (point)) 'woman-bold)) 3838 (forward-line) 3839 (setq woman-left-margin woman-default-indent 3840 woman-nofill nil) ; fill output lines 3841 (setq woman-prevailing-indent woman-default-indent) 3842 (woman2-format-paragraphs to woman-left-margin)) 3843 3844(defun woman2-SS (to) 3845 ".SS -- Sub-sub-head. Like .SH but indent heading 3 spaces. 3846Format paragraphs upto TO." 3847 (if (eolp) ; If no args then 3848 (delete-char 1)) ; apply to next line. 3849 (insert " ") 3850 (beginning-of-line) 3851 (woman2-SH to)) 3852 3853(defun woman2-LP (to) 3854 ".LP,.PP -- Begin paragraph. Set prevailing indent to 5. 3855Leave 1 blank line. Format paragraphs upto TO." 3856 (woman-delete-line 1) ; ignore any arguments 3857 (woman-interparagraph-space) 3858 (setq woman-prevailing-indent woman-default-indent) 3859 (woman2-format-paragraphs to woman-left-margin)) 3860 3861(defalias 'woman2-PP 'woman2-LP) 3862(defalias 'woman2-P 'woman2-LP) 3863 3864(defun woman2-ns (to) 3865 ".ns -- Turn on no-space mode. Format paragraphs upto TO." 3866 ;; Should not cause a break! 3867 (woman-delete-line 1) ; ignore argument(s) 3868 (setq woman-nospace t) 3869 (woman2-format-paragraphs to)) 3870 3871(defun woman2-rs (to) 3872 ".rs -- Turn off no-space mode. Format paragraphs upto TO." 3873 ;; Should not cause a break! 3874 (woman-delete-line 1) ; ignore argument(s) 3875 (setq woman-nospace nil) 3876 (woman2-format-paragraphs to)) 3877 3878(defun woman2-sp (to) 3879 ".sp N -- If N > 0 then leave 1 blank line. Format paragraphs upto TO." 3880 (let ((N (if (eolp) 1 (woman-get-numeric-arg)))) 3881 (if (>= N 0) 3882 (woman-delete-line 1) ; ignore argument(s) 3883 (setq woman-negative-vertical-space t) 3884 (insert ".sp ") 3885 (forward-line)) 3886 (setq woman-leave-blank-lines N) 3887 (woman2-format-paragraphs to))) 3888 3889(defun woman-negative-vertical-space (from) 3890 ".sp N with N < 0 => overlap following with preceding lines at FROM." 3891 ;; Run by woman-decode-region if necessary -- not usually required. 3892 (WoMan-warn "Negative vertical spacing support is experimental!") 3893 (goto-char from) 3894 (while 3895 ;; Find next control line: 3896 (re-search-forward "^\\.sp " nil t) 3897 (let ((N (woman-get-numeric-arg)) 3898 overlap overwritten) 3899 (woman-delete-whole-line) 3900 (setq from (point) 3901 overlap (buffer-substring from 3902 (progn (forward-line (- N)) (point)))) 3903 (delete-region from (point)) 3904 (forward-line N) 3905 (let ((imax (length overlap)) 3906 (i 0) c) 3907 (while (< i imax) 3908 (setq c (aref overlap i)) 3909 (cond ((eq c ?\n) ; skip 3910 (forward-line)) 3911 ((eolp) ; extend line 3912 ;; Insert character INCLUDING TEXT PROPERTIES: 3913 ;; (insert (substring overlap i (1+ i))) 3914 (let ((eol (string-match "\n" overlap i))) 3915 (insert (substring overlap i eol)) 3916 (setq i (or eol imax))) 3917 ) 3918 ((eq c ?\ ) ; skip 3919 (forward-char)) 3920 ((eq c ?\t) ; skip 3921 (if (eq (following-char) ?\t) 3922 (forward-char) ; both tabs, just skip 3923 (let ((i woman-tab-width)) 3924 (while (> i 0) 3925 (if (eolp) 3926 (insert ?\ ) ; extend line 3927 (forward-char)) ; skip 3928 (setq i (1- i))) 3929 ))) 3930 (t 3931 (if (or (eq (following-char) ?\ ) ; overwrite OK 3932 overwritten) ; warning only once per ".sp -" 3933 () 3934 (setq overwritten t) 3935 (WoMan-warn 3936 "Character(s) overwritten by negative vertical spacing in line %d" 3937 (count-lines 1 (point)))) 3938 (delete-char 1) (insert (substring overlap i (1+ i))))) 3939 (setq i (1+ i)) 3940 )) 3941 ))) 3942 3943 3944;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3945;; The following function should probably do ALL width and number 3946;; register interpolation. 3947;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3948 3949(defun woman2-process-escapes (to &optional numeric) 3950 "Process remaining escape sequences up to marker TO, preserving point. 3951Optional argument NUMERIC, if non-nil, means the argument is numeric." 3952 (assert (and (markerp to) (marker-insertion-type to))) 3953 ;; The first two cases below could be merged (maybe)! 3954 (let ((from (point))) 3955 ;; Discard zero width filler character used to hide leading dots 3956 ;; and zero width characters \|, \^: 3957 (while (re-search-forward "\\\\[&|^]" to t) 3958 (woman-delete-match 0)) 3959 (goto-char from) 3960 ;; Interrupt text processing -- CONTINUE current text with the 3961 ;; next text line (after any control lines, unless processing to 3962 ;; eol): 3963 (while (re-search-forward "\\\\c.*\n?" to t) 3964 (woman-delete-match 0)) 3965 ;; but do not delete the final newline ... 3966 (if (and (or (eobp) (= (point) to)) (not (bolp))) 3967 (insert-before-markers ?\n)) 3968 (goto-char from) 3969 (woman-translate to) 3970 (goto-char from) 3971 (woman-special-characters to) 3972 (goto-char from) 3973 ;; Printable version of the current escape character, ASSUMED to be `\' 3974 ;; This must be done LAST of all escape processing! 3975 ;; Done like this to preserve any text properties of the `\' 3976 (while (search-forward "\\" to t) 3977 (let ((c (following-char))) 3978 (cond ((eq c ?') ; \' -> ' 3979 (delete-char -1) 3980 (cond (numeric ; except in numeric args, \' -> ` 3981 (delete-char 1) 3982 (insert ?`)))) 3983 ((eq c ?\( )) ; uninterpreted special character 3984 ; \(.. -- do nothing 3985 ((eq c ?t) ; non-interpreted tab \t 3986 (delete-char 1) 3987 (delete-char -1) 3988 (insert "\t")) 3989 ((and numeric 3990 (memq c '(?w ?n ?h)))) ; leave \w, \n, \h (?????) 3991 ((eq c ?l) (woman-horizontal-line)) 3992 (t 3993 ;; \? -> ? where ? is any remaining character 3994 (WoMan-warn "Escape ignored: \\%c -> %c" c c) 3995 (delete-char -1)) 3996 ))) 3997 (goto-char from) 3998 ;; Process non-default tab settings: 3999 (cond (tab-stop-list 4000 (while (search-forward "\t" to t) 4001 (woman-tab-to-tab-stop)) 4002 (goto-char from))) 4003 4004 ;; Must replace \' by something before processing \w, done above. 4005 4006 ;; Replace all `\w' and `\n' escapes: 4007 ;; (This may be a bit too recursive!) 4008 (while (re-search-forward "\\\\[nw]" to t) 4009 (let ((from (match-beginning 0)) N) 4010 (goto-char from) 4011 (setq N (woman-parse-numeric-value)) 4012 (delete-region from (point)) 4013 ;; Interpolate value: 4014 (insert-before-markers (number-to-string N)))) 4015 (goto-char from))) 4016 4017(defun woman-horizontal-line () 4018 "\\l'Nc' -- Draw a horizontal line of length N using character c, default _." 4019 (delete-char -1) 4020 (delete-char 1) 4021 (looking-at "\\(.\\)\\(.*\\)\\1") 4022 (forward-char 1) 4023 (let* ((to (match-end 2)) 4024 (from (match-beginning 0)) 4025 (N (woman-parse-numeric-arg)) 4026 (c (if (< (point) to) (following-char) ?_))) 4027 (delete-region from to) 4028 (delete-char 1) 4029 (insert (make-string N c)) 4030 )) 4031 4032;;; 4. Text Filling, Adjusting, and Centering 4033 4034(defun woman2-br (to) 4035 ".br -- Break. Leave no blank line. Format paragraphs upto TO." 4036 (woman-delete-line 1) ; ignore any arguments 4037 (woman2-format-paragraphs to)) 4038 4039(defun woman2-fi (to) 4040 ".fi -- Fill subsequent output lines. Leave no blank line. 4041Format paragraphs upto TO." 4042 (setq woman-nofill nil) 4043 (woman-delete-line 1) ; ignore any arguments 4044 ;; Preserve any final blank line in the nofill region: 4045 (save-excursion 4046 (forward-line -1) 4047 (if (looking-at "[ \t]*$") (setq woman-leave-blank-lines 1))) 4048 (woman2-format-paragraphs to)) 4049 4050(defun woman2-nf (to) 4051 ".nf -- Nofill. Subsequent lines are neither filled nor adjusted. 4052Input text lines are copied directly to output lines without regard 4053for the current line length. Format paragraphs upto TO." 4054 (setq woman-nofill t) 4055 (woman-delete-line 1) ; ignore any arguments 4056 (woman2-format-paragraphs to)) 4057 4058(defun woman2-ad (to) 4059 ".ad c -- Line adjustment is begun (once fill mode is on). 4060Set justification mode to c if specified. 4061Format paragraphs upto TO. (Breaks, but should not.)" 4062 ;; c = l -- left, r -- right, c -- center, b or n -- both, 4063 ;; absent -- unchanged. Initial mode adj,both. 4064 (setq woman-adjust 4065 (cond ((eolp) woman-adjust-previous) 4066 ((eq (following-char) ?l) woman-adjust-left) 4067 ((eq (following-char) ?r) woman-adjust-right) 4068 ((eq (following-char) ?c) woman-adjust-center) 4069 ((memq (following-char) '(?b ?n)) woman-adjust-both) 4070 (t (woman-get-numeric-arg)) 4071 ) 4072 woman-justify (nth woman-adjust woman-justify-list)) 4073 (woman-delete-line 1) ; ignore any remaining arguments 4074 (woman2-format-paragraphs to)) 4075 4076(defun woman2-na (to) 4077 ".na -- No adjusting. Format paragraphs upto TO. 4078\(Breaks, but should not.)" 4079 (setq woman-adjust-previous woman-adjust 4080 woman-justify-previous woman-justify 4081 woman-adjust woman-adjust-left ; fill but do not adjust 4082 woman-justify (nth woman-adjust woman-justify-list)) 4083 (woman-delete-line 1) ; ignore any arguments 4084 (woman2-format-paragraphs to)) 4085 4086;;; The main formatting functions: 4087 4088(defun woman-leave-blank-lines (&optional leave) 4089 "Delete all blank lines around point. 4090Leave one blank line if optional argument LEAVE is non-nil and 4091non-zero, or if LEAVE is nil and variable `woman-leave-blank-lines' is 4092non-nil and non-zero." 4093 ;; ***** It may suffice to delete only lines ABOVE point! ***** 4094 ;; NOTE: Function arguments are evaluated left to right 4095 ;; (*note (elisp)Function Forms::.). 4096 (delete-region 4097 (save-excursion 4098 (if (not (eq (skip-syntax-backward " ") 0)) 4099 (forward-line)) ; forward-char ? 4100 (point)) 4101 (progn (skip-syntax-forward " ") 4102 (beginning-of-line) 4103 (point))) 4104 (if woman-nospace 4105 () 4106 (if (or (null leave) (eq leave 0)) 4107 ;; output any `pending' vertical space ... 4108 (setq leave woman-leave-blank-lines)) 4109 (if (and leave (> leave 0)) (insert-before-markers ?\n)) 4110 ) 4111 (setq woman-leave-blank-lines nil) 4112 ) 4113 4114;; `fill-region-as-paragraph' in `fill.el' appears to be the principal 4115;; text filling function, so that is what I use here. 4116 4117(defvar woman-temp-indent nil) 4118 4119(defun woman2-format-paragraphs (to &optional new-left) 4120 "Indent, fill and adjust paragraphs upto TO to current left margin. 4121If optional arg NEW-LEFT is non-nil then reset current left margin. 4122If `woman-nofill' is non-nil then indent without filling or adjusting." 4123 ;; Blank space should only ever be output before text. 4124 (if new-left (setq left-margin new-left)) 4125 (if (looking-at "^\\s *$") 4126 ;; A blank line should leave a space like .sp 1 (p. 14). 4127 (setq woman-leave-blank-lines 1)) 4128 (skip-syntax-forward " ") 4129 ;; Successive control lines are sufficiently common to be worth a 4130 ;; special case (maybe): 4131 (if (>= (point) to) ; >= as a precaution! 4132 () 4133 ;; (woman-leave-blank-lines) 4134 (woman-reset-nospace) 4135 ;; (woman2-process-escapes to) ; 7 October 1999 4136 (woman2-process-escapes to 'numeric) 4137 (if woman-nofill 4138 ;; Indent without filling or adjusting ... 4139 (progn 4140 (woman-leave-blank-lines) 4141 (cond (woman-temp-indent 4142 (indent-to woman-temp-indent) 4143 (forward-line))) 4144 (indent-rigidly (point) to left-margin) 4145 (woman-horizontal-escapes to)) ; 7 October 1999 4146 ;; Fill and justify ... 4147 ;; Blank lines and initial spaces cause a break. 4148; (cond ((and (= (point) to) (not (looking-at ".nf"))) ; Yuk!!! 4149; ;; No text after a request that caused a break, so delete 4150; ;; any spurious blank line left: 4151; (forward-line -1) 4152; (if (looking-at "^\\s *$") (kill-line) (forward-line)))) 4153 (while (< (point) to) 4154 (woman-leave-blank-lines) 4155 (let ((from (point))) 4156 ;; Indent first lin of paragraph: 4157 (indent-to (or woman-temp-indent left-margin)) 4158 (woman-horizontal-escapes to) ; 7 October 1999 4159 ;; Find the beginning of the next paragraph: 4160 (forward-line) 4161; (if (re-search-forward "\\(^\\s *$\\)\\|\\(^\\s +\\)" to 1) 4162; ;; A blank line should leave a space like .sp 1 (p. 14). 4163; (if (eolp) 4164; (progn 4165; (skip-syntax-forward " ") 4166; (setq woman-leave-blank-lines 1)) 4167; (setq woman-leave-blank-lines nil))) 4168 (and (re-search-forward "\\(^\\s *$\\)\\|\\(^\\s +\\)" to 1) 4169 ;; A blank line should leave a space like .sp 1 (p. 14). 4170 (eolp) 4171 (skip-syntax-forward " ") 4172 (setq woman-leave-blank-lines 1)) 4173 ;; This shouldn't happen, but in case it does (e.g. for 4174 ;; badly-formatted manfiles with no terminating newline), 4175 ;; avoid an infinite loop. 4176 (unless (and (eolp) (eobp)) 4177 (beginning-of-line)) 4178 ;; If a single short line then just leave it. 4179 ;; This is necessary to preserve some table layouts. 4180 ;; PROBABLY NOT NECESSARY WITH SQUEEZE MODIFICATION !!!!! 4181 (if (or (> (count-lines from (point)) 1) 4182 (save-excursion 4183 (backward-char) 4184 (> (current-column) fill-column))) 4185 ;; ?roff does not squeeze multiple spaces 4186 ;; (fill-region-as-paragraph from (point) woman-justify t) 4187 ;; NOSQUEEZE has no effect if JUSTIFY is full, so 4188 ;; redefine canonically-space-region, see above. 4189 (progn 4190 ;; Needs a re-write of the paragraph formatter to 4191 ;; avoid this nonsense to handle temporary indents! 4192 (if (and woman-temp-indent (< woman-temp-indent left-margin)) 4193 (let ((left-margin woman-temp-indent)) 4194 (fill-region-as-paragraph from (point) woman-justify) 4195 (save-excursion 4196 (goto-char from) 4197 (forward-line) 4198 (setq from (point))))) 4199 (fill-region-as-paragraph from (point) woman-justify)) 4200 ) 4201 ;; A blank line should leave a space like .sp 1 (p. 14). 4202 ;; Delete all but 1 trailing blank lines: 4203 ;;(woman-leave-blank-lines 1) 4204 )) 4205 ) 4206 (setq woman-temp-indent nil) 4207 ;; Non-white-space text has been processed, so ... 4208 ;;(setq woman-leave-blank-lines nil) 4209 )) 4210 4211 4212;;; Tagged, indented and hanging paragraphs: 4213 4214(defun woman2-TP (to) 4215 ".TP i -- Set prevailing indent to i. Format paragraphs upto TO. 4216Begin indented paragraph with hanging tag given by next text line. 4217If tag doesn't fit, place it on a separate line." 4218 (let ((i (woman2-get-prevailing-indent))) 4219 (woman-leave-blank-lines woman-interparagraph-distance) 4220 (woman2-tagged-paragraph to i))) 4221 4222(defun woman2-IP (to) 4223 ".IP x i -- Same as .TP with tag x. Format paragraphs upto TO." 4224 (woman-interparagraph-space) 4225 (if (eolp) ; no args 4226 ;; Like LP without resetting prevailing indent 4227 (woman2-format-paragraphs to (+ woman-left-margin 4228 woman-prevailing-indent)) 4229 (woman-forward-arg 'unquote) 4230 (let ((i (woman2-get-prevailing-indent 'leave-eol))) 4231 (beginning-of-line) 4232 (woman-leave-blank-lines) ; must be here, 4233 ;; 4234 ;; The cvs.1 manpage contains some (possibly buggy) syntax that 4235 ;; confuses woman, although the man program displays it ok. 4236 ;; Most problems are caused by IP followed by another request on 4237 ;; the next line. Without the following hack, the second request 4238 ;; gets displayed raw in the output. Note that 4239 ;; woman2-tagged-paragraph also contains a hack for similar 4240 ;; issues (eg IP followed by SP). 4241 ;; 4242 ;; i) For IP followed by one or more IPs, we ignore all but the 4243 ;; last (mimic man). The hack in w-t-p would only work for two 4244 ;; consecutive IPs, and would use the first. 4245 ;; ii) For IP followed by SP followed by one or more requests, 4246 ;; do nothing. At least in cvs.1, there is usually another IP in 4247 ;; there somewhere. 4248 (unless (or (looking-at "^\\.IP") 4249 (and (looking-at "^\\.sp") 4250 (save-excursion 4251 (and (zerop (forward-line 1)) 4252 (looking-at woman-request-regexp))))) 4253 (woman2-tagged-paragraph to i))))) 4254 4255(defun woman-find-next-control-line-carefully () 4256 "Find and return start of next control line, even if already there!" 4257 (if (looking-at "^[.']") 4258 (point) 4259 (woman-find-next-control-line))) 4260 4261(defun woman2-tagged-paragraph (to i) 4262 "Begin indented paragraph with hanging tag given by current text line. 4263If tag doesn't fit, leave it on separate line. 4264Format paragraphs upto TO. Set prevailing indent to I." 4265 (if (not (looking-at "\\s *$")) ; non-empty tag 4266 (setq woman-leave-blank-lines nil)) 4267 4268 ;; Temporary hack for bash.1, cvs.1 and groff_mmse.7 until code is revised 4269 ;; to process all requests uniformly. 4270 ;; This hack deals with IP requests followed by other requests (eg 4271 ;; SP) on the very next line. We skip over the SP, otherwise it gets 4272 ;; inserted raw in the rendered output. 4273 (cond ((and (= (point) to) 4274 (looking-at "^[.'][ \t]*\\(PD\\|br\\|ta\\|sp\\) *")) 4275 (if (member (match-string 1) '("br" "sp")) 4276 (woman-delete-line 1) 4277 (woman-delete-match 0) 4278 (if (string= (match-string 1) "ta") ; for GetInt.3 4279 (woman2-ta to) 4280 (woman-set-interparagraph-distance))) 4281 (set-marker to (woman-find-next-control-line-carefully)) 4282 )) 4283 4284 (let ((tag (point))) 4285 (woman-reset-nospace) 4286 ;; Format the tag: 4287 (woman2-process-escapes-to-eol) 4288 ;; TIDY UP THE FOLLOWING CODE 4289 ;; (indent-to woman-left-margin) 4290 (setq left-margin woman-left-margin) 4291 (forward-line) 4292 (fill-region-as-paragraph (save-excursion (forward-line -1) (point)) 4293 (point) woman-justify) 4294 4295 ;; Temporary hack for bash.1 until all requests processed uniformly: 4296 (cond ((and (= (point) to) (looking-at "^[.'][ \t]*PD *")) 4297 (woman-delete-match 0) 4298 (woman-set-interparagraph-distance) 4299 (set-marker to (woman-find-next-control-line-carefully)) 4300 )) 4301 4302 ;; Format the paragraph body, if there is one! Set indented left 4303 ;; margin anyway, because the paragraph body may begin with a 4304 ;; control line: 4305 (setq left-margin (+ woman-left-margin i)) 4306 (cond ((< (point) to) 4307 (woman2-format-paragraphs to) 4308 (goto-char tag) (end-of-line) 4309 (cond ((> (setq i (- left-margin (current-column))) 0) 4310 (delete-char 1) 4311 (delete-horizontal-space) 4312 ;; Necessary to avoid spaces inheriting underlines. 4313 ;; Cannot simply delete (current-column) whitespace 4314 ;; characters because some may be tabs! 4315 (while (> i 0) (insert ? ) (setq i (1- i))))) 4316 (goto-char to) ; necessary ??? 4317 )) 4318 )) 4319 4320(defun woman2-HP (to) 4321 ".HP i -- Set prevailing indent to i. Format paragraphs upto TO. 4322Begin paragraph with hanging indent." 4323 (let ((i (woman2-get-prevailing-indent))) 4324 (woman-interparagraph-space) 4325 (setq woman-temp-indent woman-left-margin) 4326 (woman2-format-paragraphs to (+ woman-left-margin i)) 4327 )) 4328 4329(defun woman2-get-prevailing-indent (&optional leave-eol) 4330 "Set prevailing indent to integer argument at point, and return it. 4331If no argument then return the existing prevailing indent. 4332Delete line from point and eol unless LEAVE-EOL is non-nil." 4333 (if (eolp) 4334 (or leave-eol (delete-char 1)) 4335 (let ((i (woman-get-numeric-arg))) 4336 (woman-delete-line) (or leave-eol (delete-char 1)) 4337 ;; i = 0 if the argument was not a number 4338 ;; FIXME should this be >= 0? How else to reset to 0 indent? 4339 (if (> i 0) (setq woman-prevailing-indent i)))) 4340 woman-prevailing-indent) 4341 4342(defmacro woman-push (value stack) 4343 "Push VALUE onto STACK." 4344 `(setq ,stack (cons ,value ,stack))) 4345 4346(defmacro woman-pop (variable stack) 4347 "Pop into VARIABLE the value at the top of STACK. 4348Allow for mismatched requests!" 4349 `(if ,stack 4350 (setq ,variable (car ,stack) 4351 ,stack (cdr ,stack)))) 4352 4353(defun woman2-RS (to) 4354 ".RS i -- Start relative indent, move left margin in distance i. 4355Set prevailing indent to 5 for nested indents. Format paragraphs upto TO." 4356 (woman-push woman-left-margin woman-RS-left-margin) 4357 (woman-push woman-prevailing-indent woman-RS-prevailing-indent) 4358 (setq woman-left-margin (+ woman-left-margin 4359 (woman2-get-prevailing-indent)) 4360 woman-prevailing-indent woman-default-indent) 4361 (woman2-format-paragraphs to woman-left-margin)) 4362 4363(defun woman2-RE (to) 4364 ".RE -- End of relative indent. Format paragraphs upto TO. 4365Set prevailing indent to amount of starting .RS." 4366 (woman-pop woman-left-margin woman-RS-left-margin) 4367 (woman-pop woman-prevailing-indent woman-RS-prevailing-indent) 4368 (woman-delete-line 1) ; ignore any arguments 4369 (woman2-format-paragraphs to woman-left-margin)) 4370 4371 4372;;; Line Length and Indenting: 4373 4374(defun woman-set-arg (arg &optional previous) 4375 "Reset, increment or decrement argument ARG, which must be quoted. 4376If no argument then use value of optional arg PREVIOUS if non-nil, 4377otherwise set PREVIOUS. Delete the whole remaining control line." 4378 (if (eolp) ; space already skipped 4379 (set arg (if previous (eval previous) 0)) 4380 (if previous (set previous (eval arg))) 4381 (woman2-process-escapes-to-eol 'numeric) 4382 (let ((pm (if (looking-at "[+-]") 4383 (prog1 (following-char) 4384 (forward-char 1)))) 4385 (i (woman-parse-numeric-arg))) 4386 (cond ((null pm) (set arg i)) 4387 ((= pm ?+) (set arg (+ (eval arg) i))) 4388 ((= pm ?-) (set arg (- (eval arg) i))) 4389 )) 4390 (beginning-of-line)) 4391 (woman-delete-line 1)) ; ignore any remaining arguments 4392 4393;; NEED TO RATIONALIZE NAMES FOR PREVIOUS VALUES! 4394(defvar woman-ll-fill-column woman-fill-column) 4395(defvar woman-in-left-margin woman-left-margin) 4396 4397(defun woman2-ll (to) 4398 ".ll +/-N -- Set, increment or decrement line length. 4399Format paragraphs upto TO. (Breaks, but should not.)" 4400 (woman-set-arg 'fill-column 'woman-ll-fill-column) 4401 (woman2-format-paragraphs to)) 4402 4403(defun woman2-in (to) 4404 ".in +/-N -- Set, increment or decrement the indent. 4405Format paragraphs upto TO." 4406 (woman-set-arg 'left-margin 'woman-in-left-margin) 4407 (woman2-format-paragraphs to)) 4408 4409(defun woman2-ti (to) 4410 ".ti +/-N -- Temporary indent. Format paragraphs upto TO." 4411 ;; Ignore if no argument. 4412 ;; Indent next output line only wrt current indent. 4413 ;; Current indent is not changed. 4414 (setq woman-temp-indent left-margin) 4415 (woman-set-arg 'woman-temp-indent) 4416 (woman2-format-paragraphs to nil)) 4417 4418 4419;;; Tabs, Leaders, and Fields: 4420 4421(defun woman2-ta (to) 4422 ".ta Nt ... -- Set tabs, left type, unless t=R(right), C(centered). 4423\(Breaks, but should not.) The tab stops are separated by spaces\; 4424a value preceded by + represents an increment to the previous stop value. 4425Format paragraphs upto TO." 4426 (setq tab-stop-list nil) 4427 (woman2-process-escapes-to-eol 'numeric) 4428 (save-excursion 4429 (let ((tab-stop 0)) 4430 (while (not (eolp)) 4431 (let ((plus (cond ((eq (following-char) ?+) (forward-char 1) t))) 4432 (i (woman-parse-numeric-arg))) 4433 (setq tab-stop (if plus (+ tab-stop i) i))) 4434 (if (memq (following-char) '(?R ?C)) 4435 (setq tab-stop (cons tab-stop (following-char)))) 4436 (setq tab-stop-list (cons tab-stop tab-stop-list)) 4437 (skip-syntax-forward "^ ") ; skip following R, C, `;', etc. 4438 (skip-chars-forward " \t") 4439 ))) 4440 (woman-delete-line 1) ; ignore any remaining arguments 4441 (setq tab-stop-list (reverse tab-stop-list)) 4442 (woman2-format-paragraphs to)) 4443 4444(defsubst woman-get-tab-stop (tab-stop-list) 4445 "If TAB-STOP-LIST is a cons, return its car, else return TAB-STOP-LIST." 4446 (if (consp tab-stop-list) (car tab-stop-list) tab-stop-list)) 4447 4448(defun woman-tab-to-tab-stop () 4449 "Insert spaces to next defined tab-stop column. 4450The variable `tab-stop-list' is a list whose elements are either left 4451tab stop columns or pairs (COLUMN . TYPE) where TYPE is R or C." 4452 ;; Based on tab-to-tab-stop in indent.el. 4453 ;; R & C tabs probably not quite right! 4454 (delete-backward-char 1) 4455 (let ((tabs tab-stop-list)) 4456 (while (and tabs (>= (current-column) 4457 (woman-get-tab-stop (car tabs)))) 4458 (setq tabs (cdr tabs))) 4459 (if tabs 4460 (let* ((tab (car tabs)) 4461 (type (and (consp tab) (cdr tab))) 4462 eol n) 4463 (if type 4464 (setq tab (woman-get-tab-stop tab) 4465 eol (save-excursion (end-of-line) (point)) 4466 n (save-excursion 4467 (search-forward "\t" eol t)) 4468 n (- (if n (1- n) eol) (point)) 4469 tab (- tab (if (eq type ?C) (/ n 2) n))) ) 4470 (setq n (- tab (current-column))) 4471 (while (> n 0) 4472 (insert ?\ ) 4473 (setq n (1- n)))) 4474 (insert ?\ )))) 4475 4476(defun woman2-DT (to) 4477 ".DT -- Restore default tabs. Format paragraphs upto TO. 4478\(Breaks, but should not.)" 4479 ;; Currently just terminates special tab processing. 4480 (setq tab-stop-list nil) 4481 (woman-delete-line 1) ; ignore any arguments 4482 (woman2-format-paragraphs to)) 4483 4484(defun woman2-fc (to) 4485 ".fc a b -- Set field delimiter a and pad character b. 4486Format paragraphs upto TO. 4487A VERY FIRST ATTEMPT to make fields at least readable! 4488Needs doing properly!" 4489 (if (eolp) 4490 (woman-delete-whole-line) ; ignore! 4491 (let ((delim (following-char)) 4492 (pad ?\ ) end) ; pad defaults to space 4493 (forward-char) 4494 (skip-chars-forward " \t") 4495 (or (eolp) (setq pad (following-char))) 4496 (woman-delete-whole-line) 4497 (save-excursion 4498 (if (re-search-forward "^[.'][ \t]*fc\\s " nil t) 4499 (setq end (match-beginning 0)))) 4500 ;; A field is contained between a pair of field delimiter 4501 ;; characters and consists of sub-strings separated by padding 4502 ;; indicator characters: 4503 (setq delim (string delim ?[ ?^ delim ?] ?* delim)) 4504 (save-excursion 4505 (while (re-search-forward delim end t) 4506 (goto-char (match-beginning 0)) 4507 (delete-char 1) 4508 (insert woman-unpadded-space-char) 4509 (goto-char (match-end 0)) 4510 (delete-backward-char 1) 4511 (insert-before-markers woman-unpadded-space-char) 4512 (subst-char-in-region 4513 (match-beginning 0) (match-end 0) 4514 pad woman-unpadded-space-char t) 4515 )) 4516 )) 4517 (woman2-format-paragraphs to)) 4518 4519 4520;;; Preliminary table support (.TS/.TE) 4521 4522(defun woman2-TS (to) 4523 ".TS -- Start of table code for the tbl processor. 4524Format paragraphs upto TO." 4525 ;; This is a preliminary hack that seems to suffice for lilo.8. 4526 (woman-delete-line 1) ; ignore any arguments 4527 (when woman-emulate-tbl 4528 ;; Assumes column separator is \t and intercolumn spacing is 3. 4529 ;; The first line may optionally be a list of options terminated by 4530 ;; a semicolon. Currently, just delete it: 4531 (if (looking-at ".*;[ \t]*$") (woman-delete-line 1)) ; 4532 ;; The following lines must specify the format of each line of the 4533 ;; table and end with a period. Currently, just delete them: 4534 (while (not (looking-at ".*\\.[ \t]*$")) (woman-delete-line 1)) 4535 (woman-delete-line 1) 4536 ;; For each column, find its width and align it: 4537 (let ((start (point)) (col 1)) 4538 (while (prog1 (search-forward "\t" to t) (goto-char start)) 4539 ;; Find current column width: 4540 (while (< (point) to) 4541 (when (search-forward "\t" to t) 4542 (backward-char) 4543 (if (> (current-column) col) (setq col (current-column)))) 4544 (forward-line)) 4545 ;; Align current column: 4546 (goto-char start) 4547 (setq col (+ col 3)) ; intercolumn space 4548 (while (< (point) to) 4549 (when (search-forward "\t" to t) 4550 (delete-char -1) 4551 (insert-char ?\ (- col (current-column)))) 4552 (forward-line)) 4553 (goto-char start)))) 4554 ;; Format table with no filling or adjusting (cf. woman2-nf): 4555 (setq woman-nofill t) 4556 (woman2-format-paragraphs to)) 4557 4558(defalias 'woman2-TE 'woman2-fi) 4559 ;; ".TE -- End of table code for the tbl processor." 4560 ;; Turn filling and adjusting back on. 4561 4562 4563;;; WoMan message logging: 4564 4565;; The basis for this logging code was shamelessly pirated from bytecomp.el 4566;; by Jamie Zawinski <jwz@lucid.com> & Hallvard Furuseth <hbf@ulrik.uio.no> 4567 4568(defvar WoMan-current-file nil) ; bound in woman-really-find-file 4569(defvar WoMan-Log-header-point-max nil) 4570 4571(defun WoMan-log-begin () 4572 "Log the beginning of formatting in *WoMan-Log*." 4573 (let ((WoMan-current-buffer (buffer-name))) 4574 (save-excursion 4575 (set-buffer (get-buffer-create "*WoMan-Log*")) 4576 (or (eq major-mode 'view-mode) (view-mode 1)) 4577 (setq buffer-read-only nil) 4578 (goto-char (point-max)) 4579 (insert "\n\^L\nFormatting " 4580 (if (stringp WoMan-current-file) 4581 (concat "file " WoMan-current-file) 4582 (concat "buffer " WoMan-current-buffer)) 4583 " at " (current-time-string) "\n") 4584 (setq WoMan-Log-header-point-max (point-max)) 4585 ))) 4586 4587(defun WoMan-log (format &rest args) 4588 "Log a message out of FORMAT control string and optional ARGS." 4589 (WoMan-log-1 (apply 'format format args))) 4590 4591(defun WoMan-warn (format &rest args) 4592 "Log a warning message out of FORMAT control string and optional ARGS." 4593 (setq format (apply 'format format args)) 4594 (WoMan-log-1 (concat "** " format))) 4595 4596(defun WoMan-warn-ignored (request ignored) 4597 "Log a warning message about ignored directive REQUEST. 4598IGNORED is a string appended to the log message." 4599 (let ((tail 4600 (buffer-substring (point) 4601 (save-excursion (end-of-line) (point))))) 4602 (if (and (> (length tail) 0) 4603 (/= (string-to-char tail) ?\ )) 4604 (setq tail (concat " " tail))) 4605 (WoMan-log-1 4606 (concat "** " request tail " request " ignored)))) 4607 4608(defun WoMan-log-end (time) 4609 "Log the end of formatting in *WoMan-Log*. 4610TIME specifies the time it took to format the man page, to be printed 4611with the message." 4612 (WoMan-log-1 (format "Formatting time %d seconds." time) 'end)) 4613 4614(defun WoMan-log-1 (string &optional end) 4615 "Log a message STRING in *WoMan-Log*. 4616If optional argument END is non-nil then make buffer read-only after 4617logging the message." 4618 (save-excursion 4619 (set-buffer (get-buffer-create "*WoMan-Log*")) 4620 (setq buffer-read-only nil) 4621 (goto-char (point-max)) 4622 (or end (insert " ")) (insert string "\n") 4623 (if end 4624 (setq buffer-read-only t) 4625 (if woman-show-log 4626 (select-window ; to return to 4627 (prog1 (selected-window) ; WoMan window 4628 (select-window (display-buffer (current-buffer))) 4629 (cond (WoMan-Log-header-point-max 4630 (goto-char WoMan-Log-header-point-max) 4631 (forward-line -1) 4632 (recenter 0))) 4633 ))))) 4634 nil) ; for woman-file-readable-p etc. 4635 4636(provide 'woman) 4637 4638;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 4639;;; woman.el ends here 4640