Mercurial > emacs
comparison lisp/woman.el @ 84355:2276ead2dd45
Remove spurious * in docstrings.
(woman-mini-help, woman-non-underline-faces, woman0-rename)
(woman-topic-all-completions-merge, woman-file-name-all-completions)
(woman-select-symbol-fonts, woman-expand-directory-path): Use dolist.
(woman-write-directory-cache, woman-display-extended-fonts)
(WoMan-log-begin, WoMan-log-1): Use with-current-buffer.
(woman-really-find-file): Use pop-to-buffer if switch-to-buffer fails.
(woman-mode): Use inhibit-read-only.
(woman-negative-vertical-space): Use dotimes.
(woman2-tagged-paragraph, woman-tab-to-tab-stop): Use insert-char.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 07 Sep 2007 02:45:28 +0000 |
parents | 9355f9b7bbff |
children | ec0a616d2629 |
comparison
equal
deleted
inserted
replaced
84354:1c76edb8a1b6 | 84355:2276ead2dd45 |
---|---|
518 "Browse UNIX manual pages `wo (without) man'." | 518 "Browse UNIX manual pages `wo (without) man'." |
519 :tag "WoMan" | 519 :tag "WoMan" |
520 :group 'help) | 520 :group 'help) |
521 | 521 |
522 (defcustom woman-show-log nil | 522 (defcustom woman-show-log nil |
523 "*If non-nil then show the *WoMan-Log* buffer if appropriate. | 523 "If non-nil then show the *WoMan-Log* buffer if appropriate. |
524 I.e. if any warning messages are written to it. Default is nil." | 524 I.e. if any warning messages are written to it. Default is nil." |
525 :type 'boolean | 525 :type 'boolean |
526 :group 'woman) | 526 :group 'woman) |
527 | 527 |
528 (defcustom woman-pre-format-hook nil | 528 (defcustom woman-pre-format-hook nil |
529 "*Hook run by WoMan immediately before formatting a buffer. | 529 "Hook run by WoMan immediately before formatting a buffer. |
530 Change only via `Customization' or the function `add-hook'." | 530 Change only via `Customization' or the function `add-hook'." |
531 :type 'hook | 531 :type 'hook |
532 :group 'woman) | 532 :group 'woman) |
533 | 533 |
534 (defcustom woman-post-format-hook nil | 534 (defcustom woman-post-format-hook nil |
535 "*Hook run by WoMan immediately after formatting a buffer. | 535 "Hook run by WoMan immediately after formatting a buffer. |
536 Change only via `Customization' or the function `add-hook'." | 536 Change only via `Customization' or the function `add-hook'." |
537 :type 'hook | 537 :type 'hook |
538 :group 'woman) | 538 :group 'woman) |
539 | 539 |
540 | 540 |
548 (defcustom woman-man.conf-path | 548 (defcustom woman-man.conf-path |
549 (let ((path '("/usr/lib" "/etc"))) | 549 (let ((path '("/usr/lib" "/etc"))) |
550 (if (eq system-type 'windows-nt) | 550 (if (eq system-type 'windows-nt) |
551 (mapcar 'woman-Cyg-to-Win path) | 551 (mapcar 'woman-Cyg-to-Win path) |
552 path)) | 552 path)) |
553 "*List of dirs to search and/or files to try for man config file. | 553 "List of dirs to search and/or files to try for man config file. |
554 A trailing separator (`/' for UNIX etc.) on directories is | 554 A trailing separator (`/' for UNIX etc.) on directories is |
555 optional, and the filename is used if a directory specified is | 555 optional, and the filename is used if a directory specified is |
556 the first to start with \"man\" and has an extension starting | 556 the first to start with \"man\" and has an extension starting |
557 with \".conf\". If MANPATH is not set but a config file is found | 557 with \".conf\". If MANPATH is not set but a config file is found |
558 then it is parsed instead to provide a default value for | 558 then it is parsed instead to provide a default value for |
604 (nreverse manpath))) | 604 (nreverse manpath))) |
605 | 605 |
606 (defcustom woman-manpath | 606 (defcustom woman-manpath |
607 (or (woman-parse-colon-path (getenv "MANPATH")) | 607 (or (woman-parse-colon-path (getenv "MANPATH")) |
608 '("/usr/man" "/usr/share/man" "/usr/local/man")) | 608 '("/usr/man" "/usr/share/man" "/usr/local/man")) |
609 "*List of DIRECTORY TREES to search for UN*X manual files. | 609 "List of DIRECTORY TREES to search for UN*X manual files. |
610 Each element should be the name of a directory that contains | 610 Each element should be the name of a directory that contains |
611 subdirectories of the form `man?', or more precisely subdirectories | 611 subdirectories of the form `man?', or more precisely subdirectories |
612 selected by the value of `woman-manpath-man-regexp'. Non-directory | 612 selected by the value of `woman-manpath-man-regexp'. Non-directory |
613 and unreadable files are ignored. | 613 and unreadable files are ignored. |
614 | 614 |
647 :type 'string | 647 :type 'string |
648 :group 'woman-interface) | 648 :group 'woman-interface) |
649 | 649 |
650 (defcustom woman-path | 650 (defcustom woman-path |
651 (if (eq system-type 'ms-dos) '("$DJDIR/info" "$DJDIR/man/cat[1-9onlp]")) | 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. | 652 "List of SPECIFIC DIRECTORIES to search for UN*X manual files. |
653 For example | 653 For example |
654 | 654 |
655 (\"/emacs/etc\"). | 655 (\"/emacs/etc\"). |
656 | 656 |
657 These directories are searched in addition to the directory trees | 657 These directories are searched in addition to the directory trees |
674 drive letters explicitly." | 674 drive letters explicitly." |
675 :type '(repeat (choice string (const nil))) | 675 :type '(repeat (choice string (const nil))) |
676 :group 'woman-interface) | 676 :group 'woman-interface) |
677 | 677 |
678 (defcustom woman-cache-level 2 | 678 (defcustom woman-cache-level 2 |
679 "*The level of topic caching. | 679 "The level of topic caching. |
680 1 - cache only the topic and directory lists | 680 1 - cache only the topic and directory lists |
681 (the only level before version 0.34 - only for compatibility); | 681 (the only level before version 0.34 - only for compatibility); |
682 2 - cache also the directories for each topic | 682 2 - cache also the directories for each topic |
683 (faster, without using much more memory); | 683 (faster, without using much more memory); |
684 3 - cache also the actual filenames for each topic | 684 3 - cache also the actual filenames for each topic |
693 (const :tag "Default" 2) | 693 (const :tag "Default" 2) |
694 (const :tag "Maximal" 3)) | 694 (const :tag "Maximal" 3)) |
695 :group 'woman-interface) | 695 :group 'woman-interface) |
696 | 696 |
697 (defcustom woman-cache-filename nil | 697 (defcustom woman-cache-filename nil |
698 "*The full pathname of the WoMan directory and topic cache file. | 698 "The full pathname of the WoMan directory and topic cache file. |
699 It is used to save and restore the cache between sessions. This is | 699 It is used to save and restore the cache between sessions. This is |
700 especially useful with remote-mounted man page files! The default | 700 especially useful with remote-mounted man page files! The default |
701 value of nil suppresses this action. The `standard' non-nil | 701 value of nil suppresses this action. The `standard' non-nil |
702 filename is \"~/.wmncach.el\". Remember that a prefix argument forces | 702 filename is \"~/.wmncach.el\". Remember that a prefix argument forces |
703 the `woman' command to update and re-write the cache." | 703 the `woman' command to update and re-write the cache." |
705 (const :tag "~/.wmncach.el" "~/.wmncach.el") | 705 (const :tag "~/.wmncach.el" "~/.wmncach.el") |
706 file) | 706 file) |
707 :group 'woman-interface) | 707 :group 'woman-interface) |
708 | 708 |
709 (defcustom woman-dired-keys t | 709 (defcustom woman-dired-keys t |
710 "*List of `dired' mode keys to define to run WoMan on current file. | 710 "List of `dired' mode keys to define to run WoMan on current file. |
711 E.g. '(\"w\" \"W\"), or any non-null atom to automatically define | 711 E.g. '(\"w\" \"W\"), or any non-null atom to automatically define |
712 \"w\" and \"W\" if they are unbound, or nil to do nothing. | 712 \"w\" and \"W\" if they are unbound, or nil to do nothing. |
713 Default is t." | 713 Default is t." |
714 :type '(choice (const :tag "None" nil) | 714 :type '(choice (const :tag "None" nil) |
715 (repeat string) | 715 (repeat string) |
717 :group 'woman-interface) | 717 :group 'woman-interface) |
718 | 718 |
719 (defcustom woman-imenu-generic-expression | 719 (defcustom woman-imenu-generic-expression |
720 '((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE | 720 '((nil "\n\\([A-Z].*\\)" 1) ; SECTION, but not TITLE |
721 ("*Subsections*" "^ \\([A-Z].*\\)" 1)) | 721 ("*Subsections*" "^ \\([A-Z].*\\)" 1)) |
722 "*Imenu support for Sections and Subsections. | 722 "Imenu support for Sections and Subsections. |
723 An alist with elements of the form (MENU-TITLE REGEXP INDEX) -- | 723 An alist with elements of the form (MENU-TITLE REGEXP INDEX) -- |
724 see the documentation for `imenu-generic-expression'." | 724 see the documentation for `imenu-generic-expression'." |
725 :type 'sexp | 725 :type 'sexp |
726 :group 'woman-interface) | 726 :group 'woman-interface) |
727 | 727 |
728 (defcustom woman-imenu nil | 728 (defcustom woman-imenu nil |
729 "*If non-nil then WoMan adds a Contents menu to the menubar. | 729 "If non-nil then WoMan adds a Contents menu to the menubar. |
730 It does this by calling `imenu-add-to-menubar'. Default is nil." | 730 It does this by calling `imenu-add-to-menubar'. Default is nil." |
731 :type 'boolean | 731 :type 'boolean |
732 :group 'woman-interface) | 732 :group 'woman-interface) |
733 | 733 |
734 (defcustom woman-imenu-title "CONTENTS" | 734 (defcustom woman-imenu-title "CONTENTS" |
735 "*The title to use if WoMan adds a Contents menu to the menubar. | 735 "The title to use if WoMan adds a Contents menu to the menubar. |
736 Default is \"CONTENTS\"." | 736 Default is \"CONTENTS\"." |
737 :type 'string | 737 :type 'string |
738 :group 'woman-interface) | 738 :group 'woman-interface) |
739 | 739 |
740 (defcustom woman-use-topic-at-point-default nil | 740 (defcustom woman-use-topic-at-point-default nil |
741 ;; `woman-use-topic-at-point' may be let-bound when woman is loaded, | 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. | 742 ;; in which case its global value does not get defined. |
743 ;; `woman-file-name' sets it to this value if it is unbound. | 743 ;; `woman-file-name' sets it to this value if it is unbound. |
744 "*Default value for `woman-use-topic-at-point'." | 744 "Default value for `woman-use-topic-at-point'." |
745 :type '(choice (const :tag "Yes" t) | 745 :type '(choice (const :tag "Yes" t) |
746 (const :tag "No" nil)) | 746 (const :tag "No" nil)) |
747 :group 'woman-interface) | 747 :group 'woman-interface) |
748 | 748 |
749 (defcustom woman-use-topic-at-point woman-use-topic-at-point-default | 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. | 750 "Control use of the word at point as the default topic. |
751 If non-nil the `woman' command uses the word at point automatically, | 751 If non-nil the `woman' command uses the word at point automatically, |
752 without interactive confirmation, if it exists as a topic." | 752 without interactive confirmation, if it exists as a topic." |
753 :type '(choice (const :tag "Yes" t) | 753 :type '(choice (const :tag "Yes" t) |
754 (const :tag "No" nil)) | 754 (const :tag "No" nil)) |
755 :group 'woman-interface) | 755 :group 'woman-interface) |
776 (substring woman-file-compression-regexp 0 -2) | 776 (substring woman-file-compression-regexp 0 -2) |
777 "\\)?\\'")))) | 777 "\\)?\\'")))) |
778 | 778 |
779 (defcustom woman-uncompressed-file-regexp | 779 (defcustom woman-uncompressed-file-regexp |
780 "\\.\\([0-9lmnt]\\w*\\)" ; disallow no extension | 780 "\\.\\([0-9lmnt]\\w*\\)" ; disallow no extension |
781 "*Do not change this unless you are sure you know what you are doing! | 781 "Do not change this unless you are sure you know what you are doing! |
782 Regexp used to select man source files (ignoring any compression extension). | 782 Regexp used to select man source files (ignoring any compression extension). |
783 | 783 |
784 The SysV standard man pages use two character suffixes, and this is | 784 The SysV standard man pages use two character suffixes, and this is |
785 becoming more common in the GNU world. For example, the man pages | 785 becoming more common in the GNU world. For example, the man pages |
786 in the ncurses package include `toe.1m', `form.3x', etc. | 786 in the ncurses package include `toe.1m', `form.3x', etc. |
791 :set 'set-woman-file-regexp | 791 :set 'set-woman-file-regexp |
792 :group 'woman-interface) | 792 :group 'woman-interface) |
793 | 793 |
794 (defcustom woman-file-compression-regexp | 794 (defcustom woman-file-compression-regexp |
795 "\\.\\(g?z\\|bz2\\)\\'" | 795 "\\.\\(g?z\\|bz2\\)\\'" |
796 "*Do not change this unless you are sure you know what you are doing! | 796 "Do not change this unless you are sure you know what you are doing! |
797 Regexp used to match compressed man file extensions for which | 797 Regexp used to match compressed man file extensions for which |
798 decompressors are available and handled by auto-compression mode, | 798 decompressors are available and handled by auto-compression mode, |
799 e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'. | 799 e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'. |
800 Should begin with \\. and end with \\' and MUST NOT be optional." | 800 Should begin with \\. and end with \\' and MUST NOT be optional." |
801 ;; Should be compatible with car of | 801 ;; Should be compatible with car of |
807 :group 'woman-interface) | 807 :group 'woman-interface) |
808 | 808 |
809 (defcustom woman-use-own-frame ; window-system | 809 (defcustom woman-use-own-frame ; window-system |
810 (or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21 | 810 (or (and (fboundp 'display-graphic-p) (display-graphic-p)) ; Emacs 21 |
811 (memq window-system '(x w32))) ; Emacs 20 | 811 (memq window-system '(x w32))) ; Emacs 20 |
812 "*If non-nil then use a dedicated frame for displaying WoMan windows. | 812 "If non-nil then use a dedicated frame for displaying WoMan windows. |
813 Only useful when run on a graphic display such as X or MS-Windows." | 813 Only useful when run on a graphic display such as X or MS-Windows." |
814 :type 'boolean | 814 :type 'boolean |
815 :group 'woman-interface) | 815 :group 'woman-interface) |
816 | 816 |
817 | 817 |
821 "Formatting options for browsing UNIX manual pages `wo (without) man'." | 821 "Formatting options for browsing UNIX manual pages `wo (without) man'." |
822 :tag "WoMan Formatting" | 822 :tag "WoMan Formatting" |
823 :group 'woman) | 823 :group 'woman) |
824 | 824 |
825 (defcustom woman-fill-column 65 | 825 (defcustom woman-fill-column 65 |
826 "*Right margin for formatted text -- default is 65." | 826 "Right margin for formatted text -- default is 65." |
827 :type 'integer | 827 :type 'integer |
828 :group 'woman-formatting) | 828 :group 'woman-formatting) |
829 | 829 |
830 (defcustom woman-fill-frame nil | 830 (defcustom woman-fill-frame nil |
831 ;; Based loosely on a suggestion by Theodore Jump: | 831 ;; Based loosely on a suggestion by Theodore Jump: |
832 "*If non-nil then most of the window width is used." | 832 "If non-nil then most of the window width is used." |
833 :type 'boolean | 833 :type 'boolean |
834 :group 'woman-formatting) | 834 :group 'woman-formatting) |
835 | 835 |
836 (defcustom woman-default-indent 5 | 836 (defcustom woman-default-indent 5 |
837 "*Default prevailing indent set by -man macros -- default is 5. | 837 "Default prevailing indent set by -man macros -- default is 5. |
838 Set this variable to 7 to emulate GNU man formatting." | 838 Set this variable to 7 to emulate GNU man formatting." |
839 :type 'integer | 839 :type 'integer |
840 :group 'woman-formatting) | 840 :group 'woman-formatting) |
841 | 841 |
842 (defcustom woman-bold-headings t | 842 (defcustom woman-bold-headings t |
843 "*If non-nil then embolden section and subsection headings. Default is t. | 843 "If non-nil then embolden section and subsection headings. Default is t. |
844 Heading emboldening is NOT standard `man' behavior." | 844 Heading emboldening is NOT standard `man' behavior." |
845 :type 'boolean | 845 :type 'boolean |
846 :group 'woman-formatting) | 846 :group 'woman-formatting) |
847 | 847 |
848 (defcustom woman-ignore t | 848 (defcustom woman-ignore t |
849 "*If non-nil then unrecognized requests etc. are ignored. Default is t. | 849 "If non-nil then unrecognized requests etc.. are ignored. Default is t. |
850 This gives the standard ?roff behavior. If nil then they are left in | 850 This gives the standard ?roff behavior. If nil then they are left in |
851 the buffer, which may aid debugging." | 851 the buffer, which may aid debugging." |
852 :type 'boolean | 852 :type 'boolean |
853 :group 'woman-formatting) | 853 :group 'woman-formatting) |
854 | 854 |
855 (defcustom woman-preserve-ascii t | 855 (defcustom woman-preserve-ascii t |
856 "*If non-nil, preserve ASCII characters in the WoMan buffer. | 856 "If non-nil, preserve ASCII characters in the WoMan buffer. |
857 Otherwise, to save time, some backslashes and spaces may be | 857 Otherwise, to save time, some backslashes and spaces may be |
858 represented differently (as the values of the variables | 858 represented differently (as the values of the variables |
859 `woman-escaped-escape-char' and `woman-unpadded-space-char' | 859 `woman-escaped-escape-char' and `woman-unpadded-space-char' |
860 respectively) so that the buffer content is strictly wrong even though | 860 respectively) so that the buffer content is strictly wrong even though |
861 it should display correctly. This should be irrelevant unless the | 861 it should display correctly. This should be irrelevant unless the |
863 ;; This option should probably be removed! | 863 ;; This option should probably be removed! |
864 :type 'boolean | 864 :type 'boolean |
865 :group 'woman-formatting) | 865 :group 'woman-formatting) |
866 | 866 |
867 (defcustom woman-emulation 'nroff | 867 (defcustom woman-emulation 'nroff |
868 "*WoMan emulation, currently either nroff or troff. Default is nroff. | 868 "WoMan emulation, currently either nroff or troff. Default is nroff. |
869 Troff emulation is experimental and largely untested. | 869 Troff emulation is experimental and largely untested. |
870 \(Add groff later?)" | 870 \(Add groff later?)" |
871 :type '(choice (const nroff) (const troff)) | 871 :type '(choice (const nroff) (const troff)) |
872 :group 'woman-formatting) | 872 :group 'woman-formatting) |
873 | 873 |
882 | 882 |
883 (defcustom woman-fontify | 883 (defcustom woman-fontify |
884 (or (and (fboundp 'display-color-p) (display-color-p)) | 884 (or (and (fboundp 'display-color-p) (display-color-p)) |
885 (and (fboundp 'display-graphic-p) (display-graphic-p)) | 885 (and (fboundp 'display-graphic-p) (display-graphic-p)) |
886 (x-display-color-p)) | 886 (x-display-color-p)) |
887 "*If non-nil then WoMan assumes that face support is available. | 887 "If non-nil then WoMan assumes that face support is available. |
888 It defaults to a non-nil value if the display supports either colors | 888 It defaults to a non-nil value if the display supports either colors |
889 or different fonts." | 889 or different fonts." |
890 :type 'boolean | 890 :type 'boolean |
891 :group 'woman-faces) | 891 :group 'woman-faces) |
892 | 892 |
953 (defun woman-select-symbol-fonts (fonts) | 953 (defun woman-select-symbol-fonts (fonts) |
954 "Select symbol fonts from a list FONTS of font name strings." | 954 "Select symbol fonts from a list FONTS of font name strings." |
955 (let (symbol-fonts) | 955 (let (symbol-fonts) |
956 ;; With NTEmacs 20.5, the PATTERN option to `x-list-fonts' does | 956 ;; With NTEmacs 20.5, the PATTERN option to `x-list-fonts' does |
957 ;; not seem to work and fonts may be repeated, so ... | 957 ;; not seem to work and fonts may be repeated, so ... |
958 (while fonts | 958 (dolist (font fonts) |
959 (and (string-match "-Symbol-" (car fonts)) | 959 (and (string-match "-Symbol-" font) |
960 (not (member (car fonts) symbol-fonts)) | 960 (not (member font symbol-fonts)) |
961 (setq symbol-fonts (cons (car fonts) symbol-fonts))) | 961 (setq symbol-fonts (cons font symbol-fonts)))) |
962 (setq fonts (cdr fonts))) | |
963 symbol-fonts)) | 962 symbol-fonts)) |
964 | 963 |
965 (when woman-font-support | 964 (when woman-font-support |
966 (make-face 'woman-symbol) | 965 (make-face 'woman-symbol) |
967 | 966 |
968 ;; Set the symbol font only if `woman-use-symbol-font' is true, to | 967 ;; Set the symbol font only if `woman-use-symbol-font' is true, to |
969 ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5! | 968 ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5! |
970 | 969 |
971 (defcustom woman-use-extended-font t | 970 (defcustom woman-use-extended-font t |
972 "*If non-nil then may use non-ASCII characters from the default font." | 971 "If non-nil then may use non-ASCII characters from the default font." |
973 :type 'boolean | 972 :type 'boolean |
974 :group 'woman-faces) | 973 :group 'woman-faces) |
975 | 974 |
976 (defcustom woman-use-symbol-font nil | 975 (defcustom woman-use-symbol-font nil |
977 "*If non-nil then may use the symbol font. | 976 "If non-nil then may use the symbol font. |
978 It is off by default, mainly because it may change the line spacing | 977 It is off by default, mainly because it may change the line spacing |
979 \(in NTEmacs 20.5)." | 978 \(in NTEmacs 20.5)." |
980 :type 'boolean | 979 :type 'boolean |
981 :group 'woman-faces) | 980 :group 'woman-faces) |
982 | 981 |
984 (or (woman-select-symbol-fonts (x-list-fonts "*" 'default)) | 983 (or (woman-select-symbol-fonts (x-list-fonts "*" 'default)) |
985 (woman-select-symbol-fonts (x-list-fonts "*"))) | 984 (woman-select-symbol-fonts (x-list-fonts "*"))) |
986 "Symbol font(s), preferably same size as default when WoMan was loaded.") | 985 "Symbol font(s), preferably same size as default when WoMan was loaded.") |
987 | 986 |
988 (defcustom woman-symbol-font (car woman-symbol-font-list) | 987 (defcustom woman-symbol-font (car woman-symbol-font-list) |
989 "*A string describing the symbol font to use for special characters. | 988 "A string describing the symbol font to use for special characters. |
990 It should be compatible with, and the same size as, the default text font. | 989 It should be compatible with, and the same size as, the default text font. |
991 Under MS-Windows, the default is | 990 Under MS-Windows, the default is |
992 \"-*-Symbol-normal-r-*-*-*-*-96-96-p-*-ms-symbol\"." | 991 \"-*-Symbol-normal-r-*-*-*-*-96-96-p-*-ms-symbol\"." |
993 :type `(choice | 992 :type `(choice |
994 ,@(mapcar (lambda (x) (list 'const x)) | 993 ,@(mapcar (lambda (x) (list 'const x)) |
1197 | 1196 |
1198 (defun woman-write-directory-cache () | 1197 (defun woman-write-directory-cache () |
1199 "Save the directory and topic cache. | 1198 "Save the directory and topic cache. |
1200 It is saved to the file named by the variable `woman-cache-filename'." | 1199 It is saved to the file named by the variable `woman-cache-filename'." |
1201 (if woman-cache-filename | 1200 (if woman-cache-filename |
1202 (save-excursion ; to restore current buffer | 1201 (with-current-buffer (generate-new-buffer "WoMan tmp buffer") |
1203 ;; Make a temporary buffer; name starting with space "hides" it. | 1202 ;; Make a temporary buffer; name starting with space "hides" it. |
1204 (let ((standard-output | 1203 (let ((standard-output (current-buffer)) |
1205 (set-buffer (generate-new-buffer "WoMan tmp buffer"))) | |
1206 (backup-inhibited t)) | 1204 (backup-inhibited t)) |
1207 ;; (switch-to-buffer standard-output t) ; only for debugging | 1205 ;; (switch-to-buffer standard-output t) ; only for debugging |
1208 (buffer-disable-undo standard-output) | 1206 (buffer-disable-undo standard-output) |
1209 (princ | 1207 (princ |
1210 ";;; WoMan directory and topic cache -- generated automatically\n") | 1208 ";;; WoMan directory and topic cache -- generated automatically\n") |
1342 WOMAN-PATH should be a list of specific manual directory regexps. | 1340 WOMAN-PATH should be a list of specific manual directory regexps. |
1343 Ignore any paths that are unreadable or not directories." | 1341 Ignore any paths that are unreadable or not directories." |
1344 ;; Allow each path to be a single string or a list of strings: | 1342 ;; 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))) | 1343 (if (not (listp woman-manpath)) (setq woman-manpath (list woman-manpath))) |
1346 (if (not (listp woman-path)) (setq woman-path (list woman-path))) | 1344 (if (not (listp woman-path)) (setq woman-path (list woman-path))) |
1347 (let (dir head dirs path) | 1345 (let (head dirs path) |
1348 (while woman-manpath | 1346 (dolist (dir woman-manpath) |
1349 (setq dir (car woman-manpath) | |
1350 woman-manpath (cdr woman-manpath)) | |
1351 (when (consp dir) | 1347 (when (consp dir) |
1352 (unless path | 1348 (unless path |
1353 (setq path (split-string (getenv "PATH") path-separator t))) | 1349 (setq path (split-string (getenv "PATH") path-separator t))) |
1354 (setq dir (and (member (car dir) path) | 1350 (setq dir (and (member (car dir) path) |
1355 (cdr dir)))) | 1351 (cdr dir)))) |
1359 ;; If does not actually matter here if dir ends with `/'. | 1355 ;; If does not actually matter here if dir ends with `/'. |
1360 ;; Need regexp "man" here to avoid "cat?", `.', `..', etc. | 1356 ;; Need regexp "man" here to avoid "cat?", `.', `..', etc. |
1361 (setq dir (woman-canonicalize-dir dir) | 1357 (setq dir (woman-canonicalize-dir dir) |
1362 dirs (nconc dirs (directory-files | 1358 dirs (nconc dirs (directory-files |
1363 dir t woman-manpath-man-regexp))))) | 1359 dir t woman-manpath-man-regexp))))) |
1364 (while woman-path | 1360 (dolist (dir woman-path) |
1365 (setq dir (car woman-path) | |
1366 woman-path (cdr woman-path)) | |
1367 (if (or (null dir) | 1361 (if (or (null dir) |
1368 (null (setq dir (woman-canonicalize-dir dir) | 1362 (null (setq dir (woman-canonicalize-dir dir) |
1369 head (file-name-directory dir))) | 1363 head (file-name-directory dir))) |
1370 (woman-file-readable-p head)) | 1364 (woman-file-readable-p head)) |
1371 (setq dirs | 1365 (setq dirs |
1400 The cdr of each alist element is the path-index / filename." | 1394 The cdr of each alist element is the path-index / filename." |
1401 ;; Support 3 levels of caching: each element of the alist `files' | 1395 ;; 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 | 1396 ;; will be a list of the first `woman-cache-level' elements of the |
1403 ;; following list: (topic path-index filename). This alist `files' | 1397 ;; following list: (topic path-index filename). This alist `files' |
1404 ;; is re-processed by `woman-topic-all-completions-merge'. | 1398 ;; is re-processed by `woman-topic-all-completions-merge'. |
1405 (let (dir files (path-index 0)) ; indexing starts at zero | 1399 (let (files (path-index 0)) ; indexing starts at zero |
1406 (while path | 1400 (while path |
1407 (setq dir (pop path)) | 1401 (setq dir (pop path)) |
1408 (if (woman-not-member dir path) ; use each directory only once! | 1402 (if (woman-not-member dir path) ; use each directory only once! |
1409 (push (woman-topic-all-completions-1 dir path-index) | 1403 (push (woman-topic-all-completions-1 dir path-index) |
1410 files)) | 1404 files)) |
1453 "Merge the alist ALIST so that the keys are unique. | 1447 "Merge the alist ALIST so that the keys are unique. |
1454 Also make each path-info component into a list. | 1448 Also make each path-info component into a list. |
1455 \(Note that this function changes the value of ALIST.)" | 1449 \(Note that this function changes the value of ALIST.)" |
1456 ;; Replaces unreadably "optimized" O(n^2) implementation. | 1450 ;; Replaces unreadably "optimized" O(n^2) implementation. |
1457 ;; Instead we use sorting to merge stuff efficiently. -- dak | 1451 ;; Instead we use sorting to merge stuff efficiently. -- dak |
1458 (let (elt newalist) | 1452 (let (newalist) |
1459 ;; Sort list into reverse order | 1453 ;; Sort list into reverse order |
1460 (setq alist (sort alist (lambda(x y) (string< (car y) (car x))))) | 1454 (setq alist (sort alist (lambda(x y) (string< (car y) (car x))))) |
1461 ;; merge duplicate keys. | 1455 ;; merge duplicate keys. |
1462 (if (> woman-cache-level 1) | 1456 (if (> woman-cache-level 1) |
1463 (while alist | 1457 (dolist (elt alist) |
1464 (setq elt (pop alist)) | |
1465 (if (equal (car elt) (caar newalist)) | 1458 (if (equal (car elt) (caar newalist)) |
1466 (unless (member (cdr elt) (cdar newalist)) | 1459 (unless (member (cdr elt) (cdar newalist)) |
1467 (setcdr (car newalist) (cons (cdr elt) | 1460 (setcdr (car newalist) (cons (cdr elt) |
1468 (cdar newalist)))) | 1461 (cdar newalist)))) |
1469 (setcdr elt (list (cdr elt))) | 1462 (setcdr elt (list (cdr elt))) |
1470 (push elt newalist))) | 1463 (push elt newalist))) |
1471 ;; woman-cache-level = 1 => elements are single-element lists ... | 1464 ;; woman-cache-level = 1 => elements are single-element lists ... |
1472 (while alist | 1465 (dolist (elt alist) |
1473 (setq elt (pop alist)) | |
1474 (unless (equal (car elt) (caar newalist)) | 1466 (unless (equal (car elt) (caar newalist)) |
1475 (push elt newalist)))) | 1467 (push elt newalist)))) |
1476 newalist)) | 1468 newalist)) |
1477 | 1469 |
1478 (defun woman-file-name-all-completions (topic) | 1470 (defun woman-file-name-all-completions (topic) |
1494 dir files) | 1486 dir files) |
1495 (if (cdr (car topics)) | 1487 (if (cdr (car topics)) |
1496 ;; Use cached path-info to locate files for each topic: | 1488 ;; Use cached path-info to locate files for each topic: |
1497 (let ((path-info (cdr (assoc topic topics))) | 1489 (let ((path-info (cdr (assoc topic topics))) |
1498 filename) | 1490 filename) |
1499 (while path-info | 1491 (dolist (elt path-info) |
1500 (setq dir (nth (car (car path-info)) path) | 1492 (setq dir (nth (car elt) path) |
1501 filename (car (cdr (car path-info))) | 1493 filename (car (cdr elt)) |
1502 path-info (cdr path-info) | |
1503 files (nconc files | 1494 files (nconc files |
1504 ;; Find the actual file name: | 1495 ;; Find the actual file name: |
1505 (if filename | 1496 (if filename |
1506 (list (concat dir "/" filename)) | 1497 (list (concat dir "/" filename)) |
1507 (directory-files dir t topic-regexp) | 1498 (directory-files dir t topic-regexp) |
1646 (let ((WoMan-current-file filename)) ; used for message logging | 1637 (let ((WoMan-current-file filename)) ; used for message logging |
1647 (if woman-use-own-frame | 1638 (if woman-use-own-frame |
1648 (select-frame | 1639 (select-frame |
1649 (or (and (frame-live-p woman-frame) woman-frame) | 1640 (or (and (frame-live-p woman-frame) woman-frame) |
1650 (setq woman-frame (make-frame))))) | 1641 (setq woman-frame (make-frame))))) |
1651 (switch-to-buffer (get-buffer-create bufname)) | 1642 (set-buffer (get-buffer-create bufname)) |
1643 (condition-case nil | |
1644 (switch-to-buffer (current-buffer)) | |
1645 (error (pop-to-buffer (current-buffer)))) | |
1652 (buffer-disable-undo) | 1646 (buffer-disable-undo) |
1653 (setq buffer-read-only nil) | 1647 (setq buffer-read-only nil) |
1654 (erase-buffer) ; NEEDED for reformat | 1648 (erase-buffer) ; NEEDED for reformat |
1655 (woman-insert-file-contents filename compressed) | 1649 (woman-insert-file-contents filename compressed) |
1656 ;; Set buffer's default directory to that of the file. | 1650 ;; Set buffer's default directory to that of the file. |
1914 ;; necessary when reformatting a file in its old buffer: | 1908 ;; necessary when reformatting a file in its old buffer: |
1915 (setq imenu--last-menubar-index-alist nil) | 1909 (setq imenu--last-menubar-index-alist nil) |
1916 ;; necessary to avoid re-installing the same imenu: | 1910 ;; necessary to avoid re-installing the same imenu: |
1917 (setq woman-imenu-done nil) | 1911 (setq woman-imenu-done nil) |
1918 (if woman-imenu (woman-imenu)) | 1912 (if woman-imenu (woman-imenu)) |
1919 (let (buffer-read-only) | 1913 (let ((inhibit-read-only t)) |
1920 (Man-highlight-references 'WoMan-xref-man-page)) | 1914 (Man-highlight-references 'WoMan-xref-man-page)) |
1921 (set-buffer-modified-p nil) | 1915 (set-buffer-modified-p nil) |
1922 (run-mode-hooks 'woman-mode-hook)) | 1916 (run-mode-hooks 'woman-mode-hook)) |
1923 | 1917 |
1924 (defun woman-imenu (&optional redraw) | 1918 (defun woman-imenu (&optional redraw) |
1954 (apropos-internal "woman" | 1948 (apropos-internal "woman" |
1955 (lambda (symbol) | 1949 (lambda (symbol) |
1956 (or (commandp symbol) | 1950 (or (commandp symbol) |
1957 (user-variable-p symbol))))) | 1951 (user-variable-p symbol))))) |
1958 ;; Filter out any inhibited symbols: | 1952 ;; Filter out any inhibited symbols: |
1959 (let ((tem apropos-accumulator)) | 1953 (dolist (sym apropos-accumulator) |
1960 (while tem | 1954 (if (get sym 'apropos-inhibit) |
1961 (if (get (car tem) 'apropos-inhibit) | 1955 (setq apropos-accumulator (delq sym apropos-accumulator)))) |
1962 (setq apropos-accumulator (delq (car tem) apropos-accumulator))) | |
1963 (setq tem (cdr tem)))) | |
1964 ;; Find documentation strings: | 1956 ;; Find documentation strings: |
1965 (let ((p apropos-accumulator) | 1957 (let ((p apropos-accumulator) |
1966 doc symbol) | 1958 doc symbol) |
1967 (while p | 1959 (while p |
1968 (setcar p (list ; must have 3 elements: | 1960 (setcar p (list ; must have 3 elements: |
2188 (woman-delete-match 0))) | 2180 (woman-delete-match 0))) |
2189 | 2181 |
2190 (defun woman-non-underline-faces () | 2182 (defun woman-non-underline-faces () |
2191 "Prepare non-underlined versions of underlined faces." | 2183 "Prepare non-underlined versions of underlined faces." |
2192 (let ((face-list (face-list))) | 2184 (let ((face-list (face-list))) |
2193 (while face-list | 2185 (dolist (face face-list) |
2194 (let* ((face (car face-list)) | 2186 (let ((face-name (symbol-name face))) |
2195 (face-name (symbol-name face))) | |
2196 (if (and (string-match "\\`woman-" face-name) | 2187 (if (and (string-match "\\`woman-" face-name) |
2197 (face-underline-p face)) | 2188 (face-underline-p face)) |
2198 (let ((face-no-ul (intern (concat face-name "-no-ul")))) | 2189 (let ((face-no-ul (intern (concat face-name "-no-ul")))) |
2199 (copy-face face face-no-ul) | 2190 (copy-face face face-no-ul) |
2200 (set-face-underline-p face-no-ul nil)))) | 2191 (set-face-underline-p face-no-ul nil))))))) |
2201 (setq face-list (cdr face-list))))) | |
2202 | 2192 |
2203 ;; Preprocessors | 2193 ;; Preprocessors |
2204 ;; ============= | 2194 ;; ============= |
2205 | 2195 |
2206 ;; This information is based on documentation for the man command by | 2196 ;; This information is based on documentation for the man command by |
2729 (woman-delete-whole-line)) | 2719 (woman-delete-whole-line)) |
2730 | 2720 |
2731 (defun woman0-rename () | 2721 (defun woman0-rename () |
2732 "Effect renaming required by .rn requests." | 2722 "Effect renaming required by .rn requests." |
2733 ;; For now, do this backwards AFTER all macro expansion. | 2723 ;; For now, do this backwards AFTER all macro expansion. |
2734 (while woman0-rename-alist | 2724 (dolist ((new woman0-rename-alist)) |
2735 (let* ((new (car woman0-rename-alist)) | 2725 (let ((old (cdr new)) |
2736 (old (cdr new)) | 2726 (new (car new))) |
2737 (new (car new))) | |
2738 (setq woman0-rename-alist (cdr woman0-rename-alist)) | |
2739 (goto-char (point-min)) | 2727 (goto-char (point-min)) |
2740 (setq new (concat "^[.'][ \t]*" (regexp-quote new))) | 2728 (setq new (concat "^[.'][ \t]*" (regexp-quote new))) |
2741 (setq old (concat "." old)) | 2729 (setq old (concat "." old)) |
2742 (while (re-search-forward new nil t) | 2730 (while (re-search-forward new nil t) |
2743 (replace-match old nil t))))) | 2731 (replace-match old nil t))))) |
3014 All the octal codes in the ranges [32..127] and [160..255] are displayed | 3002 All the octal codes in the ranges [32..127] and [160..255] are displayed |
3015 together with the corresponding glyphs from the default and symbol fonts. | 3003 together with the corresponding glyphs from the default and symbol fonts. |
3016 Useful for constructing the alist variable `woman-special-characters'." | 3004 Useful for constructing the alist variable `woman-special-characters'." |
3017 (interactive) | 3005 (interactive) |
3018 (with-output-to-temp-buffer "*WoMan Extended Font Map*" | 3006 (with-output-to-temp-buffer "*WoMan Extended Font Map*" |
3019 (save-excursion | 3007 (with-current-buffer standard-output |
3020 (set-buffer standard-output) | |
3021 (let ((i 32)) | 3008 (let ((i 32)) |
3022 (while (< i 256) | 3009 (while (< i 256) |
3023 (insert (format "\\%03o " i) (string i) " " (string i)) | 3010 (insert (format "\\%03o " i) (string i) " " (string i)) |
3024 (put-text-property (1- (point)) (point) | 3011 (put-text-property (1- (point)) (point) |
3025 'face 'woman-symbol) | 3012 'face 'woman-symbol) |
3918 ((eq c ?\ ) ; skip | 3905 ((eq c ?\ ) ; skip |
3919 (forward-char)) | 3906 (forward-char)) |
3920 ((eq c ?\t) ; skip | 3907 ((eq c ?\t) ; skip |
3921 (if (eq (following-char) ?\t) | 3908 (if (eq (following-char) ?\t) |
3922 (forward-char) ; both tabs, just skip | 3909 (forward-char) ; both tabs, just skip |
3923 (let ((i woman-tab-width)) | 3910 (dotimes (i woman-tab-width) |
3924 (while (> i 0) | 3911 (if (eolp) |
3925 (if (eolp) | 3912 (insert ?\ ) ; extend line |
3926 (insert ?\ ) ; extend line | 3913 (forward-char)) ; skip |
3927 (forward-char)) ; skip | |
3928 (setq i (1- i))) | |
3929 ))) | 3914 ))) |
3930 (t | 3915 (t |
3931 (if (or (eq (following-char) ?\ ) ; overwrite OK | 3916 (if (or (eq (following-char) ?\ ) ; overwrite OK |
3932 overwritten) ; warning only once per ".sp -" | 3917 overwritten) ; warning only once per ".sp -" |
3933 () | 3918 () |
4310 (delete-char 1) | 4295 (delete-char 1) |
4311 (delete-horizontal-space) | 4296 (delete-horizontal-space) |
4312 ;; Necessary to avoid spaces inheriting underlines. | 4297 ;; Necessary to avoid spaces inheriting underlines. |
4313 ;; Cannot simply delete (current-column) whitespace | 4298 ;; Cannot simply delete (current-column) whitespace |
4314 ;; characters because some may be tabs! | 4299 ;; characters because some may be tabs! |
4315 (while (> i 0) (insert ? ) (setq i (1- i))))) | 4300 (insert-char ?\s i))) |
4316 (goto-char to) ; necessary ??? | 4301 (goto-char to) ; necessary ??? |
4317 )) | 4302 )) |
4318 )) | 4303 )) |
4319 | 4304 |
4320 (defun woman2-HP (to) | 4305 (defun woman2-HP (to) |
4466 n (save-excursion | 4451 n (save-excursion |
4467 (search-forward "\t" eol t)) | 4452 (search-forward "\t" eol t)) |
4468 n (- (if n (1- n) eol) (point)) | 4453 n (- (if n (1- n) eol) (point)) |
4469 tab (- tab (if (eq type ?C) (/ n 2) n))) ) | 4454 tab (- tab (if (eq type ?C) (/ n 2) n))) ) |
4470 (setq n (- tab (current-column))) | 4455 (setq n (- tab (current-column))) |
4471 (while (> n 0) | 4456 (insert-char ?\s n)) |
4472 (insert ?\ ) | |
4473 (setq n (1- n)))) | |
4474 (insert ?\ )))) | 4457 (insert ?\ )))) |
4475 | 4458 |
4476 (defun woman2-DT (to) | 4459 (defun woman2-DT (to) |
4477 ".DT -- Restore default tabs. Format paragraphs upto TO. | 4460 ".DT -- Restore default tabs. Format paragraphs upto TO. |
4478 \(Breaks, but should not.)" | 4461 \(Breaks, but should not.)" |
4569 (defvar WoMan-Log-header-point-max nil) | 4552 (defvar WoMan-Log-header-point-max nil) |
4570 | 4553 |
4571 (defun WoMan-log-begin () | 4554 (defun WoMan-log-begin () |
4572 "Log the beginning of formatting in *WoMan-Log*." | 4555 "Log the beginning of formatting in *WoMan-Log*." |
4573 (let ((WoMan-current-buffer (buffer-name))) | 4556 (let ((WoMan-current-buffer (buffer-name))) |
4574 (save-excursion | 4557 (with-current-buffer (get-buffer-create "*WoMan-Log*") |
4575 (set-buffer (get-buffer-create "*WoMan-Log*")) | |
4576 (or (eq major-mode 'view-mode) (view-mode 1)) | 4558 (or (eq major-mode 'view-mode) (view-mode 1)) |
4577 (setq buffer-read-only nil) | 4559 (setq buffer-read-only nil) |
4578 (goto-char (point-max)) | 4560 (goto-char (point-max)) |
4579 (insert "\n\^L\nFormatting " | 4561 (insert "\n\^L\nFormatting " |
4580 (if (stringp WoMan-current-file) | 4562 (if (stringp WoMan-current-file) |
4613 | 4595 |
4614 (defun WoMan-log-1 (string &optional end) | 4596 (defun WoMan-log-1 (string &optional end) |
4615 "Log a message STRING in *WoMan-Log*. | 4597 "Log a message STRING in *WoMan-Log*. |
4616 If optional argument END is non-nil then make buffer read-only after | 4598 If optional argument END is non-nil then make buffer read-only after |
4617 logging the message." | 4599 logging the message." |
4618 (save-excursion | 4600 (with-current-buffer (get-buffer-create "*WoMan-Log*") |
4619 (set-buffer (get-buffer-create "*WoMan-Log*")) | |
4620 (setq buffer-read-only nil) | 4601 (setq buffer-read-only nil) |
4621 (goto-char (point-max)) | 4602 (goto-char (point-max)) |
4622 (or end (insert " ")) (insert string "\n") | 4603 (or end (insert " ")) (insert string "\n") |
4623 (if end | 4604 (if end |
4624 (setq buffer-read-only t) | 4605 (setq buffer-read-only t) |
4633 ))))) | 4614 ))))) |
4634 nil) ; for woman-file-readable-p etc. | 4615 nil) ; for woman-file-readable-p etc. |
4635 | 4616 |
4636 (provide 'woman) | 4617 (provide 'woman) |
4637 | 4618 |
4638 ;;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 | 4619 ;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651 |
4639 ;;; woman.el ends here | 4620 ;;; woman.el ends here |