diff options
author | Pavel Janík <Pavel@Janik.cz> | 2001-07-15 16:15:35 +0000 |
---|---|---|
committer | Pavel Janík <Pavel@Janik.cz> | 2001-07-15 16:15:35 +0000 |
commit | 5553563924453df2e3c5bf011bf5b7527172b2f6 (patch) | |
tree | e879bd365f5e59410cdd640d19d140b17a8029c3 | |
parent | 401aa4797329c34b3691872337b9be2c26e4e020 (diff) | |
download | emacs-5553563924453df2e3c5bf011bf5b7527172b2f6.tar.gz |
Some fixes to follow coding conventions in files maintained by FSF.
125 files changed, 2427 insertions, 158 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index db6d6a4f1d9..dd3a62a97d1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,42 @@ +2001-07-15 Pavel Jan,Bm(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,Bm(Bk <Pavel@Janik.cz> * arc-mode.el: A fix to follow coding conventions. diff --git a/lisp/abbrevlist.el b/lisp/abbrevlist.el index 355e24cf5ec..d10679e7aaa 100644 --- a/lisp/abbrevlist.el +++ b/lisp/abbrevlist.el @@ -1,4 +1,4 @@ -;;; 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. @@ -23,6 +23,8 @@ ;; 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) diff --git a/lisp/array.el b/lisp/array.el index d6084650a59..fc128d3a7bc 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -1,4 +1,4 @@ -;;; array.el --- array editing commands for Gnu Emacs +;;; array.el --- array editing commands for GNU Emacs ;; Copyright (C) 1987, 2000 Free Software Foundation, Inc. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 67f72ddd3df..d748fb86d68 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 8c8076a8413..aca6cf628db 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -1,4 +1,4 @@ -;;; appt.el --- appointment notification functions. +;;; appt.el --- appointment notification functions ;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc. diff --git a/lisp/case-table.el b/lisp/case-table.el index 79cc96b5b31..265f9519689 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/cdl.el b/lisp/cdl.el index 49de3db4bc2..5dd87f45db0 100644 --- a/lisp/cdl.el +++ b/lisp/cdl.el @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defun cdl-get-file (filename) diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index c0539d465a0..5d2e1e25e10 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/compare-w.el b/lisp/compare-w.el index d3788508cd3..389da2c0aad 100644 --- a/lisp/compare-w.el +++ b/lisp/compare-w.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/completion.el b/lisp/completion.el index 5d6eed2e205..152f72cab3d 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -1204,7 +1204,7 @@ Must be called after `find-exact-completion'." (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) diff --git a/lisp/custom.el b/lisp/custom.el new file mode 100644 index 00000000000..4a8a0aedb21 --- /dev/null +++ b/lisp/custom.el @@ -0,0 +1,501 @@ +;;; 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 diff --git a/lisp/derived.el b/lisp/derived.el index 8dc20972787..28b1a99bd27 100644 --- a/lisp/derived.el +++ b/lisp/derived.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 31883fe012a..911bfb20abf 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -123,7 +123,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." "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 @@ -131,7 +131,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." "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, @@ -452,7 +452,7 @@ the list of file names explicitly with the FILE-LIST argument." (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))) @@ -1902,7 +1902,7 @@ Lower levels are unaffected." 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 () diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 44d7a4298d8..452d99285c9 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -1,4 +1,4 @@ -;;; 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. @@ -24,6 +24,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (put 'display-table 'char-table-extra-slots 6) diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el index d6a81ba0f55..ee008d2094a 100644 --- a/lisp/dos-vars.el +++ b/lisp/dos-vars.el @@ -1,4 +1,4 @@ -;;; dos-vars.el --- MS-Dos specific user options. +;;; dos-vars.el --- MS-Dos specific user options ;; Copyright (C) 1998 Free Software Foundation, Inc. @@ -22,6 +22,10 @@ ;; 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) diff --git a/lisp/echistory.el b/lisp/echistory.el index 8e04d7eb01d..221d9176f51 100644 --- a/lisp/echistory.el +++ b/lisp/echistory.el @@ -22,6 +22,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (require 'electric) ; command loop diff --git a/lisp/electric.el b/lisp/electric.el index 8a155b324d5..d4678a7e3e2 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 909f741f88c..50de167ae33 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -468,4 +468,4 @@ the Emacs source tree, from which to build the file." (authors root) (write-file file))) -;; authors.el ends here +;;; authors.el ends here diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index ea5fd54094c..04078815d2e 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -210,4 +210,4 @@ Vectors work just like lists. Nested backquotes are permitted." tail)) (t (cons 'list heads))))) -;; backquote.el ends here +;;; backquote.el ends here diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 86ccb7fc51c..cbfc9a6bb09 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1,4 +1,4 @@ -;;; 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. @@ -188,7 +188,7 @@ (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) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4c6881e0b0a..ae74752d9e6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,4 +1,4 @@ -;;; 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. @@ -10,7 +10,7 @@ ;;; 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. diff --git a/lisp/emacs-lisp/float.el b/lisp/emacs-lisp/float.el index 69cfa251c89..53d31c6e33a 100644 --- a/lisp/emacs-lisp/float.el +++ b/lisp/emacs-lisp/float.el @@ -1,4 +1,4 @@ -;;; float.el --- obsolete floating point arithmetic package. +;;; float.el --- obsolete floating point arithmetic package ;; Copyright (C) 1986 Free Software Foundation, Inc. diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el index 877e62255b3..39cc1b98c09 100644 --- a/lisp/emacs-lisp/gulp.el +++ b/lisp/emacs-lisp/gulp.el @@ -1,4 +1,4 @@ -;;; gulp.el --- Ask for updates for Lisp packages +;;; gulp.el --- ask for updates for Lisp packages ;; Copyright (C) 1996 Free Software Foundation, Inc. diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index d2f7100fe17..574694654bf 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: ;; hey, here's a helping hand. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index a66d553d93a..6e476ab8fcf 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index e849cd60b96..b6fac1355c1 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/emulation/mlconvert.el b/lisp/emulation/mlconvert.el index 5b56358d3a3..78e3dc29cab 100644 --- a/lisp/emulation/mlconvert.el +++ b/lisp/emulation/mlconvert.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/emulation/mlsupport.el b/lisp/emulation/mlsupport.el index ab32291dbfe..25f32bcb2c0 100644 --- a/lisp/emulation/mlsupport.el +++ b/lisp/emulation/mlsupport.el @@ -1,4 +1,4 @@ -;;; mlsupport.el --- run-time support for mocklisp code. +;;; mlsupport.el --- run-time support for mocklisp code ;; Copyright (C) 1985 Free Software Foundation, Inc. diff --git a/lisp/env.el b/lisp/env.el index 4981fe68b4e..1824bd378ce 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -1,4 +1,4 @@ -;;; env.el --- functions to manipulate environment variables. +;;; env.el --- functions to manipulate environment variables ;; Copyright (C) 1991, 1994 Free Software Foundation, Inc. diff --git a/lisp/fast-lock.el b/lisp/fast-lock.el index 68b6683305a..bc32f31ce53 100644 --- a/lisp/fast-lock.el +++ b/lisp/fast-lock.el @@ -1,4 +1,4 @@ -;;; 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. @@ -7,7 +7,7 @@ ;; 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 diff --git a/lisp/find-dired.el b/lisp/find-dired.el index e39d58c8c4b..a58d510f20c 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -24,6 +24,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (require 'dired) diff --git a/lisp/float-sup.el b/lisp/float-sup.el index 5a93f5fec05..eb186a48095 100644 --- a/lisp/float-sup.el +++ b/lisp/float-sup.el @@ -21,6 +21,8 @@ ;; 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 diff --git a/lisp/frame.el b/lisp/frame.el index 5eceff5ba6b..7720b796e8f 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,4 +1,4 @@ -;;; 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. @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defvar frame-creation-function nil diff --git a/lisp/gnus/gnus-mule.el b/lisp/gnus/gnus-mule.el index f8100ee6402..0f8c41cc6cb 100644 --- a/lisp/gnus/gnus-mule.el +++ b/lisp/gnus/gnus-mule.el @@ -1,4 +1,4 @@ -;;; 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. @@ -28,6 +28,8 @@ ;; 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 @@ -69,4 +71,4 @@ rather than using this function." (provide 'gnus-mule) -;; gnus-mule.el ends here +;;; gnus-mule.el ends here diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index ed265af8dee..99148388aa8 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -123,7 +123,7 @@ Used for APOP authentication.") ((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)) @@ -293,7 +293,7 @@ If NOW, use that time instead." (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." diff --git a/lisp/gs.el b/lisp/gs.el index 89a21e19fcb..1399e4258a9 100644 --- a/lisp/gs.el +++ b/lisp/gs.el @@ -173,4 +173,4 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful." (provide 'gs) -;; gs.el ends here. +;;; gs.el ends here diff --git a/lisp/gud.el b/lisp/gud.el index 9119a2b9497..52bfacf6338 100644 --- a/lisp/gud.el +++ b/lisp/gud.el @@ -289,13 +289,13 @@ off the specialized speedbar mode." '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))) @@ -464,7 +464,7 @@ available with older versions of GDB." (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))) @@ -692,7 +692,7 @@ and source-file directory for your debugger." (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) @@ -1197,14 +1197,14 @@ directories if your program contains sources from more than one directory." ;; -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)) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index becc1684f57..19add581969 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -1,10 +1,10 @@ -;;; 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. @@ -29,7 +29,7 @@ ;; 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 diff --git a/lisp/hexl.el b/lisp/hexl.el index f4f2d21c098..e44da8cacda 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/imenu.el b/lisp/imenu.el index b799c68c6e2..832834afaf8 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -1,4 +1,4 @@ -;;; 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. @@ -59,7 +59,7 @@ ;; [christian] - Christian Egli Christian.Egli@hcsd.hac.com ;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu -;;; Code +;;; Code: (eval-when-compile (require 'cl)) diff --git a/lisp/info.el b/lisp/info.el index d29f3c9d55c..91344b850fb 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/informat.el b/lisp/informat.el index cb26c64fbaf..baec500ec78 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -439,7 +439,7 @@ Must be used only with -batch, and kills Emacs on completion. 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) diff --git a/lisp/international/codepage.el b/lisp/international/codepage.el index 871148f6fbe..112edc12b23 100644 --- a/lisp/international/codepage.el +++ b/lisp/international/codepage.el @@ -1,4 +1,4 @@ -;;; 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. @@ -665,4 +665,4 @@ read/written by MS-DOS software, or for display on the MS-DOS terminal." (provide 'codepage) -;; codepage.el ends here +;;; codepage.el ends here diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el index 14550a05c81..9dafdb38592 100644 --- a/lisp/international/iso-ascii.el +++ b/lisp/international/iso-ascii.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/international/iso-insert.el b/lisp/international/iso-insert.el index c3e064e0421..c88333b85f0 100644 --- a/lisp/international/iso-insert.el +++ b/lisp/international/iso-insert.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 0dd73c5edb1..8cc27b120f7 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/international/swedish.el b/lisp/international/swedish.el index 103d7259cf9..05229b2e9e5 100644 --- a/lisp/international/swedish.el +++ b/lisp/international/swedish.el @@ -1,4 +1,4 @@ -;;; swedish.el --- miscellaneous functions for dealing with Swedish. +;;; swedish.el --- miscellaneous functions for dealing with Swedish ;; Copyright (C) 1988 Free Software Foundation, Inc. @@ -23,6 +23,8 @@ ;; 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. diff --git a/lisp/isearch.el b/lisp/isearch.el index d523a5f891e..672f559c2ba 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index ae63d71c92e..1239fb39744 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -23,7 +23,7 @@ ;; 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 @@ -917,4 +917,4 @@ Returns the new status of auto compression (non-nil means on)." (provide 'jka-compr) -;; jka-compr.el ends here. +;;; jka-compr.el ends here diff --git a/lisp/kermit.el b/lisp/kermit.el index cd7ddebd779..ee4f0d54480 100644 --- a/lisp/kermit.el +++ b/lisp/kermit.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/lazy-lock.el b/lisp/lazy-lock.el index d5597d38a40..ef18b8a1ae6 100644 --- a/lisp/lazy-lock.el +++ b/lisp/lazy-lock.el @@ -1,4 +1,4 @@ -;;; 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. @@ -8,7 +8,7 @@ ;; 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 diff --git a/lisp/ledit.el b/lisp/ledit.el index 66ebe146a23..0094d515de4 100644 --- a/lisp/ledit.el +++ b/lisp/ledit.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF -;; Keyword: languages +;; Keywords: languages ;; This file is part of GNU Emacs. diff --git a/lisp/loadup.el b/lisp/loadup.el index 6291a9b803f..dc91a6b086e 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/lpr.el b/lisp/lpr.el index 9b24a7352d1..213a6d05af2 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -1,9 +1,9 @@ -;;; 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. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index d8f52df45ea..aeada6ef886 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -2,10 +2,10 @@ ;; 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. diff --git a/lisp/macros.el b/lisp/macros.el index 354ab82a467..0857dd3c2db 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -1,4 +1,4 @@ -;;; 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. @@ -43,7 +43,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command (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")) @@ -281,7 +281,7 @@ and then select the region of un-tablified names and use (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 diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el index dc4c749c31a..0721369a677 100644 --- a/lisp/mail/blessmail.el +++ b/lisp/mail/blessmail.el @@ -1,4 +1,4 @@ -;;; blessmail.el --- Decide whether movemail needs special privileges. +;;; blessmail.el --- decide whether movemail needs special privileges ;; Copyright (C) 1994 Free Software Foundation, Inc. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 0b4cfeaaaa9..ccccdddea58 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 5a7f5370340..0fd3414df04 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 3794fa6cd32..818255ffafa 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -1,4 +1,4 @@ -;;; 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. @@ -638,4 +638,4 @@ Don't use this command in Lisp programs! (if mail-abbrevs-mode (mail-abbrevs-enable)) -;;; mailabbrev.el ends here. +;;; mailabbrev.el ends here diff --git a/lisp/mail/mailpost.el b/lisp/mail/mailpost.el index f7548a94c05..f8198c9e97d 100644 --- a/lisp/mail/mailpost.el +++ b/lisp/mail/mailpost.el @@ -3,6 +3,8 @@ ;; 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 diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index d55c070b403..e35932f64df 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1,4 +1,4 @@ -;;; 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. @@ -23,6 +23,8 @@ ;; 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 @@ -1875,7 +1877,7 @@ It returns t if it got any new messages." (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) diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index 17a83cf1eba..a24292381a8 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -1,4 +1,4 @@ -;;; 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. @@ -22,6 +22,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (require 'rmail) diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 4b5d73045aa..693fbc68428 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -1,4 +1,4 @@ -;;; 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. @@ -22,6 +22,8 @@ ;; 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 diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index ad302785358..7a0871f1414 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -22,6 +22,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: ;;;###autoload diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 5bfe38a6e70..d135ad193b3 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -1,4 +1,4 @@ -;;; 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. @@ -22,6 +22,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (require 'rmail) diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index 48113907802..8e00f3e4d55 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -1,4 +1,4 @@ -;;; rmailsort.el --- Rmail: sort messages. +;;; rmailsort.el --- Rmail: sort messages ;; Copyright (C) 1990, 1993, 1994, 2001 Free Software Foundation, Inc. @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (require 'sort) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 3964274edc3..9bcdd0c36ff 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -105,7 +105,7 @@ Emacs will list the header line in the RMAIL-summary." (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) diff --git a/lisp/mail/vms-pmail.el b/lisp/mail/vms-pmail.el index ed723d12e79..7fe7771d350 100644 --- a/lisp/mail/vms-pmail.el +++ b/lisp/mail/vms-pmail.el @@ -1,4 +1,4 @@ -;;; 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. @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: ;;; diff --git a/lisp/man.el b/lisp/man.el new file mode 100644 index 00000000000..c7a2d43153c --- /dev/null +++ b/lisp/man.el @@ -0,0 +1,1186 @@ +;;; 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. + + +;;; 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 + +;; 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) + ) + + +;; ====================================================================== +;; 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)))) + + +;; ====================================================================== +;; 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)) + ""))))) + + +;; ====================================================================== +;; 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)) + )))) + + +;; ====================================================================== +;; 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)) + )))) + + +;; ====================================================================== +;; 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")))) + +;; 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 diff --git a/lisp/map-ynp.el b/lisp/map-ynp.el index e986ae87359..21e6aec67df 100644 --- a/lisp/map-ynp.el +++ b/lisp/map-ynp.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 0963629a397..d6509792672 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1,4 +1,4 @@ -;;; 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. @@ -25,6 +25,8 @@ ;; Avishai Yacobi suggested some menu rearrangements. +;;; Commentary: + ;;; Code: ;;; User options: diff --git a/lisp/misc.el b/lisp/misc.el index 9590d490ec9..ca9f6aabca5 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -21,6 +21,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defun copy-from-above-command (&optional arg) diff --git a/lisp/msb.el b/lisp/msb.el index fe9906cf933..7eb26338373 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index fb2f8120c4c..12aaaa58fe5 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4834,9 +4834,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; 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) @@ -5353,7 +5353,7 @@ Other orders of $ and _ seem to all work just fine.") ;; 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 "") @@ -5542,7 +5542,7 @@ Other orders of $ and _ seem to all work just fine.") (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 diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index bb75508935f..497052b8ab9 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -239,4 +239,4 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (provide 'goto-addr) -;;; goto-addr.el ends here. +;;; goto-addr.el ends here diff --git a/lisp/novice.el b/lisp/novice.el index 348774a90fa..c22e685aef3 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/obsolete/auto-show.el b/lisp/obsolete/auto-show.el index 93323f6c8c1..9a813374551 100644 --- a/lisp/obsolete/auto-show.el +++ b/lisp/obsolete/auto-show.el @@ -1,9 +1,11 @@ ;;; 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: @@ -46,5 +48,4 @@ to auto-show from your init file and code." (provide 'auto-show) -;; auto-show.el ends here - +;;; auto-show.el ends here diff --git a/lisp/obsolete/hilit19.el b/lisp/obsolete/hilit19.el index a324de3b1bf..0adcb88a678 100644 --- a/lisp/obsolete/hilit19.el +++ b/lisp/obsolete/hilit19.el @@ -1,4 +1,4 @@ -;;; hilit19.el --- customizable highlighting for Emacs19 +;;; hilit19.el --- customizable highlighting for Emacs 19 ;; Copyright (c) 1993, 1994 Free Software Foundation, Inc. @@ -26,7 +26,7 @@ ;;; 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. @@ -1512,4 +1512,4 @@ number of backslashes." (provide 'hilit19) -;;; hilit19 ends here. +;;; hilit19.el ends here diff --git a/lisp/obsolete/ooutline.el b/lisp/obsolete/ooutline.el index f2a324bd0f1..ea7ac542031 100644 --- a/lisp/obsolete/ooutline.el +++ b/lisp/obsolete/ooutline.el @@ -1,4 +1,4 @@ -;;; outline.el --- outline mode commands for Emacs +;;; ooutline.el --- outline mode commands for Emacs ;; Copyright (C) 1986, 1993, 1994, 1997 Free Software Foundation, Inc. @@ -582,4 +582,4 @@ Stop at the first and last subheadings of a superior heading." (provide 'outline) -;;; outline.el ends here +;;; ooutline.el ends here diff --git a/lisp/obsolete/rnews.el b/lisp/obsolete/rnews.el index b1570917ee6..03f99ff9098 100644 --- a/lisp/obsolete/rnews.el +++ b/lisp/obsolete/rnews.el @@ -1,4 +1,4 @@ -;;; 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. @@ -51,6 +51,8 @@ ;; tower@gnu.org Nov 21 1986 ;; added tower@gnu.org 22 Apr 87 +;;; Commentary: + ;;; Code: (require 'mail-utils) diff --git a/lisp/obsolete/rnewspost.el b/lisp/obsolete/rnewspost.el index 7788164b4d0..546195e37bd 100644 --- a/lisp/obsolete/rnewspost.el +++ b/lisp/obsolete/rnewspost.el @@ -52,6 +52,8 @@ ;;; >> Nuked by Mly to autoload those functions again, as the duplication of ;;; >> code was making maintenance too difficult. +;;; Commentary: + ;;; Code: (require 'sendmail) diff --git a/lisp/options.el b/lisp/options.el index f6620824a87..b7684034695 100644 --- a/lisp/options.el +++ b/lisp/options.el @@ -1,4 +1,4 @@ -;;; options.el --- edit Options command for Emacs. +;;; options.el --- edit Options command for Emacs ;; Copyright (C) 1985 Free Software Foundation, Inc. diff --git a/lisp/paren.el b/lisp/paren.el index 40e99bea0ef..b2d4775ccb2 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -1,4 +1,4 @@ -;;; paren.el --- highlight matching paren. +;;; paren.el --- highlight matching paren ;; Copyright (C) 1993, 1996 Free Software Foundation, Inc. diff --git a/lisp/paths.el b/lisp/paths.el index 6648898464c..78d4ff0acfa 100644 --- a/lisp/paths.el +++ b/lisp/paths.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el index fab3ed92559..b8458f63fa4 100644 --- a/lisp/play/dissociate.el +++ b/lisp/play/dissociate.el @@ -1,4 +1,4 @@ -;;; dissociate.el --- scramble text amusingly for Emacs. +;;; dissociate.el --- scramble text amusingly for Emacs ;; Copyright (C) 1985 Free Software Foundation, Inc. diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index eed63bca9df..7811c7c0047 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 8b98f067be9..fd8223eb6b2 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -7,6 +7,7 @@ ; 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 diff --git a/lisp/play/meese.el b/lisp/play/meese.el index f62ce3c702a..30793af6db7 100644 --- a/lisp/play/meese.el +++ b/lisp/play/meese.el @@ -3,6 +3,8 @@ ;; 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 diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 3d0c399cf7c..3eff86d2ce4 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 4b62a90e115..688f9d60c0a 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -4509,5 +4509,4 @@ EVENT is the mouse event." ;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) ;;; End: -;;; ebrowse.el ends here. - +;;; ebrowse.el ends here diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index be29de4b4f1..37f95f25041 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1,4 +1,4 @@ -;;; hide-ifdef-mode.el --- hides selected code within ifdef. +;;; hideif.el --- hides selected code within ifdef ;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. @@ -1075,4 +1075,3 @@ Return as (TOP . BOTTOM) the extent of ifdef block." (provide 'hideif) ;;; hideif.el ends here - diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 3c4ee33ebe0..15b716feaec 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -5,6 +5,8 @@ ;; 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: diff --git a/lisp/register.el b/lisp/register.el index 940ae584683..e609e8bfb73 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -1,4 +1,4 @@ -;;; register.el --- register commands for Emacs. +;;; register.el --- register commands for Emacs ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. diff --git a/lisp/rot13.el b/lisp/rot13.el index a3307ea352e..fcb349c03e5 100644 --- a/lisp/rot13.el +++ b/lisp/rot13.el @@ -1,8 +1,8 @@ -;;; 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. diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 2be03700d15..c8088536d71 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -1,4 +1,4 @@ -;;; saveplace.el --- automatically save place in files. +;;; saveplace.el --- automatically save place in files ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. @@ -238,4 +238,3 @@ To save places automatically in all files, put this in your `.emacs' file: (provide 'saveplace) ; why not... ;;; saveplace.el ends here - diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 4ab77a542e1..493a271cf23 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/server.el b/lisp/server.el index c86c08532b6..6b055e89bc6 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/sort.el b/lisp/sort.el index 33f523c9533..7a835b635e8 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/soundex.el b/lisp/soundex.el index 2a33d538695..89094e326e4 100644 --- a/lisp/soundex.el +++ b/lisp/soundex.el @@ -29,7 +29,7 @@ ;; 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") @@ -73,4 +73,4 @@ and Searching\", Addison-Wesley (1973), pp. 391-392." (provide 'soundex) -;; soundex.el ends here +;;; soundex.el ends here diff --git a/lisp/term/bg-mouse.el b/lisp/term/bg-mouse.el index 23c32e4cc6b..e4b78d18ea3 100644 --- a/lisp/term/bg-mouse.el +++ b/lisp/term/bg-mouse.el @@ -1,4 +1,4 @@ -;;; 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. @@ -24,6 +24,8 @@ ;; 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 diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index ac73c3ac4ed..c18636e2f97 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -1,4 +1,4 @@ -;;; 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. @@ -22,6 +22,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (load "term/internal" nil t) diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el index 13fb796e399..849569e1847 100644 --- a/lisp/term/sup-mouse.el +++ b/lisp/term/sup-mouse.el @@ -26,6 +26,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: ;;; User customization option: diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index e0f80d15042..0a818a5c734 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -1008,3 +1008,5 @@ A color is considered gray if the 3 components of its RGB value are equal." (setq count (1+ count))) (setq colors (cdr colors))) count)) + +;;; tty-colors.el ends here diff --git a/lisp/terminal.el b/lisp/terminal.el index 7b2f4d76adb..865b917d20a 100644 --- a/lisp/terminal.el +++ b/lisp/terminal.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 9ccbd517ea0..ef9a7f67864 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -1,4 +1,4 @@ -;;; 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. @@ -30,6 +30,7 @@ ;; and appropriate keys are presented for various kinds of entries. ;;; Code: + (defgroup bib nil "Major mode for editing bib files." :prefix "bib-" diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el index 0beccbc5fc7..718d96ed5ac 100644 --- a/lisp/textmodes/makeinfo.el +++ b/lisp/textmodes/makeinfo.el @@ -253,4 +253,3 @@ line LINE of the window, or centered if LINE is nil." (provide 'makeinfo) ;;; makeinfo.el ends here - diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index e8f5b5d6bbf..7bf8631a3f5 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -1,4 +1,4 @@ -;;; page.el --- page motion commands for emacs. +;;; page.el --- page motion commands for Emacs ;; Copyright (C) 1985 Free Software Foundation, Inc. diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 4ecc0c2d433..172c2cdf35c 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index d1f87fa0b54..25e60eb4809 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -1,4 +1,4 @@ -;;; 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. @@ -397,7 +397,7 @@ stops computed are displayed in the minibuffer with `:' at each stop." (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)) ?\ ))) @@ -486,7 +486,7 @@ shifting existing text. Leaves mark at one corner of rectangle and 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) @@ -508,7 +508,7 @@ of rectangle and point at the other (diagonally opposed) corner." (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) @@ -698,7 +698,7 @@ Note that Picture mode commands will work outside of Picture mode, but 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) @@ -735,7 +735,7 @@ With no argument strips whitespace from end of every line in Picture buffer 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) diff --git a/lisp/textmodes/scribe.el b/lisp/textmodes/scribe.el index 0123ce82d5f..d1b5aedf3c6 100644 --- a/lisp/textmodes/scribe.el +++ b/lisp/textmodes/scribe.el @@ -1,4 +1,4 @@ -;;; scribe.el --- scribe mode, and its idiosyncratic commands. +;;; scribe.el --- scribe mode, and its idiosyncratic commands ;; Copyright (C) 1985 Free Software Foundation, Inc. diff --git a/lisp/textmodes/spell.el b/lisp/textmodes/spell.el index e8fe420a842..1923c867fb7 100644 --- a/lisp/textmodes/spell.el +++ b/lisp/textmodes/spell.el @@ -1,4 +1,4 @@ -;;; spell.el --- spelling correction interface for Emacs. +;;; spell.el --- spelling correction interface for Emacs ;; Copyright (C) 1985 Free Software Foundation, Inc. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index e74f64ef23b..07dcee289b2 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1,4 +1,4 @@ -;;; 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. @@ -26,6 +26,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: ;; Pacify the byte-compiler diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 41728618cbd..e6d3e0548b2 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el index a7e6d30bd5c..d6f08b5deea 100644 --- a/lisp/textmodes/underline.el +++ b/lisp/textmodes/underline.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 9f8c3bdb8a8..d0ede90ed35 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -1,4 +1,4 @@ -;;; 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. @@ -395,4 +395,4 @@ Signal an error if the entire string was not used." ;;;###autoload (defun list-at-point () (form-at-point 'list 'listp)) -;; thingatpt.el ends here. +;;; thingatpt.el ends here diff --git a/lisp/time.el b/lisp/time.el index f879fdd5ca8..8357556df1a 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -1,4 +1,4 @@ -;;; 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. diff --git a/lisp/timer.el b/lisp/timer.el new file mode 100644 index 00000000000..3820b57365e --- /dev/null +++ b/lisp/timer.el @@ -0,0 +1,473 @@ +;;; 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) + +(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))))) + +;; 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))) + +;;;###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)) + +(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))) + +(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))))) + +(provide 'timer) + +;;; timer.el ends here diff --git a/lisp/unused.el b/lisp/unused.el index 1cb956b213f..6439bb21ee7 100644 --- a/lisp/unused.el +++ b/lisp/unused.el @@ -1,7 +1,9 @@ -;;; 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 diff --git a/lisp/vcursor.el b/lisp/vcursor.el index 3c7afbb5b0b..492d660b3a2 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -1,4 +1,4 @@ -;;; vcursor.el --- manipulate an alternative ("virtual") cursor. +;;; vcursor.el --- manipulate an alternative ("virtual") cursor ;; Copyright (C) 1994, 1996, 1998 Free Software Foundation, Inc. @@ -808,7 +808,7 @@ out how much to copy." ((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) @@ -1161,4 +1161,4 @@ Disabling the vcursor automatically turns this off." (provide 'vcursor) -;; vcursor.el ends here +;;; vcursor.el ends here diff --git a/lisp/version.el b/lisp/version.el index 297174e4606..f408e6e5b4b 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -1,4 +1,4 @@ -;;; 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. @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defconst emacs-version "21.0.105" "\ diff --git a/lisp/vms-patch.el b/lisp/vms-patch.el index f0669a97682..3d8a9c59647 100644 --- a/lisp/vms-patch.el +++ b/lisp/vms-patch.el @@ -1,4 +1,4 @@ -;;; 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. @@ -22,6 +22,8 @@ ;; 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)) diff --git a/lisp/vmsproc.el b/lisp/vmsproc.el index 020dcb304d0..14f9b2903ad 100644 --- a/lisp/vmsproc.el +++ b/lisp/vmsproc.el @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defvar display-subprocess-window nil diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el index 17d3e3a53e7..88819da9c23 100644 --- a/lisp/vt100-led.el +++ b/lisp/vt100-led.el @@ -1,4 +1,4 @@ -;;; 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. @@ -23,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defvar led-state (make-vector 5 nil) diff --git a/lisp/window.el b/lisp/window.el index e3d451c5382..a5535dcd8da 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,4 +1,4 @@ -;;; 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. @@ -22,7 +22,6 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. - ;;; Commentary: ;; Window tree functions. |