Mercurial > hg > xemacs-beta
changeset 6:27bc7f280385 r19-15b4
Import from CVS: tag r19-15b4
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:47:15 +0200 |
| parents | 49b78a777eb4 |
| children | c153ca296910 |
| files | CHANGES-beta Makefile.in configure.in lisp/comint/telnet.el lisp/electric/ebuff-menu.el lisp/ilisp/ilisp-out.el lisp/modes/cc-mode.el lisp/modes/eiffel3.el lisp/packages/buff-menu.el lisp/packages/compile.el lisp/packages/jwz-man.el lisp/packages/lpr.el lisp/packages/mic-paren.el lisp/packages/old-man.el lisp/packages/ps-print.el lisp/packages/vc.el lisp/prim/files.el lisp/prim/lisp.el lisp/prim/loaddefs.el lisp/prim/minibuf.el lisp/prim/mouse.el lisp/prim/simple.el lisp/prim/startup.el lisp/utils/mail-extr.el lisp/version.el lisp/x11/x-menubar.el site-lisp/emu-e19.el site-lisp/emu-xemacs.el site-lisp/emu.el site-lisp/richtext.el src/cmds.c src/device-x.c src/glyphs-x.c src/s/hpux10.h src/s/hpux9shxr4.h |
| diffstat | 35 files changed, 1884 insertions(+), 1864 deletions(-) [+] |
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 08:46:57 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 08:47:15 2007 +0200 @@ -1,4 +1,14 @@ -*- indented-text -*- +to 19.15 beta4 +-- Default JPEG image loading is now old tempfile code, but should work again. +-- Miscellaneous bug fixes courtesy of Christoph Wedler +-- mic-paren.el courtesy of Mikael Sjödin +-- lpr.el/ps-print.el - Allow dynamic expansion of + lpr-switches/ps-lpr-switches. +-- Lisp Bug fixes +-- Install info files compressed (courtesy of Joseph J Nuspl) +-- Default locking for Linux is now .lock locking + to 19.15 beta3 -- EDT/TPU modes synched from GNU Emacs, should actually work for the first
--- a/Makefile.in Mon Aug 13 08:46:57 2007 +0200 +++ b/Makefile.in Mon Aug 13 08:47:15 2007 +0200 @@ -394,6 +394,7 @@ vm* w3* xemacs* ; do \ ${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f ; \ chmod 0644 ${infodir}/$$f; \ + gzip -9 ${infodir}/$$f; \ done); \ else true; fi cd ${srcdir}/etc; for page in xemacs etags ctags gnuserv \
--- a/configure.in Mon Aug 13 08:46:57 2007 +0200 +++ b/configure.in Mon Aug 13 08:47:15 2007 +0200 @@ -2360,13 +2360,13 @@ if [ "${dynamic}" = "yes" ]; then case "${opsys}" in - hpux8 ) opsys=hpux8shr ;; - hpux9 ) opsys=hpux9shr ;; - hpux10 ) opsys=hpux10shr ;; - sunos4-0 ) opsys=sunos4-0shr ;; - sunos4-1 ) opsys=sunos4-1shr ;; - sunos4-1-2 ) opsys=sunos4-1-2shr ;; - sunos4-1-3 ) opsys=sunos4-1-3shr ;; + hpux8 ) opsys=hpux8-shr ;; + hpux9 ) opsys=hpux9-shr ;; + hpux10 ) opsys=hpux10-shr ;; + sunos4-0 ) opsys=sunos4-0-shr ;; + sunos4-1 ) opsys=sunos4-1-shr ;; + sunos4-1-2 ) opsys=sunos4-1-2-shr ;; + sunos4-1-3 ) opsys=sunos4-1-3-shr ;; sco5 ) opsys=sco5-shr ;; esac elif [ "${dynamic}" = "no" ]; then @@ -2539,8 +2539,16 @@ #### Some systems specify a CPP to use unless we are using GCC. #### Now that we know whether we are using GCC, we can decide whether #### to use that one. -if [ "x$NON_GNU_CPP" = x ] || [ x$GCC = x1 ] -then true + +#### Also, GNU CPP by default defines certain add'l macros that could +#### hurt us when generating makefiles. We want to switch off these +#### add'l macros for the purpose of generating makefiles. + +CPPFLAGS_MAKEFILEGEN="" +if [ "x$GCC" = x1 ] ; then + CPPFLAGS_MAKEFILEGEN=" -undef " +elif [ "x$NON_GNU_CPP" = x ] ; then + true else if [ "x$CPP" = x ]; then if [ "${with_lcc}" = "yes" ] && [ "${NON_GNU_CPP}" = "yes" ] ; then @@ -4456,7 +4464,7 @@ ( cd ./src; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; - eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; + eval `echo ${CPP} ${CPPFLAGS_MAKEFILEGEN} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ @@ -4473,7 +4481,7 @@ ( cd ./lwlib; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; - eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; + eval `echo ${CPP} ${CPPFLAGS_MAKEFILEGEN} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ @@ -4490,7 +4498,7 @@ ( cd ./lib-src; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; - eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; + eval `echo ${CPP} ${CPPFLAGS_MAKEFILEGEN} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ @@ -4507,7 +4515,7 @@ ( cd ./dynodump; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; - eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; + eval `echo ${CPP} ${CPPFLAGS_MAKEFILEGEN} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ @@ -4524,7 +4532,7 @@ ( cd ./man; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; - eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; + eval `echo ${CPP} ${CPPFLAGS_MAKEFILEGEN} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ @@ -4542,7 +4550,7 @@ ( cd ./lwlib/energize; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; - eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; + eval `echo ${CPP} ${CPPFLAGS_MAKEFILEGEN} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\
--- a/lisp/comint/telnet.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/comint/telnet.el Mon Aug 13 08:47:15 2007 +0200 @@ -102,7 +102,10 @@ ; initialization on first load. (if telnet-mode-map nil - (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map)) + ;; FSF + ;; (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map)) + (setq telnet-mode-map (make-sparse-keymap)) + (set-keymap-parents telnet-mode-map (list comint-mode-map)) (define-key telnet-mode-map "\C-m" 'telnet-send-input) ; (define-key telnet-mode-map "\C-j" 'telnet-send-input) (define-key telnet-mode-map "\C-c\C-q" 'send-process-next-char)
--- a/lisp/electric/ebuff-menu.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/electric/ebuff-menu.el Mon Aug 13 08:47:15 2007 +0200 @@ -42,7 +42,7 @@ (defvar electric-buffer-menu-mode-map nil) ;;;###autoload -(defun electric-buffer-list (arg) +(defun electric-buffer-list (&optional files-only) "Pops up a buffer describing the set of Emacs buffers. Vaguely like ITS lunar select buffer; combining typeoutoid buffer listing with menuoid buffer selection. @@ -57,11 +57,16 @@ Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. +Non-null optional arg FILES-ONLY means mention only file buffers. +When called from Lisp code, FILES-ONLY may be a regular expression, +in which case only buffers whose names match that expression are listed, +or an arbitrary predicate function. + \\{electric-buffer-menu-mode-map}" - (interactive "P") + (interactive (list (if current-prefix-arg t nil))) (let (select buffer) (save-window-excursion - (save-window-excursion (list-buffers arg)) + (save-window-excursion (list-buffers files-only)) (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*"))) (unwind-protect (progn
--- a/lisp/ilisp/ilisp-out.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/ilisp/ilisp-out.el Mon Aug 13 08:47:15 2007 +0200 @@ -262,7 +262,8 @@ "Find the window directly below us, if any. This is probably the window from which enlarge-window would steal lines." (if (or (not (string-match "XEmacs" emacs-version)) - (< emacs-minor-version 12)) + (and (= emacs-major-version 19) + (< emacs-minor-version 12))) (let* ((bottom (nth 3 (window-edges window))) (window* nil) (win window)) @@ -279,7 +280,8 @@ (defun ilisp-find-top-left-most-window () "Return the leftmost topmost window on the current screen." (if (or (not (string-match "XEmacs" emacs-version)) - (< emacs-minor-version 12)) + (and (= emacs-major-version 19) + (< emacs-minor-version 12))) (let* ((window* (selected-window)) (edges* (window-edges window*)) (win nil)
--- a/lisp/modes/cc-mode.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/modes/cc-mode.el Mon Aug 13 08:47:15 2007 +0200 @@ -1157,10 +1157,10 @@ ;; cmacexp is lame because it uses no preprocessor symbols. ;; It isn't very extensible either -- hardcodes /lib/cpp. ;; [I add it here only because c-mode has it -- BAW] -;(autoload 'c-macro-expand "cmacexp" -; "Display the result of expanding all C macros occurring in the region. -;The expansion is entirely correct because it uses the C preprocessor." -; t) +(autoload 'c-macro-expand "cmacexp" + "Display the result of expanding all C macros occurring in the region. +The expansion is entirely correct because it uses the C preprocessor." + t) ;; constant regular expressions for looking at various constructs @@ -1261,6 +1261,7 @@ ;; main entry points for the modes (defconst c-list-of-mode-names nil) +;;;###autoload (defun c-mode () "Major mode for editing K&R and ANSI C code. To submit a problem report, enter `\\[c-submit-bug-report]' from a @@ -1296,6 +1297,7 @@ (run-hooks 'c-mode-hook)) (setq c-list-of-mode-names (cons "C" c-list-of-mode-names)) +;;;###autoload (defun c++-mode () "Major mode for editing C++ code. To submit a problem report, enter `\\[c-submit-bug-report]' from a @@ -1334,6 +1336,7 @@ (run-hooks 'c++-mode-hook)) (setq c-list-of-mode-names (cons "C++" c-list-of-mode-names)) +;;;###autoload (defun objc-mode () "Major mode for editing Objective C code. To submit a problem report, enter `\\[c-submit-bug-report]' from an @@ -1372,6 +1375,7 @@ (run-hooks 'objc-mode-hook)) (setq c-list-of-mode-names (cons "ObjC" c-list-of-mode-names)) +;;;###autoload (defun java-mode () "Major mode for editing Java code. To submit a problem report, enter `\\[c-submit-bug-report]' from an @@ -2332,6 +2336,7 @@ ))) stylevars)) +;;;###autoload (defun c-set-style (stylename) "Set cc-mode variables to use one of several different indentation styles. STYLENAME is a string representing the desired style from the list of
--- a/lisp/modes/eiffel3.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/modes/eiffel3.el Mon Aug 13 08:47:15 2007 +0200 @@ -1,4 +1,4 @@ -;;; $Id: eiffel3.el,v 1.1.1.2 1996/12/18 03:44:36 steve Exp $ +;;; $Id: eiffel3.el,v 1.1.1.3 1996/12/18 04:03:07 steve Exp $ ;;;-------------------------------------------------------------------------- ;;; TowerEiffel -- Copyright (c) 1993-1996 Tower Technology Corporation. ;;; All Rights Reserved. @@ -1770,7 +1770,7 @@ (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?; "." table) + (modify-syntax-entry ?\; "." table) (modify-syntax-entry ?: "." table) (modify-syntax-entry ?! "." table) (modify-syntax-entry ?. "." table)
--- a/lisp/packages/buff-menu.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/packages/buff-menu.el Mon Aug 13 08:47:15 2007 +0200 @@ -96,8 +96,8 @@ (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table) (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only) (define-key Buffer-menu-mode-map "g" 'revert-buffer) - (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select) - (define-key Buffer-menu-mode-map [mouse-3] 'Buffer-menu-popup-menu) + (define-key Buffer-menu-mode-map 'button2 'Buffer-menu-mouse-select) + (define-key Buffer-menu-mode-map 'button3 'Buffer-menu-popup-menu) ) ;; Buffer Menu mode is suitable only for specially formatted data. @@ -489,7 +489,10 @@ (make-variable-buffer-local 'list-buffers-identification) ;; XEmacs +;;;###autoload (defvar list-buffers-directory) + +;;;###autoload (make-variable-buffer-local 'list-buffers-directory) ;; #### not synched
--- a/lisp/packages/compile.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/packages/compile.el Mon Aug 13 08:47:15 2007 +0200 @@ -303,7 +303,7 @@ (defvar grep-history nil) ;; XEmacs -(defconst compilation-font-lock-keywords (purecopy +(defvar compilation-font-lock-keywords (purecopy (list '("^[-_.\"A-Za-z0-9/+]+\\(:\\|, line \\)[0-9]+: \\([wW]arning:\\).*$" . font-lock-keyword-face)
--- a/lisp/packages/jwz-man.el Mon Aug 13 08:46:57 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,529 +0,0 @@ -;;; man.el --- browse UNIX manual pages -;; Keywords: help - -;; Copyright (C) 1985, 1993, 1994, 1996 Free Software Foundation, Inc. -;; -;; This file is part of XEmacs. - -;; XEmacs 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, or (at your option) -;; any later version. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;; This file defines "manual-entry", and the remaining definitions all -;; begin with "Manual-". This makes the autocompletion on "M-x man" work. -;; -;; Eviscerated 26-Jun-96 by Jamie Zawinski <jwz@netscape.com>. -;; All that stuff about looking at $MANPATH and building up lists of -;; directories was bullshit. Now we just invoke "man" and format the -;; output, end of story. -;; -;; [ older changelog entries removed, since they're all about code that -;; I've deleted. ] - -(defvar Manual-program "man" "\ -*Name of the program to invoke in order to format the source man pages.") - -(defvar Manual-buffer-view-mode t "\ -*Whether manual buffers should be placed in view-mode. -nil means leave the buffer in fundamental-mode in another window. -t means use `view-buffer' to display the man page in the current window. -Any other value means use `view-buffer-other-window'.") - -(defvar Manual-mode-hook nil - "Function or functions run on entry to Manual-mode.") - -(defvar Manual-page-history nil "\ -A list of names of previously visited man page buffers.") - - -;; New variables. - -(make-face 'man-italic) -(or (face-differs-from-default-p 'man-italic) - (copy-face 'italic 'man-italic)) -;; XEmacs (from Darrell Kindred): underlining is annoying due to -;; large blank spaces in this face. -;; (or (face-differs-from-default-p 'man-italic) -;; (set-face-underline-p 'man-italic t)) - -(make-face 'man-bold) -(or (face-differs-from-default-p 'man-bold) - (copy-face 'bold 'man-bold)) -(or (face-differs-from-default-p 'man-bold) - (copy-face 'man-italic 'man-bold)) - -(make-face 'man-heading) -(or (face-differs-from-default-p 'man-heading) - (copy-face 'man-bold 'man-heading)) - -(make-face 'man-xref) -(or (face-differs-from-default-p 'man-xref) - (set-face-underline-p 'man-xref t)) - -(defvar Manual-mode-map - (let ((m (make-sparse-keymap))) - (set-keymap-name m 'Manual-mode-map) - (define-key m "l" 'Manual-last-page) - (define-key m 'button2 'Manual-follow-xref) - (define-key m 'button3 'Manual-popup-menu) - m)) - -;;;###autoload -(defun manual-entry (topic &optional arg silent) - "Display the Unix manual entry (or entries) for TOPIC." - (interactive - (list (let* ((fmh "-A-Za-z0-9_.") - (default (save-excursion - (buffer-substring - (progn - (re-search-backward "\\sw" nil t) - (skip-chars-backward fmh) (point)) - (progn (skip-chars-forward fmh) (point))))) - (thing (read-string - (if (equal default "") "Manual entry: " - (concat "Manual entry: (default " default ") "))))) - (if (equal thing "") default thing)) - (prefix-numeric-value current-prefix-arg))) - ;;(interactive "sManual entry (topic): \np") - (or arg (setq arg 1)) - (let (section apropos-mode) - (let ((case-fold-search nil)) - (if (and (null section) - (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" - topic)) - (setq section (substring topic (match-beginning 2) - (match-end 2)) - topic (substring topic (match-beginning 1) - (match-end 1))) - (if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic) - (setq section "-k" - topic (substring topic (match-beginning 1)))))) - - ;; jwz: turn section "3x11" and "3n" into "3". - (if (and section (string-match "\\`\\([0-9]+\\)[^0-9]" section)) - (setq section (substring section 0 (match-end 1)))) - (if (equal section "-k") - (setq apropos-mode t)) - - (let ((bufname (cond (apropos-mode - (concat "*man apropos " topic "*")) - (t - (concat "*man " topic - (if section (concat "." section) "") - "*")))) - (temp-buffer-show-function - (cond ((eq 't Manual-buffer-view-mode) - 'view-buffer) - ((eq 'nil Manual-buffer-view-mode) - temp-buffer-show-function) - (t - 'view-buffer-other-window)))) - - (cond ((get-buffer bufname) - ;; reselect an old man page buffer if it exists already. - (save-excursion - (set-buffer (get-buffer bufname)) - (Manual-mode)) - (if temp-buffer-show-function - (funcall temp-buffer-show-function (get-buffer bufname)) - (display-buffer bufname))) - (t - (with-output-to-temp-buffer bufname - (buffer-disable-undo standard-output) - (save-excursion - (set-buffer standard-output) - (setq buffer-read-only nil) - (erase-buffer) - - (let ((args (list topic)) - args-string) - (if section - (setq args - (if (eq system-type 'usg-unix-v) - (cons "-s" (cons section args)) - (cons section args)))) - (setq args-string - (mapconcat 'identity (cons Manual-program args) " ")) - (if (string-match "\\`\\([^ \t/]*/\\)+" args-string) - (setq args-string - (substring args-string (match-end 0)))) - - (message "%s (running...)" args-string) - (apply 'call-process Manual-program nil t nil args) - - (if (< (buffer-size) 200) - (progn - (goto-char (point-min)) - (error (buffer-substring (point) - (progn (end-of-line) - (point)))))) - - (message "%s (cleaning...)" args-string) - (Manual-nuke-nroff-bs apropos-mode) - (message "%s (done.)" args-string) - ) - - (set-buffer-modified-p nil) - (Manual-mode) - )))) - (setq Manual-page-history - (cons (buffer-name) - (delete (buffer-name) Manual-page-history))))) - (message nil) - t) - -(defun Manual-mode () - (kill-all-local-variables) - (setq buffer-read-only t) - (use-local-map Manual-mode-map) - (setq major-mode 'Manual-mode - mode-name "Manual") - ;; man pages with long lines are buggy! - ;; This looks slightly better if they only - ;; overran by a couple of chars. - (setq truncate-lines t) - ;; turn off horizontal scrollbars in this buffer - (set-specifier scrollbar-height (cons (current-buffer) 0)) - (run-hooks 'Manual-mode-hook)) - -(defun Manual-last-page () - (interactive) - (while (or (not (get-buffer (car (or Manual-page-history - (error "No more history."))))) - (eq (get-buffer (car Manual-page-history)) (current-buffer))) - (setq Manual-page-history (cdr Manual-page-history))) - (switch-to-buffer (car Manual-page-history))) - - -(defmacro Manual-delete-char (n) - ;; in v19, delete-char is compiled as a function call, but delete-region - ;; is byte-coded, so it's much faster. (We were spending 40% of our time - ;; in delete-char alone.) - (list 'delete-region '(point) (list '+ '(point) n))) - -;; Hint: BS stands form more things than "back space" -(defun Manual-nuke-nroff-bs (&optional apropos-mode) - (interactive "*") - ;; - ;; turn underlining into italics - ;; - (goto-char (point-min)) - (while (search-forward "_\b" nil t) - ;; searching for underscore-backspace and then comparing the following - ;; chars until the sequence ends turns out to be much faster than searching - ;; for a regexp which matches the whole sequence. - (let ((s (match-beginning 0))) - (goto-char s) - (while (and (= (following-char) ?_) - (= (char-after (1+ (point))) ?\b)) - (Manual-delete-char 2) - (forward-char 1)) - (set-extent-face (make-extent s (point)) 'man-italic))) - ;; - ;; turn overstriking into bold - ;; - (goto-char (point-min)) - (while (re-search-forward "\\([^\n]\\)\\(\b\\1\\)" nil t) - ;; Surprisingly, searching for the above regexp is faster than searching - ;; for a backspace and then comparing the preceding and following chars, - ;; I presume because there are many false matches, meaning more funcalls - ;; to re-search-forward. - (let ((s (match-beginning 0))) - (goto-char s) - ;; Some systems (SGI) overstrike multiple times, eg, "M\bM\bM\bM". - (while (looking-at "\\([^\n]\\)\\(\b\\1\\)+") - (delete-region (+ (point) 1) (match-end 0)) - (forward-char 1)) - (set-extent-face (make-extent s (point)) 'man-bold))) - ;; - ;; hack bullets: o^H+ --> + - (goto-char (point-min)) - (while (search-forward "\b" nil t) - (Manual-delete-char -2)) - - (if (> (buffer-size) 100) ; minor kludge - (Manual-nuke-nroff-bs-footers)) - ;; - ;; turn subsection header lines into bold - ;; - (goto-char (point-min)) - (if apropos-mode - (while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t) - (forward-char -2) - (delete-backward-char 1)) - - ;; (while (re-search-forward "^[^ \t\n]" nil t) - ;; (set-extent-face (make-extent (match-beginning 0) - ;; (progn (end-of-line) (point))) - ;; 'man-heading)) - - ;; boldface the first line - (if (looking-at "[^ \t\n].*$") - (set-extent-face (make-extent (match-beginning 0) (match-end 0)) - 'man-bold)) - - ;; boldface subsequent title lines - ;; Regexp to match section headers changed to match a non-indented - ;; line preceded by a blank line and followed by an indented line. - ;; This seems to work ok for manual pages but gives better results - ;; with other nroff'd files - (while (re-search-forward "\n\n\\([^ \t\n].*\\)\n[ \t]+[^ \t\n]" nil t) - (goto-char (match-end 1)) - (set-extent-face (make-extent (match-beginning 1) (match-end 1)) - 'man-heading) - (forward-line 1)) - ) - - ;; Zap ESC7, ESC8, and ESC9 - ;; This is for Sun man pages like "man 1 csh" - (goto-char (point-min)) - (while (re-search-forward "\e[789]" nil t) - (replace-match "")) - - ;; Nuke blanks lines at start. - ;; (goto-char (point-min)) - ;; (skip-chars-forward "\n") - ;; (delete-region (point-min) (point)) - - (Manual-mouseify-xrefs) - ) - -(fset 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name - - -(defun Manual-nuke-nroff-bs-footers () - ;; Nuke headers and footers. - ;; - ;; nroff assumes pages are 66 lines high. We assume that, and that the - ;; first and last line on each page is expendible. There is no way to - ;; tell the difference between a page break in the middle of a paragraph - ;; and a page break between paragraphs (the amount of extra whitespace - ;; that nroff inserts is the same in both cases) so this might strip out - ;; a blank line were one should remain. I think that's better than - ;; leaving in a blank line where there shouldn't be one. (Need I say - ;; it: FMH.) - ;; - ;; Note that if nroff spits out error messages, pages will be more than - ;; 66 lines high, and we'll lose badly. That's ok because standard - ;; nroff doesn't do any diagnostics, and the "gnroff" wrapper for groff - ;; turns off error messages for compatibility. (At least, it's supposed - ;; to.) - ;; - (goto-char (point-min)) - ;; first lose the status output - (let ((case-fold-search t)) - (if (and (not (looking-at "[^\n]*warning")) - (looking-at "Reformatting.*\n")) - (delete-region (match-beginning 0) (match-end 0)))) - - ;; kludge around a groff bug where it won't keep quiet about some - ;; warnings even with -Wall or -Ww. - (cond ((looking-at "grotty:") - (while (looking-at "grotty:") - (delete-region (point) (progn (forward-line 1) (point)))) - (if (looking-at " *done\n") - (delete-region (point) (match-end 0))))) - - (let ((pages '()) - p) - ;; collect the page boundary markers before we start deleting, to make - ;; it easier to strip things out without changing the page sizes. - (while (not (eobp)) - (forward-line 66) - (setq pages (cons (point-marker) pages))) - (setq pages (nreverse pages)) - (while pages - (goto-char (car pages)) - (set-marker (car pages) nil) - ;; - ;; The lines are: 3 blank; footer; 6 blank; header; 3 blank. - ;; We're in between the previous footer and the following header, - ;; - ;; First lose 3 blank lines, the header, and then 3 more. - ;; - (setq p (point)) - (skip-chars-forward "\n") - (delete-region p (point)) - (and (looking-at "[^\n]+\n\n?\n?\n?") - (delete-region (match-beginning 0) (match-end 0))) - ;; - ;; Next lose the footer, and the 3 blank lines after, and before it. - ;; But don't lose the last footer of the manual entry; that contains - ;; the "last change" date, so it's not completely uninteresting. - ;; (Actually lose all blank lines before it; sh(1) needs this.) - ;; - (skip-chars-backward "\n") - (beginning-of-line) - (if (null (cdr pages)) - nil - (and (looking-at "[^\n]+\n\n?\n?\n?") - (delete-region (match-beginning 0) (match-end 0)))) - (setq p (point)) - (skip-chars-backward "\n") - (if (> (- p (point)) 4) - (delete-region (+ 2 (point)) p) - (delete-region (1+ (point)) p)) -; (and (looking-at "\n\n?\n?") -; (delete-region (match-beginning 0) (match-end 0))) - - (setq pages (cdr pages))) - ;; - ;; Now nuke the extra blank lines at the beginning and end. - (goto-char (point-min)) - (if (looking-at "\n+") - (delete-region (match-beginning 0) (match-end 0))) - (forward-line 1) - (if (looking-at "\n\n+") - (delete-region (1+ (match-beginning 0)) (match-end 0))) - (goto-char (point-max)) - (skip-chars-backward "\n") - (delete-region (point) (point-max)) - (beginning-of-line) - (forward-char -1) - (setq p (point)) - (skip-chars-backward "\n") - (if (= ?\n (following-char)) (forward-char 1)) - (if (> (point) (1+ p)) - (delete-region (point) p)) - )) - -(defun Manual-mouseify-xrefs () - (goto-char (point-min)) - (forward-line 1) - (let ((case-fold-search nil) - s e name extent) - ;; possibly it would be faster to rewrite this expression to search for - ;; a less common sequence first (like "([0-9]") and then back up to see - ;; if it's really a match. This function is 15% of the total time, 13% - ;; of which is this call to re-search-forward. - (while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.]*([0-9][a-zA-Z0-9]*)" - nil t) - (setq s (match-beginning 0) - e (match-end 0) - name (buffer-substring s e)) - (goto-char s) - (skip-chars-backward " \t") - (if (and (bolp) - (progn (backward-char 1) (= (preceding-char) ?-))) - (progn - (setq s (point)) - (skip-chars-backward "-a-zA-Z0-9_.") - (setq name (concat (buffer-substring (point) (1- s)) name)) - (setq s (point)))) - ;; if there are upper case letters in the section, downcase them. - (if (string-match "(.*[A-Z]+.*)$" name) - (setq name (concat (substring name 0 (match-beginning 0)) - (downcase (substring name (match-beginning 0)))))) - ;; (setq already-fontified (extent-at s)) - (setq extent (make-extent s e)) - (set-extent-property extent 'man (list 'Manual-follow-xref name)) - (set-extent-property extent 'highlight t) - ;; (if (not already-fontified)... - (set-extent-face extent 'man-xref) - (goto-char e)))) - -(defun Manual-follow-xref (&optional name-or-event) - "Invoke `manual-entry' on the cross-reference under the mouse. -When invoked noninteractively, the arg may be an xref string to parse instead." - (interactive "e") - (if (eventp name-or-event) - (let* ((p (event-point name-or-event)) - (extent (and p (extent-at p - (event-buffer name-or-event) - 'highlight))) - (data (and extent (extent-property extent 'man)))) - (if (eq (car-safe data) 'Manual-follow-xref) - (eval data) - (error "no manual cross-reference there."))) - (or (manual-entry name-or-event) - ;; If that didn't work, maybe it's in a different section than the - ;; man page writer expected. For example, man pages tend assume - ;; that all user programs are in section 1, but X tends to generate - ;; makefiles that put things in section "n" instead... - (and (string-match "[ \t]*([^)]+)\\'" name-or-event) - (progn - (message "No entries found for %s; checking other sections..." - name-or-event) - (manual-entry - (substring name-or-event 0 (match-beginning 0)) - nil t)))))) - -(defun Manual-popup-menu (&optional event) - "Pops up a menu of cross-references in this manual page. -If there is a cross-reference under the mouse button which invoked this -command, it will be the first item on the menu. Otherwise, they are -on the menu in the order in which they appear in the buffer." - (interactive "e") - (let ((buffer (current-buffer)) - (sep "---") - (prefix "Show Manual Page for ") - xref items) - (cond (event - (setq buffer (event-buffer event)) - (let* ((p (event-point event)) - (extent (and p (extent-at p buffer 'highlight))) - (data (and extent (extent-property extent 'man)))) - (if (eq (car-safe data) 'Manual-follow-xref) - (setq xref (nth 1 data)))))) - (if xref (setq items (list sep xref))) - (map-extents #'(lambda (extent ignore) - (let ((data (extent-property extent 'man))) - (if (and (eq (car-safe data) 'Manual-follow-xref) - (not (member (nth 1 data) items))) - (setq items (cons (nth 1 data) items))) - nil)) - buffer) - (if (eq sep (car items)) (setq items (cdr items))) - (let ((popup-menu-titles nil)) - (popup-menu - (cons "Manual Entry" - (mapcar #'(lambda (item) - (if (eq item sep) - item - (vector (concat prefix item) - (list 'Manual-follow-xref item) t))) - (nreverse items))))))) - -(defun pager-cleanup-hook () - "cleanup man page if called via $PAGER" - (let ((buf-name (or buffer-file-name (buffer-name)))) - (if (or (string-match "^/tmp/man[0-9]+" buf-name) - (string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name)) - (let (buffer manpage) - (require 'man) - (goto-char (point-min)) - (setq buffer-read-only nil) - (Manual-nuke-nroff-bs) - (goto-char (point-min)) - (if (re-search-forward "[^ \t]") - (goto-char (- (point) 1))) - (if (looking-at "\\([a-zA-Z0-9]+\\)[ \t]*(") - (setq manpage (buffer-substring (match-beginning 1) - (match-end 1))) - (setq manpage "???")) - (setq buffer - (rename-buffer - (generate-new-buffer-name (concat "*man " manpage "*")))) - (setq buffer-file-name nil) - (goto-char (point-min)) - (insert (format "%s\n" buf-name)) - (goto-char (point-min)) - (buffer-disable-undo buffer) - (set-buffer-modified-p nil) - (Manual-mode) - )))) - -(add-hook 'server-visit-hook 'pager-cleanup-hook) -(provide 'man) - -;;; man.el ends here
--- a/lisp/packages/lpr.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/packages/lpr.el Mon Aug 13 08:47:15 2007 +0200 @@ -95,6 +95,9 @@ (interactive "r") (print-region-1 start end lpr-switches t)) +;; XEmacs change +(require 'message) ; Until We can get some sensible autoloads, or + ; message-flatten-list gets put somewhere decent. (defun print-region-1 (start end switches page-headers) ;; On some MIPS system, having a space in the job name ;; crashes the printer demon. But using dashes looks ugly @@ -106,6 +109,7 @@ (binary-process-input buffer-file-type) (binary-process-output buffer-file-type) (width tab-width) + nswitches switch-string) (save-excursion (if page-headers @@ -116,9 +120,18 @@ (list lpr-headers-switches) lpr-headers-switches) switches)))) + (setq nswitches (message-flatten-list ; XEmacs + (mapcar '(lambda (arg) ; Dynamic evaluation + (cond ((stringp arg) arg) + ((functionp arg) (apply arg nil)) + ((symbolp arg) (eval arg)) + ((consp arg) (apply (car arg) + (cdr arg))) + (t nil))) + switches))) (setq switch-string - (if switches (concat " with options " - (mapconcat 'identity switches " ")) + (if nswitches (concat " with options " + (mapconcat 'identity nswitches " ")) "")) (message "Spooling%s..." switch-string) (if (/= tab-width 8) @@ -150,7 +163,7 @@ ;; These belong in pr if we are using that. (and lpr-add-switches lpr-headers-switches (list "-T" title)) - switches))) + nswitches))) (if (markerp end) (set-marker end nil)) (message "Spooling%s...done" switch-string))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/packages/mic-paren.el Mon Aug 13 08:47:15 2007 +0200 @@ -0,0 +1,577 @@ +;;; mic-paren.el --- highlight matching paren. +;;; Version 1.0 - 96-08-16 +;;; Copyright (C) 1996 Mikael Sjödin (mic@docs.uu.se) +;;; +;;; Author: Mikael Sjödin -- mic@docs.uu.se +;;; Keywords: languages, faces +;;; +;;; This file is NOT part of GNU Emacs. +;;; You may however 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, or (at your option) any later version. +;;; +;;; mic-paren 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. + +;;; ---------------------------------------------------------------------- +;;; Short Description: +;;; +;;; Load this file and Emacs will display highlighting on whatever +;;; parenthesis matches the one before or after point. This is an extension to +;;; the paren.el file distributed with Emacs. The default behaviour is similar +;;; to paren.el but try the authors favourite options: +;;; (setq paren-face 'bold) +;;; (setq paren-sexp-mode t) + +;;; ---------------------------------------------------------------------- +;;; Installation: +;;; +;;; o Place this file in a directory in your 'load-path. +;;; o Put the following in your .emacs file: +;;; (if window-system +;;; (require 'mic-paren)) +;;; o Restart your Emacs. mic-paren is now installed and activated! +;;; o To list the possible customisation enter `C-h f paren-activate' + +;;; ---------------------------------------------------------------------- +;;; Long Description: +;;; +;;; mic-paren.el is an extension to the packages paren.el and stig-paren.el for +;;; Emacs. When mic-paren is active (it is activated when loaded) Emacs normal +;;; parenthesis matching is deactivated. Instead parenthesis matching will be +;;; performed as soon as the cursor is positioned at a parenthesis. The +;;; matching parenthesis (or the entire expression between the parenthesises) +;;; is highlighted until the cursor is moved away from the parenthesis. +;;; Features include: +;;; o Both forward and backward parenthesis matching (_simultaneously_ if +;;; cursor is between two expressions). +;;; o Indication of mismatched parenthesises. +;;; o Option to select if only the matching parenthesis or the entire +;;; expression should be highlighted. +;;; o Message describing the match when the matching parenthesis is +;;; off-screen. +;;; o Optional delayed highlighting (useful on slow systems), +;;; o Functions to activate/deactivate mic-paren.el is provided. +;;; o Numerous options to control the behaviour and appearance of +;;; mic-paren.el. +;;; +;;; mic-paren.el is developed and tested under Emacs 19.28 - 19.31. It should +;;; work on earlier and forthcoming Emacs versions. +;;; +;;; This file can be obtained from http://www.docs.uu.se/~mic/emacs.html + +;; Ported to XEmacs 15-September, 1996 Steve Baur <steve@miranova.com> +;;; ====================================================================== +;;; User Options: + +(defvar paren-priority nil + "*Defines the behaviour of mic-paren when point is between a closing and an + opening parenthesis. + +A value of 'close means highlight the parenthesis matching the +close-parenthesis before the point. + +A value of 'open means highlight the parenthesis matching the open-parenthesis +after the point. + +Any other value means highlight both parenthesis matching the parenthesis +beside the point.") + + +;;; ------------------------------ + +(defvar paren-sexp-mode nil + "*If nil only the matching parenthesis is highlighted. +If non-nil the whole s-expression between the matching parenthesis is +highlighted.") + +;;; ------------------------------ + +(defvar paren-highlight-at-point t + "*If non-nil and point is after a close parenthesis, both the close and +open parenthesis is highlighted. If nil, only the open parenthesis is +highlighted.") + +;;; ------------------------------ + +(defvar paren-highlight-offscreen nil + "*If non-nil stig-paren will highlight text which is not visible in the +current buffer. + +This is useful if you regularly display the current buffer in multiple windows +or frames. For instance if you use follow-mode (by andersl@csd.uu.se), however +it may slow down your Emacs. + +(This variable is ignored (treated as non-nil) if you set paren-sexp-mode to +non-nil.)") + +;;; ------------------------------ + +(defvar paren-message-offscreen t + "*Display message if matching parenthesis is off-screen.") + +;;; ------------------------------ + +(defvar paren-message-no-match t + "*Display message if no matching parenthesis is found.") + +;;; ------------------------------ + +(defvar paren-ding-unmatched nil + "*Make noise if the cursor is at an unmatched parenthesis or no matching +parenthesis is found. + +Even if nil, typing an unmatched parenthesis produces a ding.") + +;;; ------------------------------ + +(defvar paren-delay nil + "*This variable controls when highlighting is done. The variable has +different meaning in different versions of Emacs. + +In Emacs 19.29 and below: + This variable is ignored. + +In Emacs 19.30: + A value of nil will make highlighting happen immediately (this may slow down + your Emacs if running on a slow system). Any non-nil value will delay + highlighting for the time specified by post-command-idle-delay. + +In Emacs 19.31 and above: + A value of nil will make highlighting happen immediately (this may slow down + your Emacs if running on a slow system). If not nil, the value should be a + number (possible a floating point number if your Emacs support floating point + numbers). The number is the delay before mic-paren performs highlighting. + +If you change this variable when mic-paren is active you have to re-activate +(with M-x paren-activate) mic-paren for the change to take effect.") + + +;;; ------------------------------ + +(defvar paren-dont-touch-blink nil + "*If non-nil mic-paren will not change the value of blink-matching-paren when +activated of deactivated. + +If nil mic-paren turns of blinking when activated and turns on blinking when +deactivated.") + +;;; ------------------------------ + +(defvar paren-dont-activate-on-load nil + "*If non-nil mic-paren will not activate itself when loaded.") + +;;; ------------------------------ + +(defvar paren-face (if (x-display-color-p) 'highlight 'underline) + "*Face to use for showing the matching parenthesis.") + +;;; ------------------------------ + +(defvar paren-mismatch-face (if (x-display-color-p) + (let ((fn 'paren-mismatch-face)) + (copy-face 'default fn) + (set-face-background fn "DeepPink") + fn) + 'modeline) + "*Face to use when highlighting a mismatched parenthesis.") + +;;; ====================================================================== +;;; User Functions: + +;; XEmacs compatibility +(eval-and-compile + (if (fboundp 'make-extent) + (progn + (fset 'mic-make-overlay 'make-extent) + (fset 'mic-delete-overlay 'delete-extent) + (fset 'mic-overlay-put 'set-extent-property) + (defun mic-cancel-timer (timer) (delete-itimer timer)) + (defun mic-run-with-idle-timer (secs repeat function &rest args) + (start-itimer "mic-paren-idle" function secs nil)) + ) + (fset 'mic-make-overlay 'make-overlay) + (fset 'mic-delete-overlay 'delete-overlay) + (fset 'mic-overlay-put 'overlay-put) + (fset 'mic-cancel-timer 'cancel-timer) + (fset 'mic-run-with-idle-timer 'run-with-idle-timer) + )) + + +(defun paren-activate () + "Activates mic-paren parenthesis highlighting. +paren-activate deactivates the paren.el and stig-paren.el packages if they are +active +Options: + paren-priority + paren-sexp-mode + paren-highlight-at-point + paren-highlight-offscreen + paren-message-offscreen + paren-message-no-match + paren-ding-unmatched + paren-delay + paren-dont-touch-blink + paren-dont-activate-on-load + paren-face + paren-mismatch-face" + (interactive) + ;; Deactivate mic-paren.el (To remove redundant hooks) + (paren-deactivate) + ;; Deactivate paren.el if loaded + (if (boundp 'post-command-idle-hook) + (remove-hook 'post-command-idle-hook 'show-paren-command-hook)) + (remove-hook 'post-command-hook 'show-paren-command-hook) + (and (boundp 'show-paren-overlay) + show-paren-overlay + (mic-delete-overlay show-paren-overlay)) + (and (boundp 'show-paren-overlay-1) + show-paren-overlay-1 + (mic-delete-overlay show-paren-overlay-1)) + ;; Deactivate stig-paren.el if loaded + (if (boundp 'post-command-idle-hook) + (remove-hook 'post-command-idle-hook 'stig-paren-command-hook)) + (remove-hook 'post-command-hook 'stig-paren-command-hook) + (remove-hook 'post-command-hook 'stig-paren-safe-command-hook) + (remove-hook 'pre-command-hook 'stig-paren-delete-overlay) + ;; Deactivate Emacs standard parenthesis blinking + (or paren-dont-touch-blink + (setq blink-matching-paren nil)) + + (cond + ;; If timers are available use them + ;; (Emacs 19.31 and above) + ((or (featurep 'timer) (featurep 'itimer)) + (if (numberp paren-delay) + (setq mic-paren-idle-timer + (mic-run-with-idle-timer paren-delay t + 'mic-paren-command-idle-hook)) + (add-hook 'post-command-hook 'mic-paren-command-hook))) + ;; If the idle hook exists assume it is functioning and use it + ;; (Emacs 19.30) + ((and (boundp 'post-command-idle-hook) + (boundp 'post-command-idle-delay)) + (if paren-delay + (add-hook 'post-command-idle-hook 'mic-paren-command-idle-hook) + (add-hook 'post-command-hook 'mic-paren-command-hook))) + ;; Check if we (at least) have a post-comand-hook, and use it + ;; (Emacs 19.29 and below) + ((boundp 'post-command-hook) + (add-hook 'post-command-hook 'mic-paren-command-hook)) + ;; Not possible to install mic-paren hooks + (t (error "Cannot activate mic-paren in this Emacs version")))) + + + +(defun paren-deactivate () + "Deactivates mic-paren parenthesis highlighting" + (interactive) + ;; Deactivate (don't bother to check where/if mic-paren is acivte, just + ;; delete all possible hooks and timers) + (if (boundp 'post-command-idle-hook) + (remove-hook 'post-command-idle-hook 'mic-paren-command-idle-hook)) + (if mic-paren-idle-timer + (mic-cancel-timer mic-paren-idle-timer)) + (remove-hook 'post-command-hook 'mic-paren-command-hook) + + ;; Remove any old highlighs + (mic-delete-overlay mic-paren-backw-overlay) + (mic-delete-overlay mic-paren-point-overlay) + (mic-delete-overlay mic-paren-forw-overlay) + + ;; Reactivate Emacs standard parenthesis blinking + (or paren-dont-touch-blink + (setq blink-matching-paren t)) + ) + +;;; ====================================================================== +;;; Internal variables: + +(defvar mic-paren-backw-overlay (mic-make-overlay (point-min) (point-min)) + "Overlay for the open-paren which matches the close-paren before +point. When in sexp-mode this is the overlay for the expression before point.") + +(defvar mic-paren-point-overlay (mic-make-overlay (point-min) (point-min)) + "Overlay for the close-paren before point. +(Not used when is sexp-mode.)") + +(defvar mic-paren-forw-overlay (mic-make-overlay (point-min) (point-min)) + "Overlay for the close-paren which matches the open-paren after +point. When in sexp-mode this is the overlay for the expression after point.") + +(defvar mic-paren-idle-timer nil + "Idle-timer. Used only in Emacs 19.31 and above (and if paren-delay is nil)") + + + + +;;; ====================================================================== +;;; Internal function: + + + +(defun mic-paren-command-hook () + (or executing-kbd-macro + (input-pending-p) ;[This might cause trouble since the + ; function is unreliable] + (condition-case paren-error + (mic-paren-highligt) + (error + (if (not (window-minibuffer-p (selected-window))) + (message "mic-paren catched error (please report): %s" + paren-error)))))) + +(defun mic-paren-command-idle-hook () + (condition-case paren-error + (mic-paren-highligt) + (error + (if (not (window-minibuffer-p (selected-window))) + (message "mic-paren catched error (please report): %s" + paren-error))))) + + +(defun mic-paren-highligt () + "The main-function of mic-paren. Does all highlighting, dinging, messages, +cleaning-up." + ;; Remove any old highlighting + (mic-delete-overlay mic-paren-forw-overlay) + (mic-delete-overlay mic-paren-point-overlay) + (mic-delete-overlay mic-paren-backw-overlay) + + ;; Handle backward highlighting (when after a close-paren): + ;; If positioned after a close-paren, and + ;; not before an open-paren when priority=open, and + ;; the close-paren is not escaped then + ;; perform highlighting + ;; else + ;; remove any old backward highlights + (if (and (eq (char-syntax (preceding-char)) ?\)) + (not (and (eq (char-syntax (following-char)) ?\() + (eq paren-priority 'open))) + (paren-evenp (paren-backslashes-before-char (1- (point))))) + (let (open) + ;; Find the position for the open-paren + (save-excursion + (save-restriction + (if blink-matching-paren-distance + (narrow-to-region + (max (point-min) + (- (point) blink-matching-paren-distance)) + (point-max))) + (condition-case () + (setq open (scan-sexps (point) -1)) + (error nil)))) + + ;; If match found + ;; highlight and/or print messages + ;; else + ;; print no-match message + ;; remove any old highlights + (if open + (let ((mismatch (/= (matching-paren (preceding-char)) + (char-after open))) + (visible (pos-visible-in-window-p open))) + ;; If highlight is appropriate + ;; highligt + ;; else + ;; remove any old highlight + (if (or visible paren-highlight-offscreen paren-sexp-mode) + ;; If sexp-mode + ;; highlight sexp + ;; else + ;; highlight the two parens + (if paren-sexp-mode + (progn + (setq mic-paren-backw-overlay + (mic-make-overlay open (point))) + (if mismatch + (mic-overlay-put mic-paren-backw-overlay + 'face paren-mismatch-face) + (mic-overlay-put mic-paren-backw-overlay + 'face paren-face))) + (setq mic-paren-backw-overlay + (mic-make-overlay open (1+ open))) + (and paren-highlight-at-point + (setq mic-paren-point-overlay + (mic-make-overlay (1- (point)) (point)))) + (if mismatch + (progn + (mic-overlay-put mic-paren-backw-overlay + 'face paren-mismatch-face) + (and paren-highlight-at-point + (mic-overlay-put mic-paren-point-overlay + 'face paren-mismatch-face))) + (mic-overlay-put mic-paren-backw-overlay + 'face paren-face) + (and paren-highlight-at-point + (mic-overlay-put mic-paren-point-overlay + 'face paren-face))))) + ;; Print messages if match is offscreen + (and paren-message-offscreen + (not visible) + (not (window-minibuffer-p (selected-window))) + (message "%s %s" + (if mismatch "MISMATCH:" "Matches") + (mic-paren-get-matching-open-text open))) + ;; Ding if mismatch + (and mismatch + paren-ding-unmatched + (ding))) + (and paren-message-no-match + (not (window-minibuffer-p (selected-window))) + (message "No opening parenthesis found")) + (and paren-message-no-match + paren-ding-unmatched + (ding))))) + + ;; Handle forward highlighting (when before an open-paren): + ;; If positioned before an open-paren, and + ;; not after a close-paren when priority=close, and + ;; the open-paren is not escaped then + ;; perform highlighting + ;; else + ;; remove any old forward highlights + (if (and (eq (char-syntax (following-char)) ?\() + (not (and (eq (char-syntax (preceding-char)) ?\)) + (eq paren-priority 'close))) + (paren-evenp (paren-backslashes-before-char (point)))) + (let (close) + ;; Find the position for the close-paren + (save-excursion + (save-restriction + (if blink-matching-paren-distance + (narrow-to-region + (point-min) + (min (point-max) + (+ (point) blink-matching-paren-distance)))) + (condition-case () + (setq close (scan-sexps (point) 1)) + (error nil)))) + ;; If match found + ;; highlight and/or print messages + ;; else + ;; print no-match message + ;; remove any old highlights + (if close + (let ((mismatch (/= (matching-paren (following-char)) + (char-after (1- close)))) + (visible (pos-visible-in-window-p close))) + ;; If highlight is appropriate + ;; highligt + ;; else + ;; remove any old highlight + (if (or visible paren-highlight-offscreen paren-sexp-mode) + ;; If sexp-mode + ;; highlight sexp + ;; else + ;; highlight the two parens + (if paren-sexp-mode + (progn + (setq mic-paren-forw-overlay + (mic-make-overlay (point) close)) + (if mismatch + (mic-overlay-put mic-paren-forw-overlay + 'face paren-mismatch-face) + (mic-overlay-put mic-paren-forw-overlay + 'face paren-face))) + (setq mic-paren-forw-overlay + (mic-make-overlay (1- close) close)) + (if mismatch + (mic-overlay-put mic-paren-forw-overlay + 'face paren-mismatch-face) + (mic-overlay-put mic-paren-forw-overlay + 'face paren-face)))) + + ;; Print messages if match is offscreen + (and paren-message-offscreen + (not visible) + (not (window-minibuffer-p (selected-window))) + (message "%s %s" + (if mismatch "MISMATCH:" "Matches") + (mic-paren-get-matching-close-text close))) + ;; Ding if mismatch + (and mismatch + paren-ding-unmatched + (ding))) + (and paren-message-no-match + (not (window-minibuffer-p (selected-window))) + (message "No closing parenthesis found")) + (and paren-message-no-match + paren-ding-unmatched + (ding)))))) + +;;; -------------------------------------------------- + +(defun mic-paren-get-matching-open-text (open) + "Returns a string with the context around OPEN-paren." + ;; If there's stuff on this line preceding the paren, then display text from + ;; beginning of line to paren. + ;; + ;; If, however, the paren is at the beginning of a line, then skip whitespace + ;; forward and display text from paren to end of the next line containing + ;; non-space text. + ;; + ;; (Same as in stig-paren.el) + (save-excursion + (goto-char open) + (if (save-excursion + (skip-chars-backward " \t") + (not (bolp))) + (progn + (beginning-of-line) + (concat (buffer-substring (point) (1+ open)) "...")) + (forward-char 1) ;From the beginning-of-line + (skip-chars-forward "\n \t") + (end-of-line) + (buffer-substring open (point))))) + + +(defun mic-paren-get-matching-close-text (close) + "Returns a string with the context around CLOSE-paren." + ;; The whole line up until the close-paren with "..." appended if there are + ;; more text after the close-paren + (save-excursion + (goto-char close) + (beginning-of-line) + (concat + (buffer-substring (point) close) + (progn + (goto-char close) + (if (looking-at "[ \t]*$") + "" + "..."))))) + + +(defun paren-evenp (number) + "Returns t if NUMBER is an even number, nil otherwise" + (eq 0 (% number 2))) + +(defun paren-backslashes-before-char (pnt) + (setq pnt (1- pnt)) + (let ((n 0)) + (while (and (>= pnt (point-min)) + (eq (char-syntax (char-after pnt)) ?\\)) + (setq n (1+ n)) + (setq pnt (1- pnt))) + n)) + + + +;;; ====================================================================== +;;; Initialisation when loading: + + +(or paren-dont-activate-on-load + (paren-activate)) + +;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic] +(add-hook 'window-setup-hook + (function (lambda () + (and window-system + (not paren-dont-activate-on-load) + (paren-activate))))) + +(provide 'mic-paren) +(provide 'paren)
--- a/lisp/packages/old-man.el Mon Aug 13 08:46:57 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1225 +0,0 @@ -;;; man.el --- browse UNIX manual pages -;; Keywords: help - -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. -;; -;; This file is part of XEmacs. - -;; XEmacs 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, or (at your option) -;; any later version. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Synched up with: Not synched with FSF. -;;; ICK! This file is almost completely different from FSF. -;;; Someone clarify please. - -;; Mostly rewritten by Alan K. Stebbens <aks@hub.ucsb.edu> 11-apr-90. -;; -;; o Match multiple man pages using TOPIC as a simple pattern -;; o Search unformatted pages, even when formatted matches are found -;; o Query the user as to which pages are desired -;; o Use of the prefix arg to toggle/bypass the above features -;; o Buffers named by the first topic in the buffer -;; o Automatic uncompress for compressed man pages (.Z, .z, and .gz) -;; o View the resulting buffer using M-x view mode -;; -;; Modified 16-mar-91 by Jamie Zawinski <jwz@lucid.com> to default the -;; manual topic to the symbol at point, just like find-tag does. -;; -;; Modified 22-mar-93 by jwz to use multiple fonts and follow xrefs with mouse. -;; -;; Modified 16-apr-93 by Dave Gillespie <daveg@synaptics.com> to make -;; apropos work nicely; work correctly when bold or italic is unavailable; -;; reuse old buffer if topic is re-selected (in Manual-topic-buffer mode). -;; -;; Modified 4-apr-94 by jwz: merged in Tibor Polgar's code for manpath.conf. -;; -;; Modified 19-apr-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for -;; $PAGER variable to be emacsclient and properly process man pages (assuming -;; the man pages were built by man in /tmp. also fixed bug with man list being -;; backwards. -;; -;; Modified 23-aug-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for -;; displaying only one instance of a man page (Manual-unique-man-sections-only) -;; Fixed some more man page ordering bugs, bug with Manual-query-multiple-pages. -;; -;; Modified 29-nov-94 by Ben Wing <wing@spg.amdahl.com>: small fixes -;; that should hopefully make things work under HPUX and IRIX.; -;; -;; Modified 15-jul-95 by Dale Atems <atems@physics.wayne.edu>: -;; some extensive rewriting to make things work right (more or less) -;; under IRIX. -;; -;; Modified 08-mar-96 by Hubert Palme <palme@wrcs3.urz.uni-wuppertal.de>: -;; added /usr/share/catman to the manual directory list for IRIX (5.3) -;; -;; This file defines "manual-entry", and the remaining definitions all -;; begin with "Manual-". This makes the autocompletion on "M-x man" work. -;; -;; Variables of interest: -;; -;; Manual-program -;; Manual-topic-buffer -;; Manual-buffer-view-mode -;; Manual-directory-list -;; Manual-formatted-directory-list -;; Manual-match-topic-exactly -;; Manual-query-multiple-pages -;; Manual-page-history -;; Manual-subdirectory-list -;; Manual-man-page-section-ids -;; Manual-formatted-page-prefix -;; Manual-unformatted-page-prefix -;; Manual-use-full-section-ids - -(defvar Manual-program "man" "\ -*Name of the program to invoke in order to format the source man pages.") - -(defvar Manual-section-switch (if (eq system-type 'usg-unix-v) "-s" nil) - "SysV needs this to work right.") - -(defvar Manual-topic-buffer t "\ -*Non-nil means \\[Manual-entry] should output the manual entry for TOPIC into -a buffer named *man TOPIC*, otherwise, it should name the buffer -*Manual Entry*.") - -(defvar Manual-buffer-view-mode t "\ -*Whether manual buffers should be placed in view-mode. -nil means leave the buffer in fundamental-mode in another window. -t means use `view-buffer' to display the man page in the current window. -Any other value means use `view-buffer-other-window'.") - -(defvar Manual-match-topic-exactly t "\ -*Non-nil means that \\[manual-entry] will match the given TOPIC exactly, rather -apply it as a pattern. When this is nil, and \"Manual-query-multiple-pages\" -is non-nil, then \\[manual-entry] will query you for all matching TOPICs. -This variable only has affect on the preformatted man pages (the \"cat\" files), -since the \"man\" command always does exact topic matches.") - -(defvar Manual-query-multiple-pages nil "\ -*Non-nil means that \\[manual-entry] will query the user about multiple man -pages which match the given topic. The query is done using the function -\"y-or-n-p\". If this variable is nil, all man pages with topics matching the -topic given to \\[manual-entry] will be inserted into the temporary buffer. -See the variable \"Manual-match-topic-exactly\" to control the matching.") - -(defvar Manual-unique-man-sections-only nil - "*Only present one man page per section. This variable is useful if the same or -up/down level man pages for the same entry are present in mulitple man paths. -When set to t, only the first entry found in a section is displayed, the others -are ignored without any messages or warnings. Note that duplicates can occur if -the system has both formatted and unformatted version of the same page.") - -(defvar Manual-mode-hook nil - "Function or functions run on entry to Manual-mode.") - -(defvar Manual-directory-list nil "\ -*A list of directories used with the \"man\" command, where each directory -contains a set of \"man?\" and \"cat?\" subdirectories. If this variable is nil, -it is initialized by \\[Manual-directory-list-init].") - -(defvar Manual-formatted-directory-list nil "\ -A list of directories containing formatted man pages. Initialized by -\\[Manual-directory-list-init].") - -(defvar Manual-unformatted-directory-list nil "\ -A list of directories containing the unformatted (source) man pages. -Initialized by \\[Manual-directory-list-init].") - -(defvar Manual-page-history nil "\ -A list of names of previously visited man page buffers.") - -(defvar Manual-manpath-config-file "/usr/lib/manpath.config" - "*Location of the manpath.config file, if any.") - -(defvar Manual-apropos-switch "-k" - "*Man apropos switch") - -;; New variables. - -(defvar Manual-subdirectory-list nil "\ -A list of all the subdirectories in which man pages may be found. -Iniialized by Manual-directory-list-init.") - -;; This is for SGI systems; don't know what it should be otherwise. -(defvar Manual-man-page-section-ids "1nl6823457poD" "\ -String containing all suffix characters for \"cat\" and \"man\" -that identify valid sections of the Un*x manual.") - -(defvar Manual-formatted-page-prefix "cat" "\ -Prefix for directories where formatted man pages are to be found. -Defaults to \"cat\".") - -(defvar Manual-unformatted-page-prefix "man" "\ -Prefix for directories where unformatted man pages are to be found. -Defaults to \"man\".") - -(defvar Manual-leaf-signature "" "\ -Regexp for identifying \"leaf\" subdirectories in the search path. -If empty, initialized by Manual-directory-list-init.") - -(defvar Manual-use-full-section-ids t "\ -If non-nil, pass full section ids to Manual-program, otherwise pass -only the first character. Defaults to 't'.") - -(defvar Manual-use-subdirectory-list (eq system-type 'irix) "\ -This makes manual-entry work correctly on SGI machines but it -imposes a large startup cost which is why it is not simply on by -default on all systems.") - -(defvar Manual-use-rosetta-man (not (null (locate-file "rman" exec-path))) "\ -If non-nil, use RosettaMan (rman) to filter man pages. -This makes man-page cleanup virtually instantaneous, instead of -potentially taking a long time. - -Here is information on RosettaMan, from Neal.Becker@comsat.com (Neal Becker): - -RosettaMan is a filter for UNIX manual pages. It takes as input man -pages formatted for a variety of UNIX flavors (not [tn]roff source) -and produces as output a variety of file formats. Currently -RosettaMan accepts man pages as formatted by the following flavors of -UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1, -DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following -formats: printable ASCII only (stripping page headers and footers), -section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF, -SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod. - -RosettaMan improves on other man page filters in several ways: (1) its -analysis recognizes the structural pieces of man pages, enabling high -quality output, (2) its modular structure permits easy augmentation of -output formats, (3) it accepts man pages formatted with the varient -macros of many different flavors of UNIX, and (4) it doesn't require -modification or cooperation with any other program. - -RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If -you haven't heard about TkMan, a hypertext man page browser, you -should grab it via anonymous ftp from ftp.cs.berkeley.edu: -/ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for -TkMan, RosettaMan generalizes the process so that the analysis can be -leveraged to new output formats. A single analysis engine recognizes -section heads, subsection heads, body text, lists, references to other -man pages, boldface, italics, bold italics, special characters (like -bullets), tables (to a degree) and strips out page headers and -footers. The engine sends signals to the selected output functions so -that an enhancement in the engine improves the quality of output of -all of them. Output format functions are easy to add, and thus far -average about about 75 lines of C code each. - - - -*** NOTES ON CURRENT VERSION *** - -Help! I'm looking for people to help with the following projects. -\(1) Better RTF output format. The current one works, but could be -made better. (2) Roff macros that produce text that is easily -parsable. RosettaMan handles a great variety, but some things, like -H-P's tables, are intractable. If you write an output format or -otherwise improve RosettaMan, please send in your code so that I may -share the wealth in future releases. - -This version can try to identify tables (turn this on with the -T -switch) by looking for lines with a large amount of interword spacing, -reasoning that this is space between columns of a table. This -heuristic doesn't always work and sometimes misidentifies ordinary -text as tables. In general I think it is impossible to perfectly -identify tables from nroff formatted text. However, I do think the -heuristics can be tuned, so if you have a collection of manual pages -with unrecognized tables, send me the lot, in formatted form (i.e., -after formatting with nroff -man), and uuencode them to preserve the -control characters. Better, if you can think of heuristics that -distinguish tables from ordinary text, I'd like to hear them. - - -Notes for HTML consumers: This filter does real (heuristic) -parsing--no <PRE>! Man page references are turned into hypertext links.") - -(make-face 'man-italic) -(or (face-differs-from-default-p 'man-italic) - (copy-face 'italic 'man-italic)) -;; XEmacs (from Darrell Kindred): underlining is annoying due to -;; large blank spaces in this face. -;; (or (face-differs-from-default-p 'man-italic) -;; (set-face-underline-p 'man-italic t)) - -(make-face 'man-bold) -(or (face-differs-from-default-p 'man-bold) - (copy-face 'bold 'man-bold)) -(or (face-differs-from-default-p 'man-bold) - (copy-face 'man-italic 'man-bold)) - -(make-face 'man-heading) -(or (face-differs-from-default-p 'man-heading) - (copy-face 'man-bold 'man-heading)) - -(make-face 'man-xref) -(or (face-differs-from-default-p 'man-xref) - (set-face-underline-p 'man-xref t)) - -;; Manual-directory-list-init -;; Initialize the directory lists. - -(defun Manual-directory-list-init (&optional arg) - "Initialize the Manual-directory-list variable from $MANPATH -if it is not already set, or if a prefix argument is provided." - (interactive "P") - (if arg (setq Manual-directory-list nil)) - (if (null Manual-directory-list) - (let ((manpath (getenv "MANPATH")) - (global (Manual-manpath-config-contents)) - (dirlist nil) - dir) - (cond ((and manpath global) - (setq manpath (concat manpath ":" global))) - (global - (setq manpath global)) - ((not manpath) - ;; XEmacs - (bpw/stig) Unix-specifix hack for lusers w/ no manpath - (setq manpath "/usr/local/man:/usr/share/man:/usr/share/catman:/usr/contrib/man:/usr/X11/man:/usr/man:/usr/catman"))) - ;; Make sure that any changes we've made internally are seen by man. - (setenv "MANPATH" manpath) - (while (string-match "\\`:*\\([^:]+\\)" manpath) - (setq dir (substring manpath (match-beginning 1) (match-end 1))) - (and (not (member dir dirlist)) - (setq dirlist (cons dir dirlist))) - (setq manpath (substring manpath (match-end 0)))) - (setq dirlist (nreverse dirlist)) - (setq Manual-directory-list dirlist) - (setq Manual-subdirectory-list nil) - (setq Manual-formatted-directory-list nil) - (setq Manual-unformatted-directory-list nil))) - (if (string-equal Manual-leaf-signature "") - (setq Manual-leaf-signature - (concat "/\\(" - Manual-formatted-page-prefix - "\\|" Manual-unformatted-page-prefix - "\\)" - "[" Manual-man-page-section-ids - "].?/."))) - (if Manual-use-subdirectory-list - (progn - (if (null Manual-subdirectory-list) - (setq Manual-subdirectory-list - (Manual-all-subdirectories Manual-directory-list - Manual-leaf-signature nil))) - (if (null Manual-formatted-directory-list) - (setq Manual-formatted-directory-list - (Manual-filter-subdirectories Manual-subdirectory-list - Manual-formatted-page-prefix))) - (if (null Manual-unformatted-directory-list) - (setq Manual-unformatted-directory-list - (Manual-filter-subdirectories Manual-subdirectory-list - Manual-unformatted-page-prefix)))) - (if (null Manual-formatted-directory-list) - (setq Manual-formatted-directory-list - (Manual-select-subdirectories Manual-directory-list - Manual-formatted-page-prefix))) - (if (null Manual-unformatted-directory-list) - (setq Manual-unformatted-directory-list - (Manual-select-subdirectories Manual-directory-list - Manual-unformatted-page-prefix))))) - - -(defun Manual-manpath-config-contents () - "Parse the `Manual-manpath-config-file' file, if any. -Returns a string like in $MANPATH." - (if (and Manual-manpath-config-file - (file-readable-p Manual-manpath-config-file)) - (let ((buf (get-buffer-create " *Manual-config*")) - path) - (set-buffer buf) - (buffer-disable-undo buf) - (erase-buffer) - (insert-file-contents Manual-manpath-config-file) - (while (re-search-forward "^\\(MANDATORY_MANPATH\\|MANPATH_MAP\\)" - nil t) - (and (re-search-forward "\\(/[^ \t\n]+\\)[ \t]*$") - (setq path (concat path (buffer-substring (match-beginning 1) - (match-end 1)) - ":")))) - (kill-buffer buf) - path))) -;; -;; manual-entry -- The "main" user function -;; - -;;;###autoload -(defun manual-entry (topic &optional arg silent) - "Display the Unix manual entry (or entries) for TOPIC. -If prefix arg is given, modify the search according to the value: - 2 = complement default exact matching of the TOPIC name; - exact matching default is specified by `Manual-match-topic-exactly' - 3 = force a search of the unformatted man directories - 4 = both 2 and 3 -The manual entries are searched according to the variable -Manual-directory-list, which should be a list of directories. If -Manual-directory-list is nil, \\[Manual-directory-list-init] is -invoked to create this list from the MANPATH environment variable. -See the variable Manual-topic-buffer which controls how the buffer -is named. See also the variables Manual-match-topic-exactly, -Manual-query-multiple-pages, and Manual-buffer-view-mode." - (interactive - (list (let* ((fmh "-A-Za-z0-9_.") - (default (save-excursion - (buffer-substring - (progn - (re-search-backward "\\sw" nil t) - (skip-chars-backward fmh) (point)) - (progn (skip-chars-forward fmh) (point))))) - (thing (read-string - (if (equal default "") "Manual entry: " - (concat "Manual entry: (default " default ") "))))) - (if (equal thing "") default thing)) - (prefix-numeric-value current-prefix-arg))) - ;;(interactive "sManual entry (topic): \np") - (or arg (setq arg 1)) - (Manual-directory-list-init nil) - (let ((exact (if (or (= arg 2) (= arg 4)) - (not Manual-match-topic-exactly) - Manual-match-topic-exactly)) - (force (if (>= arg 3) - t - nil)) - section fmtlist manlist apropos-mode) - (let ((case-fold-search nil)) - (if (and (null section) - (string-match - "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic)) - (setq section (substring topic (match-beginning 2) - (match-end 2)) - topic (substring topic (match-beginning 1) - (match-end 1))) - (if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic) - (setq section "-k" - topic (substring topic (match-beginning 1)))))) - (if (equal section "-k") - (setq apropos-mode t) - (or silent - (message "Looking for formatted entry for %s%s..." - topic (if section (concat "(" section ")") ""))) - (setq fmtlist (Manual-select-man-pages - Manual-formatted-directory-list - topic section exact '())) - (if (or force (not section) (null fmtlist)) - (progn - (or silent - (message "%sooking for unformatted entry for %s%s..." - (if fmtlist "L" "No formatted entry, l") - topic (if section (concat "(" section ")") ""))) - (setq manlist (Manual-select-man-pages - Manual-unformatted-directory-list - topic section exact (if force '() fmtlist)))))) - - ;; Delete duplicate man pages (a file of the same name in multiple - ;; directories.) - (or nil ;force - (let ((rest (append fmtlist manlist))) - (while rest - (let ((rest2 (cdr rest))) - (while rest2 - (if (equal (file-name-nondirectory (car rest)) - (file-name-nondirectory (car rest2))) - (setq fmtlist (delq (car rest2) fmtlist) - manlist (delq (car rest2) manlist))) - (setq rest2 (cdr rest2)))) - (setq rest (cdr rest))))) - - (if (not (or fmtlist manlist apropos-mode)) - (progn - (message "No entries found for %s%s" topic - (if section (concat "(" section ")") "")) - nil) - (let ((bufname (cond ((not Manual-topic-buffer) - ;; What's the point of retaining this? - (if apropos-mode - "*Manual Apropos*" - "*Manual Entry*")) - (apropos-mode - (concat "*man apropos " topic "*")) - (t - (concat "*man " - (cond (exact - (if section - (concat topic "." section) - topic)) - ((or (cdr fmtlist) (cdr manlist) - (and fmtlist manlist)) - ;; more than one entry found - (concat topic "...")) - (t - (file-name-nondirectory - (car (or fmtlist manlist))))) - "*")))) - (temp-buffer-show-function - (cond ((eq 't Manual-buffer-view-mode) 'view-buffer) - ((eq 'nil Manual-buffer-view-mode) - temp-buffer-show-function) - (t 'view-buffer-other-window)))) - - (if apropos-mode - (setq manlist (list (format "%s.%s" topic section)))) - - (cond - ((and Manual-topic-buffer (get-buffer bufname)) - ;; reselect an old man page buffer if it exists already. - (save-excursion - (set-buffer (get-buffer bufname)) - (Manual-mode)) - (if temp-buffer-show-function - (funcall temp-buffer-show-function (get-buffer bufname)) - (display-buffer bufname))) - (t - (with-output-to-temp-buffer bufname - (buffer-disable-undo standard-output) - (save-excursion - (set-buffer standard-output) - (setq buffer-read-only nil) - (erase-buffer) - (Manual-insert-pages fmtlist manlist apropos-mode) - (set-buffer-modified-p nil) - (Manual-mode) - )))) - (setq Manual-page-history - (cons (buffer-name) - (delete (buffer-name) Manual-page-history))) - (message nil) - t)))) - -(defun Manpage-apropos (topic &optional arg silent) - "Apropos on Unix manual pages for TOPIC. -It calls the function `manual-entry'. Look at this function for -further description. Look also at the variable `Manual-apropos-switch', -if this function doesn't work on your system." - (interactive - (list (let* ((fmh "-A-Za-z0-9_.") - (default (save-excursion - (buffer-substring - (progn - (re-search-backward "\\sw" nil t) - (skip-chars-backward fmh) (point)) - (progn (skip-chars-forward fmh) (point))))) - (thing (read-string - (if (equal default "") "Manual entry: " - (concat "Manual entry: (default " default ") "))))) - (if (equal thing "") default thing)) - (prefix-numeric-value current-prefix-arg))) - (manual-entry (concat Manual-apropos-switch " " topic) arg silent)) - -(defun Manual-insert-pages (fmtlist manlist apropos-mode) - (let ((sep (make-string 65 ?-)) - name start end topic section) - (while fmtlist ; insert any formatted files - (setq name (car fmtlist)) - (goto-char (point-max)) - (setq start (point)) - ;; In case the file can't be read or uncompressed or - ;; something like that. - (condition-case () - (Manual-insert-man-file name) - (file-error nil)) - (goto-char (point-max)) - (setq end (point)) - (save-excursion - (save-restriction - (message "Cleaning manual entry for %s..." - (file-name-nondirectory name)) - (narrow-to-region start end) - (Manual-nuke-nroff-bs) - (goto-char (point-min)) - (insert "File: " name "\n") - (goto-char (point-max)) - )) - (if (or (cdr fmtlist) manlist) - (insert "\n\n" sep "\n")) - (setq fmtlist (cdr fmtlist))) - - (while manlist ; process any unformatted files - (setq name (car manlist)) - (or (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\(\\.gz\\'\\)" name) - (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\'" name)) - (setq topic (substring name (match-beginning 1) (match-end 1))) - (setq section (substring name (match-beginning 2) (match-end 2))) - ;; This won't work under IRIX, because SGI man accepts only the - ;; "main" (one-character) section id, not full section ids - ;; like 1M, 3X, etc. Put (setq Manual-use-full-section-ids nil) - ;; in your .emacs to work around this problem. - (if (not (or Manual-use-full-section-ids (string-equal section ""))) - (setq section (substring section 0 1))) - (message "Invoking man %s%s %s..." - (if Manual-section-switch - (concat Manual-section-switch " ") - "") - section topic) - (setq start (point)) - (Manual-run-formatter name topic section) - (setq end (point)) - (save-excursion - (save-restriction - (message "Cleaning manual entry for %s(%s)..." topic section) - (narrow-to-region start end) - (Manual-nuke-nroff-bs apropos-mode) - (goto-char (point-min)) - (insert "File: " name "\n") - (goto-char (point-max)) - )) - (if (cdr manlist) - (insert "\n\n" sep "\n")) - (setq manlist (cdr manlist)))) - (if (< (buffer-size) 200) - (progn - (goto-char (point-min)) - (if (looking-at "^File: ") - (forward-line 1)) - (error (buffer-substring (point) (progn (end-of-line) (point)))))) - nil) - - -(defun Manual-run-formatter (name topic section) - (cond - ((string-match "roff\\'" Manual-program) - ;; kludge kludge - (call-process Manual-program nil t nil "-Tman" "-man" name)) - - (t - (call-process Manual-program nil t nil - (concat Manual-section-switch section) topic)))) - - ;(Manual-use-rosetta-man - ; (call-process "/bin/sh" nil t nil "-c" - ; (format "man %s %s | rman" section topic))) - - -(defvar Manual-mode-map - (let ((m (make-sparse-keymap))) - (set-keymap-name m 'Manual-mode-map) - (define-key m "l" 'Manual-last-page) - (define-key m 'button2 'Manual-follow-xref) - (define-key m 'button3 'Manual-popup-menu) - m)) - -(defun Manual-mode () - (kill-all-local-variables) - (setq buffer-read-only t) - (use-local-map Manual-mode-map) - (setq major-mode 'Manual-mode - mode-name "Manual") - ;; man pages with long lines are buggy! - ;; This looks slightly better if they only - ;; overran by a couple of chars. - (setq truncate-lines t) - (if (featurep 'scrollbar) - ;; turn off horizontal scrollbars in this buffer - (set-specifier scrollbar-height (cons (current-buffer) 0))) - (run-hooks 'Manual-mode-hook)) - -(defun Manual-last-page () - (interactive) - (while (or (not (get-buffer (car (or Manual-page-history - (error "No more history."))))) - (eq (get-buffer (car Manual-page-history)) (current-buffer))) - (setq Manual-page-history (cdr Manual-page-history))) - (switch-to-buffer (car Manual-page-history))) - - -;; Manual-select-subdirectories -;; Given a DIRLIST and a SUBDIR name, return all subdirectories of the former which -;; match the latter. - -(defun Manual-select-subdirectories (dirlist subdir) - (let ((dirs '()) - (case-fold-search nil) - (match (concat "\\`" (regexp-quote subdir))) - d) - (while dirlist - (setq d (car dirlist) dirlist (cdr dirlist)) - (if (file-directory-p d) - (let ((files (directory-files d t match nil 'dirs-only)) - (dir-temp '())) - (while files - (if (file-executable-p (car files)) - (setq dir-temp (cons (file-name-as-directory (car files)) - dir-temp))) - (setq files (cdr files))) - (and dir-temp - (setq dirs (append dirs (nreverse dir-temp))))))) - dirs)) - - -;; Manual-filter-subdirectories -;; Given a DIRLIST and a SUBDIR name, return all members of the former -;; which match the latter. - -(defun Manual-filter-subdirectories (dirlist subdir) - (let ((match (concat - "/" - (regexp-quote subdir) - "[" Manual-man-page-section-ids "]")) - slist dir) - (while dirlist - (setq dir (car dirlist) dirlist (cdr dirlist)) - (if (and (file-executable-p dir) (string-match match dir)) - (setq slist (cons dir slist)))) - (nreverse slist))) - - -(defun Manual-all-subdirectories (dirlist leaf-signature dirs &optional silent) "\ -Given a DIRLIST, return a backward-sorted list of all subdirectories -thereof, prepended to DIRS if non-nil. This function calls itself -recursively until subdirectories matching LEAF-SIGNATURE are reached, -or the hierarchy has been thoroughly searched. This code is a modified -version of a function written by Tim Bradshaw (tfb@ed.ac.uk)." - (Manual-all-subdirectories-noloop dirlist leaf-signature dirs nil silent)) - -(defun Manual-all-subdirectories-noloop (dirlist leaf-signature dirs been &optional silent) "\ -Does the job of manual-all-subdirectories and keeps track of where it -has been to avoid loops." - (let (dir) - (while dirlist - (setq dir (car dirlist) dirlist (cdr dirlist)) - (if (file-directory-p dir) - (let ((dir-temp (cons (file-name-as-directory dir) dirs))) - ;; Without feedback the user might wonder about the delay! - (or silent (message - "Building list of search directories... %s" - (car dir-temp))) - (if (member (file-truename dir) been) - () ; Ignore. We have been here before - (setq been (cons (file-truename dir) been)) - (setq dirs - (if (string-match leaf-signature dir) - dir-temp - (Manual-all-subdirectories-noloop - (directory-files dir t "[^.]$" nil 'dirs-only) - leaf-signature dir-temp been silent)))))))) - dirs) - - -(defvar Manual-bogus-file-pattern "\\.\\(lpr\\|ps\\|PS\\)\\'" - "Some systems have files in the man/man*/ directories which aren't man pages. -This pattern is used to prune those files.") - -;; Manual-select-man-pages -;; -;; Given a DIRLIST, discover all filenames which complete given the TOPIC -;; and SECTION. - -;; ## Note: BSD man looks for .../man1/foo.1 and .../man1/$MACHINE/foo.1 - -;; ## Fixed for SGI IRIX 5.x on Sat Jul 15 1995 by Dale Atems -;; (atems@physics.wayne.edu). - -(defun Manual-select-man-pages (dirlist topic section exact shadow) - (let ((case-fold-search nil)) - (and section - (let ((l '()) - ;;(match (concat (substring section 0 1) "/?\\'")) - ;; ^^^ - ;; We'll lose any pages inside subdirectories of the "standard" - ;; ones if we insist on this! The following regexp should - ;; match any directory ending with the full section id or - ;; its first character, or any direct subdirectory thereof: - (match (concat "\\(" - (regexp-quote section) - "\\|" - (substring section 0 1) - "\\)/?")) - d) - (while dirlist - (setq d (car dirlist) dirlist (cdr dirlist)) - (if (string-match match d) - (setq l (cons d l)))) - (setq dirlist l))) - (if shadow - (setq shadow (concat "/\\(" - (mapconcat #'(lambda (n) - (regexp-quote - (file-name-nondirectory n))) - shadow - "\\|") - "\\)\\'"))) - (let ((manlist '()) - (match (concat "\\`" - (regexp-quote topic) - ;; **Note: on IRIX the preformatted pages - ;; are packed, so they end with ".z". This - ;; way you miss them if you specify a - ;; section. I don't see any point to it here - ;; even on BSD systems since we're looking - ;; one level down already, but I can't test - ;; this. More thought needed (???) - - (cond ((and section - (not Manual-use-subdirectory-list)) - (concat "\\." (regexp-quote section))) - (exact - ;; If Manual-match-topic-exactly is - ;; set, then we must make sure the - ;; completions are exact, except for - ;; trailing weird characters after - ;; the section. - "\\.") - (t - "")))) - dir) - (while dirlist - (setq dir (car dirlist) dirlist (cdr dirlist)) - (if (not (file-directory-p dir)) - (progn - (message "warning: %s is not a directory" dir) - ;;(sit-for 1) - ) - (let ((files (directory-files dir t match nil t)) - f) - (while files - (setq f (car files) files (cdr files)) - (cond ((string-match Manual-bogus-file-pattern f) - ;(message "Bogus fule %s" f) (sit-for 2) - ) - ((and shadow (string-match shadow f)) - ;(message "Shadowed %s" f) (sit-for 2) - ) - ((not (file-readable-p f)) - ;(message "Losing with %s" f) (sit-for 2) - ) - (t - (setq manlist (cons f manlist)))))))) - (setq manlist (nreverse manlist)) - (and Manual-unique-man-sections-only - (setq manlist (Manual-clean-to-unique-pages-only manlist))) - (if (and manlist Manual-query-multiple-pages) - (apply #'append - (mapcar #'(lambda (page) - (and page - (y-or-n-p (format "Read %s? " page)) - (list page))) - manlist)) - manlist)))) - -(defun Manual-clean-to-unique-pages-only (manlist) - "Prune the current list of pages down to a unique set." - (let (page-name unique-pages) - (apply 'append - (mapcar '(lambda (page) - (cond (page - (and (string-match ".*/\\(.*\\)" page) - (setq page-name (substring page (match-beginning 1) - (match-end 1))) - ;; try to clip off .Z, .gz suffixes - (and (string-match "\\(.*\\)\\.\\(.+\\)\\.\\(.+\\)" - page-name) - (setq page-name - (substring page-name (match-beginning 1) - (match-end 2))))) - ;; add Manual-unique-pages if it isn't there - ;; and return file - (if (and unique-pages - page-name - (string-match (concat "\\b" page-name "\\b") - unique-pages)) - nil - (setq unique-pages (concat unique-pages - page-name - " ")) - (list page))))) - manlist)))) - - - -(defun Manual-insert-man-file (name) - ;; Insert manual file (unpacked as necessary) into buffer - (cond ((equal (substring name -3) ".gz") - (call-process "gunzip" nil t nil "--stdout" name)) - ((or (equal (substring name -2) ".Z") - ;; HPUX uses directory names that end in .Z and compressed - ;; files that don't. How gratuitously random. - (let ((case-fold-search nil)) - (string-match "\\.Z/" name))) - (call-process "zcat" name t nil)) ;; XEmacs change for HPUX - ((equal (substring name -2) ".z") - (call-process "pcat" nil t nil name)) - (t - (insert-file-contents name)))) - -(defmacro Manual-delete-char (n) - ;; in v19, delete-char is compiled as a function call, but delete-region - ;; is byte-coded, so it's much faster. - ;; (We were spending 40% of our time in delete-char alone.) - (list 'delete-region '(point) (list '+ '(point) n))) - -;; Hint: BS stands for more things than "back space" -(defun Manual-nuke-nroff-bs (&optional apropos-mode) - (interactive "*") - (if Manual-use-rosetta-man - (call-process-region (point-min) (point-max) "rman" t t nil) - ;; - ;; turn underlining into italics - ;; - (goto-char (point-min)) - (while (search-forward "_\b" nil t) - ;; searching for underscore-backspace and then comparing the following - ;; chars until the sequence ends turns out to be much faster than searching - ;; for a regexp which matches the whole sequence. - (let ((s (match-beginning 0))) - (goto-char s) - (while (and (= (following-char) ?_) - (= (char-after (1+ (point))) ?\b)) - (Manual-delete-char 2) - (forward-char 1)) - (set-extent-face (make-extent s (point)) 'man-italic))) - ;; - ;; turn overstriking into bold - ;; - (goto-char (point-min)) - (while (re-search-forward "\\([^\n]\\)\\(\b\\1\\)" nil t) - ;; Surprisingly, searching for the above regexp is faster than searching - ;; for a backspace and then comparing the preceding and following chars, - ;; I presume because there are many false matches, meaning more funcalls - ;; to re-search-forward. - (let ((s (match-beginning 0))) - (goto-char s) - ;; Some systems (SGI) overstrike multiple times, eg, "M\bM\bM\bM". - (while (looking-at "\\([^\n]\\)\\(\b\\1\\)+") - (delete-region (+ (point) 1) (match-end 0)) - (forward-char 1)) - (set-extent-face (make-extent s (point)) 'man-bold))) - ;; - ;; hack bullets: o^H+ --> + - (goto-char (point-min)) - (while (search-forward "\b" nil t) - (Manual-delete-char -2)) - - (if (> (buffer-size) 100) ; minor kludge - (Manual-nuke-nroff-bs-footers)) - ) ;; not Manual-use-rosetta-man - ;; - ;; turn subsection header lines into bold - ;; - (goto-char (point-min)) - (if apropos-mode - (while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t) - (forward-char -2) - (delete-backward-char 1)) - - ;; (while (re-search-forward "^[^ \t\n]" nil t) - ;; (set-extent-face (make-extent (match-beginning 0) - ;; (progn (end-of-line) (point))) - ;; 'man-heading)) - - ;; boldface the first line - (if (looking-at "[^ \t\n].*$") - (set-extent-face (make-extent (match-beginning 0) (match-end 0)) - 'man-bold)) - - ;; boldface subsequent title lines - ;; Regexp to match section headers changed to match a non-indented - ;; line preceded by a blank line and followed by an indented line. - ;; This seems to work ok for manual pages but gives better results - ;; with other nroff'd files - (while (re-search-forward "\n\n\\([^ \t\n].*\\)\n[ \t]+[^ \t\n]" nil t) - (goto-char (match-end 1)) - (set-extent-face (make-extent (match-beginning 1) (match-end 1)) - 'man-heading) - (forward-line 1)) - ) - - (if Manual-use-rosetta-man - nil - ;; Zap ESC7, ESC8, and ESC9 - ;; This is for Sun man pages like "man 1 csh" - (goto-char (point-min)) - (while (re-search-forward "\e[789]" nil t) - (replace-match ""))) - - ;; Nuke blanks lines at start. - ;; (goto-char (point-min)) - ;; (skip-chars-forward "\n") - ;; (delete-region (point-min) (point)) - - (Manual-mouseify-xrefs) - ) - -(fset 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name - - -(defun Manual-nuke-nroff-bs-footers () - ;; Nuke headers and footers. - ;; - ;; nroff assumes pages are 66 lines high. We assume that, and that the - ;; first and last line on each page is expendible. There is no way to - ;; tell the difference between a page break in the middle of a paragraph - ;; and a page break between paragraphs (the amount of extra whitespace - ;; that nroff inserts is the same in both cases) so this might strip out - ;; a blank line were one should remain. I think that's better than - ;; leaving in a blank line where there shouldn't be one. (Need I say - ;; it: FMH.) - ;; - ;; Note that if nroff spits out error messages, pages will be more than - ;; 66 lines high, and we'll lose badly. That's ok because standard - ;; nroff doesn't do any diagnostics, and the "gnroff" wrapper for groff - ;; turns off error messages for compatibility. (At least, it's supposed - ;; to.) - ;; - (goto-char (point-min)) - ;; first lose the status output - (let ((case-fold-search t)) - (if (and (not (looking-at "[^\n]*warning")) - (looking-at "Reformatting.*\n")) - (delete-region (match-beginning 0) (match-end 0)))) - - ;; kludge around a groff bug where it won't keep quiet about some - ;; warnings even with -Wall or -Ww. - (cond ((looking-at "grotty:") - (while (looking-at "grotty:") - (delete-region (point) (progn (forward-line 1) (point)))) - (if (looking-at " *done\n") - (delete-region (point) (match-end 0))))) - - (let ((pages '()) - p) - ;; collect the page boundary markers before we start deleting, to make - ;; it easier to strip things out without changing the page sizes. - (while (not (eobp)) - (forward-line 66) - (setq pages (cons (point-marker) pages))) - (setq pages (nreverse pages)) - (while pages - (goto-char (car pages)) - (set-marker (car pages) nil) - ;; - ;; The lines are: 3 blank; footer; 6 blank; header; 3 blank. - ;; We're in between the previous footer and the following header, - ;; - ;; First lose 3 blank lines, the header, and then 3 more. - ;; - (setq p (point)) - (skip-chars-forward "\n") - (delete-region p (point)) - (and (looking-at "[^\n]+\n\n?\n?\n?") - (delete-region (match-beginning 0) (match-end 0))) - ;; - ;; Next lose the footer, and the 3 blank lines after, and before it. - ;; But don't lose the last footer of the manual entry; that contains - ;; the "last change" date, so it's not completely uninteresting. - ;; (Actually lose all blank lines before it; sh(1) needs this.) - ;; - (skip-chars-backward "\n") - (beginning-of-line) - (if (null (cdr pages)) - nil - (and (looking-at "[^\n]+\n\n?\n?\n?") - (delete-region (match-beginning 0) (match-end 0)))) - (setq p (point)) - (skip-chars-backward "\n") - (if (> (- p (point)) 4) - (delete-region (+ 2 (point)) p) - (delete-region (1+ (point)) p)) -; (and (looking-at "\n\n?\n?") -; (delete-region (match-beginning 0) (match-end 0))) - - (setq pages (cdr pages))) - ;; - ;; Now nuke the extra blank lines at the beginning and end. - (goto-char (point-min)) - (if (looking-at "\n+") - (delete-region (match-beginning 0) (match-end 0))) - (forward-line 1) - (if (looking-at "\n\n+") - (delete-region (1+ (match-beginning 0)) (match-end 0))) - (goto-char (point-max)) - (skip-chars-backward "\n") - (delete-region (point) (point-max)) - (beginning-of-line) - (forward-char -1) - (setq p (point)) - (skip-chars-backward "\n") - (if (= ?\n (following-char)) (forward-char 1)) - (if (> (point) (1+ p)) - (delete-region (point) p)) - )) - -;(defun Manual-nuke-nroff-bs-footers () -; ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)" -; (goto-char (point-min)) -; (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Za-z]+)\\).*\\1$" nil t) -; (replace-match "")) -; -; ;; -; ;; it would appear that we have a choice between sometimes introducing -; ;; an extra blank line when a paragraph was broken by a footer, and -; ;; sometimes not putting in a blank line between two paragraphs when -; ;; a footer appeared right between them. FMH; I choose the latter. -; ;; -; -; ;; Nuke footers: "Printed 12/3/85 27 April 1981 1" -; ;; Sun appear to be on drugz: -; ;; "Sun Release 3.0B Last change: 1 February 1985 1" -; ;; HP are even worse! -; ;; " Hewlett-Packard -1- (printed 12/31/99)" FMHWA12ID!! -; ;; System V (well WICATs anyway): -; ;; "Page 1 (printed 7/24/85)" -; ;; Who is administering PCP to these corporate bozos? -; (goto-char (point-min)) -; (while (re-search-forward -; (cond -; ((eq system-type 'hpux) -; "\n\n?[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*\n") -; ((eq system-type 'dgux-unix) -; "\n\n?[ \t]*Licensed material--.*Page [0-9]*\n") -; ((eq system-type 'usg-unix-v) -; "\n\n? *Page [0-9]*.*(printed [0-9/]*)\n") -; (t -; "\n\n?\\(Printed\\|Sun Release\\) [0-9].*[0-9]\n")) -; nil t) -; (replace-match "")) -; -; ;; Also, hack X footers: -; ;; "X Version 11 Last change: Release 5 1" -; (goto-char (point-min)) -; (while (re-search-forward "\n\n?X Version [^\n]+\n" nil t) -; (replace-match "")) -; -; ;; Crunch blank lines -; (goto-char (point-min)) -; (while (re-search-forward "\n\n\n\n*" nil t) -; (replace-match "\n\n")) -; ) - -(defun Manual-mouseify-xrefs () - (goto-char (point-min)) - (forward-line 1) - (let ((case-fold-search nil) - s e name extent) - ;; possibly it would be faster to rewrite this expression to search for - ;; a less common sequence first (like "([0-9]") and then back up to see - ;; if it's really a match. This function is 15% of the total time, 13% - ;; of which is this call to re-search-forward. - (while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.]*([0-9][a-zA-Z0-9]*)" - nil t) - (setq s (match-beginning 0) - e (match-end 0) - name (buffer-substring s e)) - (goto-char s) - (skip-chars-backward " \t") - (if (and (bolp) - (progn (backward-char 1) (= (preceding-char) ?-))) - (progn - (setq s (point)) - (skip-chars-backward "-a-zA-Z0-9_.") - (setq name (concat (buffer-substring (point) (1- s)) name)) - (setq s (point)))) - ;; if there are upper case letters in the section, downcase them. - (if (string-match "(.*[A-Z]+.*)$" name) - (setq name (concat (substring name 0 (match-beginning 0)) - (downcase (substring name (match-beginning 0)))))) - ;; (setq already-fontified (extent-at s)) - (setq extent (make-extent s e)) - (set-extent-property extent 'man (list 'Manual-follow-xref name)) - (set-extent-property extent 'highlight t) - ;; (if (not already-fontified)... - (set-extent-face extent 'man-xref) - (goto-char e)))) - -(defun Manual-follow-xref (&optional name-or-event) - "Invoke `manual-entry' on the cross-reference under the mouse. -When invoked noninteractively, the arg may be an xref string to parse instead." - (interactive "e") - (if (eventp name-or-event) - (let* ((p (event-point name-or-event)) - (extent (and p (extent-at p - (event-buffer name-or-event) - 'highlight))) - (data (and extent (extent-property extent 'man)))) - (if (eq (car-safe data) 'Manual-follow-xref) - (eval data) - (error "no manual cross-reference there."))) - (let ((Manual-match-topic-exactly t) - (Manual-query-multiple-pages nil)) - (or (manual-entry name-or-event) - ;; If that didn't work, maybe it's in a different section than the - ;; man page writer expected. For example, man pages tend assume - ;; that all user programs are in section 1, but X tends to generate - ;; makefiles that put things in section "n" instead... - (and (string-match "[ \t]*([^)]+)\\'" name-or-event) - (progn - (message "No entries found for %s; checking other sections..." - name-or-event) - (manual-entry - (substring name-or-event 0 (match-beginning 0)) - nil t))))))) - -(defun Manual-popup-menu (&optional event) - "Pops up a menu of cross-references in this manual page. -If there is a cross-reference under the mouse button which invoked this -command, it will be the first item on the menu. Otherwise, they are -on the menu in the order in which they appear in the buffer." - (interactive "e") - (let ((buffer (current-buffer)) - (sep "---") - (prefix "Show Manual Page for ") - xref items) - (cond (event - (setq buffer (event-buffer event)) - (let* ((p (event-point event)) - (extent (and p (extent-at p buffer 'highlight))) - (data (and extent (extent-property extent 'man)))) - (if (eq (car-safe data) 'Manual-follow-xref) - (setq xref (nth 1 data)))))) - (if xref (setq items (list sep xref))) - (map-extents #'(lambda (extent ignore) - (let ((data (extent-property extent 'man))) - (if (and (eq (car-safe data) 'Manual-follow-xref) - (not (member (nth 1 data) items))) - (setq items (cons (nth 1 data) items))) - nil)) - buffer) - (if (eq sep (car items)) (setq items (cdr items))) - (let ((popup-menu-titles nil)) - (popup-menu - (cons "Manual Entry" - (mapcar #'(lambda (item) - (if (eq item sep) - item - (vector (concat prefix item) - (list 'Manual-follow-xref item) t))) - (nreverse items))))))) - -(defun pager-cleanup-hook () - "cleanup man page if called via $PAGER" - (let ((buf-name (or buffer-file-name (buffer-name)))) - (if (and (or (string-match "^/tmp/man[0-9]+" buf-name) - (string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name)) - (not (string-match Manual-bogus-file-pattern buf-name))) - (let (buffer manpage) - (require 'man) - (goto-char (point-min)) - (setq buffer-read-only nil) - (Manual-nuke-nroff-bs) - (goto-char (point-min)) - (if (re-search-forward "[^ \t]") - (goto-char (- (point) 1))) - (if (looking-at "\\([a-zA-Z0-9]+\\)[ \t]*(") - (setq manpage (buffer-substring (match-beginning 1) (match-end 1))) - (setq manpage "???")) - (setq buffer - (rename-buffer - (generate-new-buffer-name (concat "*man " manpage "*")))) - (setq buffer-file-name nil) - (goto-char (point-min)) - (insert (format "%s\n" buf-name)) - (goto-char (point-min)) - (buffer-disable-undo buffer) - (set-buffer-modified-p nil) - (Manual-mode) - )))) - -(add-hook 'server-visit-hook 'pager-cleanup-hook) -(provide 'man)
--- a/lisp/packages/ps-print.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/packages/ps-print.el Mon Aug 13 08:47:15 2007 +0200 @@ -1900,6 +1900,8 @@ (message "Formatting...done"))))) ;; XEmacs change +(require 'message) ; Until We can get some sensible autoloads, or + ; message-flatten-list gets put somewhere decent. ;; Permit dynamic evaluation at print time of ps-lpr-switches (defun ps-do-despool (filename) (if (or (not (boundp 'ps-spool-buffer))
--- a/lisp/packages/vc.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/packages/vc.el Mon Aug 13 08:47:15 2007 +0200 @@ -1415,6 +1415,11 @@ ) ;;;###autoload +(defun vc-rename-this-file (new) + (interactive "FVC rename file to: ") + (vc-rename-file buffer-file-name new)) + +;;;###autoload (defun vc-update-change-log (&rest args) "Find change log file and add entries from recent RCS logs. The mark is left at the end of the text prepended to the change log.
--- a/lisp/prim/files.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 08:47:15 2007 +0200 @@ -1203,7 +1203,10 @@ (setq alist (cdr alist)))) ;; If we can't deduce a mode from the file name, ;; look for an interpreter specified in the first line. - (if (null mode) + (if (and (null mode) + (save-excursion ; XEmacs + (goto-char (point-min)) + (looking-at "#!"))) (let ((firstline (buffer-substring (point-min)
--- a/lisp/prim/lisp.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/lisp.el Mon Aug 13 08:47:15 2007 +0200 @@ -115,7 +115,7 @@ With argument, do this that many times. A negative argument means move forward but still to a less deep spot. In Lisp programs, an argument is required." - (interactive "p") + (interactive "_p") (up-list (- arg))) (defun up-list (arg)
--- a/lisp/prim/loaddefs.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/loaddefs.el Mon Aug 13 08:47:15 2007 +0200 @@ -1252,7 +1252,7 @@ ;;;*** -;;;### (autoloads (rsh telnet) "telnet" "comint/telnet.el" (12864 53480)) +;;;### (autoloads (rsh telnet) "telnet" "comint/telnet.el" (12974 22547)) ;;; Generated autoloads from comint/telnet.el (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)") @@ -1832,7 +1832,7 @@ ;;;*** -;;;### (autoloads (electric-buffer-list) "ebuff-menu" "electric/ebuff-menu.el" (12863 14816)) +;;;### (autoloads (electric-buffer-list) "ebuff-menu" "electric/ebuff-menu.el" (12978 18989)) ;;; Generated autoloads from electric/ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -1850,6 +1850,11 @@ Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. +Non-null optional arg FILES-ONLY means mention only file buffers. +When called from Lisp code, FILES-ONLY may be a regular expression, +in which case only buffers whose names match that expression are listed, +or an arbitrary predicate function. + \\{electric-buffer-menu-mode-map}" t nil) ;;;*** @@ -4028,11 +4033,11 @@ ;;; Generated autoloads from ilisp/ilisp-mov.el ;;;*** - -;;;### (autoloads nil "ilisp-out" "ilisp/ilisp-out.el" (12930 49586)) + +;;;*** + +;;;### (autoloads nil "ilisp-out" "ilisp/ilisp-out.el" (12976 40472)) ;;; Generated autoloads from ilisp/ilisp-out.el - -;;;*** ;;;### (autoloads nil "ilisp-prc" "ilisp/ilisp-prc.el" (12930 49354)) ;;; Generated autoloads from ilisp/ilisp-prc.el @@ -4329,6 +4334,31 @@ (autoload 'mc-mh-snarf-keys "mc-toplev" nil t nil) ;;;*** + +;;;*** + +;;;### (autoloads nil "mel-b" "mel/mel-b.el" (12753 23908)) +;;; Generated autoloads from mel/mel-b.el + +;;;*** + +;;;### (autoloads nil "mel-g" "mel/mel-g.el" (12753 25709)) +;;; Generated autoloads from mel/mel-g.el + +;;;*** + +;;;### (autoloads nil "mel-q" "mel/mel-q.el" (12916 44214)) +;;; Generated autoloads from mel/mel-q.el + +;;;*** + +;;;### (autoloads nil "mel-u" "mel/mel-u.el" (12753 25469)) +;;; Generated autoloads from mel/mel-u.el + +;;;*** + +;;;### (autoloads nil "mel" "mel/mel.el" (12870 49280)) +;;; Generated autoloads from mel/mel.el ;;;### (autoloads (mh-letter-mode mh-smail-other-window mh-smail-batch mh-smail) "mh-comp" "mh-e/mh-comp.el" (12657 40772)) ;;; Generated autoloads from mh-e/mh-comp.el @@ -4695,9 +4725,84 @@ ;;;*** -;;;### (autoloads nil "cc-mode" "modes/cc-mode.el" (12964 17751)) +;;;### (autoloads (c-set-style java-mode objc-mode c++-mode c-mode) "cc-mode" "modes/cc-mode.el" (12978 36702)) ;;; Generated autoloads from modes/cc-mode.el +(autoload 'c-mode "cc-mode" "\ +Major mode for editing K&R and ANSI C code. +To submit a problem report, enter `\\[c-submit-bug-report]' from a +c-mode buffer. This automatically sets up a mail buffer with version +information already added. You just need to add a description of the +problem, including a reproducible test case and send the message. + +To see what version of cc-mode you are running, enter `\\[c-version]'. + +The hook variable `c-mode-hook' is run with no args, if that value is +bound and has a non-nil value. Also the hook `c-mode-common-hook' is +run first. + +Key bindings: +\\{c-mode-map}" t nil) + +(autoload 'c++-mode "cc-mode" "\ +Major mode for editing C++ code. +To submit a problem report, enter `\\[c-submit-bug-report]' from a +c++-mode buffer. This automatically sets up a mail buffer with +version information already added. You just need to add a description +of the problem, including a reproducible test case, and send the +message. + +To see what version of cc-mode you are running, enter `\\[c-version]'. + +The hook variable `c++-mode-hook' is run with no args, if that +variable is bound and has a non-nil value. Also the hook +`c-mode-common-hook' is run first. + +Key bindings: +\\{c++-mode-map}" t nil) + +(autoload 'objc-mode "cc-mode" "\ +Major mode for editing Objective C code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +objc-mode buffer. This automatically sets up a mail buffer with +version information already added. You just need to add a description +of the problem, including a reproducible test case, and send the +message. + +To see what version of cc-mode you are running, enter `\\[c-version]'. + +The hook variable `objc-mode-hook' is run with no args, if that value +is bound and has a non-nil value. Also the hook `c-mode-common-hook' +is run first. + +Key bindings: +\\{objc-mode-map}" t nil) + +(autoload 'java-mode "cc-mode" "\ +Major mode for editing Java code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +java-mode buffer. This automatically sets up a mail buffer with +version information already added. You just need to add a description +of the problem, including a reproducible test case and send the +message. + +To see what version of cc-mode you are running, enter `\\[c-version]'. + +The hook variable `java-mode-hook' is run with no args, if that value +is bound and has a non-nil value. Also the common hook +`c-mode-common-hook' is run first. Note that this mode automatically +sets the \"java\" style before calling any hooks so be careful if you +set styles in `c-mode-common-hook'. + +Key bindings: +\\{java-mode-map}" t nil) + +(autoload 'c-set-style "cc-mode" "\ +Set cc-mode variables to use one of several different indentation styles. +STYLENAME is a string representing the desired style from the list of +styles described in the variable `c-style-alist'. See that variable +for details of setting up styles." t nil) + (fset 'set-c-style 'c-set-style) ;;;*** @@ -4733,6 +4838,14 @@ ;;;### (autoloads nil "cperl-mode" "modes/cperl-mode.el" (12947 52528)) ;;; Generated autoloads from modes/cperl-mode.el +;;;### (autoloads (eiffel-mode) "eiffel3" "modes/eiffel3.el" (12975 20283)) +;;; Generated autoloads from modes/eiffel3.el + +(autoload 'eiffel-mode "eiffel3" "\ +Major mode for editing Eiffel programs." t nil) + +;;;*** + ;;;### (autoloads (enriched-decode enriched-encode enriched-mode) "enriched" "modes/enriched.el" (12860 19332)) ;;; Generated autoloads from modes/enriched.el @@ -5155,7 +5268,7 @@ ;;; Generated autoloads from modes/ksh-mode.el (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.1.1.3 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.1.1.4 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -7246,9 +7359,17 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "buff-menu" "packages/buff-menu.el" (12941 16898)) + +;;;*** + +;;;### (autoloads nil "buff-menu" "packages/buff-menu.el" (12979 22272)) ;;; Generated autoloads from packages/buff-menu.el + +(defvar list-buffers-directory) + +(make-variable-buffer-local 'list-buffers-directory) + +;;;*** ;;;### (autoloads (command-history-mode list-command-history repeat-matching-complex-command) "chistory" "packages/chistory.el" (12860 19367)) ;;; Generated autoloads from packages/chistory.el @@ -7321,7 +7442,7 @@ ;;;*** -;;;### (autoloads (first-error previous-error next-error compilation-minor-mode grep compile) "compile" "packages/compile.el" (12906 48567)) +;;;### (autoloads (first-error previous-error next-error compilation-minor-mode grep compile) "compile" "packages/compile.el" (12976 36509)) ;;; Generated autoloads from packages/compile.el (defvar compilation-mode-hook nil "\ @@ -8590,7 +8711,7 @@ ;;;### (autoloads nil "lispm-fonts" "packages/lispm-fonts.el" (12376 19482)) ;;; Generated autoloads from packages/lispm-fonts.el -;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer) "lpr" "packages/lpr.el" (12860 19392)) +;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer) "lpr" "packages/lpr.el" (12974 16779)) ;;; Generated autoloads from packages/lpr.el (defvar lpr-switches nil "\ @@ -8686,6 +8807,11 @@ redisplayed as output is inserted." t nil) ;;;*** + +;;;*** + +;;;### (autoloads nil "mic-paren" "packages/mic-paren.el" (12861 33586)) +;;; Generated autoloads from packages/mic-paren.el ;;;### (autoloads nil "mime-compose" "packages/mime-compose.el" (12727 30155)) ;;; Generated autoloads from packages/mime-compose.el @@ -8777,7 +8903,7 @@ ;;;*** -;;;### (autoloads (ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "packages/ps-print.el" (12934 24347)) +;;;### (autoloads (ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "packages/ps-print.el" (12974 16330)) ;;; Generated autoloads from packages/ps-print.el (defvar ps-paper-type 'ps-letter "\ @@ -9227,7 +9353,7 @@ ;;;*** -;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-version-diff vc-diff vc-register vc-next-action vc-file-status) "vc" "packages/vc.el" (12851 23437)) +;;;### (autoloads (vc-update-change-log vc-rename-this-file vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-version-diff vc-diff vc-register vc-next-action vc-file-status) "vc" "packages/vc.el" (12976 37023)) ;;; Generated autoloads from packages/vc.el (defvar vc-checkin-hook nil "\ @@ -9346,6 +9472,8 @@ (autoload 'vc-rename-file "vc" "\ Rename file OLD to NEW, and rename its master file likewise." t nil) +(autoload 'vc-rename-this-file "vc" nil t nil) + (autoload 'vc-update-change-log "vc" "\ Find change log file and add entries from recent RCS logs. The mark is left at the end of the text prepended to the change log. @@ -9636,11 +9764,11 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "files" "prim/files.el" (12920 56154)) + +;;;*** + +;;;### (autoloads nil "files" "prim/files.el" (12975 35300)) ;;; Generated autoloads from prim/files.el - -;;;*** ;;;### (autoloads nil "fill" "prim/fill.el" (12877 49271)) ;;; Generated autoloads from prim/fill.el @@ -9704,8 +9832,10 @@ ;;; Generated autoloads from prim/keymap.el ;;;*** - -;;;### (autoloads nil "lisp" "prim/lisp.el" (12860 19424)) + +;;;*** + +;;;### (autoloads nil "lisp" "prim/lisp.el" (12976 34290)) ;;; Generated autoloads from prim/lisp.el ;;;*** @@ -9717,9 +9847,23 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "loaddefs" "prim/loaddefs.el" (12971 18885)) + +;;;*** + +;;;*** + +;;;*** + +;;;*** + +;;;*** + +;;;*** + +;;;### (autoloads nil "loaddefs" "prim/loaddefs.el" (12978 37092)) ;;; Generated autoloads from prim/loaddefs.el + +;;;*** ;;;### (autoloads nil "loadup-el" "prim/loadup-el.el" (12639 8618)) ;;; Generated autoloads from prim/loadup-el.el @@ -9819,11 +9963,11 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "minibuf" "prim/minibuf.el" (12929 30936)) + +;;;*** + +;;;### (autoloads nil "minibuf" "prim/minibuf.el" (12977 40507)) ;;; Generated autoloads from prim/minibuf.el - -;;;*** ;;;### (autoloads nil "misc" "prim/misc.el" (12860 19429)) ;;; Generated autoloads from prim/misc.el @@ -9835,8 +9979,10 @@ ;;;### (autoloads nil "modeline" "prim/modeline.el" (12860 31802)) ;;; Generated autoloads from prim/modeline.el - -;;;### (autoloads nil "mouse" "prim/mouse.el" (12744 55115)) + +;;;*** + +;;;### (autoloads nil "mouse" "prim/mouse.el" (12976 36365)) ;;; Generated autoloads from prim/mouse.el ;;;### (autoloads (disable-command enable-command disabled-command-hook) "novice" "prim/novice.el" (12869 1329)) @@ -9963,8 +10109,10 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "replace" "prim/replace.el" (12870 12308)) + +;;;*** + +;;;### (autoloads nil "replace" "prim/replace.el" (12967 11006)) ;;; Generated autoloads from prim/replace.el ;;;### (autoloads (reposition-window) "reposition" "prim/reposition.el" (12868 64283)) @@ -10001,8 +10149,10 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "simple" "prim/simple.el" (12971 16993)) + +;;;*** + +;;;### (autoloads nil "simple" "prim/simple.el" (12976 34445)) ;;; Generated autoloads from prim/simple.el ;;;### (autoloads (reverse-region sort-columns sort-regexp-fields sort-fields sort-float-fields sort-numeric-fields sort-pages sort-paragraphs sort-lines sort-subr) "sort" "prim/sort.el" (12868 64792)) @@ -10144,15 +10294,15 @@ ;;; Generated autoloads from prim/specifier.el ;;;*** - -;;;### (autoloads nil "startup" "prim/startup.el" (12851 23466)) + +;;;*** + +;;;### (autoloads nil "startup" "prim/startup.el" (12975 23336)) ;;; Generated autoloads from prim/startup.el ;;;*** ;;;*** - -;;;*** ;;;### (autoloads nil "subr" "prim/subr.el" (12971 17139)) ;;; Generated autoloads from prim/subr.el @@ -10783,11 +10933,11 @@ ;;; Generated autoloads from tl/file-detect.el ;;;*** - -;;;### (autoloads nil "mime-setup" "tl/mime-setup.el" (12972 48090)) + +;;;*** + +;;;### (autoloads nil "mime-setup" "tl/mime-setup.el" (12972 55323)) ;;; Generated autoloads from tl/mime-setup.el - -;;;*** ;;;### (autoloads nil "mu-comment" "tl/mu-comment.el" (12714 41382)) ;;; Generated autoloads from tl/mu-comment.el @@ -11980,7 +12130,7 @@ ;;;*** -;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" "utils/mail-extr.el" (12851 23488)) +;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" "utils/mail-extr.el" (12976 37825)) ;;; Generated autoloads from utils/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -12942,11 +13092,11 @@ ;;;*** ;;;*** - -;;;### (autoloads nil "x-menubar" "x11/x-menubar.el" (12874 15306)) + +;;;*** + +;;;### (autoloads nil "x-menubar" "x11/x-menubar.el" (12976 37346)) ;;; Generated autoloads from x11/x-menubar.el - -;;;*** ;;;### (autoloads nil "x-misc" "x11/x-misc.el" (12639 8659)) ;;; Generated autoloads from x11/x-misc.el
--- a/lisp/prim/minibuf.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/minibuf.el Mon Aug 13 08:47:15 2007 +0200 @@ -1215,9 +1215,7 @@ (let ((elt (nth (1- minibuffer-history-position) (symbol-value minibuffer-history-variable)))) (insert - (if (and minibuffer-history-sexp-flag - ;; total kludge - (not (stringp elt))) + (if (not (stringp elt)) (let ((print-level nil)) (condition-case nil (let ((print-readably t)
--- a/lisp/prim/mouse.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/mouse.el Mon Aug 13 08:47:15 2007 +0200 @@ -770,9 +770,17 @@ (cond ((eq type 'word) ;; trap the beginning and end of buffer errors (condition-case () - (if forwardp - (default-mouse-track-end-of-word t) - (default-mouse-track-beginning-of-word t)) + (progn + (setq type (char-syntax (char-after (point)))) + (if forwardp + (if (= type ?\() + (goto-char (scan-sexps (point) 1)) + (if (= type ?\)) + (forward-char 1) + (default-mouse-track-end-of-word t))) + (if (= type ?\)) + (goto-char (scan-sexps (1+ (point)) -1)) + (default-mouse-track-beginning-of-word t)))) (error ()))) ((eq type 'line) (if forwardp (end-of-line) (beginning-of-line)))
--- a/lisp/prim/simple.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 08:47:15 2007 +0200 @@ -861,13 +861,13 @@ ;; XEmacs -- shouldn't these functions keep the zmacs region active? (defun forward-to-indentation (arg) "Move forward ARG lines and position at first nonblank character." - (interactive "p") + (interactive "_p") (forward-line arg) (skip-chars-forward " \t")) (defun backward-to-indentation (arg) "Move backward ARG lines and position at first nonblank character." - (interactive "p") + (interactive "_p") (forward-line (- arg)) (skip-chars-forward " \t")) @@ -1227,8 +1227,10 @@ ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command ;; loop would deactivate the mark because we inserted text. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer))))) + ;; (But doesn't work in XEmacs) + ;(goto-char (prog1 (mark t) + ;(set-marker (mark-marker) (point) (current-buffer))))) + (exchange-point-and-mark t)) ;; If we do get all the way thru, make this-command indicate that. (setq this-command 'yank) nil)
--- a/lisp/prim/startup.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/prim/startup.el Mon Aug 13 08:47:15 2007 +0200 @@ -1134,6 +1134,11 @@ (file-name-as-directory (expand-file-name "../xemacs/lock" root)) ))))) + + ;; 1996/12/6 by MORIOKA Tomohiko <morioka@jaist.ac.jp> + ;; define `default-load-path' for file-detect.el + (setq default-load-path load-path) + ;; add site-lisp dir to load-path (if site-lisp (progn @@ -1174,8 +1179,18 @@ (setq load-path (nconc load-path (list (file-name-as-directory file))))) - (setq files (cdr files)))) - )) + (setq files (cdr files)))))) + + ;; 1996/12/6 by MORIOKA Tomohiko <morioka@jaist.ac.jp> + ;; define `default-load-path' for file-detect.el + (setq default-load-path + (append default-load-path + (if site-lisp + (list site-lisp)) + (if lisp + (list lisp) + ) + )) ;; If running from the build directory, always prefer the exec-directory ;; that is here over the one that came from paths.h.
--- a/lisp/utils/mail-extr.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/utils/mail-extr.el Mon Aug 13 08:47:15 2007 +0200 @@ -1171,7 +1171,8 @@ (setq %-pos (nreverse %-pos)) ;; RFC 1034 doesn't approve of this, oh well: - (downcase-region (or (car %-pos) @-pos (point-max)) (point-max)) + ;; Neither do we, sb/lmi + ;; (downcase-region (or (car %-pos) @-pos (point-max)) (point-max)) (cond (%-pos ; implies @-pos valid (setq temp %-pos) (catch 'truncated
--- a/lisp/version.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/version.el Mon Aug 13 08:47:15 2007 +0200 @@ -26,7 +26,7 @@ (defconst emacs-version "19.15" "\ Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta3)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta4)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/x11/x-menubar.el Mon Aug 13 08:46:57 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 08:47:15 2007 +0200 @@ -501,6 +501,7 @@ ("Tools" ["Grep..." grep t] ["Compile..." compile t] + ["Shell" shell t] ["Shell Command..." shell-command t] ["Shell Command on Region..." shell-command-on-region (region-exists-p)] @@ -514,7 +515,7 @@ ["Tags Search..." tags-search t] ["Tags Replace..." tags-query-replace t] "-----" - ["Continue" tags-loop-continue t] + ["Continue Search/Replace" tags-loop-continue t] ["Pop stack" pop-tag-mark t] ["Apropos..." tags-apropos t])) @@ -532,6 +533,10 @@ (expand-file-name "sample.emacs" data-directory)) t] + ["Sample .Xdefaults" (find-file + (expand-file-name "sample.Xdefaults" + data-directory)) + t] "-----" ["Info (Detailed Docs)" info t] ("Lookup in Info" @@ -710,7 +715,9 @@ (defvar buffers-menu-submenus-for-groups-p nil "*If true, the buffers menu will contain one submenu per group of buffers, -if a grouping function is specified in `buffers-menu-grouping-function'.") +if a grouping function is specified in `buffers-menu-grouping-function'. +If this is an integer, do not build submenus if the number of buffers +is not larger than this value.") (defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer "*The function to call to select a buffer from the buffers menu. @@ -876,12 +883,16 @@ (and (integerp buffers-menu-max-size) (> buffers-menu-max-size 1) (> (length buffers) buffers-menu-max-size) - ;; shorten list of buffers + ;; shorten list of buffers (not with submenus!) + (not (and buffers-menu-grouping-function + buffers-menu-submenus-for-groups-p)) (setcdr (nthcdr buffers-menu-max-size buffers) nil)) (if buffers-menu-sort-function (setq buffers (sort buffers buffers-menu-sort-function))) (if (and buffers-menu-grouping-function - buffers-menu-submenus-for-groups-p) + buffers-menu-submenus-for-groups-p + (or (not (integerp buffers-menu-submenus-for-groups-p)) + (> (length buffers) buffers-menu-submenus-for-groups-p))) (let (groups groupnames current-group) (mapl #'(lambda (sublist) @@ -1063,7 +1074,9 @@ (face-property ',face ',property) ',(save-options-specifier-spec-list face property)))) -p built-in-face-specifiers))) + (delq 'display-table + (copy-sequence + built-in-face-specifiers))))) (face-list)))) ))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/site-lisp/emu-e19.el Mon Aug 13 08:47:15 2007 +0200 @@ -0,0 +1,265 @@ +;;; emu-e19.el --- emu module for Emacs 19 and XEmacs 19 + +;; Copyright (C) 1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Version: $Id: emu-e19.el,v 1.1.1.1 1996/12/18 04:06:19 steve Exp $ +;; Keywords: emulation, compatibility, mule, Latin-1 + +;; This file is part of emu. + +;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +;;; @ version and variant specific features +;;; + +(cond (running-xemacs + (require 'emu-xemacs)) + (running-emacs-19 + (require 'emu-19) + )) + + +;;; @ character set +;;; + +(defconst charset-ascii 0 "Character set of ASCII") +(defconst charset-latin-iso8859-1 129 "Character set of ISO-8859-1") + +(defun charset-description (charset) + "Return description of CHARSET. [emu-e19.el]" + (if (< charset 128) + (documentation-property 'charset-ascii 'variable-documentation) + (documentation-property 'charset-latin-iso8859-1 'variable-documentation) + )) + +(defun charset-registry (charset) + "Return registry name of CHARSET. [emu-e19.el]" + (if (< charset 128) + "ASCII" + "ISO8859-1")) + +(defun charset-columns (charset) + "Return number of columns a CHARSET occupies when displayed. +\[emu-e19.el]" + 1) + +(defun charset-direction (charset) + "Return the direction of a character of CHARSET by + 0 (left-to-right) or 1 (right-to-left). [emu-e19.el]" + 0) + +(defun find-charset-string (str) + "Return a list of charsets in the string. +\[emu-e19.el; Mule emulating function]" + (if (string-match "[\200-\377]" str) + (list charset-latin-iso8859-1) + )) + +(defalias 'find-non-ascii-charset-string 'find-charset-string) + +(defun find-charset-region (start end) + "Return a list of charsets in the region between START and END. +\[emu-e19.el; Mule emulating function]" + (if (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (re-search-forward "[\200-\377]" nil t) + )) + (list charset-latin-iso8859-1) + )) + +(defalias 'find-non-ascii-charset-region 'find-charset-region) + + +;;; @ coding-system +;;; + +(defconst *internal* nil) +(defconst *ctext* nil) +(defconst *noconv* nil) + +(defun decode-coding-string (string coding-system) + "Decode the STRING which is encoded in CODING-SYSTEM. +\[emu-e19.el; Emacs 20 emulating function]" + string) + +(defun encode-coding-string (string coding-system) + "Encode the STRING as CODING-SYSTEM. +\[emu-e19.el; Emacs 20 emulating function]" + string) + +(defun decode-coding-region (start end coding-system) + "Decode the text between START and END which is encoded in CODING-SYSTEM. +\[emu-e19.el; Emacs 20 emulating function]" + 0) + +(defun encode-coding-region (start end coding-system) + "Encode the text between START and END to CODING-SYSTEM. +\[emu-e19.el; Emacs 20 emulating function]" + 0) + +(defun detect-coding-region (start end) + "Detect coding-system of the text in the region between START and END. +\[emu-e19.el; Emacs 20 emulating function]" + ) + +(defun set-buffer-file-coding-system (coding-system &optional force) + "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM. +\[emu-e19.el; Emacs 20 emulating function]" + ) + +(defmacro as-binary-process (&rest body) + (` (let (selective-display) ; Disable ^M to nl translation. + (,@ body) + ))) + +(defmacro as-binary-input-file (&rest body) + (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2 + (,@ body) + ))) + + +;;; @@ for old MULE emulation +;;; + +(defun code-convert-string (str ic oc) + "Convert code in STRING from SOURCE code to TARGET code, +On successful converion, returns the result string, +else returns nil. [emu-e19.el; old MULE emulating function]" + str) + +(defun code-convert-region (beg end ic oc) + "Convert code of the text between BEGIN and END from SOURCE +to TARGET. On successful conversion returns t, +else returns nil. [emu-e19.el; old MULE emulating function]" + t) + + +;;; @ MIME charset +;;; + +(defvar charsets-mime-charset-alist + (list (cons (list charset-ascii) 'us-ascii))) + +(defvar default-mime-charset 'iso-8859-1) + +(defun mime-charset-to-coding-system (charset) + (if (stringp charset) + (setq charset (intern (downcase charset))) + ) + (and (memq charset (list 'us-ascii default-mime-charset)) + charset) + ) + +(defun detect-mime-charset-region (start end) + "Return MIME charset for region between START and END. +\[emu-e19.el]" + (if (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (re-search-forward "[\200-\377]" nil t) + )) + default-mime-charset + 'us-ascii)) + +(defun encode-mime-charset-region (start end charset) + "Encode the text between START and END as MIME CHARSET. +\[emu-e19.el]" + ) + +(defun decode-mime-charset-region (start end charset) + "Decode the text between START and END as MIME CHARSET. +\[emu-e19.el]" + ) + +(defun encode-mime-charset-string (string charset) + "Encode the STRING as MIME CHARSET. [emu-e19.el]" + string) + +(defun decode-mime-charset-string (string charset) + "Decode the STRING as MIME CHARSET. [emu-e19.el]" + string) + + +;;; @ character +;;; + +(defun char-charset (chr) + "Return the character set of char CHR. +\[emu-e19.el; XEmacs 20 emulating function]" + (if (< chr 128) + charset-ascii + charset-latin-iso8859-1)) + +(defun char-bytes (char) + "Return number of bytes a character in CHAR occupies in a buffer. +\[emu-e19.el; MULE emulating function]" + 1) + +(defalias 'char-length 'char-bytes) + +(defun char-columns (character) + "Return number of columns a CHARACTER occupies when displayed. +\[emu-e19.el]" + 1) + +;;; @@ for old MULE emulation +;;; + +(defalias 'char-width 'char-columns) + +(defalias 'char-leading-char 'char-charset) + + +;;; @ string +;;; + +(defalias 'string-columns 'length) + +(defun string-to-char-list (str) + (mapcar (function identity) str) + ) + +(defalias 'string-to-int-list 'string-to-char-list) + +(defalias 'sref 'aref) + +(defun truncate-string (str width &optional start-column) + "Truncate STR to fit in WIDTH columns. +Optional non-nil arg START-COLUMN specifies the starting column. +\[emu-e19.el; MULE 2.3 emulating function]" + (or start-column + (setq start-column 0)) + (substring str start-column width) + ) + +;;; @@ for old MULE emulation +;;; + +(defalias 'string-width 'length) + + +;;; @ end +;;; + +(provide 'emu-e19) + +;;; emu-e19.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/site-lisp/emu-xemacs.el Mon Aug 13 08:47:15 2007 +0200 @@ -0,0 +1,172 @@ +;;; emu-xemacs.el --- emu API implementation for XEmacs + +;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Version: +;; $Id: emu-xemacs.el,v 1.1.1.1 1996/12/18 04:06:19 steve Exp $ +;; Keywords: emulation, compatibility, XEmacs + +;; This file is part of emu. + +;; 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, 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Code: + +;;; @ text property +;;; + +(or (fboundp 'face-list) + (defalias 'face-list 'list-faces) + ) + +(or (memq 'underline (face-list)) + (and (fboundp 'make-face) + (make-face 'underline) + )) + +(or (face-differs-from-default-p 'underline) + (set-face-underline-p 'underline t)) + +(or (fboundp 'tl:set-text-properties) + (defun tl:set-text-properties (start end props &optional buffer) + (if (or (null buffer) (bufferp buffer)) + (if props + (while props + (put-text-property + start end (car props) (nth 1 props) buffer) + (setq props (nthcdr 2 props))) + (remove-text-properties start end ()) + ))) + ) + +(defun tl:add-text-properties (start end properties) + (add-text-properties start end + (append properties (list 'highlight t)) + ) + ) + +(defalias 'tl:make-overlay 'make-extent) +(defalias 'tl:overlay-put 'set-extent-property) +(defalias 'tl:overlay-buffer 'extent-buffer) + +(defun tl:move-overlay (extent start end &optional buffer) + (set-extent-endpoints extent start end) + ) + + +;;; @@ visible/invisible +;;; + +(defmacro enable-invisible ()) + +(defmacro end-of-invisible ()) + +(defun invisible-region (start end) + (if (save-excursion + (goto-char start) + (eq (following-char) ?\n) + ) + (setq start (1+ start)) + ) + (put-text-property start end 'invisible t) + ) + +(defun visible-region (start end) + (put-text-property start end 'invisible nil) + ) + +(defun invisible-p (pos) + (if (save-excursion + (goto-char pos) + (eq (following-char) ?\n) + ) + (setq pos (1+ pos)) + ) + (get-text-property pos 'invisible) + ) + +(defun next-visible-point (pos) + (save-excursion + (if (save-excursion + (goto-char pos) + (eq (following-char) ?\n) + ) + (setq pos (1+ pos)) + ) + (or (next-single-property-change pos 'invisible) + (point-max)) + )) + + +;;; @ mouse +;;; + +(defvar mouse-button-1 'button1) +(defvar mouse-button-2 'button2) +(defvar mouse-button-3 'button3) + + +;;; @ dired +;;; + +(or (fboundp 'dired-other-frame) + (defun dired-other-frame (dirname &optional switches) + "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame." + (interactive (dired-read-dir-and-switches "in other frame ")) + (switch-to-buffer-other-frame (dired-noselect dirname switches)) + ) + ) + + +;;; @ string +;;; + +(defmacro char-list-to-string (char-list) + "Convert list of character CHAR-LIST to string. [emu-xemacs.el]" + `(mapconcat #'char-to-string ,char-list "")) + + +;;; @@ to avoid bug of XEmacs 19.14 +;;; + +(or (string-match "^../" + (file-relative-name "/usr/local/share" "/usr/local/lib")) + ;; This function was imported from Emacs 19.33. + (defun file-relative-name (filename &optional directory) + "Convert FILENAME to be relative to DIRECTORY +(default: default-directory). [emu-xemacs.el]" + (setq filename (expand-file-name filename) + directory (file-name-as-directory + (expand-file-name + (or directory default-directory)))) + (let ((ancestor "")) + (while (not (string-match (concat "^" (regexp-quote directory)) + filename)) + (setq directory (file-name-directory (substring directory 0 -1)) + ancestor (concat "../" ancestor))) + (concat ancestor (substring filename (match-end 0))) + )) + ) + + +;;; @ end +;;; + +(provide 'emu-xemacs) + +;;; emu-xemacs.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/site-lisp/emu.el Mon Aug 13 08:47:15 2007 +0200 @@ -0,0 +1,293 @@ +;;; emu.el --- Emulation module for each Emacs variants + +;; Copyright (C) 1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Version: $Id: emu.el,v 1.1.1.1 1996/12/18 04:06:19 steve Exp $ +;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs + +;; This file is part of emu. + +;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(defmacro defun-maybe (name &rest everything-else) + (or (and (fboundp name) + (not (get name 'defun-maybe)) + ) + (` (or (fboundp (quote (, name))) + (progn + (defun (, name) (,@ everything-else)) + (put (quote (, name)) 'defun-maybe t) + )) + ))) + +(put 'defun-maybe 'lisp-indent-function 'defun) + + +(or (boundp 'emacs-major-version) + (defconst emacs-major-version (string-to-int emacs-version))) +(or (boundp 'emacs-minor-version) + (defconst emacs-minor-version + (string-to-int + (substring + emacs-version + (string-match (format "%d\\." emacs-major-version) emacs-version) + )))) + +(defvar running-emacs-18 (<= emacs-major-version 18)) +(defvar running-xemacs (string-match "XEmacs" emacs-version)) + +(defvar running-mule-merged-emacs (and (not (boundp 'MULE)) + (not running-xemacs) (featurep 'mule))) +(defvar running-xemacs-with-mule (and running-xemacs (featurep 'mule))) + +(defvar running-emacs-19 (and (not running-xemacs) (= emacs-major-version 19))) +(defvar running-emacs-19_29-or-later + (or (and running-emacs-19 (>= emacs-minor-version 29)) + (and (not running-xemacs)(>= emacs-major-version 20)))) + +(defvar running-xemacs-19 (and running-xemacs + (= emacs-major-version 19))) +(defvar running-xemacs-20-or-later (and running-xemacs + (>= emacs-major-version 20))) +(defvar running-xemacs-19_14-or-later + (or (and running-xemacs-19 (>= emacs-minor-version 14)) + running-xemacs-20-or-later)) + +(cond (running-mule-merged-emacs + ;; for mule merged EMACS + (require 'emu-e20) + ) + (running-xemacs-with-mule + ;; for XEmacs/mule + (require 'emu-x20) + ) + ((boundp 'MULE) + ;; for MULE 1.* and 2.* + (require 'emu-mule) + ) + ((boundp 'NEMACS) + ;; for NEmacs and NEpoch + (require 'emu-nemacs) + ) + (t + ;; for EMACS 19 and XEmacs 19 (without mule) + (require 'emu-e19) + )) + + +;;; @ binary access +;;; + +(defun insert-binary-file-contents-literally + (filename &optional visit beg end replace) + "Like `insert-file-contents-literally', q.v., but don't code conversion. +A buffer may be modified in several ways after reading into the buffer due +to advanced Emacs features, such as file-name-handlers, format decoding, +find-file-hooks, etc. + This function ensures that none of these modifications will take place. +\[emu.el]" + (as-binary-input-file + (insert-file-contents-literally filename visit beg end replace) + )) + + +;;; @ MIME charset +;;; + +(defun charsets-to-mime-charset (charsets) + "Return MIME charset from list of charset CHARSETS. +This function refers variable `charsets-mime-charset-alist' +and `default-mime-charset'. [emu.el]" + (if charsets + (or (catch 'tag + (let ((rest charsets-mime-charset-alist) + cell csl) + (while (setq cell (car rest)) + (if (catch 'not-subset + (let ((set1 charsets) + (set2 (car cell)) + obj) + (while set1 + (setq obj (car set1)) + (or (memq obj set2) + (throw 'not-subset nil) + ) + (setq set1 (cdr set1)) + ) + t)) + (throw 'tag (cdr cell)) + ) + (setq rest (cdr rest)) + ))) + default-mime-charset))) + + +;;; @ EMACS 19.29 emulation +;;; + +(defvar path-separator ":" + "Character used to separate concatenated paths.") + +(defun-maybe buffer-substring-no-properties (beg end) + "Return the text from BEG to END, without text properties, as a string. +\[emu.el; EMACS 19.29 emulating function]" + (let ((string (buffer-substring beg end))) + (tl:set-text-properties 0 (length string) nil string) + string)) + +(defun-maybe match-string (num &optional string) + "Return string of text matched by last search. +NUM specifies which parenthesized expression in the last regexp. + Value is nil if NUMth pair didn't match, or there were less than NUM pairs. +Zero means the entire text matched by the whole regexp or whole string. +STRING should be given if the last search was by `string-match' on STRING. +\[emu.el; EMACS 19.29 emulating function]" + (if (match-beginning num) + (if string + (substring string (match-beginning num) (match-end num)) + (buffer-substring (match-beginning num) (match-end num))))) + +(or running-emacs-19_29-or-later + running-xemacs + ;; for Emacs 19.28 or earlier + (fboundp 'si:read-string) + (progn + (fset 'si:read-string (symbol-function 'read-string)) + + (defun read-string (prompt &optional initial-input history) + "Read a string from the minibuffer, prompting with string PROMPT. +If non-nil, second arg INITIAL-INPUT is a string to insert before reading. +The third arg HISTORY, is dummy for compatibility. [emu.el] +See `read-from-minibuffer' for details of HISTORY argument." + (si:read-string prompt initial-input) + ) + )) + +;; This function was imported Emacs 19.30. +(defun-maybe add-to-list (list-var element) + "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. +If you want to use `add-to-list' on a variable that is not defined +until a certain package is loaded, you should put the call to `add-to-list' +into a hook function that will be run only after loading the package. +\[emu.el; EMACS 19.30 emulating function]" + (or (member element (symbol-value list-var)) + (set list-var (cons element (symbol-value list-var))) + )) + + +;;; @ EMACS 19.30 emulation +;;; + +(cond ((fboundp 'insert-file-contents-literally) + ) + ((boundp 'file-name-handler-alist) + (defun insert-file-contents-literally + (filename &optional visit beg end replace) + "Like `insert-file-contents', q.v., but only reads in the file. +A buffer may be modified in several ways after reading into the buffer due +to advanced Emacs features, such as file-name-handlers, format decoding, +find-file-hooks, etc. + This function ensures that none of these modifications will take place. +\[emu.el; Emacs 19.30 emulating function]" + (let (file-name-handler-alist) + (insert-file-contents filename visit beg end replace) + )) + ) + (t + (defalias 'insert-file-contents-literally 'insert-file-contents) + )) + + +;;; @ EMACS 19.31 emulation +;;; + +(defun-maybe buffer-live-p (object) + "Return non-nil if OBJECT is a buffer which has not been killed. +Value is nil if OBJECT is not a buffer or if it has been killed. +\[emu.el; EMACS 19.31 emulating function]" + (and object + (get-buffer object) + (buffer-name (get-buffer object)) + )) + +(or (fboundp 'save-selected-window) + ;; This function was imported Emacs 19.33. + (defmacro save-selected-window (&rest body) + "Execute BODY, then select the window that was selected before BODY. +\[emu.el; EMACS 19.31 emulating function]" + (list 'let + '((save-selected-window-window (selected-window))) + (list 'unwind-protect + (cons 'progn body) + (list 'select-window 'save-selected-window-window)))) + ) + + +;;; @ XEmacs emulation +;;; + +(defun-maybe functionp (obj) + "Returns t if OBJ is a function, nil otherwise. +\[emu.el; XEmacs emulating function]" + (or (subrp obj) + (byte-code-function-p obj) + (and (symbolp obj)(fboundp obj)) + (and (consp obj)(eq (car obj) 'lambda)) + )) + + +;;; @ for XEmacs 20 +;;; + +(or (fboundp 'char-int) + (fset 'char-int (symbol-function 'identity)) + ) +(or (fboundp 'int-char) + (fset 'int-char (symbol-function 'identity)) + ) + + +;;; @ for text/richtext and text/enriched +;;; + +(cond ((or running-emacs-19_29-or-later running-xemacs-19_14-or-later) + ;; have enriched.el + (autoload 'richtext-decode "richtext") + (or (assq 'text/richtext format-alist) + (setq format-alist + (cons + (cons 'text/richtext + '("Extended MIME text/richtext format." + "Content-[Tt]ype:[ \t]*text/richtext" + richtext-decode richtext-encode t enriched-mode)) + format-alist))) + ) + (t + ;; don't have enriched.el + (autoload 'richtext-decode "tinyrich") + (autoload 'enriched-decode "tinyrich") + )) + + +;;; @ end +;;; + +(provide 'emu) + +;;; emu.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/site-lisp/richtext.el Mon Aug 13 08:47:15 2007 +0200 @@ -0,0 +1,185 @@ +;;; richtext.el -- read and save files in text/richtext format + +;; Copyright (C) 1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Created: 1995/7/15 +;; Version: $Id: richtext.el,v 1.1.1.1 1996/12/18 04:06:19 steve Exp $ +;; Keywords: wp, faces, MIME, multimedia + +;; This file is not part of GNU Emacs yet. + +;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'enriched) + + +;;; @ variables +;;; + +(defconst richtext-initial-annotation + (lambda () + (format "Content-Type: text/richtext\nText-Width: %d\n\n" + (enriched-text-width))) + "What to insert at the start of a text/richtext file. +If this is a string, it is inserted. If it is a list, it should be a lambda +expression, which is evaluated to get the string to insert.") + +(defconst richtext-annotation-regexp + "[ \t\n]*\\(<\\(/\\)?\\([-A-za-z0-9]+\\)>\\)[ \t\n]*" + "Regular expression matching richtext annotations.") + +(defconst richtext-translations + '((face (bold-italic "bold" "italic") + (bold "bold") + (italic "italic") + (underline "underline") + (fixed "fixed") + (excerpt "excerpt") + (default ) + (nil enriched-encode-other-face)) + (invisible (t "comment")) + (left-margin (4 "indent")) + (right-margin (4 "indentright")) + (justification (right "flushright") + (left "flushleft") + (full "flushboth") + (center "center")) + ;; The following are not part of the standard: + (FUNCTION (enriched-decode-foreground "x-color") + (enriched-decode-background "x-bg-color")) + (read-only (t "x-read-only")) + (unknown (nil format-annotate-value)) +; (font-size (2 "bigger") ; unimplemented +; (-2 "smaller")) +) + "List of definitions of text/richtext annotations. +See `format-annotate-region' and `format-deannotate-region' for the definition +of this structure.") + + +;;; @ encoder +;;; + +(defun richtext-encode (from to) + (if enriched-verbose (message "Richtext: encoding document...")) + (save-restriction + (narrow-to-region from to) + (delete-to-left-margin) + (unjustify-region) + (goto-char from) + (format-replace-strings '(("<" . "<lt>"))) + (format-insert-annotations + (format-annotate-region from (point-max) richtext-translations + 'enriched-make-annotation enriched-ignore)) + (goto-char from) + (insert (if (stringp enriched-initial-annotation) + richtext-initial-annotation + (funcall richtext-initial-annotation))) + (enriched-map-property-regions 'hard + (lambda (v b e) + (goto-char b) + (if (eolp) + (while (search-forward "\n" nil t) + (replace-match "<nl>\n") + ))) + (point) nil) + (if enriched-verbose (message nil)) + ;; Return new end. + (point-max))) + + +;;; @ decoder +;;; + +(defun richtext-next-annotation () + "Find and return next text/richtext annotation. +Return value is \(begin end name positive-p), or nil if none was found." + (catch 'tag + (while (re-search-forward richtext-annotation-regexp nil t) + (let* ((beg0 (match-beginning 0)) + (end0 (match-end 0)) + (beg (match-beginning 1)) + (end (match-end 1)) + (name (downcase (buffer-substring + (match-beginning 3) (match-end 3)))) + (pos (not (match-beginning 2))) + ) + (cond ((equal name "lt") + (delete-region beg end) + (goto-char beg) + (insert "<") + ) + ((equal name "comment") + (if pos + (throw 'tag (list beg0 end name pos)) + (throw 'tag (list beg end0 name pos)) + ) + ) + (t + (throw 'tag (list beg end name pos)) + )) + )))) + +(defun richtext-decode (from to) + (if enriched-verbose (message "Richtext: decoding document...")) + (save-excursion + (save-restriction + (narrow-to-region from to) + (goto-char from) + (let ((file-width (enriched-get-file-width)) + (use-hard-newlines t)) + (enriched-remove-header) + + (goto-char from) + (while (re-search-forward "\n\n+" nil t) + (replace-match "\n") + ) + + ;; Deal with newlines + (goto-char from) + (while (re-search-forward "[ \t\n]*<nl>[ \t\n]*" nil t) + (replace-match "\n") + (put-text-property (match-beginning 0) (point) 'hard t) + (put-text-property (match-beginning 0) (point) 'front-sticky nil) + ) + + ;; Translate annotations + (format-deannotate-region from (point-max) richtext-translations + 'richtext-next-annotation) + + ;; Fill paragraphs + (if (or (and file-width ; possible reasons not to fill: + (= file-width (enriched-text-width))) ; correct wd. + (null enriched-fill-after-visiting) ; never fill + (and (eq 'ask enriched-fill-after-visiting) ; asked & declined + (not (y-or-n-p "Re-fill for current display width? ")))) + ;; Minimally, we have to insert indentation and justification. + (enriched-insert-indentation) + (if enriched-verbose (message "Filling paragraphs...")) + (fill-region (point-min) (point-max)))) + (if enriched-verbose (message nil)) + (point-max)))) + + +;;; @ end +;;; + +(provide 'richtext) + +;;; richtext.el ends here
--- a/src/cmds.c Mon Aug 13 08:46:57 2007 +0200 +++ b/src/cmds.c Mon Aug 13 08:47:15 2007 +0200 @@ -149,14 +149,33 @@ { struct buffer *b = decode_buffer (buffer, 1); + BUF_SET_PT(b, XINT (Fpoint_at_bol(arg, buffer))); + return Qnil; +} + +DEFUN ("point-at-bol", Fpoint_at_bol, Spoint_at_bol, 0, 2, 0 /* +Return the character position of the first character on the current line. +With argument N not nil or 1, move forward N - 1 lines first. +If scan reaches end of buffer, return that position. +This function does not move point. +*/ ) + (arg, buffer) +{ + struct buffer *b = decode_buffer (buffer, 1); + register int orig, end; + XSETBUFFER (buffer, b); if (NILP (arg)) arg = make_int (1); else CHECK_INT (arg); + orig = BUF_PT(b); Fforward_line (make_int (XINT (arg) - 1), buffer); - return Qnil; + end = BUF_PT(b); + BUF_SET_PT(b, orig); + + return make_int (end); } DEFUN ("end-of-line", Fend_of_line, Send_of_line, @@ -171,6 +190,20 @@ { struct buffer *buf = decode_buffer (buffer, 1); + BUF_SET_PT(buf, XINT (Fpoint_at_eol (arg, buffer))); + return Qnil; +} + +DEFUN ("point-at-eol", Fpoint_at_eol, Spoint_at_eol, 0, 2, 0 /* +Return the character position of the last character on the current line. +With argument N not nil or 1, move forward N - 1 lines first. +If scan reaches end of buffer, return that position. +This function does not move point. +*/ ) + (arg, buffer) +{ + struct buffer *buf = decode_buffer (buffer, 1); + XSETBUFFER (buffer, buf); if (NILP (arg)) @@ -178,9 +211,8 @@ else CHECK_INT (arg); - BUF_SET_PT (buf, find_before_next_newline (buf, BUF_PT (buf), 0, - XINT (arg) - (XINT (arg) <= 0))); - return Qnil; + return find_before_next_newline (buf, BUF_PT (buf), 0, + XINT (arg) - (XINT (arg) <= 0)); } DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "*p\nP" /*
--- a/src/device-x.c Mon Aug 13 08:46:57 2007 +0200 +++ b/src/device-x.c Mon Aug 13 08:47:15 2007 +0200 @@ -224,9 +224,6 @@ allocate_x_device_struct (d); - if (NILP (Vdefault_x_device)) - Vdefault_x_device = device; - make_argc_argv (Vx_initial_argv_list, &argc, &argv); if (STRINGP (Vx_emacs_application_class) && @@ -250,6 +247,9 @@ signal_simple_error ("X server not responding\n", display); } + if (NILP (Vdefault_x_device)) + Vdefault_x_device = device; + if (NILP (DEVICE_NAME (d))) DEVICE_NAME (d) = display;
--- a/src/glyphs-x.c Mon Aug 13 08:46:57 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 08:47:15 2007 +0200 @@ -1050,6 +1050,9 @@ #include "jpeglib.h" #include "jerror.h" +/* The in-core jpeg code doesn't work, so I'm avoiding it for now. -sb */ +#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1 + static void jpeg_validate (Lisp_Object instantiator) { @@ -1269,7 +1272,7 @@ unwind.dpy = dpy; record_unwind_protect (jpeg_instantiate_unwind, make_opaque_ptr (&unwind)); -#ifdef USE_TEMP_FILES_FOR_IMAGES +#ifdef USE_TEMP_FILES_FOR_JPEG_IMAGES /* Step 0: Write out to a temp file. The JPEG routines require you to read from a file unless @@ -1325,7 +1328,7 @@ /* Step 2: specify data source (eg, a file) */ -#ifdef USE_FILEIO_FOR_IMAGES +#ifdef USE_TEMP_FILES_FOR_JPEG_IMAGES jpeg_stdio_src (&cinfo, unwind.instream); #else {
--- a/src/s/hpux10.h Mon Aug 13 08:46:57 2007 +0200 +++ b/src/s/hpux10.h Mon Aug 13 08:47:15 2007 +0200 @@ -2,7 +2,7 @@ /* System description file for hpux version 10. */ -#include "hpux9shr.h" +#include "hpux9-shr.h" /* We have to go this route, rather than hpux9's approach of renaming the functions via macros. The system's stdlib.h has fully prototyped