;; -*- mode: emacs-lisp; coding: hebrew-iso-8bit-unix; -*- ;; ek-man.el --- Enhancments to man pages (fontify) ;; Copyright (C) 1998-2000 Ehud karni ;; This file is NOT part of GNU Emacs, distribution conditions below. ;; ;; EHUD KARNI ינרק דוהא ;; Ben Gurion st' 14 ןוירוג ןב 'חר ;; Kfar - Sava 44 257 אבס - רפכ ;; =================================== ;; 972-(0)9-7659599 ;; =================================== ;; RCS: $Id: ek-man.el,v 1.101 2000/03/05 14:45:32 ehud Exp ehud $ ;; ;; LOG: $Log: ek-man.el,v $ ;; LOG: Revision 1.101 2000/03/05 14:45:32 ehud ;; LOG: Comment headers changes (NOT GNU) + 1 line fix for 20.5 ;; LOG: ;; Revision 1.100 1998/11/11 14:35:53 ehud ;; Initial RCS (and last for 19.34) version ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (setq current-language-environment "none") ;; needed in 20.5 (require 'man) ;; ensure man is loaded (define-key Man-mode-map "+" 'Man-next-manpage) (define-key Man-mode-map "-" 'Man-previous-manpage) (define-key Man-mode-map "b" 'beginning-of-buffer) (define-key Man-mode-map "e" 'end-of-buffer) (define-key Man-mode-map "h" 'describe-mode) (setq Man-filter-list (list (cons Man-sed-command (list (if Man-sed-script (concat "-e '" Man-sed-script "'") "") "-e '/^[\001-\032][\001-\032]*$/d'" "-e '/\e[789]/s///g'" "-e '/[Nn]o such file or directory/d'" ;; EK "-e '/Reformatting page. Wait/d'" "-e '/Reformatting entry. Wait/d'" "-e '/^[ \t]*\\([A-Za-z][A-Za-z]*([0-9][A-Za-z]*)\\).*\\1$/d'" ;; EK "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'" "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'" "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'" "-e '/^[ \t]*Page[ \t]*[0-9][0-9]*[ \t]*$/d'" ;; EK "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'" "-e '/^Printed[ \t][0-9].*[0-9]$/d'" "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'" "-e '/^[A-za-z].*Last[ \t]change:/d'" "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'" "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'" "-e '/Licensed material--property of copyright holder.*$/d'" ;; EK "-e '/^[ \t]*GNU Project[ \t]*[0-9][0-9]*.[A-Za-z]*.[0-9][0-9]*[ \t]*[0-9][0-9]*[ \t]*$/d'" ;; EK "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'" )) (cons Man-awk-command (list "'\n" "BEGIN { blankline=0; anonblank=0; }\n" "/^[ \t]*$/ { blankline++; next; }\n" "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" "'" )) (if (not Man-uses-untabify-flag) (cons Man-untabify-command Man-untabify-command-args) ) )) (setq Man-bold-under-face 'bold-under) (defun Man-getpage-in-background (topic) "Ehud Karni hack for decoration on DG-UX. Uses TOPIC to build and fire off the manpage and cleaning command." (let* ((man-args topic) (bufname (concat "*Man " man-args "*")) (buffer (get-buffer bufname))) (if buffer (Man-notify-when-ready buffer) (require 'env) (message "Invoking %s %s in the background" manual-program man-args) (setq buffer (generate-new-buffer bufname)) (save-excursion (set-buffer buffer) (setq Man-original-frame (selected-frame)) (setq Man-arguments man-args)) (let ((process-environment (copy-sequence process-environment))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" (if faces-on "ansi" "dumb")) (set-process-sentinel (start-process manual-program buffer "sh" "-c" (format (Man-build-man-command) man-args)) 'Man-bgproc-sentinel))))) (defun Man-fontify-manpage () "Ehud Karni hack - fix original bug in _\\b. Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." (interactive) (let* (overwrite-mode ;; set to insert because of bug in backward-delete-char (bold 'bold) (new_under '(Man-underline-face (bold Man-bold-under-face) (Man-overstrike-face Man-bold-under-face) (Man-bold-under-face Man-bold-under-face))) (new_bold '(bold (Man-underline-face Man-bold-under-face) (Man-bold-under-face Man-bold-under-face))) (new_over '(Man-overstrike-face (Man-underline-face Man-bold-under-face) (Man-bold-under-face Man-bold-under-face))) ) (message "Please wait: making up the %s man page..." Man-arguments) (goto-char (point-min)) (while (search-forward "\e[1m" nil t) (delete-backward-char 4) (put-text-property (point) (progn (if (search-forward "\e[0m" nil 'move) (delete-backward-char 4)) (point)) 'face Man-overstrike-face)) (goto-char (point-min)) (while (search-forward "\e[4;1;m" nil t) (delete-backward-char 7) (put-text-property (point) (progn (if (search-forward "\e[0m" nil 'move) (delete-backward-char 4)) (point)) 'face Man-bold-under-face)) (goto-char (point-min)) (while (search-forward "\e[4m" nil t) (delete-backward-char 4) (put-text-property (point) (progn (if (search-forward "\e[m" nil 'move) (delete-backward-char 3)) (point)) 'face bold)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b\\1\\)" nil t) (backward-delete-char 2) (Man-fontify-manpage-char new_over)) (goto-char (point-min)) (while (search-forward "_\b" nil t) (backward-delete-char 2) (forward-char 1) (Man-fontify-manpage-char new_under)) (goto-char (point-min)) (while (search-forward "\b_" nil t) (backward-delete-char 2) (Man-fontify-manpage-char new_under)) (goto-char (point-min)) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "#") (Man-fontify-manpage-char new_bold)) (goto-char (point-min)) (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+") (Man-fontify-manpage-char new_bold)) ;; \255 is some kind of dash in Latin-1. (goto-char (point-min)) (while (search-forward "\255" nil t) (replace-match "-")) (message "%s man page made up" Man-arguments))) (defun Man-fontify-manpage-char (face-rep-list) "set new face to current char according to current face. FACE-REP-LIST is list of defualt new-face and pairs: current-face, new-face. e.g. ('bold ('under 'bold-under) ('revers 'bold-revers))" (let* ((def-face (car face-rep-list)) ;; use this if none or not in the list (pos (1- (point))) ;; current position (-1) (cf (get-text-property pos 'face)) ;; current face (may be nil) of nf) ;; pair: old-face, new-face (setq face-rep-list (cdr face-rep-list));; skip def new face (if cf (while face-rep-list (and (equal cf (symbol-value (car (car face-rep-list)))) (setq def-face (nth 1 (car face-rep-list))) (setq face-rep-list '())) (setq face-rep-list (cdr face-rep-list)))) (put-text-property pos (1+ pos) 'face (symbol-value def-face)) (goto-char pos))) ;; back 1 char ! ;;============================ end of ek-man ===================================