+2001-07-15 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
+
+ * abbrevlist.el, array.el, buff-menu.el, calendar/appt.el,
+ case-table.el, cdl.el, cmuscheme.el, compare-w.el, completion.el,
+ custom.el, derived.el, dired-aux.el, disp-table.el, dos-vars.el,
+ echistory.el, electric.el, emacs-lisp/authors.el,
+ emacs-lisp/backquote.el, emacs-lisp/byte-opt.el,
+ emacs-lisp/bytecomp.el, emacs-lisp/float.el, emacs-lisp/gulp.el,
+ emacs-lisp/helper.el, emacs-lisp/lisp-mode.el,
+ emacs-lisp/regexp-opt.el, emulation/mlconvert.el,
+ emulation/mlsupport.el, env.el, fast-lock.el, find-dired.el,
+ float-sup.el, frame.el, gnus/gnus-mule.el, gnus/pop3.el, gs.el,
+ gud.el, help-macro.el, hexl.el, imenu.el, info.el, informat.el,
+ international/codepage.el, international/iso-ascii.el,
+ international/iso-insert.el, international/iso-transl.el,
+ international/swedish.el, isearch.el, jka-compr.el, kermit.el,
+ lazy-lock.el, ledit.el, loadup.el, lpr.el, ls-lisp.el, macros.el,
+ mail/blessmail.el, mail/emacsbug.el, mail/mail-extr.el,
+ mail/mailabbrev.el, mail/mailpost.el, mail/rmail.el,
+ mail/rmailedit.el, mail/rmailkwd.el, mail/rmailmsc.el,
+ mail/rmailout.el, mail/rmailsort.el, mail/rmailsum.el,
+ mail/vms-pmail.el, man.el, map-ynp.el, menu-bar.el, misc.el,
+ msb.el, net/ange-ftp.el, net/goto-addr.el, novice.el,
+ obsolete/auto-show.el, obsolete/hilit19.el, obsolete/ooutline.el,
+ obsolete/rnews.el, obsolete/rnewspost.el, options.el, paren.el,
+ paths.el, play/dissociate.el, play/doctor.el, play/hanoi.el,
+ play/meese.el, progmodes/compile.el, progmodes/ebrowse.el,
+ progmodes/hideif.el, progmodes/modula2.el, register.el, rot13.el,
+ saveplace.el, scroll-bar.el, server.el, sort.el, soundex.el,
+ term/bg-mouse.el, term/pc-win.el, term/sup-mouse.el,
+ term/tty-colors.el, terminal.el, textmodes/bib-mode.el,
+ textmodes/makeinfo.el, textmodes/page.el, textmodes/paragraphs.el,
+ textmodes/picture.el, textmodes/scribe.el, textmodes/spell.el,
+ textmodes/tex-mode.el, textmodes/text-mode.el,
+ textmodes/underline.el, thingatpt.el, time.el, timer.el,
+ unused.el, vcursor.el, version.el, vms-patch.el, vmsproc.el,
+ vt100-led.el, window.el: Some fixes to follow coding conventions in
+ files maintained by FSF.
+
2001-07-13 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
* arc-mode.el: A fix to follow coding conventions.
-;;; abbrevlist.el --- list one abbrev table alphabetically ordered.
+;;; abbrevlist.el --- list one abbrev table alphabetically ordered
;; Copyright (C) 1986, 1992 Free Software Foundation, Inc.
;; Suggested by a previous version by Gildea.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defun list-one-abbrev-table (abbrev-table output-buffer)
-;;; array.el --- array editing commands for Gnu Emacs
+;;; array.el --- array editing commands for GNU Emacs
;; Copyright (C) 1987, 2000 Free Software Foundation, Inc.
-;;; buff-menu.el --- buffer menu main function and support functions.
+;;; buff-menu.el --- buffer menu main function and support functions
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 2000 Free Software Foundation, Inc.
-;;; appt.el --- appointment notification functions.
+;;; appt.el --- appointment notification functions
;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
-;;; case-table.el --- code to extend the character set and support case tables.
+;;; case-table.el --- code to extend the character set and support case tables
;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defun cdl-get-file (filename)
-;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el.
+;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
;; Copyright (C) 1988, 1994, 1997 Free Software Foundation, Inc.
-;;; compare-w.el --- compare text between windows for Emacs.
+;;; compare-w.el --- compare text between windows for Emacs
;; Copyright (C) 1986, 1989, 1993, 1997 Free Software Foundation, Inc.
(defun locate-completion-db-error ()
;; recursive error: really scrod
- (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report."))
+ (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report"))
;; WRITES
(defun add-completion-to-tail-if-new (string)
--- /dev/null
+;;; custom.el --- tools for declaring and initializing options
+;;
+;; Copyright (C) 1996, 1997, 1999, 2001 Free Software Foundation, Inc.
+;;
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Maintainer: FSF
+;; Keywords: help, faces
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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.
+
+;;; Commentary:
+;;
+;; This file only contain the code needed to declare and initialize
+;; user options. The code to customize options is autoloaded from
+;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual.
+
+;; The code implementing face declarations is in `cus-face.el'
+
+;;; Code:
+
+(require 'widget)
+
+(defvar custom-define-hook nil
+ ;; Customize information for this option is in `cus-edit.el'.
+ "Hook called after defining each customize option.")
+
+;;; The `defcustom' Macro.
+
+(defun custom-initialize-default (symbol value)
+ "Initialize SYMBOL with VALUE.
+This will do nothing if symbol already has a default binding.
+Otherwise, if symbol has a `saved-value' property, it will evaluate
+the car of that and used as the default binding for symbol.
+Otherwise, VALUE will be evaluated and used as the default binding for
+symbol."
+ (unless (default-boundp symbol)
+ ;; Use the saved value if it exists, otherwise the standard setting.
+ (set-default symbol (if (get symbol 'saved-value)
+ (eval (car (get symbol 'saved-value)))
+ (eval value)))))
+
+(defun custom-initialize-set (symbol value)
+ "Initialize SYMBOL based on VALUE.
+If the symbol doesn't have a default binding already,
+then set it using its `:set' function (or `set-default' if it has none).
+The value is either the value in the symbol's `saved-value' property,
+if any, or VALUE."
+ (unless (default-boundp symbol)
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol
+ (if (get symbol 'saved-value)
+ (eval (car (get symbol 'saved-value)))
+ (eval value)))))
+
+(defun custom-initialize-reset (symbol value)
+ "Initialize SYMBOL based on VALUE.
+Set the symbol, using its `:set' function (or `set-default' if it has none).
+The value is either the symbol's current value
+ \(as obtained using the `:get' function), if any,
+or the value in the symbol's `saved-value' property if any,
+or (last of all) VALUE."
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol
+ (cond ((default-boundp symbol)
+ (funcall (or (get symbol 'custom-get) 'default-value)
+ symbol))
+ ((get symbol 'saved-value)
+ (eval (car (get symbol 'saved-value))))
+ (t
+ (eval value)))))
+
+(defun custom-initialize-changed (symbol value)
+ "Initialize SYMBOL with VALUE.
+Like `custom-initialize-reset', but only use the `:set' function if
+not using the standard setting.
+For the standard setting, use `set-default'."
+ (cond ((default-boundp symbol)
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol
+ (funcall (or (get symbol 'custom-get) 'default-value)
+ symbol)))
+ ((get symbol 'saved-value)
+ (funcall (or (get symbol 'custom-set) 'set-default)
+ symbol
+ (eval (car (get symbol 'saved-value)))))
+ (t
+ (set-default symbol (eval value)))))
+
+(defun custom-declare-variable (symbol default doc &rest args)
+ "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
+DEFAULT should be an expression to evaluate to compute the default value,
+not the default value itself."
+ ;; Remember the standard setting.
+ (put symbol 'standard-value (list default))
+ ;; Maybe this option was rogue in an earlier version. It no longer is.
+ (when (get symbol 'force-value)
+ (put symbol 'force-value nil))
+ (when doc
+ (put symbol 'variable-documentation doc))
+ (let ((initialize 'custom-initialize-reset)
+ (requests nil))
+ (while args
+ (let ((arg (car args)))
+ (setq args (cdr args))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (cond ((eq keyword :initialize)
+ (setq initialize value))
+ ((eq keyword :set)
+ (put symbol 'custom-set value))
+ ((eq keyword :get)
+ (put symbol 'custom-get value))
+ ((eq keyword :require)
+ (setq requests (cons value requests)))
+ ((eq keyword :type)
+ (put symbol 'custom-type (purecopy value)))
+ ((eq keyword :options)
+ (if (get symbol 'custom-options)
+ ;; Slow safe code to avoid duplicates.
+ (mapc (lambda (option)
+ (custom-add-option symbol option))
+ value)
+ ;; Fast code for the common case.
+ (put symbol 'custom-options (copy-sequence value))))
+ (t
+ (custom-handle-keyword symbol keyword value
+ 'custom-variable))))))
+ (put symbol 'custom-requests requests)
+ ;; Do the actual initialization.
+ (funcall initialize symbol default))
+ (setq current-load-list (cons symbol current-load-list))
+ (run-hooks 'custom-define-hook)
+ symbol)
+
+(defmacro defcustom (symbol value doc &rest args)
+ "Declare SYMBOL as a customizable variable that defaults to VALUE.
+DOC is the variable documentation.
+
+Neither SYMBOL nor VALUE needs to be quoted.
+If SYMBOL is not already bound, initialize it to VALUE.
+The remaining arguments should have the form
+
+ [KEYWORD VALUE]...
+
+The following keywords are meaningful:
+
+:type VALUE should be a widget type for editing the symbols value.
+:options VALUE should be a list of valid members of the widget type.
+:group VALUE should be a customization group.
+ Add SYMBOL to that group.
+:initialize
+ VALUE should be a function used to initialize the
+ variable. It takes two arguments, the symbol and value
+ given in the `defcustom' call. The default is
+ `custom-initialize-default'
+:set VALUE should be a function to set the value of the symbol.
+ It takes two arguments, the symbol to set and the value to
+ give it. The default choice of function is `custom-set-default'.
+:get VALUE should be a function to extract the value of symbol.
+ The function takes one argument, a symbol, and should return
+ the current value for that symbol. The default choice of function
+ is `custom-default-value'.
+:require
+ VALUE should be a feature symbol. If you save a value
+ for this option, then when your `.emacs' file loads the value,
+ it does (require VALUE) first.
+:version
+ VALUE should be a string specifying that the variable was
+ first introduced, or its default value was changed, in Emacs
+ version VERSION.
+
+Read the section about customization in the Emacs Lisp manual for more
+information."
+ ;; It is better not to use backquote in this file,
+ ;; because that makes a bootstrapping problem
+ ;; if you need to recompile all the Lisp files using interpreted code.
+ (nconc (list 'custom-declare-variable
+ (list 'quote symbol)
+ (list 'quote value)
+ doc)
+ args))
+
+;;; The `defface' Macro.
+
+(defmacro defface (face spec doc &rest args)
+ "Declare FACE as a customizable face that defaults to SPEC.
+FACE does not need to be quoted.
+
+Third argument DOC is the face documentation.
+
+If FACE has been set with `custom-set-face', set the face attributes
+as specified by that function, otherwise set the face attributes
+according to SPEC.
+
+The remaining arguments should have the form
+
+ [KEYWORD VALUE]...
+
+The following KEYWORDs are defined:
+
+:group VALUE should be a customization group.
+ Add FACE to that group.
+
+SPEC should be an alist of the form ((DISPLAY ATTS)...).
+
+The first element of SPEC where the DISPLAY matches the frame
+is the one that takes effect in that frame. The ATTRs in this
+element take effect; the other elements are ignored, on that frame.
+
+ATTS is a list of face attributes followed by their values:
+ (ATTR VALUE ATTR VALUE...)
+
+The possible attributes are `:family', `:width', `:height', `:weight',
+`:slant', `:underline', `:overline', `:strike-through', `:box',
+`:foreground', `:background', `:stipple', and `:inverse-video'.
+
+DISPLAY can either be the symbol t, which will match all frames, or an
+alist of the form \((REQ ITEM...)...). For the DISPLAY to match a
+FRAME, the REQ property of the frame must match one of the ITEM. The
+following REQ are defined:
+
+`type' (the value of `window-system')
+ Under X, in addition to the values `window-system' can take,
+ `motif', `lucid' and `x-toolkit' are allowed, and match when
+ the Motif toolkit, Lucid toolkit, or any X toolkit is in use.
+
+`class' (the frame's color support)
+ Should be one of `color', `grayscale', or `mono'.
+
+`background' (what color is used for the background text)
+ Should be one of `light' or `dark'.
+
+Read the section about customization in the Emacs Lisp manual for more
+information."
+ ;; It is better not to use backquote in this file,
+ ;; because that makes a bootstrapping problem
+ ;; if you need to recompile all the Lisp files using interpreted code.
+ (nconc (list 'custom-declare-face (list 'quote face) spec doc) args))
+
+;;; The `defgroup' Macro.
+
+(defun custom-declare-group (symbol members doc &rest args)
+ "Like `defgroup', but SYMBOL is evaluated as a normal argument."
+ (while members
+ (apply 'custom-add-to-group symbol (car members))
+ (setq members (cdr members)))
+ (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
+ (when doc
+ ;; This text doesn't get into DOC.
+ (put symbol 'group-documentation (purecopy doc)))
+ (while args
+ (let ((arg (car args)))
+ (setq args (cdr args))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (cond ((eq keyword :prefix)
+ (put symbol 'custom-prefix value))
+ (t
+ (custom-handle-keyword symbol keyword value
+ 'custom-group))))))
+ (run-hooks 'custom-define-hook)
+ symbol)
+
+(defmacro defgroup (symbol members doc &rest args)
+ "Declare SYMBOL as a customization group containing MEMBERS.
+SYMBOL does not need to be quoted.
+
+Third arg DOC is the group documentation.
+
+MEMBERS should be an alist of the form ((NAME WIDGET)...) where
+NAME is a symbol and WIDGET is a widget for editing that symbol.
+Useful widgets are `custom-variable' for editing variables,
+`custom-face' for edit faces, and `custom-group' for editing groups.
+
+The remaining arguments should have the form
+
+ [KEYWORD VALUE]...
+
+The following KEYWORDs are defined:
+
+:group VALUE should be a customization group.
+ Add SYMBOL to that group.
+
+:version VALUE should be a string specifying that the group was introduced
+ in Emacs version VERSION.
+
+Read the section about customization in the Emacs Lisp manual for more
+information."
+ ;; It is better not to use backquote in this file,
+ ;; because that makes a bootstrapping problem
+ ;; if you need to recompile all the Lisp files using interpreted code.
+ (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args))
+
+(defun custom-add-to-group (group option widget)
+ "To existing GROUP add a new OPTION of type WIDGET.
+If there already is an entry for OPTION and WIDGET, nothing is done."
+ (let ((members (get group 'custom-group))
+ (entry (list option widget)))
+ (unless (member entry members)
+ (put group 'custom-group (nconc members (list entry))))))
+
+;;; Properties.
+
+(defun custom-handle-all-keywords (symbol args type)
+ "For customization option SYMBOL, handle keyword arguments ARGS.
+Third argument TYPE is the custom option type."
+ (while args
+ (let ((arg (car args)))
+ (setq args (cdr args))
+ (unless (symbolp arg)
+ (error "Junk in args %S" args))
+ (let ((keyword arg)
+ (value (car args)))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (setq args (cdr args))
+ (custom-handle-keyword symbol keyword value type)))))
+
+(defun custom-handle-keyword (symbol keyword value type)
+ "For customization option SYMBOL, handle KEYWORD with VALUE.
+Fourth argument TYPE is the custom option type."
+ (if purify-flag
+ (setq value (purecopy value)))
+ (cond ((eq keyword :group)
+ (custom-add-to-group value symbol type))
+ ((eq keyword :version)
+ (custom-add-version symbol value))
+ ((eq keyword :link)
+ (custom-add-link symbol value))
+ ((eq keyword :load)
+ (custom-add-load symbol value))
+ ((eq keyword :tag)
+ (put symbol 'custom-tag value))
+ ((eq keyword :set-after)
+ (custom-add-dependencies symbol value))
+ (t
+ (error "Unknown keyword %s" keyword))))
+
+(defun custom-add-dependencies (symbol value)
+ "To the custom option SYMBOL, add dependencies specified by VALUE.
+VALUE should be a list of symbols. For each symbol in that list,
+this specifies that SYMBOL should be set after the specified symbol, if
+both appear in constructs like `custom-set-variables'."
+ (unless (listp value)
+ (error "Invalid custom dependency `%s'" value))
+ (let* ((deps (get symbol 'custom-dependencies))
+ (new-deps deps))
+ (while value
+ (let ((dep (car value)))
+ (unless (symbolp dep)
+ (error "Invalid custom dependency `%s'" dep))
+ (unless (memq dep new-deps)
+ (setq new-deps (cons dep new-deps)))
+ (setq value (cdr value))))
+ (unless (eq deps new-deps)
+ (put symbol 'custom-dependencies new-deps))))
+
+(defun custom-add-option (symbol option)
+ "To the variable SYMBOL add OPTION.
+
+If SYMBOL is a hook variable, OPTION should be a hook member.
+For other types variables, the effect is undefined."
+ (let ((options (get symbol 'custom-options)))
+ (unless (member option options)
+ (put symbol 'custom-options (cons option options)))))
+
+(defun custom-add-link (symbol widget)
+ "To the custom option SYMBOL add the link WIDGET."
+ (let ((links (get symbol 'custom-links)))
+ (unless (member widget links)
+ (put symbol 'custom-links (cons (purecopy widget) links)))))
+
+(defun custom-add-version (symbol version)
+ "To the custom option SYMBOL add the version VERSION."
+ (put symbol 'custom-version (purecopy version)))
+
+(defun custom-add-load (symbol load)
+ "To the custom option SYMBOL add the dependency LOAD.
+LOAD should be either a library file name, or a feature name."
+ (let ((loads (get symbol 'custom-loads)))
+ (unless (member load loads)
+ (put symbol 'custom-loads (cons (purecopy load) loads)))))
+
+;;; Initializing.
+
+(defvar custom-local-buffer nil
+ "Non-nil, in a Customization buffer, means customize a specific buffer.
+If this variable is non-nil, it should be a buffer,
+and it means customize the local bindings of that buffer.
+This variable is a permanent local, and it normally has a local binding
+in every Customization buffer.")
+(put 'custom-local-buffer 'permanent-local t)
+
+(defun custom-set-variables (&rest args)
+ "Initialize variables according to user preferences.
+
+The arguments should be a list where each entry has the form:
+
+ (SYMBOL VALUE [NOW [REQUEST [COMMENT]]])
+
+The unevaluated VALUE is stored as the saved value for SYMBOL.
+If NOW is present and non-nil, VALUE is also evaluated and bound as
+the default value for the SYMBOL.
+REQUEST is a list of features we must require for SYMBOL.
+COMMENT is a comment string about SYMBOL."
+ (setq args
+ (sort args
+ (lambda (a1 a2)
+ (let* ((sym1 (car a1))
+ (sym2 (car a2))
+ (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
+ (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
+ (cond ((and 1-then-2 2-then-1)
+ (error "Circular custom dependency between `%s' and `%s'"
+ sym1 sym2))
+ (1-then-2 t)
+ (t nil))))))
+ (while args
+ (let ((entry (car args)))
+ (if (listp entry)
+ (let* ((symbol (nth 0 entry))
+ (value (nth 1 entry))
+ (now (nth 2 entry))
+ (requests (nth 3 entry))
+ (comment (nth 4 entry))
+ set)
+ (when requests
+ (put symbol 'custom-requests requests)
+ (mapc 'require requests))
+ (setq set (or (get symbol 'custom-set) 'custom-set-default))
+ (put symbol 'saved-value (list value))
+ (put symbol 'saved-variable-comment comment)
+ ;; Allow for errors in the case where the setter has
+ ;; changed between versions, say, but let the user know.
+ (condition-case data
+ (cond (now
+ ;; Rogue variable, set it now.
+ (put symbol 'force-value t)
+ (funcall set symbol (eval value)))
+ ((default-boundp symbol)
+ ;; Something already set this, overwrite it.
+ (funcall set symbol (eval value))))
+ (error
+ (message "Error setting %s: %s" symbol data)))
+ (setq args (cdr args))
+ (and (or now (default-boundp symbol))
+ (put symbol 'variable-comment comment)))
+ ;; Old format, a plist of SYMBOL VALUE pairs.
+ (message "Warning: old format `custom-set-variables'")
+ (ding)
+ (sit-for 2)
+ (let ((symbol (nth 0 args))
+ (value (nth 1 args)))
+ (put symbol 'saved-value (list value)))
+ (setq args (cdr (cdr args)))))))
+
+(defun custom-set-default (variable value)
+ "Default :set function for a customizable variable.
+Normally, this sets the default value of VARIABLE to VALUE,
+but if `custom-local-buffer' is non-nil,
+this sets the local binding in that buffer instead."
+ (if custom-local-buffer
+ (with-current-buffer custom-local-buffer
+ (set variable value))
+ (set-default variable value)))
+
+;;; The End.
+
+;; Process the defcustoms for variables loaded before this file.
+(while custom-declare-variable-list
+ (apply 'custom-declare-variable (car custom-declare-variable-list))
+ (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
+
+(provide 'custom)
+
+;;; custom.el ends here
-;;; derived.el --- allow inheritance of major modes.
+;;; derived.el --- allow inheritance of major modes
;;; (formerly mode-clone.el)
;; Copyright (C) 1993, 1994, 1999 Free Software Foundation, Inc.
"Change the group of the marked (or next ARG) files."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
- (error "chgrp not supported on this system."))
+ (error "chgrp not supported on this system"))
(dired-do-chxxx "Group" "chgrp" 'chgrp arg))
;;;###autoload
"Change the owner of the marked (or next ARG) files."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
- (error "chown not supported on this system."))
+ (error "chown not supported on this system"))
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
;; Process all the files in FILES in batches of a convenient size,
(while (/= 0 arg)
(setq file (dired-get-filename nil t))
(if (not file)
- (error "Can only kill file lines.")
+ (error "Can only kill file lines")
(save-excursion (and file
(dired-goto-subdir file)
(dired-kill-subdir)))
dir (file-name-directory (directory-file-name dir))))
;;(setq dir (expand-file-name dir))
(or (dired-goto-subdir dir)
- (error "Cannot go up to %s - not in this tree." dir))))
+ (error "Cannot go up to %s - not in this tree" dir))))
;;;###autoload
(defun dired-tree-down ()
-;;; disp-table.el --- functions for dealing with char tables.
+;;; disp-table.el --- functions for dealing with char tables
;; Copyright (C) 1987, 1994, 1995, 1999 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(put 'display-table 'char-table-extra-slots 6)
-;;; dos-vars.el --- MS-Dos specific user options.
+;;; dos-vars.el --- MS-Dos specific user options
;; Copyright (C) 1998 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
+;;; Code:
+
(defgroup dos-fns nil
"MS-DOS specific functions."
:group 'environment)
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'electric) ; command loop
-;;; electric.el --- window maker and Command loop for `electric' modes.
+;;; electric.el --- window maker and Command loop for `electric' modes
;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.
(authors root)
(write-file file)))
-;; authors.el ends here
+;;; authors.el ends here
tail))
(t (cons 'list heads)))))
-;; backquote.el ends here
+;;; backquote.el ends here
-;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
+;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
;;; Copyright (c) 1991, 1994, 2000, 2001 Free Software Foundation, Inc.
(defun byte-compile-log-lap-1 (format &rest args)
(if (aref byte-code-vector 0)
- (error "The old version of the disassembler is loaded. Reload new-bytecomp as well."))
+ (error "The old version of the disassembler is loaded. Reload new-bytecomp as well"))
(byte-compile-log-1
(apply 'format format
(let (c a)
-;;; bytecomp.el --- compilation of Lisp code into byte code.
+;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000
;; Free Software Foundation, Inc.
;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.82 $")
+(defconst byte-compile-version "$Revision: 2.83 $")
;; This file is part of GNU Emacs.
-;;; float.el --- obsolete floating point arithmetic package.
+;;; float.el --- obsolete floating point arithmetic package
;; Copyright (C) 1986 Free Software Foundation, Inc.
-;;; gulp.el --- Ask for updates for Lisp packages
+;;; gulp.el --- ask for updates for Lisp packages
;; Copyright (C) 1996 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;; hey, here's a helping hand.
-;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
+;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
;; Copyright (C) 1985, 1986, 1999, 2000, 2001 Free Software Foundation, Inc.
-;;; regexp-opt.el --- generate efficient regexps to match strings.
+;;; regexp-opt.el --- generate efficient regexps to match strings
;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
-;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp.
+;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; mlsupport.el --- run-time support for mocklisp code.
+;;; mlsupport.el --- run-time support for mocklisp code
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; env.el --- functions to manipulate environment variables.
+;;; env.el --- functions to manipulate environment variables
;; Copyright (C) 1991, 1994 Free Software Foundation, Inc.
-;;; fast-lock.el --- Automagic text properties caching for fast Font Lock mode.
+;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
;; Keywords: faces files
;; Version: 3.14
-;;; This file is part of GNU Emacs.
+;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'dired)
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;; Provide a meaningful error message if we are running on
-;;; frame.el --- multi-frame management independent of window systems.
+;;; frame.el --- multi-frame management independent of window systems
;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001
;; Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defvar frame-creation-function nil
-;;; gnus-mule.el --- Provide backward compatibility function to GNUS
+;;; gnus-mule.el --- provide backward compatibility function to GNUS
;; Copyright (C) 1995,1997 Free Software Foundation, Inc.
;; Copyright (C) 1995, 2000 Electrotechnical Laboratory, JAPAN.
;; This file provides the function `gnus-mule-add-group' for backward
;; compatibility with old version of Gnus included in Emacs 20.
+;;; Code:
+
(require 'gnus-sum)
;;;###autoload
(provide 'gnus-mule)
-;; gnus-mule.el ends here
+;;; gnus-mule.el ends here
((equal 'pass pop3-authentication-scheme)
(pop3-user process pop3-maildrop)
(pop3-pass process))
- (t (error "Invalid POP3 authentication scheme.")))
+ (t (error "Invalid POP3 authentication scheme")))
(setq message-count (car (pop3-stat process)))
(pop3-quit process)
message-count))
(pop3-send-command process (format "USER %s" user))
(let ((response (pop3-read-response process t)))
(if (not (and response (string-match "+OK" response)))
- (error (format "USER %s not valid." user)))))
+ (error (format "USER %s not valid" user)))))
(defun pop3-pass (process)
"Send authentication information to the server."
(provide 'gs)
-;; gs.el ends here.
+;;; gs.el ends here
'speedbar-highlight-face
(cond ((eq ff 'gud-gdb-find-file)
'gud-gdb-goto-stackframe)
- (t (error "Should never be here.")))
+ (t (error "Should never be here")))
(car frames) t))
(setq frames (cdr frames)))
; (let ((selected-frame
; (cond ((eq ff 'gud-gdb-find-file)
; (gud-gdb-selected-frame-info buffer))
-; (t (error "Should never be here."))))))
+; (t (error "Should never be here"))))))
)
(setq gud-last-speedbar-stackframe gud-last-last-frame)))
(and gud-gdb-complete-list
(string-match "^Undefined command: \"complete\""
(car gud-gdb-complete-list))
- (error "This version of GDB doesn't support the `complete' command."))
+ (error "This version of GDB doesn't support the `complete' command"))
;; Sort the list like readline.
(setq gud-gdb-complete-list
(sort gud-gdb-complete-list (function string-lessp)))
(not (and (boundp 'tags-file-name)
(stringp tags-file-name)
(file-exists-p tags-file-name))))
- (error "The sdb support requires a valid tags table to work."))
+ (error "The sdb support requires a valid tags table to work"))
(gud-common-init command-line 'gud-sdb-massage-args
'gud-sdb-marker-filter 'gud-sdb-find-file)
;; -e goes with the next arg, so shift one extra.
(or (funcall shift)
;; -e as the last arg is an error in Perl.
- (error "No code specified for -e."))
+ (error "No code specified for -e"))
(setq seen-e t))
(funcall shift))
(unless seen-e
(if (or (not args)
(string-match "^-" (car args)))
- (error "Can't use stdin as the script to debug."))
+ (error "Can't use stdin as the script to debug"))
;; This is the program name.
(funcall shift))
-;;; help-macro.el --- Makes command line help such as help-for-help
+;;; help-macro.el --- makes command line help such as help-for-help
;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
;; Author: Lynn Slater <lrs@indetech.com>
;; Maintainer: FSF
-;; Created: : Mon Oct 1 11:42:39 1990
+;; Created: Mon Oct 1 11:42:39 1990
;; Adapted-By: ESR
;; This file is part of GNU Emacs.
;; This file supplies the macro make-help-screen which constructs
;; single character dispatching with browsable help such as that provided
;; by help-for-help. This can be used to make many modes easier to use; for
-;; example, the Gnu Emacs Empire Tool uses this for every "nested" mode map
+;; example, the GNU Emacs Empire Tool uses this for every "nested" mode map
;; called from the main mode map.
;; The name of this package was changed from help-screen.el to
-;;; hexl.el --- edit a file in a hex dump format using the hexl filter.
+;;; hexl.el --- edit a file in a hex dump format using the hexl filter
;; Copyright (C) 1989, 1994, 1998, 2001 Free Software Foundation, Inc.
-;;; imenu.el --- Framework for mode-specific buffer indexes.
+;;; imenu.el --- framework for mode-specific buffer indexes
;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
;; [christian] - Christian Egli Christian.Egli@hcsd.hac.com
;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu
-;;; Code
+;;; Code:
(eval-when-compile (require 'cl))
-;;; info.el --- info package for Emacs.
+;;; info.el --- info package for Emacs
;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
;; Free Software Foundation, Inc.
Each file will be processed even if an error occurred previously.
For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
(if (not noninteractive)
- (error "batch-info-validate may only be used -batch."))
+ (error "batch-info-validate may only be used -batch"))
(let ((version-control t)
(auto-save-default nil)
(find-file-run-dired nil)
-;;; codepage.el --- MS-DOS/MS-Windows specific coding systems.
+;;; codepage.el --- MS-DOS/MS-Windows specific coding systems
;; Copyright (C) 1998 Free Software Foundation, Inc.
(provide 'codepage)
-;; codepage.el ends here
+;;; codepage.el ends here
-;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals.
+;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals
;; Copyright (C) 1987, 1995 Free Software Foundation, Inc.
-;;; iso-insert.el --- insert functions for ISO 8859/1.
+;;; iso-insert.el --- insert functions for ISO 8859/1
;; Copyright (C) 1987, 1994 Free Software Foundation, Inc.
-;;; iso-transl.el --- keyboard input definitions for ISO 8859/1.
+;;; iso-transl.el --- keyboard input definitions for ISO 8859/1
;; Copyright (C) 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
-;;; swedish.el --- miscellaneous functions for dealing with Swedish.
+;;; swedish.el --- miscellaneous functions for dealing with Swedish
;; Copyright (C) 1988 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;; Written by Howard Gayle. See case-table.el for details.
-;;; isearch.el --- incremental search minor mode.
+;;; isearch.el --- incremental search minor mode
;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Commentary:
+;;; Commentary:
;; This package implements low-level support for reading, writing,
;; and loading compressed files. It hooks into the low-level file
(provide 'jka-compr)
-;; jka-compr.el ends here.
+;;; jka-compr.el ends here
-;;; kermit.el --- additions to shell mode for use with kermit, etc.
+;;; kermit.el --- additions to shell mode for use with kermit
;; Copyright (C) 1988 Free Software Foundation, Inc.
-;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode.
+;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2001
;; Free Software Foundation, Inc.
;; Keywords: faces files
;; Version: 2.11
-;;; This file is part of GNU Emacs.
+;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; Copyright (C) 1985 Free Software Foundation, Inc.
;; Maintainer: FSF
-;; Keyword: languages
+;; Keywords: languages
;; This file is part of GNU Emacs.
-;;; loadup.el --- load up standardly loaded Lisp files for Emacs.
+;;; loadup.el --- load up standardly loaded Lisp files for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
-;;; lpr.el --- print Emacs buffer on line printer.
+;;; lpr.el --- print Emacs buffer on line printer
;; Copyright (C) 1985, 1988, 1992, 1994, 2001 Free Software Foundation, Inc.
-;; Maintainer: FSF
-;; Keywords: unix
+;; Maintainer: FSF
+;; Keywords: unix
;; This file is part of GNU Emacs.
;; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
-;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
-;; Maintainer: FSF
-;; Keywords: unix, dired
+;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
+;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
+;; Maintainer: FSF
+;; Keywords: unix, dired
;; This file is part of GNU Emacs.
-;;; macros.el --- non-primitive commands for keyboard macros.
+;;; macros.el --- non-primitive commands for keyboard macros
;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
(and (fboundp symbol)
(not (stringp (symbol-function symbol)))
(not (vectorp (symbol-function symbol)))
- (error "Function %s is already defined and not a keyboard macro."
+ (error "Function %s is already defined and not a keyboard macro"
symbol))
(if (string-equal symbol "")
(error "No command name given"))
(or macro
(progn
(if (null last-kbd-macro)
- (error "No keyboard macro has been defined."))
+ (error "No keyboard macro has been defined"))
(setq macro last-kbd-macro)))
(save-excursion
(let ((end-marker (progn
-;;; blessmail.el --- Decide whether movemail needs special privileges.
+;;; blessmail.el --- decide whether movemail needs special privileges
;; Copyright (C) 1994 Free Software Foundation, Inc.
-;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list.
+;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
;; Copyright (C) 1985, 1994, 1997, 1998 Free Software Foundation, Inc.
-;;; mail-extr.el --- extract full name and address from RFC 822 mail header.
+;;; mail-extr.el --- extract full name and address from RFC 822 mail header
;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001
;; Free Software Foundation, Inc.
-;;; mailabbrev.el --- abbrev-expansion of mail aliases.
+;;; mailabbrev.el --- abbrev-expansion of mail aliases
;; Copyright (C) 1985, 86, 87, 92, 93, 96, 1997, 2000
;; Free Software Foundation, Inc.
(if mail-abbrevs-mode
(mail-abbrevs-enable))
-;;; mailabbrev.el ends here.
+;;; mailabbrev.el ends here
;; This is in the public domain
;; since Delp distributed it without a copyright notice in 1986.
+;; This file is part of GNU Emacs.
+
;; Author: Gary Delp <delp@huey.Udel.Edu>
;; Maintainer: FSF
;; Created: 13 Jan 1986
-;;; rmail.el --- main code of "RMAIL" mail reader for Emacs.
+;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000, 2001
;; Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu
(goto-char beg)
(forward-line 1)
(if (/= (following-char) ?0)
- (error "Bad format in RMAIL file."))
+ (error "Bad format in RMAIL file"))
(let ((inhibit-read-only t)
(delta (- (buffer-size) end)))
(delete-char 1)
-;;; rmailedit.el --- "RMAIL edit mode" Edit the current message.
+;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
;; Copyright (C) 1985, 1994, 2001 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'rmail)
-;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs.
+;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
;; Copyright (C) 1985, 1988, 1994, 2001 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;; Global to all RMAIL buffers. It exists primarily for the sake of
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;;;###autoload
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
+;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
;; Copyright (C) 1985, 1987, 1993, 1994, 2001 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'rmail)
-;;; rmailsort.el --- Rmail: sort messages.
+;;; rmailsort.el --- Rmail: sort messages
;; Copyright (C) 1990, 1993, 1994, 2001 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(require 'sort)
(interactive "sRegexp to summarize by: ")
(if (string= regexp "")
(setq regexp (or rmail-last-regexp
- (error "No regexp specified."))))
+ (error "No regexp specified"))))
(setq rmail-last-regexp regexp)
(rmail-new-summary (concat "regexp " regexp)
(list 'rmail-summary-by-regexp regexp)
-;;; vms-pmail.el --- use Emacs as the editor within VMS mail.
+;;; vms-pmail.el --- use Emacs as the editor within VMS mail
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;;;
--- /dev/null
+;;; man.el --- browse UNIX manual pages
+
+;; Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+
+;; Author: Barry A. Warsaw <bwarsaw@cen.com>
+;; Maintainer: FSF
+;; Keywords: help
+;; Adapted-By: ESR, pot
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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.
+
+;;; Commentary:
+
+;; This code provides a function, `man', with which you can browse
+;; UNIX manual pages. Formatting is done in background so that you
+;; can continue to use your Emacs while processing is going on.
+;;
+;; The mode also supports hypertext-like following of manual page SEE
+;; ALSO references, and other features. See below or do `?' in a
+;; manual page buffer for details.
+
+;; ========== Credits and History ==========
+;; In mid 1991, several people posted some interesting improvements to
+;; man.el from the standard emacs 18.57 distribution. I liked many of
+;; these, but wanted everything in one single package, so I decided
+;; to incorporate them into a single manual browsing mode. While
+;; much of the code here has been rewritten, and some features added,
+;; these folks deserve lots of credit for providing the initial
+;; excellent packages on which this one is based.
+
+;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, posted a very nice
+;; improvement which retrieved and cleaned the manpages in a
+;; background process, and which correctly deciphered such options as
+;; man -k.
+
+;; Eric Rose <erose@jessica.stanford.edu>, submitted manual.el which
+;; provided a very nice manual browsing mode.
+
+;; This package was available as `superman.el' from the LCD package
+;; for some time before it was accepted into Emacs 19. The entry
+;; point and some other names have been changed to make it a drop-in
+;; replacement for the old man.el package.
+
+;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
+;; making it faster, more robust and more tolerant of different
+;; systems' man idiosyncrasies.
+
+;; ========== Features ==========
+;; + Runs "man" in the background and pipes the results through a
+;; series of sed and awk scripts so that all retrieving and cleaning
+;; is done in the background. The cleaning commands are configurable.
+;; + Syntax is the same as Un*x man
+;; + Functionality is the same as Un*x man, including "man -k" and
+;; "man <section>", etc.
+;; + Provides a manual browsing mode with keybindings for traversing
+;; the sections of a manpage, following references in the SEE ALSO
+;; section, and more.
+;; + Multiple manpages created with the same man command are put into
+;; a narrowed buffer circular list.
+
+;; ============= TODO ===========
+;; - Add a command for printing.
+;; - The awk script deletes multiple blank lines. This behaviour does
+;; not allow to understand if there was indeed a blank line at the
+;; end or beginning of a page (after the header, or before the
+;; footer). A different algorithm should be used. It is easy to
+;; compute how many blank lines there are before and after the page
+;; headers, and after the page footer. But it is possible to compute
+;; the number of blank lines before the page footer by euristhics
+;; only. Is it worth doing?
+;; - Allow a user option to mean that all the manpages should go in
+;; the same buffer, where they can be browsed with M-n and M-p.
+;; - Allow completion on the manpage name when calling man. This
+;; requires a reliable list of places where manpages can be found. The
+;; drawback would be that if the list is not complete, the user might
+;; be led to believe that the manpages in the missing directories do
+;; not exist.
+
+\f
+;;; Code:
+
+(require 'assoc)
+
+;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+;; empty defvars (keep the compiler quiet)
+
+(defgroup man nil
+ "Browse UNIX manual pages."
+ :prefix "Man-"
+ :group 'help)
+
+
+(defvar Man-notify)
+(defvar Man-current-page)
+(defvar Man-page-list)
+(defcustom Man-filter-list nil
+ "*Manpage cleaning filter command phrases.
+This variable contains a list of the following form:
+
+'((command-string phrase-string*)*)
+
+Each phrase-string is concatenated onto the command-string to form a
+command filter. The (standard) output (and standard error) of the Un*x
+man command is piped through each command filter in the order the
+commands appear in the association list. The final output is placed in
+the manpage buffer."
+ :type '(repeat (list (string :tag "Command String")
+ (repeat :inline t
+ (string :tag "Phrase String"))))
+ :group 'man)
+
+(defvar Man-original-frame)
+(defvar Man-arguments)
+(defvar Man-sections-alist)
+(defvar Man-refpages-alist)
+(defvar Man-uses-untabify-flag t
+ "Non-nil means use `untabify' instead of `Man-untabify-command'.")
+(defvar Man-page-mode-string)
+(defvar Man-sed-script nil
+ "Script for sed to nuke backspaces and ANSI codes from manpages.")
+
+;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+;; user variables
+
+(defcustom Man-fontify-manpage-flag t
+ "*Non-nil means make up the manpage with fonts."
+ :type 'boolean
+ :group 'man)
+
+(defcustom Man-overstrike-face 'bold
+ "*Face to use when fontifying overstrike."
+ :type 'face
+ :group 'man)
+
+(defcustom Man-underline-face 'underline
+ "*Face to use when fontifying underlining."
+ :type 'face
+ :group 'man)
+
+;; Use the value of the obsolete user option Man-notify, if set.
+(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
+ "*Selects the behavior when manpage is ready.
+This variable may have one of the following values, where (sf) means
+that the frames are switched, so the manpage is displayed in the frame
+where the man command was called from:
+
+newframe -- put the manpage in its own frame (see `Man-frame-parameters')
+pushy -- make the manpage the current buffer in the current window
+bully -- make the manpage the current buffer and only window (sf)
+aggressive -- make the manpage the current buffer in the other window (sf)
+friendly -- display manpage in the other window but don't make current (sf)
+polite -- don't display manpage, but prints message and beep when ready
+quiet -- like `polite', but don't beep
+meek -- make no indication that the manpage is ready
+
+Any other value of `Man-notify-method' is equivalent to `meek'."
+ :type '(radio (const newframe) (const pushy) (const bully)
+ (const aggressive) (const friendly)
+ (const polite) (const quiet) (const meek))
+ :group 'man)
+
+(defcustom Man-frame-parameters nil
+ "*Frame parameter list for creating a new frame for a manual page."
+ :type 'sexp
+ :group 'man)
+
+(defcustom Man-downcase-section-letters-flag t
+ "*Non-nil means letters in sections are converted to lower case.
+Some Un*x man commands can't handle uppercase letters in sections, for
+example \"man 2V chmod\", but they are often displayed in the manpage
+with the upper case letter. When this variable is t, the section
+letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before
+being sent to the man background process."
+ :type 'boolean
+ :group 'man)
+
+(defcustom Man-circular-pages-flag t
+ "*Non-nil means the manpage list is treated as circular for traversal."
+ :type 'boolean
+ :group 'man)
+
+(defcustom Man-section-translations-alist
+ (list
+ '("3C++" . "3")
+ ;; Some systems have a real 3x man section, so let's comment this.
+ ;; '("3X" . "3") ; Xlib man pages
+ '("3X11" . "3")
+ '("1-UCB" . ""))
+ "*Association list of bogus sections to real section numbers.
+Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
+their references which Un*x `man' does not recognize. This
+association list is used to translate those sections, when found, to
+the associated section number."
+ :type '(repeat (cons (string :tag "Bogus Section")
+ (string :tag "Real Section")))
+ :group 'man)
+
+(defvar manual-program "man"
+ "The name of the program that produces man pages.")
+
+(defvar Man-untabify-command "pr"
+ "Command used for untabifying.")
+
+(defvar Man-untabify-command-args (list "-t" "-e")
+ "List of arguments to be passed to `Man-untabify-command' (which see).")
+
+(defvar Man-sed-command "sed"
+ "Command used for processing sed scripts.")
+
+(defvar Man-awk-command "awk"
+ "Command used for processing awk scripts.")
+
+(defvar Man-mode-line-format
+ '("-"
+ mode-line-mule-info
+ mode-line-modified
+ mode-line-frame-identification
+ mode-line-buffer-identification " "
+ global-mode-string
+ " " Man-page-mode-string
+ " %[(" mode-name mode-line-process minor-mode-alist "%n)%]--"
+ (line-number-mode "L%l--")
+ (column-number-mode "C%c--")
+ (-3 . "%p") "-%-")
+ "Mode line format for manual mode buffer.")
+
+(defvar Man-mode-map nil
+ "Keymap for Man mode.")
+
+(defvar Man-mode-hook nil
+ "Hook run when Man mode is enabled.")
+
+(defvar Man-cooked-hook nil
+ "Hook run after removing backspaces but before `Man-mode' processing.")
+
+(defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
+ "Regular expression describing the name of a manpage (without section).")
+
+(defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
+ "Regular expression describing a manpage section within parentheses.")
+
+(defvar Man-page-header-regexp
+ (if (and (string-match "-solaris2\\." system-configuration)
+ (not (string-match "-solaris2\\.[123435]$" system-configuration)))
+ (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
+ "(\\(" Man-section-regexp "\\))\\)$")
+ (concat "^[ \t]*\\(" Man-name-regexp
+ "(\\(" Man-section-regexp "\\))\\).*\\1"))
+ "Regular expression describing the heading of a page.")
+
+(defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
+ "Regular expression describing a manpage heading entry.")
+
+(defvar Man-see-also-regexp "SEE ALSO"
+ "Regular expression for SEE ALSO heading (or your equivalent).
+This regexp should not start with a `^' character.")
+
+(defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
+ "Regular expression describing first heading on a manpage.
+This regular expression should start with a `^' character.")
+
+(defvar Man-reference-regexp
+ (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
+ "Regular expression describing a reference to another manpage.")
+
+;; This includes the section as an optional part to catch hyphenated
+;; refernces to manpages.
+(defvar Man-hyphenated-reference-regexp
+ (concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?")
+ "Regular expression describing a reference in the SEE ALSO section.")
+
+(defvar Man-switches ""
+ "Switches passed to the man command, as a single string.")
+
+(defvar Man-specified-section-option
+ (if (string-match "-solaris[0-9.]*$" system-configuration)
+ "-s"
+ "")
+ "Option that indicates a specified a manual section name.")
+
+;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+;; end user variables
+\f
+;; other variables and keymap initializations
+(make-variable-buffer-local 'Man-sections-alist)
+(make-variable-buffer-local 'Man-refpages-alist)
+(make-variable-buffer-local 'Man-page-list)
+(make-variable-buffer-local 'Man-current-page)
+(make-variable-buffer-local 'Man-page-mode-string)
+(make-variable-buffer-local 'Man-original-frame)
+(make-variable-buffer-local 'Man-arguments)
+
+(setq-default Man-sections-alist nil)
+(setq-default Man-refpages-alist nil)
+(setq-default Man-page-list nil)
+(setq-default Man-current-page 0)
+(setq-default Man-page-mode-string "1 of 1")
+
+(defconst Man-sysv-sed-script "\
+/\b/ { s/_\b//g
+ s/\b_//g
+ s/o\b+/o/g
+ s/+\bo/o/g
+ :ovstrk
+ s/\\(.\\)\b\\1/\\1/g
+ t ovstrk
+ }
+/\e\\[[0-9][0-9]*m/ s///g"
+ "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
+
+(defconst Man-berkeley-sed-script "\
+/\b/ { s/_\b//g\\
+ s/\b_//g\\
+ s/o\b+/o/g\\
+ s/+\bo/o/g\\
+ :ovstrk\\
+ s/\\(.\\)\b\\1/\\1/g\\
+ t ovstrk\\
+ }\\
+/\e\\[[0-9][0-9]*m/ s///g"
+ "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
+
+(defvar man-mode-syntax-table
+ (let ((table (copy-syntax-table (standard-syntax-table))))
+ (modify-syntax-entry ?. "w" table)
+ (modify-syntax-entry ?_ "w" table)
+ table)
+ "Syntax table used in Man mode buffers.")
+
+(if Man-mode-map
+ nil
+ (setq Man-mode-map (make-keymap))
+ (suppress-keymap Man-mode-map)
+ (define-key Man-mode-map " " 'scroll-up)
+ (define-key Man-mode-map "\177" 'scroll-down)
+ (define-key Man-mode-map "n" 'Man-next-section)
+ (define-key Man-mode-map "p" 'Man-previous-section)
+ (define-key Man-mode-map "\en" 'Man-next-manpage)
+ (define-key Man-mode-map "\ep" 'Man-previous-manpage)
+ (define-key Man-mode-map ">" 'end-of-buffer)
+ (define-key Man-mode-map "<" 'beginning-of-buffer)
+ (define-key Man-mode-map "." 'beginning-of-buffer)
+ (define-key Man-mode-map "r" 'Man-follow-manual-reference)
+ (define-key Man-mode-map "g" 'Man-goto-section)
+ (define-key Man-mode-map "s" 'Man-goto-see-also-section)
+ (define-key Man-mode-map "k" 'Man-kill)
+ (define-key Man-mode-map "q" 'Man-quit)
+ (define-key Man-mode-map "m" 'man)
+ (define-key Man-mode-map "\r" 'man-follow)
+ (define-key Man-mode-map "?" 'describe-mode)
+ )
+
+\f
+;; ======================================================================
+;; utilities
+
+(defun Man-init-defvars ()
+ "Used for initialising variables based on display's color support.
+This is necessary if one wants to dump man.el with Emacs."
+
+ ;; Avoid possible error in call-process by using a directory that must exist.
+ (let ((default-directory "/"))
+ (setq Man-sed-script
+ (cond
+ (Man-fontify-manpage-flag
+ nil)
+ ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
+ Man-sysv-sed-script)
+ ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
+ Man-berkeley-sed-script)
+ (t
+ nil))))
+
+ (setq Man-filter-list
+ ;; Avoid trailing nil which confuses customize.
+ (apply 'list
+ (cons
+ Man-sed-command
+ (list
+ (if Man-sed-script
+ (concat "-e '" Man-sed-script "'")
+ "")
+ "-e '/^[\001-\032][\001-\032]*$/d'"
+ "-e '/\e[789]/s///g'"
+ "-e '/Reformatting page. Wait/d'"
+ "-e '/Reformatting entry. Wait/d'"
+ "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
+ "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
+ "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
+ "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
+ "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
+ "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
+ "-e '/^[A-Za-z].*Last[ \t]change:/d'"
+ "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
+ "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
+ "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
+ ))
+ (cons
+ Man-awk-command
+ (list
+ "'\n"
+ "BEGIN { blankline=0; anonblank=0; }\n"
+ "/^$/ { if (anonblank==0) next; }\n"
+ "{ anonblank=1; }\n"
+ "/^$/ { blankline++; next; }\n"
+ "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
+ "'"
+ ))
+ (if (not Man-uses-untabify-flag)
+ ;; The outer list will be stripped off by apply.
+ (list (cons
+ Man-untabify-command
+ Man-untabify-command-args))
+ )))
+)
+
+(defsubst Man-match-substring (&optional n string)
+ "Return the substring matched by the last search.
+Optional arg N means return the substring matched by the Nth paren
+grouping. Optional second arg STRING means return a substring from
+that string instead of from the current buffer."
+ (if (null n) (setq n 0))
+ (if string
+ (substring string (match-beginning n) (match-end n))
+ (buffer-substring (match-beginning n) (match-end n))))
+
+(defsubst Man-make-page-mode-string ()
+ "Formats part of the mode line for Man mode."
+ (format "%s page %d of %d"
+ (or (nth 2 (nth (1- Man-current-page) Man-page-list))
+ "")
+ Man-current-page
+ (length Man-page-list)))
+
+(defsubst Man-build-man-command ()
+ "Builds the entire background manpage and cleaning command."
+ (let ((command (concat manual-program " " Man-switches
+ ; Stock MS-DOS shells cannot redirect stderr;
+ ; `call-process' below sends it to /dev/null,
+ ; so we don't need `2>' even with DOS shells
+ ; which do support stderr redirection.
+ (if (not (fboundp 'start-process))
+ " %s"
+ (concat " %s 2>" null-device))))
+ (flist Man-filter-list))
+ (while (and flist (car flist))
+ (let ((pcom (car (car flist)))
+ (pargs (cdr (car flist))))
+ (setq command
+ (concat command " | " pcom " "
+ (mapconcat (lambda (phrase)
+ (if (not (stringp phrase))
+ (error "Malformed Man-filter-list"))
+ phrase)
+ pargs " ")))
+ (setq flist (cdr flist))))
+ command))
+
+(defun Man-translate-references (ref)
+ "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
+Leave it as is if already in that style. Possibly downcase and
+translate the section (see the Man-downcase-section-letters-flag
+and the Man-section-translations-alist variables)."
+ (let ((name "")
+ (section "")
+ (slist Man-section-translations-alist))
+ (cond
+ ;; "chmod(2V)" case ?
+ ((string-match (concat "^" Man-reference-regexp "$") ref)
+ (setq name (Man-match-substring 1 ref)
+ section (Man-match-substring 2 ref)))
+ ;; "2v chmod" case ?
+ ((string-match (concat "^\\(" Man-section-regexp
+ "\\) +\\(" Man-name-regexp "\\)$") ref)
+ (setq name (Man-match-substring 2 ref)
+ section (Man-match-substring 1 ref))))
+ (if (string= name "")
+ ref ; Return the reference as is
+ (if Man-downcase-section-letters-flag
+ (setq section (downcase section)))
+ (while slist
+ (let ((s1 (car (car slist)))
+ (s2 (cdr (car slist))))
+ (setq slist (cdr slist))
+ (if Man-downcase-section-letters-flag
+ (setq s1 (downcase s1)))
+ (if (not (string= s1 section)) nil
+ (setq section (if Man-downcase-section-letters-flag
+ (downcase s2)
+ s2)
+ slist nil))))
+ (concat Man-specified-section-option section " " name))))
+
+\f
+;; ======================================================================
+;; default man entry: get word under point
+
+(defsubst Man-default-man-entry ()
+ "Make a guess at a default manual entry.
+This guess is based on the text surrounding the cursor."
+ (let (word)
+ (save-excursion
+ ;; Default man entry title is any word the cursor is on, or if
+ ;; cursor not on a word, then nearest preceding word.
+ (setq word (current-word))
+ (if (string-match "[._]+$" word)
+ (setq word (substring word 0 (match-beginning 0))))
+ ;; If looking at something like ioctl(2) or brc(1M), include the
+ ;; section number in the returned value. Remove text properties.
+ (forward-word 1)
+ ;; Use `format' here to clear any text props from `word'.
+ (format "%s%s"
+ word
+ (if (looking-at
+ (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
+ (format "(%s)" (Man-match-substring 1))
+ "")))))
+
+\f
+;; ======================================================================
+;; Top level command and background process sentinel
+
+;; For compatibility with older versions.
+;;;###autoload
+(defalias 'manual-entry 'man)
+
+;;;###autoload
+(defun man (man-args)
+ "Get a Un*x manual page and put it in a buffer.
+This command is the top-level command in the man package. It runs a Un*x
+command to retrieve and clean a manpage in the background and places the
+results in a Man mode (manpage browsing) buffer. See variable
+`Man-notify-method' for what happens when the buffer is ready.
+If a buffer already exists for this man page, it will display immediately.
+
+To specify a man page from a certain section, type SUBJECT(SECTION) or
+SECTION SUBJECT when prompted for a manual entry."
+ (interactive
+ (list (let* ((default-entry (Man-default-man-entry))
+ (input (read-string
+ (format "Manual entry%s: "
+ (if (string= default-entry "")
+ ""
+ (format " (default %s)" default-entry))))))
+ (if (string= input "")
+ (if (string= default-entry "")
+ (error "No man args given")
+ default-entry)
+ input))))
+
+ ;; Possibly translate the "subject(section)" syntax into the
+ ;; "section subject" syntax and possibly downcase the section.
+ (setq man-args (Man-translate-references man-args))
+
+ (Man-getpage-in-background man-args))
+
+;;;###autoload
+(defun man-follow (man-args)
+ "Get a Un*x manual page of the item under point and put it in a buffer."
+ (interactive (list (Man-default-man-entry)))
+ (if (or (not man-args)
+ (string= man-args ""))
+ (error "No item under point")
+ (man man-args)))
+
+(defun Man-getpage-in-background (topic)
+ "Use TOPIC to build and fire off the manpage and cleaning command."
+ (let* ((man-args topic)
+ (bufname (concat "*Man " man-args "*"))
+ (buffer (get-buffer bufname)))
+ (if buffer
+ (Man-notify-when-ready buffer)
+ (require 'env)
+ (message "Invoking %s %s in the background" manual-program man-args)
+ (setq buffer (generate-new-buffer bufname))
+ (save-excursion
+ (set-buffer buffer)
+ (setq Man-original-frame (selected-frame))
+ (setq Man-arguments man-args))
+ (let ((process-environment (copy-sequence process-environment))
+ ;; The following is so Awk script gets \n intact
+ ;; But don't prevent decoding of the outside.
+ (coding-system-for-write 'raw-text-unix)
+ ;; We must decode the output by a coding system that the
+ ;; system's locale suggests in multibyte mode.
+ (coding-system-for-read
+ (if default-enable-multibyte-characters
+ locale-coding-system 'raw-text-unix))
+ ;; Avoid possible error by using a directory that always exists.
+ (default-directory "/"))
+ ;; Prevent any attempt to use display terminal fanciness.
+ (setenv "TERM" "dumb")
+ (if (fboundp 'start-process)
+ (set-process-sentinel
+ (start-process manual-program buffer "sh" "-c"
+ (format (Man-build-man-command) man-args))
+ 'Man-bgproc-sentinel)
+ (progn
+ (let ((exit-status
+ (call-process shell-file-name nil (list buffer nil) nil "-c"
+ (format (Man-build-man-command) man-args)))
+ (msg ""))
+ (or (and (numberp exit-status)
+ (= exit-status 0))
+ (and (numberp exit-status)
+ (setq msg
+ (format "exited abnormally with code %d"
+ exit-status)))
+ (setq msg exit-status))
+ (Man-bgproc-sentinel bufname msg))))))))
+
+(defun Man-notify-when-ready (man-buffer)
+ "Notify the user when MAN-BUFFER is ready.
+See the variable `Man-notify-method' for the different notification behaviors."
+ (let ((saved-frame (save-excursion
+ (set-buffer man-buffer)
+ Man-original-frame)))
+ (cond
+ ((eq Man-notify-method 'newframe)
+ ;; Since we run asynchronously, perhaps while Emacs is waiting
+ ;; for input, we must not leave a different buffer current. We
+ ;; can't rely on the editor command loop to reselect the
+ ;; selected window's buffer.
+ (save-excursion
+ (let ((frame (make-frame Man-frame-parameters)))
+ (set-window-buffer (frame-selected-window frame) man-buffer)
+ (set-window-dedicated-p (frame-selected-window frame) t)
+ (or (display-multi-frame-p frame)
+ (select-frame frame)))))
+ ((eq Man-notify-method 'pushy)
+ (switch-to-buffer man-buffer))
+ ((eq Man-notify-method 'bully)
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer)
+ (delete-other-windows))
+ ((eq Man-notify-method 'aggressive)
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (pop-to-buffer man-buffer))
+ ((eq Man-notify-method 'friendly)
+ (and (frame-live-p saved-frame)
+ (select-frame saved-frame))
+ (display-buffer man-buffer 'not-this-window))
+ ((eq Man-notify-method 'polite)
+ (beep)
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ ((eq Man-notify-method 'quiet)
+ (message "Manual buffer %s is ready" (buffer-name man-buffer)))
+ ((or (eq Man-notify-method 'meek)
+ t)
+ (message ""))
+ )))
+
+(defun Man-softhyphen-to-minus ()
+ ;; \255 is some kind of dash in Latin-N. Versions of Debian man, at
+ ;; least, emit it even when not in a Latin-N locale.
+ (unless (eq t (compare-strings "latin-" 0 nil
+ current-language-environment 0 6 t))
+ (goto-char (point-min))
+ (let ((str "\255"))
+ (if enable-multibyte-characters
+ (setq str (string-as-multibyte str)))
+ (while (search-forward str nil t) (replace-match "-")))))
+
+(defun Man-fontify-manpage ()
+ "Convert overstriking and underlining to the correct fonts.
+Same for the ANSI bold and normal escape sequences."
+ (interactive)
+ (message "Please wait: making up the %s man page..." Man-arguments)
+ (goto-char (point-min))
+ (while (search-forward "\e[1m" nil t)
+ (delete-backward-char 4)
+ (put-text-property (point)
+ (progn (if (search-forward "\e[0m" nil 'move)
+ (delete-backward-char 4))
+ (point))
+ 'face Man-overstrike-face))
+ (if (< (buffer-size) (position-bytes (point-max)))
+ ;; Multibyte characters exist.
+ (progn
+ (goto-char (point-min))
+ (while (search-forward "__\b\b" nil t)
+ (backward-delete-char 4)
+ (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (goto-char (point-min))
+ (while (search-forward "\b\b__" nil t)
+ (backward-delete-char 4)
+ (put-text-property (1- (point)) (point) 'face Man-underline-face))))
+ (goto-char (point-min))
+ (while (search-forward "_\b" nil t)
+ (backward-delete-char 2)
+ (put-text-property (point) (1+ (point)) 'face Man-underline-face))
+ (goto-char (point-min))
+ (while (search-forward "\b_" nil t)
+ (backward-delete-char 2)
+ (put-text-property (1- (point)) (point) 'face Man-underline-face))
+ (goto-char (point-min))
+ (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
+ (replace-match "\\1")
+ (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
+ (goto-char (point-min))
+ (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
+ (replace-match "o")
+ (put-text-property (1- (point)) (point) 'face 'bold))
+ (goto-char (point-min))
+ (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
+ (replace-match "+")
+ (put-text-property (1- (point)) (point) 'face 'bold))
+ (Man-softhyphen-to-minus)
+ (message "%s man page made up" Man-arguments))
+
+(defun Man-cleanup-manpage ()
+ "Remove overstriking and underlining from the current buffer."
+ (interactive)
+ (message "Please wait: cleaning up the %s man page..."
+ Man-arguments)
+ (if (or (interactive-p) (not Man-sed-script))
+ (progn
+ (goto-char (point-min))
+ (while (search-forward "_\b" nil t) (backward-delete-char 2))
+ (goto-char (point-min))
+ (while (search-forward "\b_" nil t) (backward-delete-char 2))
+ (goto-char (point-min))
+ (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
+ (replace-match "\\1"))
+ (goto-char (point-min))
+ (while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
+ (goto-char (point-min))
+ (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
+ ))
+ (goto-char (point-min))
+ (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
+ (Man-softhyphen-to-minus)
+ (message "%s man page cleaned up" Man-arguments))
+
+(defun Man-bgproc-sentinel (process msg)
+ "Manpage background process sentinel.
+When manpage command is run asynchronously, PROCESS is the process
+object for the manpage command; when manpage command is run
+synchronously, PROCESS is the name of the buffer where the manpage
+command is run. Second argument MSG is the exit message of the
+manpage command."
+ (let ((Man-buffer (if (stringp process) (get-buffer process)
+ (process-buffer process)))
+ (delete-buff nil)
+ (err-mess nil))
+
+ (if (null (buffer-name Man-buffer)) ;; deleted buffer
+ (or (stringp process)
+ (set-process-buffer process nil))
+
+ (save-excursion
+ (set-buffer Man-buffer)
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (cond ((or (looking-at "No \\(manual \\)*entry for")
+ (looking-at "[^\n]*: nothing appropriate$"))
+ (setq err-mess (buffer-substring (point)
+ (progn
+ (end-of-line) (point)))
+ delete-buff t))
+ ((or (stringp process)
+ (not (and (eq (process-status process) 'exit)
+ (= (process-exit-status process) 0))))
+ (or (zerop (length msg))
+ (progn
+ (setq err-mess
+ (concat (buffer-name Man-buffer)
+ ": process "
+ (let ((eos (1- (length msg))))
+ (if (= (aref msg eos) ?\n)
+ (substring msg 0 eos) msg))))
+ (goto-char (point-max))
+ (insert (format "\nprocess %s" msg))))
+ ))
+ (if delete-buff
+ (kill-buffer Man-buffer)
+ (if Man-fontify-manpage-flag
+ (Man-fontify-manpage)
+ (Man-cleanup-manpage))
+ (run-hooks 'Man-cooked-hook)
+ (Man-mode)
+ (set-buffer-modified-p nil)
+ ))
+ ;; Restore case-fold-search before calling
+ ;; Man-notify-when-ready because it may switch buffers.
+
+ (if (not delete-buff)
+ (Man-notify-when-ready Man-buffer))
+
+ (if err-mess
+ (error err-mess))
+ ))))
+
+\f
+;; ======================================================================
+;; set up manual mode in buffer and build alists
+
+(defun Man-mode ()
+ "A mode for browsing Un*x manual pages.
+
+The following man commands are available in the buffer. Try
+\"\\[describe-key] <key> RET\" for more information:
+
+\\[man] Prompt to retrieve a new manpage.
+\\[Man-follow-manual-reference] Retrieve reference in SEE ALSO section.
+\\[Man-next-manpage] Jump to next manpage in circular list.
+\\[Man-previous-manpage] Jump to previous manpage in circular list.
+\\[Man-next-section] Jump to next manpage section.
+\\[Man-previous-section] Jump to previous manpage section.
+\\[Man-goto-section] Go to a manpage section.
+\\[Man-goto-see-also-section] Jumps to the SEE ALSO manpage section.
+\\[Man-quit] Deletes the manpage window, bury its buffer.
+\\[Man-kill] Deletes the manpage window, kill its buffer.
+\\[describe-mode] Prints this help text.
+
+The following variables may be of some use. Try
+\"\\[describe-variable] <variable-name> RET\" for more information:
+
+`Man-notify-method' What happens when manpage formatting is done.
+`Man-downcase-section-letters-flag' Force section letters to lower case.
+`Man-circular-pages-flag' Treat multiple manpage list as circular.
+`Man-section-translations-alist' List of section numbers and their Un*x equiv.
+`Man-filter-list' Background manpage filter command.
+`Man-mode-line-format' Mode line format for Man mode buffers.
+`Man-mode-map' Keymap bindings for Man mode buffers.
+`Man-mode-hook' Normal hook run on entry to Man mode.
+`Man-section-regexp' Regexp describing manpage section letters.
+`Man-heading-regexp' Regexp describing section headers.
+`Man-see-also-regexp' Regexp for SEE ALSO section (or your equiv).
+`Man-first-heading-regexp' Regexp for first heading on a manpage.
+`Man-reference-regexp' Regexp matching a references in SEE ALSO.
+`Man-switches' Background `man' command switches.
+
+The following key bindings are currently in effect in the buffer:
+\\{Man-mode-map}"
+ (interactive)
+ (setq major-mode 'Man-mode
+ mode-name "Man"
+ buffer-auto-save-file-name nil
+ mode-line-format Man-mode-line-format
+ truncate-lines t
+ buffer-read-only t)
+ (buffer-disable-undo (current-buffer))
+ (auto-fill-mode -1)
+ (use-local-map Man-mode-map)
+ (set-syntax-table man-mode-syntax-table)
+ (Man-build-page-list)
+ (Man-strip-page-headers)
+ (Man-unindent)
+ (Man-goto-page 1)
+ (run-hooks 'Man-mode-hook))
+
+(defsubst Man-build-section-alist ()
+ "Build the association list of manpage sections."
+ (setq Man-sections-alist nil)
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (while (re-search-forward Man-heading-regexp (point-max) t)
+ (aput 'Man-sections-alist (Man-match-substring 1))
+ (forward-line 1))))
+
+(defsubst Man-build-references-alist ()
+ "Build the association list of references (in the SEE ALSO section)."
+ (setq Man-refpages-alist nil)
+ (save-excursion
+ (if (Man-find-section Man-see-also-regexp)
+ (let ((start (progn (forward-line 1) (point)))
+ (end (progn
+ (Man-next-section 1)
+ (point)))
+ hyphenated
+ (runningpoint -1))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (back-to-indentation)
+ (while (and (not (eobp)) (/= (point) runningpoint))
+ (setq runningpoint (point))
+ (if (re-search-forward Man-hyphenated-reference-regexp end t)
+ (let* ((word (Man-match-substring 0))
+ (len (1- (length word))))
+ (if hyphenated
+ (setq word (concat hyphenated word)
+ hyphenated nil
+ ;; Update len, in case a reference spans
+ ;; more than two lines (paranoia).
+ len (1- (length word))))
+ (if (= (aref word len) ?-)
+ (setq hyphenated (substring word 0 len)))
+ (if (string-match Man-reference-regexp word)
+ (aput 'Man-refpages-alist word))))
+ (skip-chars-forward " \t\n,"))))))
+ (setq Man-refpages-alist (nreverse Man-refpages-alist)))
+
+(defun Man-build-page-list ()
+ "Build the list of separate manpages in the buffer."
+ (setq Man-page-list nil)
+ (let ((page-start (point-min))
+ (page-end (point-max))
+ (header ""))
+ (goto-char page-start)
+ ;; (switch-to-buffer (current-buffer))(debug)
+ (while (not (eobp))
+ (setq header
+ (if (looking-at Man-page-header-regexp)
+ (Man-match-substring 1)
+ nil))
+ ;; Go past both the current and the next Man-first-heading-regexp
+ (if (re-search-forward Man-first-heading-regexp nil 'move 2)
+ (let ((p (progn (beginning-of-line) (point))))
+ ;; We assume that the page header is delimited by blank
+ ;; lines and that it contains at most one blank line. So
+ ;; if we back by three blank lines we will be sure to be
+ ;; before the page header but not before the possible
+ ;; previous page header.
+ (search-backward "\n\n" nil t 3)
+ (if (re-search-forward Man-page-header-regexp p 'move)
+ (beginning-of-line))))
+ (setq page-end (point))
+ (setq Man-page-list (append Man-page-list
+ (list (list (copy-marker page-start)
+ (copy-marker page-end)
+ header))))
+ (setq page-start page-end)
+ )))
+
+(defun Man-strip-page-headers ()
+ "Strip all the page headers but the first from the manpage."
+ (let ((buffer-read-only nil)
+ (case-fold-search nil)
+ (page-list Man-page-list)
+ (page ())
+ (header ""))
+ (while page-list
+ (setq page (car page-list))
+ (and (nth 2 page)
+ (goto-char (car page))
+ (re-search-forward Man-first-heading-regexp nil t)
+ (setq header (buffer-substring (car page) (match-beginning 0)))
+ ;; Since the awk script collapses all successive blank
+ ;; lines into one, and since we don't want to get rid of
+ ;; the fast awk script, one must choose between adding
+ ;; spare blank lines between pages when there were none and
+ ;; deleting blank lines at page boundaries when there were
+ ;; some. We choose the first, so we comment the following
+ ;; line.
+ ;; (setq header (concat "\n" header)))
+ (while (search-forward header (nth 1 page) t)
+ (replace-match "")))
+ (setq page-list (cdr page-list)))))
+
+(defun Man-unindent ()
+ "Delete the leading spaces that indent the manpage."
+ (let ((buffer-read-only nil)
+ (case-fold-search nil)
+ (page-list Man-page-list))
+ (while page-list
+ (let ((page (car page-list))
+ (indent "")
+ (nindent 0))
+ (narrow-to-region (car page) (car (cdr page)))
+ (if Man-uses-untabify-flag
+ (untabify (point-min) (point-max)))
+ (if (catch 'unindent
+ (goto-char (point-min))
+ (if (not (re-search-forward Man-first-heading-regexp nil t))
+ (throw 'unindent nil))
+ (beginning-of-line)
+ (setq indent (buffer-substring (point)
+ (progn
+ (skip-chars-forward " ")
+ (point))))
+ (setq nindent (length indent))
+ (if (zerop nindent)
+ (throw 'unindent nil))
+ (setq indent (concat indent "\\|$"))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at indent)
+ (forward-line 1)
+ (throw 'unindent nil)))
+ (goto-char (point-min)))
+ (while (not (eobp))
+ (or (eolp)
+ (delete-char nindent))
+ (forward-line 1)))
+ (setq page-list (cdr page-list))
+ ))))
+
+\f
+;; ======================================================================
+;; Man mode commands
+
+(defun Man-next-section (n)
+ "Move point to Nth next section (default 1)."
+ (interactive "p")
+ (let ((case-fold-search nil))
+ (if (looking-at Man-heading-regexp)
+ (forward-line 1))
+ (if (re-search-forward Man-heading-regexp (point-max) t n)
+ (beginning-of-line)
+ (goto-char (point-max)))))
+
+(defun Man-previous-section (n)
+ "Move point to Nth previous section (default 1)."
+ (interactive "p")
+ (let ((case-fold-search nil))
+ (if (looking-at Man-heading-regexp)
+ (forward-line -1))
+ (if (re-search-backward Man-heading-regexp (point-min) t n)
+ (beginning-of-line)
+ (goto-char (point-min)))))
+
+(defun Man-find-section (section)
+ "Move point to SECTION if it exists, otherwise don't move point.
+Returns t if section is found, nil otherwise."
+ (let ((curpos (point))
+ (case-fold-search nil))
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" section) (point-max) t)
+ (progn (beginning-of-line) t)
+ (goto-char curpos)
+ nil)
+ ))
+
+(defun Man-goto-section ()
+ "Query for section to move point to."
+ (interactive)
+ (aput 'Man-sections-alist
+ (let* ((default (aheadsym Man-sections-alist))
+ (completion-ignore-case t)
+ chosen
+ (prompt (concat "Go to section: (default " default ") ")))
+ (setq chosen (completing-read prompt Man-sections-alist))
+ (if (or (not chosen)
+ (string= chosen ""))
+ default
+ chosen)))
+ (Man-find-section (aheadsym Man-sections-alist)))
+
+(defun Man-goto-see-also-section ()
+ "Move point the the \"SEE ALSO\" section.
+Actually the section moved to is described by `Man-see-also-regexp'."
+ (interactive)
+ (if (not (Man-find-section Man-see-also-regexp))
+ (error (concat "No " Man-see-also-regexp
+ " section found in the current manpage"))))
+
+(defun Man-possibly-hyphenated-word ()
+ "Return a possibly hyphenated word at point.
+If the word starts at the first non-whitespace column, and the
+previous line ends with a hyphen, return the last word on the previous
+line instead. Thus, if a reference to \"tcgetpgrp(3V)\" is hyphenated
+as \"tcgetp-grp(3V)\", and point is at \"grp(3V)\", we return
+\"tcgetp-\" instead of \"grp\"."
+ (save-excursion
+ (skip-syntax-backward "w()")
+ (skip-chars-forward " \t")
+ (let ((beg (point))
+ (word (current-word)))
+ (when (eq beg (save-excursion
+ (back-to-indentation)
+ (point)))
+ (end-of-line 0)
+ (if (eq (char-before) ?-)
+ (setq word (current-word))))
+ word)))
+
+(defun Man-follow-manual-reference (reference)
+ "Get one of the manpages referred to in the \"SEE ALSO\" section.
+Specify which REFERENCE to use; default is based on word at point."
+ (interactive
+ (if (not Man-refpages-alist)
+ (error "There are no references in the current man page")
+ (list (let* ((default (or
+ (car (all-completions
+ (let ((word (Man-possibly-hyphenated-word)))
+ ;; strip a trailing '-':
+ (if (string-match "-$" word)
+ (substring word 0
+ (match-beginning 0))
+ word))
+ Man-refpages-alist))
+ (aheadsym Man-refpages-alist)))
+ chosen
+ (prompt (concat "Refer to: (default " default ") ")))
+ (setq chosen (completing-read prompt Man-refpages-alist nil t))
+ (if (or (not chosen)
+ (string= chosen ""))
+ default
+ chosen)))))
+ (if (not Man-refpages-alist)
+ (error "Can't find any references in the current manpage")
+ (aput 'Man-refpages-alist reference)
+ (Man-getpage-in-background
+ (Man-translate-references (aheadsym Man-refpages-alist)))))
+
+(defun Man-kill ()
+ "Kill the buffer containing the manpage."
+ (interactive)
+ (quit-window t))
+
+(defun Man-quit ()
+ "Bury the buffer containing the manpage."
+ (interactive)
+ (quit-window))
+
+(defun Man-goto-page (page)
+ "Go to the manual page on page PAGE."
+ (interactive
+ (if (not Man-page-list)
+ (let ((args Man-arguments))
+ (kill-buffer (current-buffer))
+ (error "Can't find the %s manpage" args))
+ (if (= (length Man-page-list) 1)
+ (error "You're looking at the only manpage in the buffer")
+ (list (read-minibuffer (format "Go to manpage [1-%d]: "
+ (length Man-page-list)))))))
+ (if (not Man-page-list)
+ (let ((args Man-arguments))
+ (kill-buffer (current-buffer))
+ (error "Can't find the %s manpage" args)))
+ (if (or (< page 1)
+ (> page (length Man-page-list)))
+ (error "No manpage %d found" page))
+ (let* ((page-range (nth (1- page) Man-page-list))
+ (page-start (car page-range))
+ (page-end (car (cdr page-range))))
+ (setq Man-current-page page
+ Man-page-mode-string (Man-make-page-mode-string))
+ (widen)
+ (goto-char page-start)
+ (narrow-to-region page-start page-end)
+ (Man-build-section-alist)
+ (Man-build-references-alist)
+ (goto-char (point-min))))
+
+
+(defun Man-next-manpage ()
+ "Find the next manpage entry in the buffer."
+ (interactive)
+ (if (= (length Man-page-list) 1)
+ (error "This is the only manpage in the buffer"))
+ (if (< Man-current-page (length Man-page-list))
+ (Man-goto-page (1+ Man-current-page))
+ (if Man-circular-pages-flag
+ (Man-goto-page 1)
+ (error "You're looking at the last manpage in the buffer"))))
+
+(defun Man-previous-manpage ()
+ "Find the previous manpage entry in the buffer."
+ (interactive)
+ (if (= (length Man-page-list) 1)
+ (error "This is the only manpage in the buffer"))
+ (if (> Man-current-page 1)
+ (Man-goto-page (1- Man-current-page))
+ (if Man-circular-pages-flag
+ (Man-goto-page (length Man-page-list))
+ (error "You're looking at the first manpage in the buffer"))))
+\f
+;; Init the man package variables, if not already done.
+(Man-init-defvars)
+
+(add-to-list 'debug-ignored-errors "^No manpage [0-9]* found$")
+(add-to-list 'debug-ignored-errors "^Can't find the .* manpage$")
+
+(provide 'man)
+
+;;; man.el ends here
-;;; map-ynp.el --- General-purpose boolean question-asker.
+;;; map-ynp.el --- general-purpose boolean question-asker
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-;;; menu-bar.el --- define a default menu bar.
+;;; menu-bar.el --- define a default menu bar
;; Copyright (C) 1993, 1994, 1995, 2000, 2001 Free Software Foundation, Inc.
;; Avishai Yacobi suggested some menu rearrangements.
+;;; Commentary:
+
;;; Code:
;;; User options:
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defun copy-from-above-command (&optional arg)
-;;; msb.el --- Customizable buffer-selection with multiple menus.
+;;; msb.el --- customizable buffer-selection with multiple menus
;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001
;; Free Software Foundation, Inc.
;; think so, because expand-filename should have already short-circuited
;; them.
(cond ((string-equal dir-name "/")
- (error "Cannot get listing for fictitious \"/\" directory."))
+ (error "Cannot get listing for fictitious \"/\" directory"))
((string-match "^/[-A-Z0-9_$]+:/$" dir-name)
- (error "Cannot get listing for device."))
+ (error "Cannot get listing for device"))
((ange-ftp-fix-name-for-vms dir-name))))
(or (assq 'vms ange-ftp-fix-dir-name-func-alist)
;; Remember that there are no directories in MTS.
(defun ange-ftp-fix-dir-name-for-mts (dir-name)
(if (string-equal dir-name "/")
- (error "Cannot get listing for fictitious \"/\" directory.")
+ (error "Cannot get listing for fictitious \"/\" directory")
(let ((dir-name (ange-ftp-fix-name-for-mts dir-name)))
(cond
((string-equal dir-name "")
(defun ange-ftp-fix-dir-name-for-cms (dir-name)
(cond
((string-equal "/" dir-name)
- (error "Cannot get listing for fictitious \"/\" directory."))
+ (error "Cannot get listing for fictitious \"/\" directory"))
((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name)
(let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1)))
;; host and user are bound in the call to ange-ftp-send-cmd
(provide 'goto-addr)
-;;; goto-addr.el ends here.
+;;; goto-addr.el ends here
-;;; novice.el --- handling of disabled commands ("novice mode") for Emacs.
+;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
;; Copyright (C) 1985, 1986, 1987, 1994 Free Software Foundation, Inc.
;;; auto-show.el --- perform automatic horizontal scrolling as point moves
;;; This file is in the public domain.
-;;; Keywords: scroll display convenience
-;;; Author: Pete Ware <ware@cis.ohio-state.edu>
-;;; Maintainer: FSF
+;; This file is part of GNU Emacs.
+
+;; Keywords: scroll display convenience
+;; Author: Pete Ware <ware@cis.ohio-state.edu>
+;; Maintainer: FSF
;;; Commentary:
(provide 'auto-show)
-;; auto-show.el ends here
-
+;;; auto-show.el ends here
-;;; hilit19.el --- customizable highlighting for Emacs19
+;;; hilit19.el --- customizable highlighting for Emacs 19
;; Copyright (c) 1993, 1994 Free Software Foundation, Inc.
;;; Commentary:
-;; Hilit19.el is a customizable highlighting package for Emacs19. It supports
+;; Hilit19.el is a customizable highlighting package for Emacs 19. It supports
;; not only source code highlighting, but also Info, RMAIL, VM, gnus...
;; Hilit19 knows (or thinks it knows) how to highlight emacs buffers in
;; about 25 different modes.
(provide 'hilit19)
-;;; hilit19 ends here.
+;;; hilit19.el ends here
-;;; outline.el --- outline mode commands for Emacs
+;;; ooutline.el --- outline mode commands for Emacs
;; Copyright (C) 1986, 1993, 1994, 1997 Free Software Foundation, Inc.
(provide 'outline)
-;;; outline.el ends here
+;;; ooutline.el ends here
-;;; rnews.el --- USENET news reader for gnu emacs
+;;; rnews.el --- USENET news reader for GNU Emacs
;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
;; tower@gnu.org Nov 21 1986
;; added tower@gnu.org 22 Apr 87
+;;; Commentary:
+
;;; Code:
(require 'mail-utils)
;;; >> Nuked by Mly to autoload those functions again, as the duplication of
;;; >> code was making maintenance too difficult.
+;;; Commentary:
+
;;; Code:
(require 'sendmail)
-;;; options.el --- edit Options command for Emacs.
+;;; options.el --- edit Options command for Emacs
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; paren.el --- highlight matching paren.
+;;; paren.el --- highlight matching paren
;; Copyright (C) 1993, 1996 Free Software Foundation, Inc.
-;;; paths.el --- define pathnames for use by various Emacs commands.
+;;; paths.el --- define pathnames for use by various Emacs commands
;; Copyright (C) 1986, 1988, 1994, 1999, 2000 Free Software Foundation, Inc.
-;;; dissociate.el --- scramble text amusingly for Emacs.
+;;; dissociate.el --- scramble text amusingly for Emacs
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; doctor.el --- psychological help for frustrated users.
+;;; doctor.el --- psychological help for frustrated users
;; Copyright (C) 1985, 1987, 1994, 1996, 2000 Free Software Foundation, Inc.
; Author (a) 1985, Damon Anton Permezel
; This is in the public domain
; since he distributed it without copyright notice in 1985.
+;; This file is part of GNU Emacs.
;
; Support for horizontal poles, large numbers of rings, real-time,
; faces, defcustom, and Towers of Unix added in 1999 by Alakazam
;; This is in the public domain on account of being distributed since
;; 1985 or 1986 without a copyright notice.
+;; This file is part of GNU Emacs.
+
;; Maintainer: FSF
;; Keywords: games
-;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
+;;; compile.el --- run compiler as inferior of Emacs, parse error messages
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999 Free Software Foundation, Inc.
;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
;;; End:
-;;; ebrowse.el ends here.
-
+;;; ebrowse.el ends here
-;;; hide-ifdef-mode.el --- hides selected code within ifdef.
+;;; hideif.el --- hides selected code within ifdef
;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
(provide 'hideif)
;;; hideif.el ends here
-
;; Maintainer: FSF
;; Keywords: languages
+;; This file is part of GNU Emacs.
+
;; The authors distributed this without a copyright notice
;; back in 1988, so it is in the public domain. The original included
;; the following credit:
-;;; register.el --- register commands for Emacs.
+;;; register.el --- register commands for Emacs
;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
-;;; rot13.el --- display a buffer in rot13.
+;;; rot13.el --- display a buffer in rot13
;; Copyright (C) 1988 Free Software Foundation, Inc.
-;; Author: Howard Gayle:
+;; Author: Howard Gayle
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;;; saveplace.el --- automatically save place in files.
+;;; saveplace.el --- automatically save place in files
;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
(provide 'saveplace) ; why not...
;;; saveplace.el ends here
-
-;;; scroll-bar.el --- window system-independent scroll bar support.
+;;; scroll-bar.el --- window system-independent scroll bar support
;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001
;; Free Software Foundation, Inc.
-;;; server.el --- Lisp code for GNU Emacs running as server process.
+;;; server.el --- Lisp code for GNU Emacs running as server process
;; Copyright (C) 1986, 87, 92, 94, 95, 96, 97, 98, 99, 2000, 2001
;; Free Software Foundation, Inc.
-;;; sort.el --- commands to sort text in an Emacs buffer.
+;;; sort.el --- commands to sort text in an Emacs buffer
;; Copyright (C) 1986, 1987, 1994, 1995 Free Software Foundation, Inc.
;; The Soundex algorithm maps English words into representations of
;; how they sound. Words with vaguely similar sound map to the same string.
-;;; Code:
+;;; Code:
(defvar soundex-alist
'((?B . "1") (?F . "1") (?P . "1") (?V . "1")
(provide 'soundex)
-;; soundex.el ends here
+;;; soundex.el ends here
-;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse.
+;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse
;; Copyright (C) Free Software Foundation, Inc. Oct 1985.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
-;;; pc-win.el --- setup support for `PC windows' (whatever that is).
+;;; pc-win.el --- setup support for `PC windows' (whatever that is)
;; Copyright (C) 1994, 1996, 1997, 1999, 2001 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(load "term/internal" nil t)
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;;; User customization option:
(setq count (1+ count)))
(setq colors (cdr colors)))
count))
+
+;;; tty-colors.el ends here
-;;; terminal.el --- terminal emulator for GNU Emacs.
+;;; terminal.el --- terminal emulator for GNU Emacs
;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc.
-;;; bib-mode.el --- bib-mode, major mode for editing bib files.
+;;; bib-mode.el --- major mode for editing bib files
;; Copyright (C) 1989 Free Software Foundation, Inc.
;; and appropriate keys are presented for various kinds of entries.
;;; Code:
+
(defgroup bib nil
"Major mode for editing bib files."
:prefix "bib-"
(provide 'makeinfo)
;;; makeinfo.el ends here
-
-;;; page.el --- page motion commands for emacs.
+;;; page.el --- page motion commands for Emacs
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; paragraphs.el --- paragraph and sentence parsing.
+;;; paragraphs.el --- paragraph and sentence parsing
;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001
;; Free Software Foundation, Inc.
-;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model.
+;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
(skip-chars-forward " \t")
(setq tabs (cons (current-column) tabs)))
(if (null tabs)
- (error "No characters in set %s on this line."
+ (error "No characters in set %s on this line"
(regexp-quote picture-tab-chars))))))
(setq tab-stop-list tabs)
(let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ )))
point at the other (diagonally opposed) corner."
(interactive "P")
(if (not (consp picture-killed-rectangle))
- (error "No rectangle saved.")
+ (error "No rectangle saved")
(picture-insert-rectangle picture-killed-rectangle insertp)))
(defun picture-yank-at-click (click arg)
(interactive "cRectangle from register: \nP")
(let ((rectangle (get-register register)))
(if (not (consp rectangle))
- (error "Register %c does not contain a rectangle." register)
+ (error "Register %c does not contain a rectangle" register)
(picture-insert-rectangle rectangle insertp))))
(defun picture-insert-rectangle (rectangle &optional insertp)
they are not defaultly assigned to keys."
(interactive)
(if (eq major-mode 'picture-mode)
- (error "You are already editing a picture.")
+ (error "You are already editing a picture")
(make-local-variable 'picture-mode-old-local-map)
(setq picture-mode-old-local-map (current-local-map))
(use-local-map picture-mode-map)
otherwise just return to previous mode."
(interactive "P")
(if (not (eq major-mode 'picture-mode))
- (error "You aren't editing a Picture.")
+ (error "You aren't editing a Picture")
(if (not nostrip) (delete-trailing-whitespace))
(setq mode-name picture-mode-old-mode-name)
(use-local-map picture-mode-old-local-map)
-;;; scribe.el --- scribe mode, and its idiosyncratic commands.
+;;; scribe.el --- scribe mode, and its idiosyncratic commands
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; spell.el --- spelling correction interface for Emacs.
+;;; spell.el --- spelling correction interface for Emacs
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands.
+;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands
;; Copyright (C) 1985, 86, 89, 92, 94, 95, 96, 97, 98, 1999
;; Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
;; Pacify the byte-compiler
-;;; text-mode.el --- text mode, and its idiosyncratic commands.
+;;; text-mode.el --- text mode, and its idiosyncratic commands
;; Copyright (C) 1985, 1992, 1994 Free Software Foundation, Inc.
-;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs.
+;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs
;; Copyright (C) 1985 Free Software Foundation, Inc.
-;;; thingatpt.el --- Get the `thing' at point
+;;; thingatpt.el --- get the `thing' at point
;; Copyright (C) 1991,92,93,94,95,96,97,1998,2000
;; Free Software Foundation, Inc.
;;;###autoload
(defun list-at-point () (form-at-point 'list 'listp))
-;; thingatpt.el ends here.
+;;; thingatpt.el ends here
-;;; time.el --- display time, load and mail indicator in mode line of Emacs.
+;;; time.el --- display time, load and mail indicator in mode line of Emacs
;; Copyright (C) 1985, 86, 87, 93, 94, 96, 2000, 2001
;; Free Software Foundation, Inc.
--- /dev/null
+;;; timer.el --- run a function with args at some time in future
+
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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.
+
+;;; Commentary:
+
+;; This package gives you the capability to run Emacs Lisp commands at
+;; specified times in the future, either as one-shots or periodically.
+
+;;; Code:
+
+;; Layout of a timer vector:
+;; [triggered-p high-seconds low-seconds usecs repeat-delay
+;; function args idle-delay]
+
+(defun timer-create ()
+ "Create a timer object."
+ (let ((timer (make-vector 8 nil)))
+ (aset timer 0 t)
+ timer))
+
+(defun timerp (object)
+ "Return t if OBJECT is a timer."
+ (and (vectorp object) (= (length object) 8)))
+
+(defun timer-set-time (timer time &optional delta)
+ "Set the trigger time of TIMER to TIME.
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a non-zero integer, make the timer
+fire repeatedly that many seconds apart."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 1 (car time))
+ (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
+ (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
+ (nth 2 time))
+ 0))
+ (aset timer 4 (and (numberp delta) (> delta 0) delta))
+ timer)
+
+(defun timer-set-idle-time (timer secs &optional repeat)
+ "Set the trigger idle time of TIMER to SECS.
+If optional third argument REPEAT is non-nil, make the timer
+fire each time Emacs is idle for that many seconds."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 1 0)
+ (aset timer 2 0)
+ (aset timer 3 0)
+ (timer-inc-time timer secs)
+ (aset timer 4 repeat)
+ timer)
+
+(defun timer-next-integral-multiple-of-time (time secs)
+ "Yield the next value after TIME that is an integral multiple of SECS.
+More precisely, the next value, after TIME, that is an integral multiple
+of SECS seconds since the epoch. SECS may be a fraction."
+ (let ((time-base (ash 1 16)))
+ (if (fboundp 'atan)
+ ;; Use floating point, taking care to not lose precision.
+ (let* ((float-time-base (float time-base))
+ (million 1000000.0)
+ (time-usec (+ (* million
+ (+ (* float-time-base (nth 0 time))
+ (nth 1 time)))
+ (nth 2 time)))
+ (secs-usec (* million secs))
+ (mod-usec (mod time-usec secs-usec))
+ (next-usec (+ (- time-usec mod-usec) secs-usec))
+ (time-base-million (* float-time-base million)))
+ (list (floor next-usec time-base-million)
+ (floor (mod next-usec time-base-million) million)
+ (floor (mod next-usec million))))
+ ;; Floating point is not supported.
+ ;; Use integer arithmetic, avoiding overflow if possible.
+ (let* ((mod-sec (mod (+ (* (mod time-base secs)
+ (mod (nth 0 time) secs))
+ (nth 1 time))
+ secs))
+ (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
+ (list (+ (nth 0 time) (floor next-1-sec time-base))
+ (mod next-1-sec time-base)
+ 0)))))
+
+(defun timer-relative-time (time secs &optional usecs)
+ "Advance TIME by SECS seconds and optionally USECS microseconds.
+SECS may be a fraction."
+ (let ((high (car time))
+ (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
+ (micro (if (numberp (car-safe (cdr-safe (cdr time))))
+ (nth 2 time)
+ 0)))
+ ;; Add
+ (if usecs (setq micro (+ micro usecs)))
+ (if (floatp secs)
+ (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
+ (setq low (+ low (floor secs)))
+
+ ;; Normalize
+ (setq low (+ low (/ micro 1000000)))
+ (setq micro (mod micro 1000000))
+ (setq high (+ high (/ low 65536)))
+ (setq low (logand low 65535))
+
+ (list high low (and (/= micro 0) micro))))
+
+(defun timer-inc-time (timer secs &optional usecs)
+ "Increment the time set in TIMER by SECS seconds and USECS microseconds.
+SECS may be a fraction."
+ (let ((time (timer-relative-time
+ (list (aref timer 1) (aref timer 2) (aref timer 3))
+ secs
+ usecs)))
+ (aset timer 1 (nth 0 time))
+ (aset timer 2 (nth 1 time))
+ (aset timer 3 (or (nth 2 time) 0))))
+
+(defun timer-set-time-with-usecs (timer time usecs &optional delta)
+ "Set the trigger time of TIMER to TIME.
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a non-zero integer, make the timer
+fire repeatedly that many seconds apart."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 1 (car time))
+ (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
+ (aset timer 3 usecs)
+ (aset timer 4 (and (numberp delta) (> delta 0) delta))
+ timer)
+
+(defun timer-set-function (timer function &optional args)
+ "Make TIMER call FUNCTION with optional ARGS when triggering."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 5 function)
+ (aset timer 6 args)
+ timer)
+\f
+(defun timer-activate (timer)
+ "Put TIMER on the list of active timers."
+ (if (and (timerp timer)
+ (integerp (aref timer 1))
+ (integerp (aref timer 2))
+ (integerp (aref timer 3))
+ (aref timer 5))
+ (let ((timers timer-list)
+ last)
+ ;; Skip all timers to trigger before the new one.
+ (while (and timers
+ (or (> (aref timer 1) (aref (car timers) 1))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (> (aref timer 2) (aref (car timers) 2)))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (= (aref timer 2) (aref (car timers) 2))
+ (> (aref timer 3) (aref (car timers) 3)))))
+ (setq last timers
+ timers (cdr timers)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (if last
+ (setcdr last (cons timer timers))
+ (setq timer-list (cons timer timers)))
+ (aset timer 0 nil)
+ (aset timer 7 nil)
+ nil)
+ (error "Invalid or uninitialized timer")))
+
+(defun timer-activate-when-idle (timer &optional dont-wait)
+ "Arrange to activate TIMER whenever Emacs is next idle.
+If optional argument DONT-WAIT is non-nil, then enable the
+timer to activate immediately, or at the right time, if Emacs
+is already idle."
+ (if (and (timerp timer)
+ (integerp (aref timer 1))
+ (integerp (aref timer 2))
+ (integerp (aref timer 3))
+ (aref timer 5))
+ (let ((timers timer-idle-list)
+ last)
+ ;; Skip all timers to trigger before the new one.
+ (while (and timers
+ (or (> (aref timer 1) (aref (car timers) 1))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (> (aref timer 2) (aref (car timers) 2)))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (= (aref timer 2) (aref (car timers) 2))
+ (> (aref timer 3) (aref (car timers) 3)))))
+ (setq last timers
+ timers (cdr timers)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (if last
+ (setcdr last (cons timer timers))
+ (setq timer-idle-list (cons timer timers)))
+ (aset timer 0 (not dont-wait))
+ (aset timer 7 t)
+ nil)
+ (error "Invalid or uninitialized timer")))
+
+;;;###autoload
+(defalias 'disable-timeout 'cancel-timer)
+;;;###autoload
+(defun cancel-timer (timer)
+ "Remove TIMER from the list of active timers."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (setq timer-list (delq timer timer-list))
+ (setq timer-idle-list (delq timer timer-idle-list))
+ nil)
+
+;;;###autoload
+(defun cancel-function-timers (function)
+ "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
+ (interactive "aCancel timers of function: ")
+ (let ((tail timer-list))
+ (while tail
+ (if (eq (aref (car tail) 5) function)
+ (setq timer-list (delq (car tail) timer-list)))
+ (setq tail (cdr tail))))
+ (let ((tail timer-idle-list))
+ (while tail
+ (if (eq (aref (car tail) 5) function)
+ (setq timer-idle-list (delq (car tail) timer-idle-list)))
+ (setq tail (cdr tail)))))
+\f
+;; Record the last few events, for debugging.
+(defvar timer-event-last-2 nil)
+(defvar timer-event-last-1 nil)
+(defvar timer-event-last nil)
+
+(defvar timer-max-repeats 10
+ "*Maximum number of times to repeat a timer, if real time jumps.")
+
+(defun timer-until (timer time)
+ "Calculate number of seconds from when TIMER will run, until TIME.
+TIMER is a timer, and stands for the time when its next repeat is scheduled.
+TIME is a time-list."
+ (let ((high (- (car time) (aref timer 1)))
+ (low (- (nth 1 time) (aref timer 2))))
+ (+ low (* high 65536))))
+
+(defun timer-event-handler (timer)
+ "Call the handler for the timer TIMER.
+This function is called, by name, directly by the C code."
+ (setq timer-event-last-2 timer-event-last-1)
+ (setq timer-event-last-1 timer-event-last)
+ (setq timer-event-last timer)
+ (let ((inhibit-quit t))
+ (if (timerp timer)
+ (progn
+ ;; Delete from queue.
+ (cancel-timer timer)
+ ;; Re-schedule if requested.
+ (if (aref timer 4)
+ (if (aref timer 7)
+ (timer-activate-when-idle timer)
+ (timer-inc-time timer (aref timer 4) 0)
+ ;; If real time has jumped forward,
+ ;; perhaps because Emacs was suspended for a long time,
+ ;; limit how many times things get repeated.
+ (if (and (numberp timer-max-repeats)
+ (< 0 (timer-until timer (current-time))))
+ (let ((repeats (/ (timer-until timer (current-time))
+ (aref timer 4))))
+ (if (> repeats timer-max-repeats)
+ (timer-inc-time timer (* (aref timer 4) repeats)))))
+ (timer-activate timer)))
+ ;; Run handler.
+ ;; We do this after rescheduling so that the handler function
+ ;; can cancel its own timer successfully with cancel-timer.
+ (condition-case nil
+ (apply (aref timer 5) (aref timer 6))
+ (error nil)))
+ (error "Bogus timer event"))))
+
+;; This function is incompatible with the one in levents.el.
+(defun timeout-event-p (event)
+ "Non-nil if EVENT is a timeout event."
+ (and (listp event) (eq (car event) 'timer-event)))
+\f
+;;;###autoload
+(defun run-at-time (time repeat function &rest args)
+ "Perform an action at time TIME.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
+from now, a value from `current-time', or t (with non-nil REPEAT)
+meaning the next integral multiple of REPEAT.
+REPEAT may be an integer or floating point number.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
+
+ (or (null repeat)
+ (and (numberp repeat) (< 0 repeat))
+ (error "Invalid repetition interval"))
+
+ ;; Special case: nil means "now" and is useful when repeating.
+ (if (null time)
+ (setq time (current-time)))
+
+ ;; Special case: t means the next integral multiple of REPEAT.
+ (if (and (eq time t) repeat)
+ (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
+
+ ;; Handle numbers as relative times in seconds.
+ (if (numberp time)
+ (setq time (timer-relative-time (current-time) time)))
+
+ ;; Handle relative times like "2 hours and 35 minutes"
+ (if (stringp time)
+ (let ((secs (timer-duration time)))
+ (if secs
+ (setq time (timer-relative-time (current-time) secs)))))
+
+ ;; Handle "11:23pm" and the like. Interpret it as meaning today
+ ;; which admittedly is rather stupid if we have passed that time
+ ;; already. (Though only Emacs hackers hack Emacs at that time.)
+ (if (stringp time)
+ (progn
+ (require 'diary-lib)
+ (let ((hhmm (diary-entry-time time))
+ (now (decode-time)))
+ (if (>= hhmm 0)
+ (setq time
+ (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
+ (nth 4 now) (nth 5 now) (nth 8 now)))))))
+
+ (or (consp time)
+ (error "Invalid time format"))
+
+ (let ((timer (timer-create)))
+ (timer-set-time timer time repeat)
+ (timer-set-function timer function args)
+ (timer-activate timer)
+ timer))
+
+;;;###autoload
+(defun run-with-timer (secs repeat function &rest args)
+ "Perform an action after a delay of SECS seconds.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+SECS and REPEAT may be integers or floating point numbers.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
+ (apply 'run-at-time secs repeat function args))
+
+;;;###autoload
+(defun add-timeout (secs function object &optional repeat)
+ "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
+If REPEAT is non-nil, repeat the timer every REPEAT seconds.
+This function is for compatibility; see also `run-with-timer'."
+ (run-with-timer secs repeat function object))
+
+;;;###autoload
+(defun run-with-idle-timer (secs repeat function &rest args)
+ "Perform an action the next time Emacs is idle for SECS seconds.
+The action is to call FUNCTION with arguments ARGS.
+SECS may be an integer or a floating point number.
+
+If REPEAT is non-nil, do the action each time Emacs has been idle for
+exactly SECS seconds (that is, only once for each time Emacs becomes idle).
+
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive
+ (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
+ (y-or-n-p "Repeat each time Emacs is idle? ")
+ (intern (completing-read "Function: " obarray 'fboundp t))))
+ (let ((timer (timer-create)))
+ (timer-set-function timer function args)
+ (timer-set-idle-time timer secs repeat)
+ (timer-activate-when-idle timer)
+ timer))
+\f
+(defun with-timeout-handler (tag)
+ (throw tag 'timeout))
+
+;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
+
+;;;###autoload
+(defmacro with-timeout (list &rest body)
+ "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
+If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
+The call should look like:
+ (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
+The timeout is checked whenever Emacs waits for some kind of external
+event \(such as keyboard input, input from subprocesses, or a certain time);
+if the program loops without waiting in any way, the timeout will not
+be detected."
+ (let ((seconds (car list))
+ (timeout-forms (cdr list)))
+ `(let ((with-timeout-tag (cons nil nil))
+ with-timeout-value with-timeout-timer)
+ (if (catch with-timeout-tag
+ (progn
+ (setq with-timeout-timer
+ (run-with-timer ,seconds nil
+ 'with-timeout-handler
+ with-timeout-tag))
+ (setq with-timeout-value (progn . ,body))
+ nil))
+ (progn . ,timeout-forms)
+ (cancel-timer with-timeout-timer)
+ with-timeout-value))))
+
+(defun y-or-n-p-with-timeout (prompt seconds default-value)
+ "Like (y-or-n-p PROMPT), with a timeout.
+If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
+ (with-timeout (seconds default-value)
+ (y-or-n-p prompt)))
+\f
+(defvar timer-duration-words
+ (list (cons "microsec" 0.000001)
+ (cons "microsecond" 0.000001)
+ (cons "millisec" 0.001)
+ (cons "millisecond" 0.001)
+ (cons "sec" 1)
+ (cons "second" 1)
+ (cons "min" 60)
+ (cons "minute" 60)
+ (cons "hour" (* 60 60))
+ (cons "day" (* 24 60 60))
+ (cons "week" (* 7 24 60 60))
+ (cons "fortnight" (* 14 24 60 60))
+ (cons "month" (* 30 24 60 60)) ; Approximation
+ (cons "year" (* 365.25 24 60 60)) ; Approximation
+ )
+ "Alist mapping temporal words to durations in seconds")
+
+(defun timer-duration (string)
+ "Return number of seconds specified by STRING, or nil if parsing fails."
+ (let ((secs 0)
+ (start 0)
+ (case-fold-search t))
+ (while (string-match
+ "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
+ string start)
+ (let ((count (if (match-beginning 1)
+ (string-to-number (match-string 1 string))
+ 1))
+ (itemsize (cdr (assoc (match-string 2 string)
+ timer-duration-words))))
+ (if itemsize
+ (setq start (match-end 0)
+ secs (+ secs (* count itemsize)))
+ (setq secs nil
+ start (length string)))))
+ (if (= start (length string))
+ secs
+ (if (string-match "\\`[0-9.]+\\'" string)
+ (string-to-number string)))))
+\f
+(provide 'timer)
+
+;;; timer.el ends here
-;;; unused.el --- editing commands in GNU Emacs that turned out not to be used.
+;;; unused.el --- editing commands in GNU Emacs that turned out not to be used
;;; This file is in the public domain, as it was distributed in
;;; 1985 or 1986 without a copyright notice. Written by RMS.
+;; This file is part of GNU Emacs.
+
;; Maintainer: FSF
;; Keywords: emulations
-;;; vcursor.el --- manipulate an alternative ("virtual") cursor.
+;;; vcursor.el --- manipulate an alternative ("virtual") cursor
;; Copyright (C) 1994, 1996, 1998 Free Software Foundation, Inc.
((and (overlayp vcursor-overlay) (overlay-start vcursor-overlay))
t)
(arg nil)
- (t (error "The virtual cursor is not active now.")))
+ (t (error "The virtual cursor is not active now")))
)
(defun vcursor-disable (&optional arg)
(provide 'vcursor)
-;; vcursor.el ends here
+;;; vcursor.el ends here
-;;; version.el --- record version number of Emacs.
+;;; version.el --- record version number of Emacs
;;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001
;;; Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defconst emacs-version "21.0.105" "\
-;;; vms-patch.el --- override parts of files.el for VMS.
+;;; vms-patch.el --- override parts of files.el for VMS
;; Copyright (C) 1986, 1992 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(setq auto-mode-alist (cons '(("\\.com\\'" . dcl-mode)) auto-mode-alist))
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defvar display-subprocess-window nil
-;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones.
+;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
;; Copyright (C) 1988 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
(defvar led-state (make-vector 5 nil)
-;;; window.el --- GNU Emacs window commands aside from those written in C.
+;;; window.el --- GNU Emacs window commands aside from those written in C
;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001
;; Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-
;;; Commentary:
;; Window tree functions.
HCoop / bpt / emacs.git / commitdiff