From 98c245d0d2f401d9cdc6de17507fa610297b0ce2 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sun, 17 Jun 2007 02:18:00 +0000 Subject: [PATCH 001/163] (syms_of_xdisp) : Fix typo in docstring. --- src/xdisp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index f2c6b1b6b12..fe08b7b0f5e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24137,7 +24137,7 @@ unselects the minibuffer if it is active. */); This dynamically changes the tool-bar's height to the minimum height that is needed to make all tool-bar items visible. If value is `grow-only', the tool-bar's height is only increased -automatically; to decreace the tool-bar height, use \\[recenter]. */); +automatically; to decrease the tool-bar height, use \\[recenter]. */); Vauto_resize_tool_bars = Qt; DEFVAR_BOOL ("auto-raise-tool-bar-buttons", &auto_raise_tool_bar_buttons_p, From c3e35d758bcea8124c4345a0f0152aefcd020f06 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sun, 17 Jun 2007 02:36:20 +0000 Subject: [PATCH 002/163] *** empty log message *** --- src/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 3d303ac3c5f..3f6e43f2bca 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2007-06-17 Juanma Barranquero + + * xdisp.c (syms_of_xdisp) : + Fix typo in docstring. + 2007-06-16 Eli Zaretskii * w32menu.c (add_menu_item): Escape `&' characters in menu items From 293bb86c13df740bf45b20a4155d780fe23bfdef Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 17 Jun 2007 22:19:25 +0000 Subject: [PATCH 003/163] *** empty log message *** --- lisp/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c8bd63eb17e..d711f4f0c80 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-17 Glenn Morris + + * lpr.el (lpr-page-header-switches): Move %s to separate element + for correct quoting. Doc fix. + 2007-06-13 Johan Bockg,Ae(Brd (tiny change) * term/xterm.el (terminal-init-xterm): Escape parens in character From be62e9d52d759cb6b352e2b1606dcb9bc9aecbb9 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 17 Jun 2007 22:19:58 +0000 Subject: [PATCH 004/163] (lpr-page-header-switches): Move %s to separate element for correct quoting. Doc fix. --- lisp/lpr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/lpr.el b/lisp/lpr.el index c4eec3fa62b..9775abc74f9 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -140,9 +140,10 @@ See definition of `print-region-1' for calling conventions." ;; Berkeley systems support -F, and GNU pr supports both -f and -F, ;; So it looks like -F is a better default. -(defcustom lpr-page-header-switches '("-h %s" "-F") +(defcustom lpr-page-header-switches '("-h" "%s" "-F") "*List of strings to use as options for the page-header-generating program. -If `%s' appears in one of the strings, it is substituted by the page title. +If `%s' appears in any of the strings, it is substituted by the page title. +Note that for correct quoting, `%s' should normally be a separate element. The variable `lpr-page-header-program' specifies the program to use." :type '(repeat string) :group 'lpr) From d058c8a14e688f90e547b687686a77efaf996845 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sun, 17 Jun 2007 22:25:08 +0000 Subject: [PATCH 005/163] (add_menu_item): Don't use multibyte string functions on unicode strings. --- src/ChangeLog | 5 ++++ src/w32menu.c | 68 ++++++++++++++++++++++++++++++++++----------------- 2 files changed, 51 insertions(+), 22 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 3f6e43f2bca..7de6155d427 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2007-06-17 Jason Rumney + + * w32menu.c (add_menu_item): Don't use multibyte string functions on + unicode strings. + 2007-06-17 Juanma Barranquero * xdisp.c (syms_of_xdisp) : diff --git a/src/w32menu.c b/src/w32menu.c index bcd56c8c88e..d8d6fa186bd 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -2291,29 +2291,53 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) /* Quote any special characters within the menu item's text and key binding. */ nlen = orig_len = strlen (out_string); - for (p = out_string; *p; p = _mbsinc (p)) - { - if (_mbsnextc (p) == '&') - nlen++; - } + if (unicode_append_menu) + { + /* With UTF-8, & cannot be part of a multibyte character. */ + for (p = out_string; *p; p++) + { + if (*p == '&') + nlen++; + } + } + else + { + /* If encoded with the system codepage, use multibyte string + functions in case of multibyte characters that contain '&'. */ + for (p = out_string; *p; p = _mbsinc (p)) + { + if (_mbsnextc (p) == '&') + nlen++; + } + } + if (nlen > orig_len) - { - p = out_string; - out_string = alloca (nlen + 1); - q = out_string; - while (*p) - { - if (_mbsnextc (p) == '&') - { - _mbsncpy (q, p, 1); - q = _mbsinc (q); - } - _mbsncpy (q, p, 1); - p = _mbsinc (p); - q = _mbsinc (q); - } - *q = '\0'; - } + { + p = out_string; + out_string = alloca (nlen + 1); + q = out_string; + while (*p) + { + if (unicode_append_menu) + { + if (*p == '&') + *q++ = *p; + *q++ = *p++; + } + else + { + if (_mbsnextc (p) == '&') + { + _mbsncpy (q, p, 1); + q = _mbsinc (q); + } + _mbsncpy (q, p, 1); + p = _mbsinc (p); + q = _mbsinc (q); + } + } + *q = '\0'; + } if (item != NULL) fuFlags = MF_POPUP; From 07fe3281d697bfdd7a244ddbfd9d0bd78ccc0e7e Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Tue, 19 Jun 2007 11:59:20 +0000 Subject: [PATCH 006/163] Use emacs.manifest. --- nt/ChangeLog | 6 ++++++ nt/emacs.rc | 1 + 2 files changed, 7 insertions(+) diff --git a/nt/ChangeLog b/nt/ChangeLog index 11b974e10ab..a7c1d181341 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,9 @@ +2007-06-15 Jason Rumney + + * emacs.manifest: New file. + + * emacs.rc: Use it. + 2007-06-02 Chong Yidong * Version 22.1 released. diff --git a/nt/emacs.rc b/nt/emacs.rc index cf72b88a8ea..861b336fd35 100644 --- a/nt/emacs.rc +++ b/nt/emacs.rc @@ -1,5 +1,6 @@ Emacs ICON icons\emacs.ico 32649 CURSOR icons\hand.cur +1 24 "emacs.manifest" #ifndef VS_VERSION_INFO #define VS_VERSION_INFO 1 From 3abd207ebc97a97b86b039cc6b0aa32de0da865c Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 20 Jun 2007 08:26:23 +0000 Subject: [PATCH 007/163] *** empty log message *** --- lisp/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d711f4f0c80..0bfc5ab7a8e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-06-18 Alan Mackenzie + + * progmodes/cc-mode.el (c-remove-any-local-eval-or-mode-variables): + When removing lines, also remove the \n. Correction of patch of + 2007-04-21. + 2007-06-17 Glenn Morris * lpr.el (lpr-page-header-switches): Move %s to separate element From 5c4c911a172a714bcb745e76860738f25ab38a84 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 20 Jun 2007 08:27:53 +0000 Subject: [PATCH 008/163] (c-remove-any-local-eval-or-mode-variables): When removing lines, also remove the \n. Correction of patch of 2007-04-21. --- lisp/progmodes/cc-mode.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 390d49eaea4..dcbcc618dca 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -790,7 +790,8 @@ compatible with old code; callers should always specify it." ;; If the buffer specifies `mode' or `eval' in its File Local Variable list ;; or on the first line, remove all occurrences. See ;; `c-postprocess-file-styles' for justification. There is no need to save - ;; point here, or even bother too much about the buffer contents. + ;; point here, or even bother too much about the buffer contents. However, + ;; DON'T mess up the kill-ring. ;; ;; Most of the code here is derived from Emacs 21.3's `hack-local-variables' ;; in files.el. @@ -819,8 +820,8 @@ compatible with old code; callers should always specify it." (regexp-quote suffix) "$") nil t) - (beginning-of-line) - (delete-region (point) (progn (end-of-line) (point))))) + (forward-line 0) + (delete-region (point) (progn (forward-line) (point))))) ;; Delete the first line, if we've got one, in case it contains a mode spec. (unless (and lv-point @@ -828,7 +829,8 @@ compatible with old code; callers should always specify it." (forward-line 0) (bobp))) (goto-char (point-min)) - (delete-region (point) (progn (end-of-line) (point)))))) + (unless (eobp) + (delete-region (point) (progn (forward-line) (point))))))) (defun c-postprocess-file-styles () "Function that post processes relevant file local variables in CC Mode. From 43e9fc935faa1120a5b973bbc2a021c20401e782 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 20 Jun 2007 08:49:12 +0000 Subject: [PATCH 009/163] (_wsa_errlist): Fix typo in error message. (init_environment): Ignore any environment variable from the registry having a null value. --- src/ChangeLog | 6 ++++++ src/w32.c | 38 ++++++++++++++++++-------------------- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 7de6155d427..6f1be74a8e2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2007-06-20 Juanma Barranquero + + * w32.c (_wsa_errlist): Fix typo in error message. + (init_environment): Ignore any environment variable from the + registry having a null value. + 2007-06-17 Jason Rumney * w32menu.c (add_menu_item): Don't use multibyte string functions on diff --git a/src/w32.c b/src/w32.c index 9ad82c7a231..4124011b451 100644 --- a/src/w32.c +++ b/src/w32.c @@ -113,7 +113,7 @@ extern int w32_num_mouse_buttons; /* - Initialization states + Initialization states */ static BOOL g_b_init_is_windows_9x; static BOOL g_b_init_open_process_token; @@ -486,20 +486,16 @@ init_user_info () the user-sid as the user id value (same for group id using the primary group sid from the process token). */ - char user_sid[256], name[256], domain[256]; - DWORD length = sizeof (name), dlength = sizeof (domain), trash; - HANDLE token = NULL; - SID_NAME_USE user_type; + char user_sid[256], name[256], domain[256]; + DWORD length = sizeof (name), dlength = sizeof (domain), trash; + HANDLE token = NULL; + SID_NAME_USE user_type; - if ( - open_process_token (GetCurrentProcess (), TOKEN_QUERY, &token) - && get_token_information ( - token, TokenUser, - (PVOID) user_sid, sizeof (user_sid), &trash) - && lookup_account_sid ( - NULL, *((PSID *) user_sid), name, &length, - domain, &dlength, &user_type) - ) + if (open_process_token (GetCurrentProcess (), TOKEN_QUERY, &token) + && get_token_information (token, TokenUser, + (PVOID) user_sid, sizeof (user_sid), &trash) + && lookup_account_sid (NULL, *((PSID *) user_sid), name, &length, + domain, &dlength, &user_type)) { strcpy (the_passwd.pw_name, name); /* Determine a reasonable uid value. */ @@ -524,7 +520,7 @@ init_user_info () /* Get group id */ if (get_token_information (token, TokenPrimaryGroup, - (PVOID) user_sid, sizeof (user_sid), &trash)) + (PVOID) user_sid, sizeof (user_sid), &trash)) { SID_IDENTIFIER_AUTHORITY * pSIA; @@ -541,7 +537,7 @@ init_user_info () } } /* If security calls are not supported (presumably because we - are running under Windows 95), fallback to this. */ + are running under Windows 95), fallback to this. */ else if (GetUserName (name, &length)) { strcpy (the_passwd.pw_name, name); @@ -1110,7 +1106,9 @@ init_environment (char ** argv) { int dont_free = 0; - if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL) + if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL + /* Also ignore empty environment variables. */ + || *lpval == 0) { lpval = env_vars[i].def_value; dwType = REG_EXPAND_SZ; @@ -2481,7 +2479,7 @@ stat (const char * path, struct stat * buf) != INVALID_HANDLE_VALUE) { /* This is more accurate in terms of gettting the correct number - of links, but is quite slow (it is noticable when Emacs is + of links, but is quite slow (it is noticeable when Emacs is making a list of file name completions). */ BY_HANDLE_FILE_INFORMATION info; @@ -2966,7 +2964,7 @@ struct { WSAEINVALIDPROCTABLE , "Invalid procedure table from service provider", WSAEINVALIDPROVIDER , "Invalid service provider version number", WSAEPROVIDERFAILEDINIT , "Unable to initialize a service provider", - WSASYSCALLFAILURE , "System call failured", + WSASYSCALLFAILURE , "System call failure", WSASERVICE_NOT_FOUND , "Service not found", /* not sure */ WSATYPE_NOT_FOUND , "Class type not found", WSA_E_NO_MORE , "No more resources available", /* really not sure */ @@ -4160,7 +4158,7 @@ globals_of_w32 () SetConsoleCtrlHandler(shutdown_handler, TRUE); } -/* end of nt.c */ +/* end of w32.c */ /* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1 (do not change this comment) */ From 72a75b41db354b0846da2c728d3c09f48fb24fc8 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 20 Jun 2007 15:19:37 +0000 Subject: [PATCH 010/163] (ido-find-file-in-dir): Don't signal an error for empty directories. --- lisp/ChangeLog | 11 ++++++++--- lisp/ido.el | 3 +-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0bfc5ab7a8e..38f8794f862 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,9 +1,14 @@ +2007-06-20 Juanma Barranquero + + * ido.el (ido-find-file-in-dir): Don't signal an error for + empty directories. + 2007-06-18 Alan Mackenzie * progmodes/cc-mode.el (c-remove-any-local-eval-or-mode-variables): When removing lines, also remove the \n. Correction of patch of 2007-04-21. - + 2007-06-17 Glenn Morris * lpr.el (lpr-page-header-switches): Move %s to separate element @@ -11,8 +16,8 @@ 2007-06-13 Johan Bockg,Ae(Brd (tiny change) - * term/xterm.el (terminal-init-xterm): Escape parens in character - constants. + * term/xterm.el (terminal-init-xterm): Escape parens in character + constants. 2007-06-12 Ralf Angeli diff --git a/lisp/ido.el b/lisp/ido.el index 5a7be3e5ae6..0808075b495 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3994,8 +3994,7 @@ For details of keybindings, see `ido-switch-buffer'." (defun ido-find-file-in-dir (dir) "Switch to another file starting from DIR." (interactive "DDir: ") - (if (not (equal (substring dir -1) "/")) - (setq dir (concat dir "/"))) + (setq dir (file-name-as-directory dir)) (ido-file-internal ido-default-file-method nil dir nil nil nil 'ignore)) ;;;###autoload From 5fd6ff96085082b7ff81cb0ab93bb7618d88a840 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Wed, 20 Jun 2007 15:22:59 +0000 Subject: [PATCH 011/163] progmodes/vera-mode.el: New file. --- lisp/ChangeLog | 4 + lisp/progmodes/vera-mode.el | 1506 +++++++++++++++++++++++++++++++++++ 2 files changed, 1510 insertions(+) create mode 100644 lisp/progmodes/vera-mode.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 38f8794f862..3668a5a8c09 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-06-20 Reto Zimmermann + + * progmodes/vera-mode.el: New file. + 2007-06-20 Juanma Barranquero * ido.el (ido-find-file-in-dir): Don't signal an error for diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el new file mode 100644 index 00000000000..67d881030db --- /dev/null +++ b/lisp/progmodes/vera-mode.el @@ -0,0 +1,1506 @@ +;;; vera-mode.el --- major mode for editing Vera files. + +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007 Free Software Foundation, Inc. + +;; Author: Reto Zimmermann +;; Maintainer: Reto Zimmermann +;; Version: 2.26 +;; Keywords: languages vera +;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html + +(defconst vera-version "2.18" + "Vera Mode version number.") + +(defconst vera-time-stamp "2007-06-11" + "Vera Mode time stamp for last update.") + +;; This file is not 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 provides a simple Emacs major mode for editing Vera code. +;; It includes the following features: + +;; - Syntax highlighting +;; - Indentation +;; - Word/keyword completion +;; - Block commenting +;; - Works under GNU Emacs and XEmacs + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Documentation + +;; See comment string of function `vera-mode' or type `C-c C-h' in Emacs. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Installation + +;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X + +;; Put `vera-mode.el' into the `site-lisp' directory of your Emacs installation +;; or into an arbitrary directory that is added to the load path by the +;; following line in your Emacs start-up file (`.emacs'): + +;; (setq load-path (cons (expand-file-name "") load-path)) + +;; If you already have the compiled `vera-mode.elc' file, put it in the same +;; directory. Otherwise, byte-compile the source file: +;; Emacs: M-x byte-compile-file -> vera-mode.el +;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vera-mode.el + +;; Add the following lines to the `site-start.el' file in the `site-lisp' +;; directory of your Emacs installation or to your Emacs start-up file +;; (`.emacs'): + +;; (autoload 'vera-mode "vera-mode" "Vera Mode" t) +;; (setq auto-mode-alist (cons '("\\.vr[hi]?\\'" . vera-mode) auto-mode-alist)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: + +;; XEmacs handling +(defconst vera-xemacs (string-match "XEmacs" emacs-version) + "Non-nil if XEmacs is used.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup vera nil + "Customizations for Vera Mode." + :prefix "vera-" + :version "22.2" + :group 'languages) + +(defcustom vera-basic-offset 2 + "*Amount of basic offset used for indentation." + :type 'integer + :group 'vera) + +(defcustom vera-underscore-is-part-of-word nil + "*Non-nil means consider the underscore character `_' as part of word. +An identifier containing underscores is then treated as a single word in +select and move operations. All parts of an identifier separated by underscore +are treated as single words otherwise." + :type 'boolean + :group 'vera) + +(defcustom vera-intelligent-tab t + "*Non-nil means `TAB' does indentation, word completion and tab insertion. +That is, if preceeding character is part of a word then complete word, +else if not at beginning of line then insert tab, +else if last command was a `TAB' or `RET' then dedent one step, +else indent current line. +If nil, TAB always indents current line." + :type 'boolean + :group 'vera) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Mode definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Key bindings + +(defvar vera-mode-map () + "Keymap for Vera Mode.") + +(setq vera-mode-map (make-sparse-keymap)) +;; backspace/delete key bindings +(define-key vera-mode-map [backspace] 'backward-delete-char-untabify) +(unless (boundp 'delete-key-deletes-forward) ; XEmacs variable + (define-key vera-mode-map [delete] 'delete-char) + (define-key vera-mode-map [(meta delete)] 'kill-word)) +;; standard key bindings +(define-key vera-mode-map "\M-e" 'vera-forward-statement) +(define-key vera-mode-map "\M-a" 'vera-backward-statement) +(define-key vera-mode-map "\M-\C-e" 'vera-forward-same-indent) +(define-key vera-mode-map "\M-\C-a" 'vera-backward-same-indent) +;; mode specific key bindings +(define-key vera-mode-map "\C-c\t" 'indent-according-to-mode) +(define-key vera-mode-map "\M-\C-\\" 'vera-indent-region) +(define-key vera-mode-map "\C-c\C-c" 'vera-comment-uncomment-region) +(define-key vera-mode-map "\C-c\C-f" 'vera-fontify-buffer) +(define-key vera-mode-map "\C-c\C-v" 'vera-version) +(define-key vera-mode-map "\M-\t" 'tab-to-tab-stop) +;; electric key bindings +(define-key vera-mode-map "\t" 'vera-electric-tab) +(define-key vera-mode-map "\r" 'vera-electric-return) +(define-key vera-mode-map " " 'vera-electric-space) +(define-key vera-mode-map "{" 'vera-electric-opening-brace) +(define-key vera-mode-map "}" 'vera-electric-closing-brace) +(define-key vera-mode-map "#" 'vera-electric-pound) +(define-key vera-mode-map "*" 'vera-electric-star) +(define-key vera-mode-map "/" 'vera-electric-slash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Menu + +(require 'easymenu) + +(easy-menu-define vera-mode-menu vera-mode-map + "Menu keymap for Vera Mode." + '("Vera" + ["(Un)Comment Out Region" vera-comment-uncomment-region (mark)] + "--" + ["Move Forward Statement" vera-forward-statement t] + ["Move Backward Statement" vera-backward-statement t] + ["Move Forward Same Indent" vera-forward-same-indent t] + ["Move Backward Same Indent" vera-backward-same-indent t] + "--" + ["Indent Line" indent-according-to-mode t] + ["Indent Region" vera-indent-region (mark)] + ["Indent Buffer" vera-indent-buffer t] + "--" + ["Fontify Buffer" vera-fontify-buffer t] + "--" + ["Documentation" describe-mode] + ["Version" vera-version t] + ["Bug Report..." vera-submit-bug-report t] + "--" + ("Options" + ["Indentation Offset..." (customize-option 'vera-basic-offset) t] + ["Underscore is Part of Word" + (customize-set-variable 'vera-underscore-is-part-of-word + (not vera-underscore-is-part-of-word)) + :style toggle :selected vera-underscore-is-part-of-word] + ["Use Intelligent Tab" + (customize-set-variable 'vera-intelligent-tab + (not vera-intelligent-tab)) + :style toggle :selected vera-intelligent-tab] + "--" + ["Save Options" customize-save-customized t] + "--" + ["Customize..." vera-customize t]))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Syntax table + +(defvar vera-mode-syntax-table + (let ((syntax-table (make-syntax-table))) + ;; punctuation + (modify-syntax-entry ?\# "." syntax-table) + (modify-syntax-entry ?\$ "." syntax-table) + (modify-syntax-entry ?\% "." syntax-table) + (modify-syntax-entry ?\& "." syntax-table) + (modify-syntax-entry ?\' "." syntax-table) + (modify-syntax-entry ?\* "." syntax-table) + (modify-syntax-entry ?\- "." syntax-table) + (modify-syntax-entry ?\+ "." syntax-table) + (modify-syntax-entry ?\. "." syntax-table) + (modify-syntax-entry ?\/ "." syntax-table) + (modify-syntax-entry ?\: "." syntax-table) + (modify-syntax-entry ?\; "." syntax-table) + (modify-syntax-entry ?\< "." syntax-table) + (modify-syntax-entry ?\= "." syntax-table) + (modify-syntax-entry ?\> "." syntax-table) + (modify-syntax-entry ?\\ "." syntax-table) + (modify-syntax-entry ?\| "." syntax-table) + ;; string + (modify-syntax-entry ?\" "\"" syntax-table) + ;; underscore + (when vera-underscore-is-part-of-word + (modify-syntax-entry ?\_ "w" syntax-table)) + ;; escape + (modify-syntax-entry ?\\ "\\" syntax-table) + ;; parentheses to match + (modify-syntax-entry ?\( "()" syntax-table) + (modify-syntax-entry ?\) ")(" syntax-table) + (modify-syntax-entry ?\[ "(]" syntax-table) + (modify-syntax-entry ?\] ")[" syntax-table) + (modify-syntax-entry ?\{ "(}" syntax-table) + (modify-syntax-entry ?\} "){" syntax-table) + ;; comment + (if vera-xemacs + (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs + (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs + (modify-syntax-entry ?\* ". 23" syntax-table) + ;; newline and CR + (modify-syntax-entry ?\n "> b" syntax-table) + (modify-syntax-entry ?\^M "> b" syntax-table) + syntax-table) + "Syntax table used in `vera-mode' buffers.") + +(defvar vera-mode-ext-syntax-table + (let ((syntax-table (copy-syntax-table vera-mode-syntax-table))) + ;; extended syntax table including '_' (for simpler search regexps) + (modify-syntax-entry ?_ "w" syntax-table) + syntax-table) + "Syntax table extended by `_' used in `vera-mode' buffers.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Mode definition + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.vr[hi]?\\'" . vera-mode)) + +;;;###autoload +(defun vera-mode () + "Major mode for editing Vera code. + +Usage: +------ + + INDENTATION: Typing `TAB' at the beginning of a line indents the line. + The amount of indentation is specified by option `vera-basic-offset'. + Indentation can be done for an entire region \(`M-C-\\') or buffer (menu). + `TAB' always indents the line if option `vera-intelligent-tab' is nil. + + WORD/COMMAND COMPLETION: Typing `TAB' after a (not completed) word looks + for a word in the buffer or a Vera keyword that starts alike, inserts it + and adjusts case. Re-typing `TAB' toggles through alternative word + completions. + + Typing `TAB' after a non-word character inserts a tabulator stop (if not + at the beginning of a line). `M-TAB' always inserts a tabulator stop. + + COMMENTS: `C-c C-c' comments out a region if not commented out, and + uncomments a region if already commented out. + + HIGHLIGHTING (fontification): Vera keywords, predefined types and + constants, function names, declaration names, directives, as well as + comments and strings are highlighted using different colors. + + VERA VERSION: OpenVera 1.4 and Vera version 6.2.8. + + +Maintenance: +------------ + +To submit a bug report, use the corresponding menu entry within Vera Mode. +Add a description of the problem and include a reproducible test case. + +Feel free to send questions and enhancement requests to . + +Official distribution is at +. + + + The Vera Mode Maintainer + Reto Zimmermann + +Key bindings: +------------- + +\\{vera-mode-map}" + (interactive) + (kill-all-local-variables) + (setq major-mode 'vera-mode) + (setq mode-name "Vera") + ;; set maps and tables + (use-local-map vera-mode-map) + (set-syntax-table vera-mode-syntax-table) + ;; set local variables + (require 'cc-cmds) + (set (make-local-variable 'comment-start) "//") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-column) 40) + (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") + (set (make-local-variable 'comment-end-skip) " *\\*+/\\| *//+") + (set (make-local-variable 'comment-indent-function) 'c-comment-indent) + (set (make-local-variable 'paragraph-start) "^$") + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'require-final-newline) t) + (set (make-local-variable 'indent-tabs-mode) nil) + (set (make-local-variable 'indent-line-function) 'vera-indent-line) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; initialize font locking + (set (make-local-variable 'font-lock-defaults) + '(vera-font-lock-keywords nil nil ((?\_ . "w")))) + ;; add menu (XEmacs) + (easy-menu-add vera-mode-menu) + ;; miscellaneous + (message "Vera Mode %s. Type C-c C-h for documentation." vera-version) + ;; run hooks + (run-hooks 'vera-mode-hook)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Vera definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Keywords + +(defconst vera-keywords + '( + "after" "all" "any" "around" "assoc_index" "assoc_size" "async" + "bad_state" "bad_trans" "before" "begin" "big_endian" "bind" + "bin_activation" "bit_normal" "bit_reverse" "break" "breakpoint" + "case" "casex" "casez" "class" "constraint" "continue" + "coverage" "coverage_block" "coverage_def" "coverage_depth" + "coverage_goal" "coverage_group" "coverage_option" "coverage_val" + "cross_num_print_missing" "cross_auto_bin_max" "cov_comment" + "default" "depth" "dist" "do" + "else" "end" "enum" "exhaustive" "export" "extends" "extern" + "for" "foreach" "fork" "function" + "hdl_task" "hdl_node" "hide" + "if" "illegal_self_transition" "illegal_state" "illegal_transition" + "in" "interface" "invisible" + "join" + "little_endian" "local" + "m_bad_state" "m_bad_trans" "m_state" "m_trans" + "negedge" "new" "newcov" "non_rand" "none" "not" "null" + "or" "ordered" + "packed" "port" "posedge" "proceed" "prod" "prodget" "prodset" + "program" "protected" "public" + "rand" "randc" "randcase" "randseq" "repeat" "return" "rules" + "sample" "sample_event" "shadow" "soft" "state" "static" "super" + "task" "terminate" "this" "trans" "typedef" + "unpacked" + "var" "vca" "vector" "verilog_node" "verilog_task" + "vhdl_node" "vhdl_task" "virtual" "virtuals" "visible" "void" + "while" "wildcard" "with" + ) + "List of Vera keywords.") + +(defconst vera-types + '( + "integer" "bit" "reg" "string" "bind_var" "event" + "inout" "input" "output" + "ASYNC" "CLOCK" + "NDRIVE" "NHOLD" "NRX" "NRZ" "NR0" "NR1" "NSAMPLE" + "PDRIVE" "PHOLD" "PRX" "PRZ" "PR0" "PR1" "PSAMPLE" + ) + "List of Vera predefined types.") + +(defconst vera-q-values + '( + "gnr" "grx" "grz" "gr0" "gr1" + "nr" "rx" "rz" "r0" "r1" + "snr" "srx" "srz" "sr0" "sr1" + ) + "List of Vera predefined VCA q_values.") + +(defconst vera-functions + '( + ;; system functions and tasks + "alloc" + "call_func" "call_task" "cast_assign" "close_conn" "cm_coverage" + "cm_get_coverage" "cm_get_limit" + "coverage_backup_database_file" "coverage_save_database" + "delay" + "error" "error_mode" "error_wait" "exit" + "fclose" "feof" "ferror" "fflush" "flag" "fopen" "fprintf" "freadb" + "freadb" "freadh" "freadstr" + "get_bind" "get_bind_id" "get_conn_err" "get_cycle" "get_env" + "get_memsize" "get_plus_arg" "get_systime" "get_time" "get_time_unit" + "getstate" + "initstate" + "lock_file" + "mailbox_get" "mailbox_put" "mailbox_receive" "mailbox_send" + "make_client" "make_server" + "os_command" + "printf" "psprintf" + "query" "query_str" "query_x" + "rand48" "random" "region_enter" "region_exit" "rewind" + "semaphore_get" "semaphore_put" "setstate" "signal_connect" "simwave_plot" + "srandom" "sprintf" "sscanf" "stop" "suspend_thread" "sync" + "timeout" "trace" "trigger" + "unit_delay" "unlock_file" "up_connections" + "urand48" "urandom" "urandom_range" + "vera_bit_reverse" "vera_crc" "vera_pack" "vera_pack_big_endian" + "vera_plot" "vera_report_profile" "vera_unpack" "vera_unpack_big_endian" + "vsv_call_func" "vsv_call_task" "vsv_close_conn" "vsv_get_conn_err" + "vsv_make_client" "vsv_make_server" "vsv_up_connections" + "vsv_wait_for_done" "vsv_wait_for_input" + "wait_child" "wait_var" + ;; class methods + "Configure" "DisableTrigger" "DoAction" "EnableCount" "EnableTrigger" + "Event" "GetAssert" "GetCount" "GetFirstAssert" "GetName" "GetNextAssert" + "Wait" + "atobin" "atohex" "atoi" "atooct" + "backref" "bittostr" "capacity" "compare" "constraint_mode" + "delete" + "empty" + "find" "find_index" "first" "first_index" + "get_at_least" "get_auto_bin" "get_cov_weight" "get_coverage_goal" + "get_cross_bin_max" "get_status" "get_status_msg" "getc" + "hash" + "icompare" "insert" "inst_get_at_least" "inst_get_auto_bin_max" + "inst_get_collect" "inst_get_cov_weight" "inst_get_coverage_goal" + "inst_getcross_bin_max" "inst_query" "inst_set_at_least" + "inst_set_auto_bin_max" "inst_set_bin_activiation" "inst_set_collect" + "inst_set_cov_weight" "inst_set_coverage_goal" "inst_set_cross_bin_max" + "itoa" + "last" "last_index" "len" "load" + "match" "max" "max_index" "min" "min_index" + "object_compare" "object_copy" "object_print" + "pack" "pick_index" "pop_back" "pop_front" "post_pack" "post_randomize" + "post_unpack" "postmatch" "pre_pack" "pre_randomize" "prematch" "push_back" + "push_front" "putc" + "query" "query_str" + "rand_mode" "randomize" "reserve" "reverse" "rsort" + "search" "set_at_least" "set_auto_bin_max" "set_bin_activiation" + "set_cov_weight" "set_coverage_goal" "set_cross_bin_max" "set_name" "size" + "sort" "substr" "sum" + "thismatch" "tolower" "toupper" + "unique_index" "unpack" + ;; empty methods + "new" "object_compare" + "post_boundary" "post_pack" "post_randomize" "post_unpack" "pre-randomize" + "pre_boundary" "pre_pack" "pre_unpack" + ) + "List of Vera predefined system functions, tasks and class methods.") + +(defconst vera-constants + '( + "ALL" "ANY" + "BAD_STATE" "BAD_TRANS" + "CALL" "CHECK" "CHGEDGE" "CLEAR" "COPY_NO_WAIT" "COPY_WAIT" + "CROSS" "CROSS_TRANS" + "DEBUG" "DELETE" + "EC_ARRAYX" "EC_CODE_END" "EC_CONFLICT" "EC_EVNTIMOUT" "EC_EXPECT" + "EC_FULLEXPECT" "EC_MBXTMOUT" "EC_NEXPECT" "EC_RETURN" "EC_RGNTMOUT" + "EC_SCONFLICT" "EC_SEMTMOUT" "EC_SEXPECT" "EC_SFULLEXPECT" "EC_SNEXTPECT" + "EC_USERSET" "EQ" "EVENT" + "FAIL" "FIRST" "FORK" + "GE" "GOAL" "GT" "HAND_SHAKE" "HI" "HIGH" "HNUM" + "LE" "LIC_EXIT" "LIC_PRERR" "LIC_PRWARN" "LIC_WAIT" "LO" "LOAD" "LOW" "LT" + "MAILBOX" "MAX_COM" + "NAME" "NE" "NEGEDGE" "NEXT" "NO_OVERLAP" "NO_OVERLAP_STATE" + "NO_OVERLAP_TRANS" "NO_VARS" "NO_WAIT" "NUM" "NUM_BIN" "NUM_DET" + "OFF" "OK" "OK_LAST" "ON" "ONE_BLAST" "ONE_SHOT" "ORDER" + "PAST_IT" "PERCENT" "POSEDGE" "PROGRAM" + "RAWIN" "REGION" "REPORT" + "SAMPLE" "SAVE" "SEMAPHORE" "SET" "SILENT" "STATE" "STR" + "STR_ERR_OUT_OF_RANGE" "STR_ERR_REGEXP_SYNTAX" "SUM" + "TRANS" + "VERBOSE" + "WAIT" + "stderr" "stdin" "stdout" + ) + "List of Vera predefined constants.") + +(defconst vera-rvm-types + '( + "VeraListIterator_VeraListIterator_rvm_log" + "VeraListIterator_rvm_data" "VeraListIterator_rvm_log" + "VeraListNodeVeraListIterator_rvm_log" "VeraListNodervm_data" + "VeraListNodervm_log" "VeraList_VeraListIterator_rvm_log" + "VeraList_rvm_data" "VeraList_rvm_log" + "rvm_broadcast" "rvm_channel_class" "rvm_data" "rvm_data" "rvm_env" + "rvm_log" "rvm_log_modifier" "rvm_log_msg" "rvm_log_msg" "rvm_log_msg_info" + "rvm_log_watchpoint" "rvm_notify" "rvm_notify_event" + "rvm_notify_event_config" "rvm_scheduler" "rvm_scheduler_election" + "rvm_watchdog" "rvm_watchdog_port" "rvm_xactor" "rvm_xactor_callbacks" + ) + "List of Vera-RVM keywords.") + +(defconst vera-rvm-functions + '( + "extern_rvm_atomic_gen" "extern_rvm_channel" "extern_rvm_scenario_gen" + "rvm_OO_callback" "rvm_atomic_gen" "rvm_atomic_gen_callbacks_decl" + "rvm_atomic_gen_decl" "rvm_atomic_scenario_decl" "rvm_channel" + "rvm_channel_" "rvm_channel_decl" "rvm_command" "rvm_cycle" "rvm_debug" + "rvm_error" "rvm_fatal" "rvm_note" "rvm_protocol" "rvm_report" + "rvm_scenario_decl" "rvm_scenario_election_decl" "rvm_scenario_gen" + "rvm_scenario_gen_callbacks_decl" "rvm_scenario_gen_decl" + "rvm_trace" "rvm_transaction" "rvm_user" "rvm_verbose" "rvm_warning" + ) + "List of Vera-RVM functions.") + +(defconst vera-rvm-constants + '( + "RVM_NUMERIC_VERSION_MACROS" "RVM_VERSION" "RVM_MINOR" "RVM_PATCH" + "rvm_channel__SOURCE" "rvm_channel__SINK" "rvm_channel__NO_ACTIVE" + "rvm_channel__ACT_PENDING" "rvm_channel__ACT_STARTED" + "rvm_channel__ACT_COMPLETED" "rvm_channel__FULL" "rvm_channel__EMPTY" + "rvm_channel__PUT" "rvm_channel__GOT" "rvm_channel__PEEKED" + "rvm_channel__ACTIVATED" "rvm_channel__STARTED" "rvm_channel__COMPLETED" + "rvm_channel__REMOVED" "rvm_channel__LOCKED" "rvm_channel__UNLOCKED" + "rvm_data__EXECUTE" "rvm_data__STARTED" "rvm_data__ENDED" + "rvm_env__CFG_GENED" "rvm_env__BUILT" "rvm_env__DUT_CFGED" + "rvm_env__STARTED" "rvm_env__RESTARTED" "rvm_env__ENDED" "rvm_env__STOPPED" + "rvm_env__CLEANED" "rvm_env__DONE" "rvm_log__DEFAULT" "rvm_log__UNCHANGED" + "rvm_log__FAILURE_TYP" "rvm_log__NOTE_TYP" "rvm_log__DEBUG_TYP" + "rvm_log__REPORT_TYP" "rvm_log__NOTIFY_TYP" "rvm_log__TIMING_TYP" + "rvm_log__XHANDLING_TYP" "rvm_log__PROTOCOL_TYP" "rvm_log__TRANSACTION_TYP" + "rvm_log__COMMAND_TYP" "rvm_log__CYCLE_TYP" "rvm_log__USER_TYP_0" + "rvm_log__USER_TYP_1" "rvm_log__USER_TYP_2" "rvm_log__USER_TYP_3" + "rvm_log__DEFAULT_TYP" "rvm_log__ALL_TYPES" "rvm_log__FATAL_SEV" + "rvm_log__ERROR_SEV" "rvm_log__WARNING_SEV" "rvm_log__NORMAL_SEV" + "rvm_log__TRACE_SEV" "rvm_log__DEBUG_SEV" "rvm_log__VERBOSE_SEV" + "rvm_log__HIDDEN_SEV" "rvm_log__IGNORE_SEV" "rvm_log__DEFAULT_SEV" + "rvm_log__ALL_SEVERITIES" "rvm_log__CONTINUE" "rvm_log__COUNT_AS_ERROR" + "rvm_log__DEBUGGER" "rvm_log__DUMP" "rvm_log__STOP" "rvm_log__ABORT" + "rvm_notify__ONE_SHOT_TRIGGER" "rvm_notify__ONE_BLAST_TRIGGER" + "rvm_notify__HAND_SHAKE_TRIGGER" "rvm_notify__ON_OFF_TRIGGER" + "rvm_xactor__XACTOR_IDLE" "rvm_xactor__XACTOR_BUSY" + "rvm_xactor__XACTOR_STARTED" "rvm_xactor__XACTOR_STOPPED" + "rvm_xactor__XACTOR_RESET" "rvm_xactor__XACTOR_SOFT_RST" + "rvm_xactor__XACTOR_FIRM_RST" "rvm_xactor__XACTOR_HARD_RST" + "rvm_xactor__XACTOR_PROTOCOL_RST" "rvm_broadcast__AFAP" + "rvm_broadcast__ALAP" "rvm_watchdog__TIMEOUT" + "rvm_env__DUT_RESET" "rvm_log__INTERNAL_TYP" + "RVM_SCHEDULER_IS_XACTOR" "RVM_BROADCAST_IS_XACTOR" + ) + "List of Vera-RVM predefined constants.") + +;; `regexp-opt' undefined (`xemacs-devel' not installed) +(unless (fboundp 'regexp-opt) + (defun regexp-opt (strings &optional paren) + (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) + (concat open (mapconcat 'regexp-quote strings "\\|") close)))) + +(defconst vera-keywords-regexp + (concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>") + "Regexp for Vera keywords.") + +(defconst vera-types-regexp + (concat "\\<\\(" (regexp-opt vera-types) "\\)\\>") + "Regexp for Vera predefined types.") + +(defconst vera-q-values-regexp + (concat "\\<\\(" (regexp-opt vera-q-values) "\\)\\>") + "Regexp for Vera predefined VCA q_values.") + +(defconst vera-functions-regexp + (concat "\\<\\(" (regexp-opt vera-functions) "\\)\\>") + "Regexp for Vera predefined system functions, tasks and class methods.") + +(defconst vera-constants-regexp + (concat "\\<\\(" (regexp-opt vera-constants) "\\)\\>") + "Regexp for Vera predefined constants.") + +(defconst vera-rvm-types-regexp + (concat "\\<\\(" (regexp-opt vera-rvm-types) "\\)\\>") + "Regexp for Vera-RVM keywords.") + +(defconst vera-rvm-functions-regexp + (concat "\\<\\(" (regexp-opt vera-rvm-functions) "\\)\\>") + "Regexp for Vera-RVM predefined system functions, tasks and class methods.") + +(defconst vera-rvm-constants-regexp + (concat "\\<\\(" (regexp-opt vera-rvm-constants) "\\)\\>") + "Regexp for Vera-RVM predefined constants.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Font locking +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; XEmacs compatibility +(when vera-xemacs + (require 'font-lock) + (copy-face 'font-lock-reference-face 'font-lock-constant-face) + (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face)) + +(defun vera-font-lock-match-item (limit) + "Match, and move over, any declaration item after point. Adapted from +`font-lock-match-c-style-declaration-item-and-skip-to-next'." + (condition-case nil + (save-restriction + (narrow-to-region (point-min) limit) + ;; match item + (when (looking-at "\\s-*\\(\\w+\\)") + (save-match-data + (goto-char (match-end 1)) + ;; move to next item + (if (looking-at "\\(\\s-*\\(\\[[^]]*\\]\\s-*\\)?,\\)") + (goto-char (match-end 1)) + (end-of-line) t)))) + (error t))) + +(defvar vera-font-lock-keywords + (list + ;; highlight keywords + (list vera-keywords-regexp 1 'font-lock-keyword-face) + ;; highlight types + (list vera-types-regexp 1 'font-lock-type-face) + ;; highlight RVM types + (list vera-rvm-types-regexp 1 'font-lock-type-face) + ;; highlight constants + (list vera-constants-regexp 1 'font-lock-constant-face) + ;; highlight RVM constants + (list vera-rvm-constants-regexp 1 'font-lock-constant-face) + ;; highlight q_values + (list vera-q-values-regexp 1 'font-lock-constant-face) + ;; highlight predefined functions, tasks and methods + (list vera-functions-regexp 1 'vera-font-lock-function) + ;; highlight predefined RVM functions + (list vera-rvm-functions-regexp 1 'vera-font-lock-function) + ;; highlight functions + '("\\<\\(\\w+\\)\\s-*(" 1 font-lock-function-name-face) + ;; highlight various declaration names + '("^\\s-*\\(port\\|program\\|task\\)\\s-+\\(\\w+\\)\\>" + 2 font-lock-function-name-face) + '("^\\s-*bind\\s-+\\(\\w+\\)\\s-+\\(\\w+\\)\\>" + (1 font-lock-function-name-face) (2 font-lock-function-name-face)) + ;; highlight interface declaration names + '("^\\s-*\\(class\\|interface\\)\\s-+\\(\\w+\\)\\>" + 2 vera-font-lock-interface) + ;; highlight variable name definitions + (list (concat "^\\s-*" vera-types-regexp "\\s-*\\(\\[[^]]+\\]\\s-+\\)?") + '(vera-font-lock-match-item nil nil (1 font-lock-variable-name-face))) + (list (concat "^\\s-*" vera-rvm-types-regexp "\\s-*\\(\\[[^]]+\\]\\s-+\\)?") + '(vera-font-lock-match-item nil nil (1 font-lock-variable-name-face))) + ;; highlight numbers + '("\\([0-9]*'[bdoh][0-9a-fA-FxXzZ_]+\\)" 1 vera-font-lock-number) + ;; highlight filenames in #include directives + '("^#\\s-*include\\s-*\\(<[^>\"\n]*>?\\)" + 1 font-lock-string-face) + ;; highlight directives and directive names + '("^#\\s-*\\(\\w+\\)\\>[ \t!]*\\(\\w+\\)?" + (1 font-lock-builtin-face) (2 font-lock-variable-name-face nil t)) + ;; highlight `@', `$' and `#' + '("\\([@$#]\\)" 1 font-lock-keyword-face) + ;; highlight @ and # definitions + '("@\\s-*\\(\\w*\\)\\(\\s-*,\\s-*\\(\\w+\\)\\)?\\>[^.]" + (1 vera-font-lock-number) (3 vera-font-lock-number nil t)) + ;; highlight interface signal name + '("\\(\\w+\\)\\.\\w+" 1 vera-font-lock-interface) + ) + "Regular expressions to highlight in Vera Mode.") + +(defvar vera-font-lock-number 'vera-font-lock-number + "Face name to use for @ definitions.") + +(defvar vera-font-lock-function 'vera-font-lock-function + "Face name to use for predefined functions and tasks.") + +(defvar vera-font-lock-interface 'vera-font-lock-interface + "Face name to use for interface names.") + +(defface vera-font-lock-number + '((((class color) (background light)) (:foreground "Gold4")) + (((class color) (background dark)) (:foreground "BurlyWood1")) + (t (:italic t :bold t))) + "Font lock mode face used to highlight @ definitions." + :group 'font-lock-highlighting-faces) +(put 'vera-font-lock-number-face 'face-alias 'vera-font-lock-number) + +(defface vera-font-lock-function + '((((class color) (background light)) (:foreground "DarkCyan")) + (((class color) (background dark)) (:foreground "Orchid1")) + (t (:italic t :bold t))) + "Font lock mode face used to highlight predefined functions and tasks." + :group 'font-lock-highlighting-faces) +(put 'vera-font-lock-function-face 'face-alias 'vera-font-lock-function) + +(defface vera-font-lock-interface + '((((class color) (background light)) (:foreground "Grey40")) + (((class color) (background dark)) (:foreground "Grey80")) + (t (:italic t :bold t))) + "Font lock mode face used to highlight interface names." + :group 'font-lock-highlighting-faces) +(put 'vera-font-lock-interface-face 'face-alias 'vera-font-lock-interface) + +(defun vera-fontify-buffer () + "Fontify buffer." + (interactive) + (font-lock-fontify-buffer)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Indentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar vera-echo-syntactic-information-p nil + "If non-nil, syntactic info is echoed when the line is indented.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; offset functions + +(defconst vera-offsets-alist + '((comment . vera-lineup-C-comments) + (comment-intro . vera-lineup-comment) + (string . -1000) + (directive . -1000) + (block-open . 0) + (block-intro . +) + (block-close . 0) + (arglist-intro . +) + (arglist-cont . +) + (arglist-cont-nonempty . 0) + (arglist-close . 0) + (statement . 0) + (statement-cont . +) + (substatement . +) + (else-clause . 0)) + "Association list of syntactic element symbols and indentation offsets. +Adapted from `c-offsets-alist'.") + +(defun vera-evaluate-offset (offset langelem symbol) + "OFFSET can be a number, a function, a variable, a list, or one of +the symbols + or -." + (cond + ((eq offset '+) (setq offset vera-basic-offset)) + ((eq offset '-) (setq offset (- vera-basic-offset))) + ((eq offset '++) (setq offset (* 2 vera-basic-offset))) + ((eq offset '--) (setq offset (* 2 (- vera-basic-offset)))) + ((eq offset '*) (setq offset (/ vera-basic-offset 2))) + ((eq offset '/) (setq offset (/ (- vera-basic-offset) 2))) + ((functionp offset) (setq offset (funcall offset langelem))) + ((listp offset) + (setq offset + (let (done) + (while (and (not done) offset) + (setq done (vera-evaluate-offset (car offset) langelem symbol) + offset (cdr offset))) + (if (not done) + 0 + done)))) + ((not (numberp offset)) (setq offset (symbol-value offset)))) + offset) + +(defun vera-get-offset (langelem) + "Get offset from LANGELEM which is a cons cell of the form: +\(SYMBOL . RELPOS). The symbol is matched against +vera-offsets-alist and the offset found there is either returned, +or added to the indentation at RELPOS. If RELPOS is nil, then +the offset is simply returned." + (let* ((symbol (car langelem)) + (relpos (cdr langelem)) + (match (assq symbol vera-offsets-alist)) + (offset (cdr-safe match))) + (if (not match) + (setq offset 0 + relpos 0) + (setq offset (vera-evaluate-offset offset langelem symbol))) + (+ (if (and relpos + (< relpos (save-excursion (beginning-of-line) (point)))) + (save-excursion + (goto-char relpos) + (current-column)) + 0) + (vera-evaluate-offset offset langelem symbol)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; help functions + +(defsubst vera-point (position) + "Returns the value of point at certain commonly referenced POSITIONs. +POSITION can be one of the following symbols: + bol -- beginning of line + eol -- end of line + boi -- back to indentation + ionl -- indentation of next line + iopl -- indentation of previous line + bonl -- beginning of next line + bopl -- beginning of previous line +This function does not modify point or mark." + (save-excursion + (cond + ((eq position 'bol) (beginning-of-line)) + ((eq position 'eol) (end-of-line)) + ((eq position 'boi) (back-to-indentation)) + ((eq position 'bonl) (forward-line 1)) + ((eq position 'bopl) (forward-line -1)) + ((eq position 'iopl) (forward-line -1) (back-to-indentation)) + ((eq position 'ionl) (forward-line 1) (back-to-indentation)) + (t (error "Unknown buffer position requested: %s" position))) + (point))) + +(defun vera-in-literal (&optional lim) + "Determine if point is in a Vera literal." + (save-excursion + (let ((state (parse-partial-sexp (or lim (point-min)) (point)))) + (cond + ((nth 3 state) 'string) + ((nth 4 state) 'comment) + (t nil))))) + +(defun vera-in-comment-p () + "Determine if point is in a Vera comment." + (save-excursion + (re-search-backward "\\(/\\*\\)\\|\\(\\*/\\)" nil t) + (match-string 1))) + +(defun vera-skip-forward-literal () + "Skip forward literal and return t if within one." + (let ((state (save-excursion (parse-partial-sexp (point-min) (point))))) + (cond + ((nth 3 state) (search-forward "\"") t) ; inside string + ((nth 7 state) (forward-line 1) t) ; inside // comment + ((nth 4 state) (search-forward "*/") t) ; inside /* */ comment + (t nil)))) + +(defun vera-skip-backward-literal () + "Skip backward literal and return t if within one." + (let ((state (save-excursion (parse-partial-sexp (point-min) (point))))) + (cond + ((nth 3 state) (search-backward "\"") t) ; inside string + ((nth 7 state) (search-backward "//") t) ; inside // comment + ((nth 4 state) (search-backward "/*") t) ; inside /* */ comment + (t nil)))) + +(defsubst vera-re-search-forward (regexp &optional bound noerror) + "Like `re-search-forward', but skips over matches in literals." + (store-match-data '(nil nil)) + (while (and (re-search-forward regexp bound noerror) + (vera-skip-forward-literal) + (progn (store-match-data '(nil nil)) + (if bound (< (point) bound) t)))) + (match-end 0)) + +(defsubst vera-re-search-backward (regexp &optional bound noerror) + "Like `re-search-backward', but skips over matches in literals." + (store-match-data '(nil nil)) + (while (and (re-search-backward regexp bound noerror) + (vera-skip-backward-literal) + (progn (store-match-data '(nil nil)) + (if bound (> (point) bound) t)))) + (match-end 0)) + +(defun vera-forward-syntactic-ws (&optional lim skip-directive) + "Forward skip of syntactic whitespace." + (save-restriction + (let* ((lim (or lim (point-max))) + (here lim) + (hugenum (point-max))) + (narrow-to-region lim (point)) + (while (/= here (point)) + (setq here (point)) + (forward-comment hugenum) + (when (and skip-directive (looking-at "^\\s-*#")) + (end-of-line)))))) + +(defun vera-backward-syntactic-ws (&optional lim skip-directive) + "Backward skip over syntactic whitespace." + (save-restriction + (let* ((lim (or lim (point-min))) + (here lim) + (hugenum (- (point-max)))) + (when (< lim (point)) + (narrow-to-region lim (point)) + (while (/= here (point)) + (setq here (point)) + (forward-comment hugenum) + (when (and skip-directive + (save-excursion (back-to-indentation) + (= (following-char) ?\#))) + (beginning-of-line))))))) + +(defmacro vera-prepare-search (&rest body) + "Switch to syntax table that includes '_', then execute BODY, and finally +restore the old environment. Used for consistent searching." + `(let ((current-syntax-table (syntax-table)) + result + (restore-prog ; program to restore enviroment + '(progn + ;; restore syntax table + (set-syntax-table current-syntax-table)))) + ;; use extended syntax table + (set-syntax-table vera-mode-ext-syntax-table) + ;; execute BODY safely + (setq result + (condition-case info + (progn ,@body) + (error (eval restore-prog) ; restore environment on error + (error (cadr info))))) ; pass error up + ;; restore environment + (eval restore-prog) + result)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; comment indentation functions + +(defsubst vera-langelem-col (langelem &optional preserve-point) + "Convenience routine to return the column of LANGELEM's relpos. +Leaves point at the relpos unless PRESERVE-POINT is non-nil." + (let ((here (point))) + (goto-char (cdr langelem)) + (prog1 (current-column) + (if preserve-point + (goto-char here))))) + +(defun vera-lineup-C-comments (langelem) + "Line up C block comment continuation lines. +Nicked from `c-lineup-C-comments'." + (save-excursion + (let ((here (point)) + (stars (progn (back-to-indentation) + (skip-chars-forward "*"))) + (langelem-col (vera-langelem-col langelem))) + (back-to-indentation) + (if (not (re-search-forward "/\\([*]+\\)" (vera-point 'eol) t)) + (progn + (if (not (looking-at "[*]+")) + (progn + ;; we now have to figure out where this comment begins. + (goto-char here) + (back-to-indentation) + (if (looking-at "[*]+/") + (progn (goto-char (match-end 0)) + (forward-comment -1)) + (goto-char (cdr langelem)) + (back-to-indentation)))) + (- (current-column) langelem-col)) + (if (zerop stars) + (progn + (skip-chars-forward " \t") + (- (current-column) langelem-col)) + ;; how many stars on comment opening line? if greater than + ;; on current line, align left. if less than or equal, + ;; align right. this should also pick up Javadoc style + ;; comments. + (if (> (length (match-string 1)) stars) + (progn + (back-to-indentation) + (- (current-column) -1 langelem-col)) + (- (current-column) stars langelem-col))))))) + +(defun vera-lineup-comment (langelem) + "Line up a comment start." + (save-excursion + (back-to-indentation) + (if (bolp) + ;; not indent if at beginning of line + -1000 + ;; otherwise indent accordingly + (goto-char (cdr langelem)) + (current-column)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; move functions + +(defconst vera-beg-block-re "{\\|\\<\\(begin\\|fork\\)\\>") + +(defconst vera-end-block-re "}\\|\\<\\(end\\|join\\(\\s-+\\(all\\|any\\|none\\)\\)?\\)\\>") + +(defconst vera-beg-substatement-re "\\<\\(else\\|for\\|if\\|repeat\\|while\\)\\>") + +(defun vera-corresponding-begin (&optional recursive) + "Find corresponding block begin if cursor is at a block end." + (while (and (vera-re-search-backward + (concat "\\(" vera-end-block-re "\\)\\|" vera-beg-block-re) + nil t) + (match-string 1)) + (vera-corresponding-begin t)) + (unless recursive (vera-beginning-of-substatement))) + +(defun vera-corresponding-if () + "Find corresponding `if' if cursor is at `else'." + (while (and (vera-re-search-backward "}\\|\\<\\(if\\|else\\)\\>" nil t) + (not (equal (match-string 0) "if"))) + (if (equal (match-string 0) "else") + (vera-corresponding-if) + (forward-char) + (backward-sexp)))) + +(defun vera-beginning-of-statement () + "Go to beginning of current statement." + (let (pos) + (while + (progn + ;; search for end of previous statement + (while + (and (vera-re-search-backward + (concat "[);]\\|" vera-beg-block-re + "\\|" vera-end-block-re) nil t) + (equal (match-string 0) ")")) + (forward-char) + (backward-sexp)) + (setq pos (match-beginning 0)) + ;; go back to beginning of current statement + (goto-char (or (match-end 0) 0)) + (vera-forward-syntactic-ws nil t) + (when (looking-at "(") + (forward-sexp) + (vera-forward-syntactic-ws nil t)) + ;; if "else" found, go to "if" and search again + (when (looking-at "\\") + (vera-corresponding-if) + (setq pos (point)) + t)) + ;; if search is repeated, go to beginning of last search + (goto-char pos)))) + +(defun vera-beginning-of-substatement () + "Go to beginning of current substatement." + (let ((lim (point)) + pos) + ;; go to beginning of statement + (vera-beginning-of-statement) + (setq pos (point)) + ;; go forward all substatement opening statements until at LIM + (while (and (< (point) lim) + (vera-re-search-forward vera-beg-substatement-re lim t)) + (setq pos (match-beginning 0))) + (vera-forward-syntactic-ws nil t) + (when (looking-at "(") + (forward-sexp) + (vera-forward-syntactic-ws nil t)) + (when (< (point) lim) + (setq pos (point))) + (goto-char pos))) + +(defun vera-forward-statement () + "Move forward one statement." + (interactive) + (vera-prepare-search + (while (and (vera-re-search-forward + (concat "[(;]\\|" vera-beg-block-re "\\|" vera-end-block-re) + nil t) + (equal (match-string 0) "(")) + (backward-char) + (forward-sexp)) + (vera-beginning-of-substatement))) + +(defun vera-backward-statement () + "Move backward one statement." + (interactive) + (vera-prepare-search + (vera-backward-syntactic-ws nil t) + (unless (= (preceding-char) ?\)) + (backward-char)) + (vera-beginning-of-substatement))) + +(defun vera-forward-same-indent () + "Move forward to next line with same indent." + (interactive) + (let ((pos (point)) + (indent (current-indentation))) + (beginning-of-line 2) + (while (and (not (eobp)) + (or (looking-at "^\\s-*$") + (> (current-indentation) indent))) + (beginning-of-line 2)) + (if (= (current-indentation) indent) + (back-to-indentation) + (message "No following line with same indent found in this block") + (goto-char pos)))) + +(defun vera-backward-same-indent () + "Move backward to previous line with same indent." + (interactive) + (let ((pos (point)) + (indent (current-indentation))) + (beginning-of-line -0) + (while (and (not (bobp)) + (or (looking-at "^\\s-*$") + (> (current-indentation) indent))) + (beginning-of-line -0)) + (if (= (current-indentation) indent) + (back-to-indentation) + (message "No preceding line with same indent found in this block") + (goto-char pos)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; syntax analysis + +(defmacro vera-add-syntax (symbol &optional relpos) + "A simple macro to append the syntax in SYMBOL to the syntax list. +try to increase performance by using this macro." + `(setq syntax (cons (cons ,symbol ,(or relpos 0)) syntax))) + +(defun vera-guess-basic-syntax () + "Determine syntactic context of current line of code." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + syntax state placeholder pos) + ;; determine syntax state + (setq state (parse-partial-sexp (point-min) (point))) + (cond + ;; CASE 1: in a comment? + ((nth 4 state) + ;; skip empty lines + (while (and (zerop (forward-line -1)) + (looking-at "^\\s-*$"))) + (vera-add-syntax 'comment (vera-point 'boi))) + ;; CASE 2: in a string? + ((nth 3 state) + (vera-add-syntax 'string)) + ;; CASE 3: at a directive? + ((save-excursion (back-to-indentation) (= (following-char) ?\#)) + (vera-add-syntax 'directive (point))) + ;; CASE 4: after an opening parenthesis (argument list continuation)? + ((and (nth 1 state) + (or (= (char-after (nth 1 state)) ?\() + ;; also for concatenation (opening '{' and ',' on eol/eopl) + (and (= (char-after (nth 1 state)) ?\{) + (or (save-excursion + (vera-backward-syntactic-ws) (= (char-before) ?,)) + (save-excursion + (end-of-line) (= (char-before) ?,)))))) + (goto-char (1+ (nth 1 state))) + ;; is there code after the opening parenthesis on the same line? + (if (looking-at "\\s-*$") + (vera-add-syntax 'arglist-cont (vera-point 'boi)) + (vera-add-syntax 'arglist-cont-nonempty (point)))) + ;; CASE 5: at a block closing? + ((save-excursion (back-to-indentation) (looking-at vera-end-block-re)) + ;; look for the corresponding begin + (vera-corresponding-begin) + (vera-add-syntax 'block-close (vera-point 'boi))) + ;; CASE 6: at a block intro (the first line after a block opening)? + ((and (save-excursion + (vera-backward-syntactic-ws nil t) + ;; previous line ends with a block opening? + (or (/= (skip-chars-backward "{") 0) (backward-word 1)) + (when (looking-at vera-beg-block-re) + ;; go to beginning of substatement + (vera-beginning-of-substatement) + (setq placeholder (point)))) + ;; not if "fork" is followed by "{" + (save-excursion + (not (and (progn (back-to-indentation) (looking-at "{")) + (progn (goto-char placeholder) + (looking-at "\\")))))) + (goto-char placeholder) + (vera-add-syntax 'block-intro (vera-point 'boi))) + ;; CASE 7: at the beginning of an else clause? + ((save-excursion (back-to-indentation) (looking-at "\\")) + ;; find corresponding if + (vera-corresponding-if) + (vera-add-syntax 'else-clause (vera-point 'boi))) + ;; CASE 8: at the beginning of a statement? + ;; is the previous command completed? + ((or (save-excursion + (vera-backward-syntactic-ws nil t) + (setq placeholder (point)) + ;; at the beginning of the buffer? + (or (bobp) + ;; previous line ends with a semicolon or + ;; is a block opening or closing? + (when (or (/= (skip-chars-backward "{};") 0) + (progn (back-to-indentation) + (looking-at (concat vera-beg-block-re "\\|" + vera-end-block-re)))) + ;; if at a block closing, go to beginning + (when (looking-at vera-end-block-re) + (vera-corresponding-begin)) + ;; go to beginning of the statement + (vera-beginning-of-statement) + (setq placeholder (point))) + ;; at a directive? + (when (progn (back-to-indentation) (looking-at "#")) + ;; go to previous statement + (vera-beginning-of-statement) + (setq placeholder (point))))) + ;; at a block opening? + (when (save-excursion (back-to-indentation) + (looking-at vera-beg-block-re)) + ;; go to beginning of the substatement + (vera-beginning-of-substatement) + (setq placeholder (point)))) + (goto-char placeholder) + (vera-add-syntax 'statement (vera-point 'boi))) + ;; CASE 9: at the beginning of a substatement? + ;; is this line preceeded by a substatement opening statement? + ((save-excursion (vera-backward-syntactic-ws nil t) + (when (= (preceding-char) ?\)) (backward-sexp)) + (backward-word 1) + (setq placeholder (point)) + (looking-at vera-beg-substatement-re)) + (goto-char placeholder) + (vera-add-syntax 'substatement (vera-point 'boi))) + ;; CASE 10: it must be a statement continuation! + (t + ;; go to beginning of statement + (vera-beginning-of-substatement) + (vera-add-syntax 'statement-cont (vera-point 'boi)))) + ;; special case: look for a comment start + (goto-char indent-point) + (skip-chars-forward " \t") + (when (looking-at comment-start) + (vera-add-syntax 'comment-intro)) + ;; return syntax + syntax))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; indentation functions + +(defun vera-indent-line () + "Indent the current line as Vera code. Optional SYNTAX is the +syntactic information for the current line. Returns the amount of +indentation change (in columns)." + (interactive) + (vera-prepare-search + (let* ((syntax (vera-guess-basic-syntax)) + (pos (- (point-max) (point))) + (indent (apply '+ (mapcar 'vera-get-offset syntax))) + (shift-amt (- (current-indentation) indent))) + (when vera-echo-syntactic-information-p + (message "syntax: %s, indent= %d" syntax indent)) + (unless (zerop shift-amt) + (beginning-of-line) + (delete-region (point) (vera-point 'boi)) + (indent-to indent)) + (if (< (point) (vera-point 'boi)) + (back-to-indentation) + ;; If initial point was within line's indentation, position after + ;; the indentation. Else stay at same point in text. + (when (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt))) + +(defun vera-indent-buffer () + "Indent whole buffer as Vera code. +Calls `indent-region' for whole buffer." + (interactive) + (message "Indenting buffer...") + (indent-region (point-min) (point-max) nil) + (message "Indenting buffer...done")) + +(defun vera-indent-region (start end column) + "Indent region as Vera code." + (interactive "r\nP") + (message "Indenting region...") + (indent-region start end column) + (message "Indenting region...done")) + +(defsubst vera-indent-block-closing () + "If previous word is a block closing or `else', indent line again." + (when (= (char-syntax (preceding-char)) ?w) + (save-excursion + (backward-word 1) + (when (and (not (vera-in-literal)) + (looking-at (concat vera-end-block-re "\\|\\"))) + (indent-according-to-mode))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; electrifications + +(defun vera-electric-tab (&optional prefix-arg) + "If preceeding character is part of a word or a paren then hippie-expand, +else if right of non whitespace on line then tab-to-tab-stop, +else if last command was a tab or return then dedent one step or if a comment +toggle between normal indent and inline comment indent, +else indent `correctly'. +If `vera-intelligent-tab' is nil, always indent line." + (interactive "*P") + (if vera-intelligent-tab + (progn + (cond ((memq (char-syntax (preceding-char)) '(?w ?_)) + (let ((case-fold-search t) + (case-replace nil) + (hippie-expand-only-buffers + (or (and (boundp 'hippie-expand-only-buffers) + hippie-expand-only-buffers) + '(vera-mode)))) + (vera-expand-abbrev prefix-arg))) + ((> (current-column) (current-indentation)) + (tab-to-tab-stop)) + ((and (or (eq last-command 'vera-electric-tab) + (eq last-command 'vera-electric-return)) + (/= 0 (current-indentation))) + (backward-delete-char-untabify vera-basic-offset nil)) + (t (indent-according-to-mode))) + (setq this-command 'vera-electric-tab)) + (indent-according-to-mode))) + +(defun vera-electric-return () + "Insert newline and indent. Indent current line if it is a block closing." + (interactive) + (vera-indent-block-closing) + (newline-and-indent)) + +(defun vera-electric-space (arg) + "Insert a space. Indent current line if it is a block closing." + (interactive "*P") + (unless arg + (vera-indent-block-closing)) + (self-insert-command (prefix-numeric-value arg))) + +(defun vera-electric-opening-brace (arg) + "Outdent opening brace." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (unless arg + (indent-according-to-mode))) + +(defun vera-electric-closing-brace (arg) + "Outdent closing brace." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (unless arg + (indent-according-to-mode))) + +(defun vera-electric-pound (arg) + "Insert `#' and indent as directive it first character of line." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (unless arg + (save-excursion + (backward-char) + (skip-chars-backward " \t") + (when (bolp) + (delete-horizontal-space))))) + +(defun vera-electric-star (arg) + "Insert a star character. Nicked from `c-electric-star'." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (if (and (not arg) + (memq (vera-in-literal) '(comment)) + (eq (char-before) ?*) + (save-excursion + (forward-char -1) + (skip-chars-backward "*") + (if (eq (char-before) ?/) + (forward-char -1)) + (skip-chars-backward " \t") + (bolp))) + (indent-according-to-mode))) + +(defun vera-electric-slash (arg) + "Insert a slash character. Nicked from `c-electric-slash'." + (interactive "*P") + (let* ((ch (char-before)) + (indentp (and (not arg) + (eq last-command-char ?/) + (or (and (eq ch ?/) + (not (vera-in-literal))) + (and (eq ch ?*) + (vera-in-literal)))))) + (self-insert-command (prefix-numeric-value arg)) + (when indentp + (indent-according-to-mode)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Miscellaneous +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hippie expand customization (for expansion of Vera commands) + +(defvar vera-abbrev-list + (append (list nil) vera-keywords + (list nil) vera-types + (list nil) vera-functions + (list nil) vera-constants + (list nil) vera-rvm-types + (list nil) vera-rvm-functions + (list nil) vera-rvm-constants) + "Predefined abbreviations for Vera.") + +(defvar vera-expand-upper-case nil) + +(eval-when-compile (require 'hippie-exp)) + +(defun vera-try-expand-abbrev (old) + "Try expanding abbreviations from `vera-abbrev-list'." + (unless old + (he-init-string (he-dabbrev-beg) (point)) + (setq he-expand-list + (let ((abbrev-list vera-abbrev-list) + (sel-abbrev-list '())) + (while abbrev-list + (when (or (not (stringp (car abbrev-list))) + (string-match + (concat "^" he-search-string) (car abbrev-list))) + (setq sel-abbrev-list + (cons (car abbrev-list) sel-abbrev-list))) + (setq abbrev-list (cdr abbrev-list))) + (nreverse sel-abbrev-list)))) + (while (and he-expand-list + (or (not (stringp (car he-expand-list))) + (he-string-member (car he-expand-list) he-tried-table t))) + (unless (stringp (car he-expand-list)) + (setq vera-expand-upper-case (car he-expand-list))) + (setq he-expand-list (cdr he-expand-list))) + (if (null he-expand-list) + (progn (when old (he-reset-string)) + nil) + (he-substitute-string + (if vera-expand-upper-case + (upcase (car he-expand-list)) + (car he-expand-list)) + t) + (setq he-expand-list (cdr he-expand-list)) + t)) + +;; function for expanding abbrevs and dabbrevs +(defun vera-expand-abbrev (arg)) +(fset 'vera-expand-abbrev (make-hippie-expand-function + '(try-expand-dabbrev + try-expand-dabbrev-all-buffers + vera-try-expand-abbrev))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Comments + +(defun vera-comment-uncomment-region (beg end &optional arg) + "Comment region if not commented, uncomment region if already commented." + (interactive "r\nP") + (goto-char beg) + (if (looking-at (regexp-quote comment-start)) + (comment-region beg end '(4)) + (comment-region beg end))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Help functions + +(defun vera-customize () + "Call the customize function with `vera' as argument." + (interactive) + (customize-group 'vera)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Other + +;; remove ".vr" from `completion-ignored-extensions' +(setq completion-ignored-extensions + (delete ".vr" completion-ignored-extensions)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Bug reports +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst vera-mode-help-address "Reto Zimmermann " + "Address for Vera Mode bug reports.") + +;; get reporter-submit-bug-report when byte-compiling +(eval-when-compile + (require 'reporter)) + +(defun vera-submit-bug-report () + "Submit via mail a bug report on Vera Mode." + (interactive) + ;; load in reporter + (and + (y-or-n-p "Do you want to submit a report on Vera Mode? ") + (require 'reporter) + (let ((reporter-prompt-for-summary-p t)) + (reporter-submit-bug-report + vera-mode-help-address + (concat "Vera Mode " vera-version) + (list + ;; report all important variables + 'vera-basic-offset + 'vera-underscore-is-part-of-word + 'vera-intelligent-tab + ) + nil nil + "Hi Reto,")))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Documentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun vera-version () + "Echo the current version of Vera Mode in the minibuffer." + (interactive) + (message "Vera Mode %s (%s)" vera-version vera-time-stamp)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'vera-mode) + +;;; vera-mode.el ends here From 76e4973a857ec84c85df7c199530436c3150862d Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Wed, 20 Jun 2007 21:26:53 +0000 Subject: [PATCH 012/163] (w32_BDF_to_x_font): Unmap memory when finished. (w32_free_bdf_font): Unmap memory not handle. --- src/ChangeLog | 5 +++++ src/w32bdf.c | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 6f1be74a8e2..8a700909590 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2007-06-20 Jason Rumney + + * w32bdf.c (w32_BDF_to_x_font): Unmap memory when finished. + (w32_free_bdf_font): Unmap memory not handle. + 2007-06-20 Juanma Barranquero * w32.c (_wsa_errlist): Fix typo in error message. diff --git a/src/w32bdf.c b/src/w32bdf.c index 64ec2f7a3b0..40e705a18c9 100644 --- a/src/w32bdf.c +++ b/src/w32bdf.c @@ -302,7 +302,7 @@ w32_free_bdf_font(bdffont *fontp) font_char *pch; cache_bitmap *pcb; - UnmapViewOfFile(fontp->hfilemap); + UnmapViewOfFile(fontp->font); CloseHandle(fontp->hfilemap); CloseHandle(fontp->hfile); @@ -867,6 +867,7 @@ int w32_BDF_to_x_font (char *file, char* xstr, int len) retval = 1; } } + UnmapViewOfFile (font); CloseHandle (hfile); CloseHandle (hfilemap); return retval; From fc98ca56e08e5b6838a0170b81329196939045c6 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 21 Jun 2007 04:07:24 +0000 Subject: [PATCH 013/163] Header changes: mark file as part of Emacs, update FSF address. --- lisp/progmodes/vera-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 67d881030db..f26fd02ab17 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -15,7 +15,7 @@ (defconst vera-time-stamp "2007-06-11" "Vera Mode time stamp for last update.") -;; This file is not 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 @@ -29,8 +29,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: From bfe7f3fcfc145e0915b35edc1c84f955b93599db Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Thu, 21 Jun 2007 22:01:27 +0000 Subject: [PATCH 014/163] (convert_mono_to_color_image): Swap fore and background. --- src/image.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/image.c b/src/image.c index ebb73e3996e..a032a7f5b62 100644 --- a/src/image.c +++ b/src/image.c @@ -3044,8 +3044,8 @@ static void convert_mono_to_color_image (f, img, foreground, background) release_frame_dc (f, hdc); old_prev = SelectObject (old_img_dc, img->pixmap); new_prev = SelectObject (new_img_dc, new_pixmap); - SetTextColor (new_img_dc, foreground); - SetBkColor (new_img_dc, background); + SetTextColor (new_img_dc, background); + SetBkColor (new_img_dc, foreground); BitBlt (new_img_dc, 0, 0, img->width, img->height, old_img_dc, 0, 0, SRCCOPY); From d217d3901c15b284843513d783891bfb1eea3723 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Thu, 21 Jun 2007 22:08:56 +0000 Subject: [PATCH 015/163] *** empty log message *** --- src/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 8a700909590..d0ac94b2e58 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2007-06-21 Jason Rumney + + * image.c (convert_mono_to_color_image): Swap fore and background. + 2007-06-20 Jason Rumney * w32bdf.c (w32_BDF_to_x_font): Unmap memory when finished. From 247eedf8e9e01c4fe0fdc3a474f3763cacacc2c2 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Thu, 21 Jun 2007 22:55:44 +0000 Subject: [PATCH 016/163] vera-mode.el (vera-mode): Fix `commend-end-skip' setting. (vera-font-lock-match-item): Fix doc string. (vera-in-comment-p): Remove unused function. (vera-skip-forward-literal,vera-skip-backward-literal): Improve code, use `syntax-ppss'. (vera-forward-syntactic-ws): Fix argument order. (vera-prepare-search): Use `with-syntax-table'. (vera-indent-line): Fix doc string. (vera-electric-tab): Fix doc string. (vera-expand-abbrev): Define alias instead of using `fset'. (vera-comment-uncomment-region): Use `comment-start-skip'. --- lisp/ChangeLog | 14 +++++ lisp/progmodes/vera-mode.el | 106 +++++++++++++++--------------------- 2 files changed, 57 insertions(+), 63 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3668a5a8c09..b8277ef6be7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2007-06-21 Reto Zimmermann + + * vera-mode.el (vera-mode): Fix `commend-end-skip' setting. + (vera-font-lock-match-item): Fix doc string. + (vera-in-comment-p): Remove unused function. + (vera-skip-forward-literal,vera-skip-backward-literal): Improve code, + use `syntax-ppss'. + (vera-forward-syntactic-ws): Fix argument order. + (vera-prepare-search): Use `with-syntax-table'. + (vera-indent-line): Fix doc string. + (vera-electric-tab): Fix doc string. + (vera-expand-abbrev): Define alias instead of using `fset'. + (vera-comment-uncomment-region): Use `comment-start-skip'. + 2007-06-20 Reto Zimmermann * progmodes/vera-mode.el: New file. diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index f26fd02ab17..124aaceb1f9 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -5,14 +5,14 @@ ;; Author: Reto Zimmermann ;; Maintainer: Reto Zimmermann -;; Version: 2.26 +;; Version: 2.28 ;; Keywords: languages vera ;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html (defconst vera-version "2.18" "Vera Mode version number.") -(defconst vera-time-stamp "2007-06-11" +(defconst vera-time-stamp "2007-06-21" "Vera Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -106,7 +106,7 @@ are treated as single words otherwise." (defcustom vera-intelligent-tab t "*Non-nil means `TAB' does indentation, word completion and tab insertion. -That is, if preceeding character is part of a word then complete word, +That is, if preceding character is part of a word then complete word, else if not at beginning of line then insert tab, else if last command was a `TAB' or `RET' then dedent one step, else indent current line. @@ -315,7 +315,7 @@ Key bindings: (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-column) 40) (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") - (set (make-local-variable 'comment-end-skip) " *\\*+/\\| *//+") + (set (make-local-variable 'comment-end-skip) " *\\*+/\\| *\n") (set (make-local-variable 'comment-indent-function) 'c-comment-indent) (set (make-local-variable 'paragraph-start) "^$") (set (make-local-variable 'paragraph-separate) paragraph-start) @@ -606,8 +606,8 @@ Key bindings: (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face)) (defun vera-font-lock-match-item (limit) - "Match, and move over, any declaration item after point. Adapted from -`font-lock-match-c-style-declaration-item-and-skip-to-next'." + "Match, and move over, any declaration item after point. +Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." (condition-case nil (save-restriction (narrow-to-region (point-min) limit) @@ -687,7 +687,6 @@ Key bindings: (t (:italic t :bold t))) "Font lock mode face used to highlight @ definitions." :group 'font-lock-highlighting-faces) -(put 'vera-font-lock-number-face 'face-alias 'vera-font-lock-number) (defface vera-font-lock-function '((((class color) (background light)) (:foreground "DarkCyan")) @@ -695,7 +694,6 @@ Key bindings: (t (:italic t :bold t))) "Font lock mode face used to highlight predefined functions and tasks." :group 'font-lock-highlighting-faces) -(put 'vera-font-lock-function-face 'face-alias 'vera-font-lock-function) (defface vera-font-lock-interface '((((class color) (background light)) (:foreground "Grey40")) @@ -703,13 +701,8 @@ Key bindings: (t (:italic t :bold t))) "Font lock mode face used to highlight interface names." :group 'font-lock-highlighting-faces) -(put 'vera-font-lock-interface-face 'face-alias 'vera-font-lock-interface) - -(defun vera-fontify-buffer () - "Fontify buffer." - (interactive) - (font-lock-fontify-buffer)) +(defalias 'vera-fontify-buffer 'font-lock-fontify-buffer) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Indentation @@ -789,7 +782,7 @@ the offset is simply returned." ;; help functions (defsubst vera-point (position) - "Returns the value of point at certain commonly referenced POSITIONs. + "Return the value of point at certain commonly referenced POSITIONs. POSITION can be one of the following symbols: bol -- beginning of line eol -- end of line @@ -820,29 +813,34 @@ This function does not modify point or mark." ((nth 4 state) 'comment) (t nil))))) -(defun vera-in-comment-p () - "Determine if point is in a Vera comment." - (save-excursion - (re-search-backward "\\(/\\*\\)\\|\\(\\*/\\)" nil t) - (match-string 1))) - (defun vera-skip-forward-literal () "Skip forward literal and return t if within one." - (let ((state (save-excursion (parse-partial-sexp (point-min) (point))))) - (cond - ((nth 3 state) (search-forward "\"") t) ; inside string - ((nth 7 state) (forward-line 1) t) ; inside // comment - ((nth 4 state) (search-forward "*/") t) ; inside /* */ comment - (t nil)))) + (let ((state (save-excursion + (if (fboundp 'syntax-ppss) + (syntax-ppss) + (parse-partial-sexp (point-min) (point)))))) + (when (nth 8 state) + ;; Inside a string or comment. + (goto-char (nth 8 state)) + (if (nth 3 state) + ;; A string. + (condition-case nil (forward-sexp 1) + ;; Can't find end of string: it extends til end of buffer. + (error (goto-char (point-max)))) + ;; A comment. + (forward-comment 1)) + t))) (defun vera-skip-backward-literal () "Skip backward literal and return t if within one." - (let ((state (save-excursion (parse-partial-sexp (point-min) (point))))) - (cond - ((nth 3 state) (search-backward "\"") t) ; inside string - ((nth 7 state) (search-backward "//") t) ; inside // comment - ((nth 4 state) (search-backward "/*") t) ; inside /* */ comment - (t nil)))) + (let ((state (save-excursion + (if (fboundp 'syntax-ppss) + (syntax-ppss) + (parse-partial-sexp (point-min) (point)))))) + (when (nth 8 state) + ;; Inside a string or comment. + (goto-char (nth 8 state)) + t))) (defsubst vera-re-search-forward (regexp &optional bound noerror) "Like `re-search-forward', but skips over matches in literals." @@ -868,7 +866,7 @@ This function does not modify point or mark." (let* ((lim (or lim (point-max))) (here lim) (hugenum (point-max))) - (narrow-to-region lim (point)) + (narrow-to-region (point) lim) (while (/= here (point)) (setq here (point)) (forward-comment hugenum) @@ -892,25 +890,8 @@ This function does not modify point or mark." (beginning-of-line))))))) (defmacro vera-prepare-search (&rest body) - "Switch to syntax table that includes '_', then execute BODY, and finally -restore the old environment. Used for consistent searching." - `(let ((current-syntax-table (syntax-table)) - result - (restore-prog ; program to restore enviroment - '(progn - ;; restore syntax table - (set-syntax-table current-syntax-table)))) - ;; use extended syntax table - (set-syntax-table vera-mode-ext-syntax-table) - ;; execute BODY safely - (setq result - (condition-case info - (progn ,@body) - (error (eval restore-prog) ; restore environment on error - (error (cadr info))))) ; pass error up - ;; restore environment - (eval restore-prog) - result)) + "Execute BODY with a syntax table that includes '_'." + `(with-syntax-table vera-mode-ext-syntax-table ,@body)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; comment indentation functions @@ -1198,7 +1179,7 @@ try to increase performance by using this macro." (goto-char placeholder) (vera-add-syntax 'statement (vera-point 'boi))) ;; CASE 9: at the beginning of a substatement? - ;; is this line preceeded by a substatement opening statement? + ;; is this line preceded by a substatement opening statement? ((save-excursion (vera-backward-syntactic-ws nil t) (when (= (preceding-char) ?\)) (backward-sexp)) (backward-word 1) @@ -1223,9 +1204,8 @@ try to increase performance by using this macro." ;; indentation functions (defun vera-indent-line () - "Indent the current line as Vera code. Optional SYNTAX is the -syntactic information for the current line. Returns the amount of -indentation change (in columns)." + "Indent the current line as Vera code. +Return the amount of indentation change (in columns)." (interactive) (vera-prepare-search (let* ((syntax (vera-guess-basic-syntax)) @@ -1274,8 +1254,9 @@ Calls `indent-region' for whole buffer." ;; electrifications (defun vera-electric-tab (&optional prefix-arg) - "If preceeding character is part of a word or a paren then hippie-expand, -else if right of non whitespace on line then tab-to-tab-stop, + "Do what I mean (indent, expand, tab, change indent, etc..). +If preceding character is part of a word or a paren then `hippie-expand', +else if right of non whitespace on line then `tab-to-tab-stop', else if last command was a tab or return then dedent one step or if a comment toggle between normal indent and inline comment indent, else indent `correctly'. @@ -1424,9 +1405,8 @@ If `vera-intelligent-tab' is nil, always indent line." t)) ;; function for expanding abbrevs and dabbrevs -(defun vera-expand-abbrev (arg)) -(fset 'vera-expand-abbrev (make-hippie-expand-function - '(try-expand-dabbrev +(defalias 'vera-expand-abbrev + (make-hippie-expand-function '(try-expand-dabbrev try-expand-dabbrev-all-buffers vera-try-expand-abbrev))) @@ -1437,7 +1417,7 @@ If `vera-intelligent-tab' is nil, always indent line." "Comment region if not commented, uncomment region if already commented." (interactive "r\nP") (goto-char beg) - (if (looking-at (regexp-quote comment-start)) + (if (looking-at comment-start-skip) (comment-region beg end '(4)) (comment-region beg end))) From 9b40e204ec4deafee200519db1dcbb0074a1083c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Jun 2007 09:52:06 +0000 Subject: [PATCH 017/163] (insert-directory): Don't treat FILE as a wildcard if FILE exists as a directory. --- lisp/ChangeLog | 5 +++++ lisp/ls-lisp.el | 5 ++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b8277ef6be7..e2441910578 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-23 Eli Zaretskii + + * ls-lisp.el (insert-directory): Don't treat FILE as a wildcard if + FILE exists as a directory. + 2007-06-21 Reto Zimmermann * vera-mode.el (vera-mode): Fix `commend-end-skip' setting. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 94c8004ff5e..5d6d68e3271 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -229,7 +229,10 @@ that work are: A a c i r S s t u U X g G B C R and F partly." ;; `ls' don't mind, we certainly do, because it makes us think ;; there is no wildcard, only a directory name. (if (and ls-lisp-support-shell-wildcards - (string-match "[[?*]" file)) + (string-match "[[?*]" file) + ;; Prefer an existing directory to wildcards, like + ;; dired-noselect does. + (not (file-directory-p file))) (progn (or (not (eq (aref file (1- (length file))) ?/)) (setq file (substring file 0 (1- (length file))))) From 5a70dca3a42542951a9095b2f0d5a4f3aaba8f73 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 23 Jun 2007 10:45:01 +0000 Subject: [PATCH 018/163] (ruler-mode): Prevent clobbering the original `header-line-format' when reentering ruler mode. --- lisp/ruler-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index b2c48349a05..13895aea2eb 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -29,7 +29,7 @@ ;;; Commentary: ;; This library provides a minor mode to display a ruler in the header -;; line. It works only on Emacs 21. +;; line. It works from Emacs 21 onwards. ;; ;; You can use the mouse to change the `fill-column' `comment-column', ;; `goal-column', `window-margins' and `tab-stop-list' settings: @@ -562,7 +562,8 @@ Call `ruler-mode-ruler-function' to compute the ruler value.") (progn ;; When `ruler-mode' is on save previous header line format ;; and install the ruler header line format. - (when (local-variable-p 'header-line-format) + (when (and (local-variable-p 'header-line-format) + (not (local-variable-p 'ruler-mode-header-line-format-old))) (set (make-local-variable 'ruler-mode-header-line-format-old) header-line-format)) (setq header-line-format ruler-mode-header-line-format) From ff3cc240fa3a224bb967eb739ceac211aaf9a427 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 23 Jun 2007 10:50:07 +0000 Subject: [PATCH 019/163] *** empty log message *** --- lisp/ChangeLog | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e2441910578..868bc7af2e8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-23 Juanma Barranquero + + * ruler-mode.el (ruler-mode): Prevent clobbering the original + `header-line-format' when reentering ruler mode. + 2007-06-23 Eli Zaretskii * ls-lisp.el (insert-directory): Don't treat FILE as a wildcard if @@ -8,7 +13,7 @@ * vera-mode.el (vera-mode): Fix `commend-end-skip' setting. (vera-font-lock-match-item): Fix doc string. (vera-in-comment-p): Remove unused function. - (vera-skip-forward-literal,vera-skip-backward-literal): Improve code, + (vera-skip-forward-literal, vera-skip-backward-literal): Improve code, use `syntax-ppss'. (vera-forward-syntactic-ws): Fix argument order. (vera-prepare-search): Use `with-syntax-table'. @@ -10350,7 +10355,7 @@ * calendar/cal-menu.el (calendar-mode-map, calendar-mouse-3-map): * calendar/calendar.el (calendar-mode-map): - * calendar/diary-lib.el (include-other-diary-files,diary-mail-entries): + * calendar/diary-lib.el (include-other-diary-files, diary-mail-entries): * calendar/appt.el (appt-check, appt-make-list): Refer to diary-view-entries, diary-list-entries, diary-show-all-entries rather than obsolete aliases. @@ -11427,7 +11432,7 @@ (org-table-create-or-convert-from-region): New commands (org-table-toggle-vline-visibility): Command removed. (org-table-convert-region): Made a command. - (orgtbl-deleta-backward-char,orgtbl-delete-char): Remove commands. + (orgtbl-deleta-backward-char, orgtbl-delete-char): Remove commands. Replace with the normal org- functions. (org-self-insert-command): Don't trigger realign unnecessarily when blanking a field that is not full. @@ -11837,7 +11842,7 @@ (ibuffer-mode-header-map): New keymaps. (ibuffer-update-title-and-summary): Enable mouse face highlighting and keybindings for column headers. - (name,size,mode) : Add a header-mouse-map + (name, size, mode) : Add a header-mouse-map property. 2006-04-02 Drew Adams (tiny change) From 43bed6688c95bbdb292dae7b0c155c9a5a73f7e3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Jun 2007 11:24:56 +0000 Subject: [PATCH 020/163] (insert-directory): If an invalid regexp error is thrown, try using FILE as a literal file name, not a wildcard. Check for FILE as an existing file, not just a directory. --- lisp/ChangeLog | 6 ++++++ lisp/ls-lisp.el | 23 ++++++++++++++++++----- 2 files changed, 24 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 868bc7af2e8..fbf0ba84d7d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-06-23 Eli Zaretskii + + * ls-lisp.el (insert-directory): If an invalid regexp error is + thrown, try using FILE as a literal file name, not a wildcard. + Check for FILE as an existing file, not just a directory. + 2007-06-23 Juanma Barranquero * ruler-mode.el (ruler-mode): Prevent clobbering the original diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 5d6d68e3271..b4cd485d7a0 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -216,6 +216,7 @@ that work are: A a c i r S s t u U X g G B C R and F partly." ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory)) + (orig-file file) wildcard-regexp) (if handler (funcall handler 'insert-directory file switches @@ -230,9 +231,9 @@ that work are: A a c i r S s t u U X g G B C R and F partly." ;; there is no wildcard, only a directory name. (if (and ls-lisp-support-shell-wildcards (string-match "[[?*]" file) - ;; Prefer an existing directory to wildcards, like + ;; Prefer an existing file to wildcards, like ;; dired-noselect does. - (not (file-directory-p file))) + (not (file-exists-p file))) (progn (or (not (eq (aref file (1- (length file))) ?/)) (setq file (substring file 0 (1- (length file))))) @@ -244,9 +245,21 @@ that work are: A a c i r S s t u U X g G B C R and F partly." (file-name-nondirectory file)) file (file-name-directory file)) (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'"))) - (ls-lisp-insert-directory - file switches (ls-lisp-time-index switches) - wildcard-regexp full-directory-p) + (condition-case err + (ls-lisp-insert-directory + file switches (ls-lisp-time-index switches) + wildcard-regexp full-directory-p) + (invalid-regexp + ;; Maybe they wanted a literal file that just happens to + ;; use characters special to shell wildcards. + (if (equal (cadr err) "Unmatched [ or [^") + (progn + (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") + file (file-relative-name orig-file)) + (ls-lisp-insert-directory + file switches (ls-lisp-time-index switches) + nil full-directory-p)) + (signal (car err) (cdr err))))) ;; Try to insert the amount of free space. (save-excursion (goto-char (point-min)) From 6ede9eeac138cd1d48f55a7e7fdeaeacb69bee9d Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sat, 23 Jun 2007 16:57:51 +0000 Subject: [PATCH 021/163] Added note about new style scrollbars on Windows XP and later. --- etc/NEWS | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 1dd73170408..11e40efd4f6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,11 @@ before deleting/copying the indicated directory recursively. than the window, the usual keys for moving the cursor cause the image to be scrolled horizontally or vertically instead. +** Scrollbars follow the system theme on Windows XP and later. +Windows XP introduced themed scrollbars, but applications have to take +special steps to use them. Emacs now has the appropriate resources linked +in to make it use the scrollbars from the system theme. + * New Modes and Packages in Emacs 22.2 ** The new package css-mode.el provides a major mode for editing CSS files. From 3ae6b03fe61fa3a458a3bd334b367db98f0f9f7b Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sun, 24 Jun 2007 20:03:06 +0000 Subject: [PATCH 022/163] (desktop-read): Run `desktop-not-loaded-hook' in the directory where the desktop file was found, as the docstring says. (desktop-kill): Use `read-directory-name'. (desktop-load-locked-desktop): New option. (desktop-read): Use it. (desktop-truncate, desktop-outvar, desktop-restore-file-buffer): Use `when'. (desktop-save-mode-off): New function. (desktop-base-lock-name, desktop-not-loaded-hook): New variables. (desktop-full-lock-name, desktop-file-modtime, desktop-owner, desktop-claim-lock, desktop-release-lock): New functions. (desktop-kill): Tell `desktop-save' that this is the last save. Release the lock afterwards. (desktop-buffer-info): New function. (desktop-save): Use it. Run `desktop-save-hook' where the doc says to. Detect conflicts, and manage the lock. (desktop-read): Detect conflicts. Manage the lock. --- lisp/ChangeLog | 24 ++ lisp/desktop.el | 568 +++++++++++++++++++++++++++++------------------- 2 files changed, 365 insertions(+), 227 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fbf0ba84d7d..dedce43365f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,27 @@ +2007-06-24 Juanma Barranquero + + * desktop.el (desktop-read): Run `desktop-not-loaded-hook' in the + directory where the desktop file was found, as the docstring says. + (desktop-kill): Use `read-directory-name'. + + * desktop.el (desktop-load-locked-desktop): New option. + (desktop-read): Use it. + (desktop-truncate, desktop-outvar, desktop-restore-file-buffer): + Use `when'. + +2007-06-24 Davis Herring + + * desktop.el (desktop-save-mode-off): New function. + (desktop-base-lock-name, desktop-not-loaded-hook): New variables. + (desktop-full-lock-name, desktop-file-modtime, desktop-owner) + (desktop-claim-lock, desktop-release-lock): New functions. + (desktop-kill): Tell `desktop-save' that this is the last save. + Release the lock afterwards. + (desktop-buffer-info): New function. + (desktop-save): Use it. Run `desktop-save-hook' where the doc + says to. Detect conflicts, and manage the lock. + (desktop-read): Detect conflicts. Manage the lock. + 2007-06-23 Eli Zaretskii * ls-lisp.el (insert-directory): If an invalid regexp error is diff --git a/lisp/desktop.el b/lisp/desktop.el index e44e943db3e..d9939ac0b85 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -162,6 +162,10 @@ and function `desktop-read' for details." (define-obsolete-variable-alias 'desktop-enable 'desktop-save-mode "22.1") +(defun desktop-save-mode-off () + "Disable `desktop-save-mode'. Provided for use in hooks." + (desktop-save-mode 0)) + (defcustom desktop-save 'ask-if-new "*Specifies whether the desktop should be saved when it is killed. A desktop is killed when the user changes desktop or quits Emacs. @@ -186,6 +190,22 @@ determine where the desktop is saved." :group 'desktop :version "22.1") +(defcustom desktop-load-locked-desktop 'ask + "Specifies whether the desktop should be loaded if locked. +Possible values are: + t -- load anyway. + nil -- don't load. + ask -- ask the user. +If the value is nil, or `ask' and the user chooses not to load the desktop, +the normal hook `desktop-not-loaded-hook' is run." + :type + '(choice + (const :tag "Load anyway" t) + (const :tag "Don't load" nil) + (const :tag "Ask the user" ask)) + :group 'desktop + :version "22.2") + (defcustom desktop-base-file-name (convert-standard-filename ".emacs.desktop") "Name of file for Emacs desktop, excluding the directory part." @@ -194,6 +214,13 @@ determine where the desktop is saved." (define-obsolete-variable-alias 'desktop-basefilename 'desktop-base-file-name "22.1") +(defcustom desktop-base-lock-name + (convert-standard-filename ".emacs.desktop.lock") + "Name of lock file for Emacs desktop, excluding the directory part." + :type 'file + :group 'desktop + :version "22.2") + (defcustom desktop-path '("." "~") "List of directories to search for the desktop file. The base name of the file is specified in `desktop-base-file-name'." @@ -219,6 +246,15 @@ May be used to show a dired buffer." :group 'desktop :version "22.1") +(defcustom desktop-not-loaded-hook nil + "Normal hook run when the user declines to re-use a desktop file. +Run in the directory in which the desktop file was found. +May be used to deal with accidental multiple Emacs jobs." + :type 'hook + :group 'desktop + :options '(desktop-save-mode-off save-buffers-kill-emacs) + :version "22.2") + (defcustom desktop-after-read-hook nil "Normal hook run after a successful `desktop-read'. May be used to show a buffer list." @@ -486,6 +522,11 @@ See also `desktop-minor-mode-table'.") DIRNAME omitted or nil means use `desktop-dirname'." (expand-file-name desktop-base-file-name (or dirname desktop-dirname))) +(defun desktop-full-lock-name (&optional dirname) + "Return the full name of the desktop lock file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (expand-file-name desktop-base-lock-name (or dirname desktop-dirname))) + (defconst desktop-header ";; -------------------------------------------------------------------------- ;; Desktop File for Emacs @@ -495,12 +536,45 @@ DIRNAME omitted or nil means use `desktop-dirname'." (defvar desktop-delay-hook nil "Hooks run after all buffers are loaded; intended for internal use.") +;; ---------------------------------------------------------------------------- +;; Desktop file conflict detection +(defvar desktop-file-modtime nil + "When the desktop file was last modified to the knowledge of this Emacs. +Used to detect desktop file conflicts.") + +(defun desktop-owner (&optional dirname) + "Return the PID of the Emacs process that owns the desktop file in DIRNAME. +Return nil if no desktop file found or no Emacs process is using it. +DIRNAME omitted or nil means use `desktop-dirname'." + (let (owner) + (and (file-exists-p (desktop-full-lock-name dirname)) + (condition-case nil + (with-temp-buffer + (insert-file-contents-literally (desktop-full-lock-name dirname)) + (goto-char (point-min)) + (setq owner (read (current-buffer))) + (integerp owner)) + (error nil)) + owner))) + +(defun desktop-claim-lock (&optional dirname) + "Record this Emacs process as the owner of the desktop file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (write-region (number-to-string (emacs-pid)) nil + (desktop-full-lock-name dirname))) + +(defun desktop-release-lock (&optional dirname) + "Remove the lock file for the desktop in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (let ((file (desktop-full-lock-name dirname))) + (when (file-exists-p file) (delete-file file)))) + ;; ---------------------------------------------------------------------------- (defun desktop-truncate (list n) "Truncate LIST to at most N elements destructively." (let ((here (nthcdr (1- n) list))) - (if (consp here) - (setcdr here nil)))) + (when (consp here) + (setcdr here nil)))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -513,7 +587,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." (desktop-lazy-abort) (dolist (var desktop-globals-to-clear) (if (symbolp var) - (eval `(setq-default ,var nil)) + (eval `(setq-default ,var nil)) (eval `(setq-default ,(car var) ,(cdr var))))) (let ((buffers (buffer-list)) (preserve-regexp (concat "^\\(" @@ -552,14 +626,14 @@ is nil, ask the user where to save the desktop." (setq desktop-dirname (file-name-as-directory (expand-file-name - (call-interactively - (lambda (dir) - (interactive "DDirectory for desktop file: ") dir)))))) + (read-directory-name "Directory for desktop file: " nil nil t))))) (condition-case err - (desktop-save desktop-dirname) + (desktop-save desktop-dirname t) (file-error (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") - (signal (car err) (cdr err))))))) + (signal (car err) (cdr err)))))) + ;; If we own it, we don't anymore. + (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))) ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) @@ -573,6 +647,46 @@ is nil, ask the user where to save the desktop." (setq args (cdr args))) value))) +;; ---------------------------------------------------------------------------- +(defun desktop-buffer-info (buffer) + (set-buffer buffer) + (list + ;; basic information + (desktop-file-name (buffer-file-name) dirname) + (buffer-name) + major-mode + ;; minor modes + (let (ret) + (mapc + #'(lambda (minor-mode) + (and (boundp minor-mode) + (symbol-value minor-mode) + (let* ((special (assq minor-mode desktop-minor-mode-table)) + (value (cond (special (cadr special)) + ((functionp minor-mode) minor-mode)))) + (when value (add-to-list 'ret value))))) + (mapcar #'car minor-mode-alist)) + ret) + ;; point and mark, and read-only status + (point) + (list (mark t) mark-active) + buffer-read-only + ;; auxiliary information + (when (functionp desktop-save-buffer) + (funcall desktop-save-buffer dirname)) + ;; local variables + (let ((locals desktop-locals-to-save) + (loclist (buffer-local-variables)) + (ll)) + (while locals + (let ((here (assq (car locals) loclist))) + (if here + (setq ll (cons here ll)) + (when (member (car locals) loclist) + (setq ll (cons (car locals) ll))))) + (setq locals (cdr locals))) + ll))) + ;; ---------------------------------------------------------------------------- (defun desktop-internal-v2s (value) "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. @@ -580,77 +694,77 @@ TXT is a string that when read and evaluated yields value. QUOTE may be `may' (value may be quoted), `must' (values must be quoted), or nil (value may not be quoted)." (cond - ((or (numberp value) (null value) (eq t value) (keywordp value)) - (cons 'may (prin1-to-string value))) - ((stringp value) - (let ((copy (copy-sequence value))) - (set-text-properties 0 (length copy) nil copy) - ;; Get rid of text properties because we cannot read them - (cons 'may (prin1-to-string copy)))) - ((symbolp value) - (cons 'must (prin1-to-string value))) - ((vectorp value) - (let* ((special nil) - (pass1 (mapcar - (lambda (el) - (let ((res (desktop-internal-v2s el))) - (if (null (car res)) - (setq special t)) - res)) - value))) - (if special - (cons nil (concat "(vector " - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - pass1 - " ") - ")")) - (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) - ((consp value) - (let ((p value) - newlist - use-list* - anynil) - (while (consp p) - (let ((q.txt (desktop-internal-v2s (car p)))) - (or anynil (setq anynil (null (car q.txt)))) - (setq newlist (cons q.txt newlist))) - (setq p (cdr p))) - (if p - (let ((last (desktop-internal-v2s p))) - (or anynil (setq anynil (null (car last)))) - (or anynil - (setq newlist (cons '(must . ".") newlist))) - (setq use-list* t) - (setq newlist (cons last newlist)))) - (setq newlist (nreverse newlist)) - (if anynil - (cons nil - (concat (if use-list* "(desktop-list* " "(list ") - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - newlist - " ") - ")")) - (cons 'must - (concat "(" (mapconcat 'cdr newlist " ") ")"))))) - ((subrp value) - (cons nil (concat "(symbol-function '" - (substring (prin1-to-string value) 7 -1) - ")"))) - ((markerp value) - (let ((pos (prin1-to-string (marker-position value))) - (buf (prin1-to-string (buffer-name (marker-buffer value))))) - (cons nil (concat "(let ((mk (make-marker)))" - " (add-hook 'desktop-delay-hook" - " (list 'lambda '() (list 'set-marker mk " - pos " (get-buffer " buf ")))) mk)")))) - (t ; save as text - (cons 'may "\"Unprintable entity\"")))) + ((or (numberp value) (null value) (eq t value) (keywordp value)) + (cons 'may (prin1-to-string value))) + ((stringp value) + (let ((copy (copy-sequence value))) + (set-text-properties 0 (length copy) nil copy) + ;; Get rid of text properties because we cannot read them + (cons 'may (prin1-to-string copy)))) + ((symbolp value) + (cons 'must (prin1-to-string value))) + ((vectorp value) + (let* ((special nil) + (pass1 (mapcar + (lambda (el) + (let ((res (desktop-internal-v2s el))) + (if (null (car res)) + (setq special t)) + res)) + value))) + (if special + (cons nil (concat "(vector " + (mapconcat (lambda (el) + (if (eq (car el) 'must) + (concat "'" (cdr el)) + (cdr el))) + pass1 + " ") + ")")) + (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) + ((consp value) + (let ((p value) + newlist + use-list* + anynil) + (while (consp p) + (let ((q.txt (desktop-internal-v2s (car p)))) + (or anynil (setq anynil (null (car q.txt)))) + (setq newlist (cons q.txt newlist))) + (setq p (cdr p))) + (if p + (let ((last (desktop-internal-v2s p))) + (or anynil (setq anynil (null (car last)))) + (or anynil + (setq newlist (cons '(must . ".") newlist))) + (setq use-list* t) + (setq newlist (cons last newlist)))) + (setq newlist (nreverse newlist)) + (if anynil + (cons nil + (concat (if use-list* "(desktop-list* " "(list ") + (mapconcat (lambda (el) + (if (eq (car el) 'must) + (concat "'" (cdr el)) + (cdr el))) + newlist + " ") + ")")) + (cons 'must + (concat "(" (mapconcat 'cdr newlist " ") ")"))))) + ((subrp value) + (cons nil (concat "(symbol-function '" + (substring (prin1-to-string value) 7 -1) + ")"))) + ((markerp value) + (let ((pos (prin1-to-string (marker-position value))) + (buf (prin1-to-string (buffer-name (marker-buffer value))))) + (cons nil (concat "(let ((mk (make-marker)))" + " (add-hook 'desktop-delay-hook" + " (list 'lambda '() (list 'set-marker mk " + pos " (get-buffer " buf ")))) mk)")))) + (t ; save as text + (cons 'may "\"Unprintable entity\"")))) ;; ---------------------------------------------------------------------------- (defun desktop-value-to-string (value) @@ -676,17 +790,16 @@ which means to truncate VAR's value to at most MAX-SIZE elements (if (consp varspec) (setq var (car varspec) size (cdr varspec)) (setq var varspec)) - (if (boundp var) - (progn - (if (and (integerp size) - (> size 0) - (listp (eval var))) - (desktop-truncate (eval var) size)) - (insert "(setq " - (symbol-name var) - " " - (desktop-value-to-string (symbol-value var)) - ")\n"))))) + (when (boundp var) + (when (and (integerp size) + (> size 0) + (listp (eval var))) + (desktop-truncate (eval var) size)) + (insert "(setq " + (symbol-name var) + " " + (desktop-value-to-string (symbol-value var)) + ")\n")))) ;; ---------------------------------------------------------------------------- (defun desktop-save-buffer-p (filename bufname mode &rest dummy) @@ -724,90 +837,70 @@ DIRNAME must be the directory in which the desktop file will be saved." ;; ---------------------------------------------------------------------------- ;;;###autoload -(defun desktop-save (dirname) +(defun desktop-save (dirname &optional release) "Save the desktop in a desktop file. Parameter DIRNAME specifies where to save the desktop file. +Optional parameter RELEASE says whether we're done with this desktop. See also `desktop-base-file-name'." (interactive "DDirectory to save desktop file in: ") - (run-hooks 'desktop-save-hook) - (setq dirname (file-name-as-directory (expand-file-name dirname))) + (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion - (let ((filename (desktop-full-file-name dirname)) - (info - (mapcar - #'(lambda (b) - (set-buffer b) - (list - (desktop-file-name (buffer-file-name) dirname) - (buffer-name) - major-mode - ;; minor modes - (let (ret) - (mapc - #'(lambda (minor-mode) - (and - (boundp minor-mode) - (symbol-value minor-mode) - (let* ((special (assq minor-mode desktop-minor-mode-table)) - (value (cond (special (cadr special)) - ((functionp minor-mode) minor-mode)))) - (when value (add-to-list 'ret value))))) - (mapcar #'car minor-mode-alist)) - ret) - (point) - (list (mark t) mark-active) - buffer-read-only - ;; Auxiliary information - (when (functionp desktop-save-buffer) - (funcall desktop-save-buffer dirname)) - (let ((locals desktop-locals-to-save) - (loclist (buffer-local-variables)) - (ll)) - (while locals - (let ((here (assq (car locals) loclist))) - (if here - (setq ll (cons here ll)) - (when (member (car locals) loclist) - (setq ll (cons (car locals) ll))))) - (setq locals (cdr locals))) - ll))) - (buffer-list))) - (eager desktop-restore-eager)) - (with-temp-buffer - (insert - ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n" - desktop-header - ";; Created " (current-time-string) "\n" - ";; Desktop file format version " desktop-file-version "\n" - ";; Emacs version " emacs-version "\n\n" - ";; Global section:\n") - (dolist (varspec desktop-globals-to-save) - (desktop-outvar varspec)) - (if (memq 'kill-ring desktop-globals-to-save) - (insert - "(setq kill-ring-yank-pointer (nthcdr " - (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) - " kill-ring))\n")) + (let ((eager desktop-restore-eager) + (new-modtime (nth 5 (file-attributes (desktop-full-file-name))))) + (when + (or (not new-modtime) ; nothing to overwrite + (equal desktop-file-modtime new-modtime) + (yes-or-no-p (if desktop-file-modtime + (if (> (float-time new-modtime) (float-time desktop-file-modtime)) + "Desktop file is more recent than the one loaded. Save anyway? " + "Desktop file isn't the one loaded. Overwrite it? ") + "Current desktop was not loaded from a file. Overwrite this desktop file? ")) + (unless release (error "Desktop file conflict"))) - (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") - (dolist (l info) - (when (apply 'desktop-save-buffer-p l) - (insert "(" - (if (or (not (integerp eager)) - (unless (zerop eager) - (setq eager (1- eager)) - t)) - "desktop-create-buffer" - "desktop-append-buffer-args") - " " - desktop-file-version) - (dolist (e l) - (insert "\n " (desktop-value-to-string e))) - (insert ")\n\n"))) - (setq default-directory dirname) - (let ((coding-system-for-write 'emacs-mule)) - (write-region (point-min) (point-max) filename nil 'nomessage))))) - (setq desktop-dirname dirname)) + ;; If we're done with it, release the lock. + ;; Otherwise, claim it if it's unclaimed or if we created it. + (if release + (desktop-release-lock) + (unless (and new-modtime (desktop-owner)) (desktop-claim-lock))) + + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n" + desktop-header + ";; Created " (current-time-string) "\n" + ";; Desktop file format version " desktop-file-version "\n" + ";; Emacs version " emacs-version "\n") + (save-excursion (run-hooks 'desktop-save-hook)) + (goto-char (point-max)) + (insert "\n;; Global section:\n") + (mapc (function desktop-outvar) desktop-globals-to-save) + (when (memq 'kill-ring desktop-globals-to-save) + (insert + "(setq kill-ring-yank-pointer (nthcdr " + (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) + " kill-ring))\n")) + + (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") + (dolist (l (mapcar 'desktop-buffer-info (buffer-list))) + (when (apply 'desktop-save-buffer-p l) + (insert "(" + (if (or (not (integerp eager)) + (if (zerop eager) + nil + (setq eager (1- eager)))) + "desktop-create-buffer" + "desktop-append-buffer-args") + " " + desktop-file-version) + (dolist (e l) + (insert "\n " (desktop-value-to-string e))) + (insert ")\n\n"))) + + (setq default-directory dirname) + (let ((coding-system-for-write 'emacs-mule)) + (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) + ;; We remember when it was modified (which is presumably just now). + (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))))))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -856,35 +949,56 @@ It returns t if a desktop file was loaded, nil otherwise." ;; Default: Home directory. "~")))) (if (file-exists-p (desktop-full-file-name)) - ;; Desktop file found, process it. - (let ((desktop-first-buffer nil) - (desktop-buffer-ok-count 0) - (desktop-buffer-fail-count 0) - ;; Avoid desktop saving during evaluation of desktop buffer. - (desktop-save nil)) - (desktop-lazy-abort) - ;; Evaluate desktop buffer. - (load (desktop-full-file-name) t t t) - ;; `desktop-create-buffer' puts buffers at end of the buffer list. - ;; We want buffers existing prior to evaluating the desktop (and not reused) - ;; to be placed at the end of the buffer list, so we move them here. - (mapc 'bury-buffer - (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) - (switch-to-buffer (car (buffer-list))) - (run-hooks 'desktop-delay-hook) - (setq desktop-delay-hook nil) - (run-hooks 'desktop-after-read-hook) - (message "Desktop: %d buffer%s restored%s%s." - desktop-buffer-ok-count - (if (= 1 desktop-buffer-ok-count) "" "s") - (if (< 0 desktop-buffer-fail-count) - (format ", %d failed to restore" desktop-buffer-fail-count) - "") - (if desktop-buffer-args-list - (format ", %d to restore lazily" - (length desktop-buffer-args-list)) - "")) - t) + ;; Desktop file found, but is it already in use? + (let ((desktop-first-buffer nil) + (desktop-buffer-ok-count 0) + (desktop-buffer-fail-count 0) + (owner (desktop-owner)) + ;; Avoid desktop saving during evaluation of desktop buffer. + (desktop-save nil)) + (if (and owner + (memq desktop-load-locked-desktop '(nil ask)) + (or (null desktop-load-locked-desktop) + (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ +Using it may cause conflicts. Use it anyway? " owner))))) + (progn + (let ((default-directory desktop-dirname)) + (run-hooks 'desktop-not-loaded-hook)) + (setq desktop-dirname nil) + (message "Desktop file in use; not loaded.")) + (desktop-lazy-abort) + ;; Evaluate desktop buffer and remember when it was modified. + (load (desktop-full-file-name) t t t) + (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) + ;; If it wasn't already, mark it as in-use, to bother other + ;; desktop instances. + (unless owner + (condition-case nil + (desktop-claim-lock) + (file-error (message "Couldn't record use of desktop file") + (sit-for 1)))) + + ;; `desktop-create-buffer' puts buffers at end of the buffer list. + ;; We want buffers existing prior to evaluating the desktop (and + ;; not reused) to be placed at the end of the buffer list, so we + ;; move them here. + (mapc 'bury-buffer + (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) + (switch-to-buffer (car (buffer-list))) + (run-hooks 'desktop-delay-hook) + (setq desktop-delay-hook nil) + (run-hooks 'desktop-after-read-hook) + (message "Desktop: %d buffer%s restored%s%s." + desktop-buffer-ok-count + (if (= 1 desktop-buffer-ok-count) "" "s") + (if (< 0 desktop-buffer-fail-count) + (format ", %d failed to restore" desktop-buffer-fail-count) + "") + (if desktop-buffer-args-list + (format ", %d to restore lazily" + (length desktop-buffer-args-list)) + "")) + t)) ;; No desktop file found. (desktop-clear) (let ((default-directory desktop-dirname)) @@ -946,28 +1060,28 @@ directory DIRNAME." desktop-buffer-name desktop-buffer-misc) "Restore a file buffer." - (if desktop-buffer-file-name - (if (or (file-exists-p desktop-buffer-file-name) - (let ((msg (format "Desktop: File \"%s\" no longer exists." - desktop-buffer-file-name))) - (if desktop-missing-file-warning - (y-or-n-p (concat msg " Re-create buffer? ")) - (message "%s" msg) - nil))) - (let* ((auto-insert nil) ; Disable auto insertion - (coding-system-for-read - (or coding-system-for-read - (cdr (assq 'buffer-file-coding-system - desktop-buffer-locals)))) - (buf (find-file-noselect desktop-buffer-file-name))) - (condition-case nil - (switch-to-buffer buf) - (error (pop-to-buffer buf))) - (and (not (eq major-mode desktop-buffer-major-mode)) - (functionp desktop-buffer-major-mode) - (funcall desktop-buffer-major-mode)) - buf) - nil))) + (when desktop-buffer-file-name + (if (or (file-exists-p desktop-buffer-file-name) + (let ((msg (format "Desktop: File \"%s\" no longer exists." + desktop-buffer-file-name))) + (if desktop-missing-file-warning + (y-or-n-p (concat msg " Re-create buffer? ")) + (message "%s" msg) + nil))) + (let* ((auto-insert nil) ; Disable auto insertion + (coding-system-for-read + (or coding-system-for-read + (cdr (assq 'buffer-file-coding-system + desktop-buffer-locals)))) + (buf (find-file-noselect desktop-buffer-file-name))) + (condition-case nil + (switch-to-buffer buf) + (error (pop-to-buffer buf))) + (and (not (eq major-mode desktop-buffer-major-mode)) + (functionp desktop-buffer-major-mode) + (funcall desktop-buffer-major-mode)) + buf) + nil))) (defun desktop-load-file (function) "Load the file where auto loaded FUNCTION is defined." @@ -1062,19 +1176,19 @@ directory DIRNAME." (error (message "%s" (error-message-string err)) 1)))) (when desktop-buffer-mark (if (consp desktop-buffer-mark) - (progn - (set-mark (car desktop-buffer-mark)) - (setq mark-active (car (cdr desktop-buffer-mark)))) + (progn + (set-mark (car desktop-buffer-mark)) + (setq mark-active (car (cdr desktop-buffer-mark)))) (set-mark desktop-buffer-mark))) ;; Never override file system if the file really is read-only marked. - (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) + (when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) (while desktop-buffer-locals (let ((this (car desktop-buffer-locals))) (if (consp this) - ;; an entry of this form `(symbol . value)' - (progn - (make-local-variable (car this)) - (set (car this) (cdr this))) + ;; an entry of this form `(symbol . value)' + (progn + (make-local-variable (car this)) + (set (car this) (cdr this))) ;; an entry of the form `symbol' (make-local-variable this) (makunbound this))) From 8d2ff2390a2ad6e5916944c6440f7b9ecffe4757 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Sun, 24 Jun 2007 21:59:25 +0000 Subject: [PATCH 023/163] new Back-Cover Text --- lispref/ChangeLog | 4 +++ lispref/elisp.texi | 8 ++--- lispref/vol1.texi | 6 ++-- lispref/vol2.texi | 6 ++-- man/ChangeLog | 4 +++ man/emacs.texi | 8 ++--- man/texinfo.tex | 77 ++++++++++++++++++++++++++++++---------------- 7 files changed, 72 insertions(+), 41 deletions(-) diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 689c5612cad..39f35d78ac4 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,7 @@ +2007-06-24 Karl Berry + + * elisp.texi, vol1.texi, vol2.texi: new Back-Cover Text. + 2007-06-14 Karl Berry * anti.texi (Antinews): typo. diff --git a/lispref/elisp.texi b/lispref/elisp.texi index 4fbd46b4564..79c9bda8934 100644 --- a/lispref/elisp.texi +++ b/lispref/elisp.texi @@ -15,7 +15,7 @@ @end direntry @c in general, keep the following line commented out, unless doing a -@c copy of this manual that will be published. the manual should go +@c copy of this manual that will be published. The manual should go @c onto the distribution in the full, 8.5 x 11" size. @c set smallbook @@ -61,9 +61,9 @@ Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying diff --git a/lispref/vol1.texi b/lispref/vol1.texi index 5dff4f076b9..d0989f6c58e 100644 --- a/lispref/vol1.texi +++ b/lispref/vol1.texi @@ -80,9 +80,9 @@ Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying diff --git a/lispref/vol2.texi b/lispref/vol2.texi index 2ccbaefca9b..35ffa0e88b2 100644 --- a/lispref/vol2.texi +++ b/lispref/vol2.texi @@ -80,9 +80,9 @@ Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying diff --git a/man/ChangeLog b/man/ChangeLog index 98faf2482b1..fcbeb4f03f8 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,7 @@ +2007-06-24 Karl Berry + + * emacs.texi: new Back-Cover Text. + 2007-06-07 Michael Albinus Sync with Tramp 2.0.56. diff --git a/man/emacs.texi b/man/emacs.texi index 9086745ba66..ba4367080f4 100644 --- a/man/emacs.texi +++ b/man/emacs.texi @@ -25,9 +25,9 @@ Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying @@ -37,7 +37,7 @@ Software Foundation raise funds for GNU development.'' @end direntry @c in general, keep the following line commented out, unless doing a -@c copy of this manual that will be published. the manual should go +@c copy of this manual that will be published. The manual should go @c onto the distribution in the full, 8.5 x 11" size. @c set smallbook diff --git a/man/texinfo.tex b/man/texinfo.tex index d1447748435..d3107f9fc33 100644 --- a/man/texinfo.tex +++ b/man/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2007-05-03.09} +\def\texinfoversion{2007-06-24.23} % % Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -1435,7 +1435,7 @@ \indexnofonts \setupdatafile \catcode`\\=\active \otherbackslash - \input \jobname.toc + \input \tocreadfilename \endgroup } % @@ -4301,11 +4301,8 @@ % The following is kludged to not output a line of dots in the index if % there are no page numbers. The next person who breaks this will be % cursed by a Unix daemon. - \def\tempa{{\rm }}% - \def\tempb{#1}% - \edef\tempc{\tempa}% - \edef\tempd{\tempb}% - \ifx\tempc\tempd + \setbox\boxA = \hbox{#1}% + \ifdim\wd\boxA = 0pt \ % \else % @@ -5177,7 +5174,7 @@ \def\readtocfile{% \setupdatafile \activecatcodes - \input \jobname.toc + \input \tocreadfilename } \newskip\contentsrightmargin \contentsrightmargin=1in @@ -5208,11 +5205,16 @@ \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi } +% redefined for the two-volume lispref. We always output on +% \jobname.toc even if this is redefined. +% +\def\tocreadfilename{\jobname.toc} % Normal (long) toc. +% \def\contents{% \startcontents{\putwordTOC}% - \openin 1 \jobname.toc + \openin 1 \tocreadfilename\space \ifeof 1 \else \readtocfile \fi @@ -5250,7 +5252,7 @@ \let\numsubsubsecentry = \numsecentry \let\appsubsubsecentry = \numsecentry \let\unnsubsubsecentry = \numsecentry - \openin 1 \jobname.toc + \openin 1 \tocreadfilename\space \ifeof 1 \else \readtocfile \fi @@ -5763,11 +5765,11 @@ % regular 0x27. % \def\codequoteright{% - \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax - '% - \else - \char'15 - \fi + \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax + \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax + '% + \else \char'15 \fi + \else \char'15 \fi } % % and a similar option for the left quote char vs. a grave accent. @@ -5775,11 +5777,11 @@ % the code environments to do likewise. % \def\codequoteleft{% - \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax - `% - \else - \char'22 - \fi + \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax + \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax + `% + \else \char'22 \fi + \else \char'22 \fi } % \begingroup @@ -7432,22 +7434,41 @@ % @documentlanguage is usually given very early, just after % @setfilename. If done too late, it may not override everything -% properly. Single argument is the language abbreviation. -% It would be nice if we could set up a hyphenation file here. +% properly. Single argument is the language (de) or locale (de_DE) +% abbreviation. It would be nice if we could set up a hyphenation file. % -\parseargdef\documentlanguage{% +{ + \catcode`\_ = \active + \globaldefs=1 +\parseargdef\documentlanguage{\begingroup + \let_=\normalunderscore % normal _ character for filenames \tex % read txi-??.tex file in plain TeX. - % Read the file if it exists. + % Read the file by the name they passed if it exists. \openin 1 txi-#1.tex \ifeof 1 - \errhelp = \nolanghelp - \errmessage{Cannot read language file txi-#1.tex}% + \documentlanguagetrywithoutunderscore{#1_\finish}% \else \input txi-#1.tex \fi \closein 1 \endgroup +\endgroup} } +% +% If they passed de_DE, and txi-de_DE.tex doesn't exist, +% try txi-de.tex. +% +\def\documentlanguagetrywithoutunderscore#1_#2\finish{% + \openin 1 txi-#1.tex + \ifeof 1 + \errhelp = \nolanghelp + \errmessage{Cannot read language file txi-#1.tex}% + \else + \input txi-#1.tex + \fi + \closein 1 +} +% \newhelp\nolanghelp{The given language definition file cannot be found or is empty. Maybe you need to install it? In the current directory should work if nowhere else does.} @@ -8314,6 +8335,8 @@ \ifpdf \pdfpageheight #7\relax \pdfpagewidth #8\relax + \pdfhorigin = 1 true in + \pdfvorigin = 1 true in \fi % \setleading{\textleading} @@ -8340,7 +8363,7 @@ \textleading = 12pt % \internalpagesizes{7.5in}{5in}% - {\voffset}{.25in}% + {-.2in}{0in}% {\bindingoffset}{16pt}% {9.25in}{7in}% % From 7387d2a0ebe045390a46a52a53c6a3051cf6c343 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Mon, 25 Jun 2007 12:30:40 +0000 Subject: [PATCH 024/163] (main): Set console codepages to "ANSI". --- nt/ChangeLog | 4 ++++ nt/cmdproxy.c | 6 ++++++ 2 files changed, 10 insertions(+) diff --git a/nt/ChangeLog b/nt/ChangeLog index a7c1d181341..cf6b3e9984f 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2007-06-25 Jason Rumney + + * cmdproxy.c (main): Set console codepages to "ANSI". + 2007-06-15 Jason Rumney * emacs.manifest: New file. diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 4e4f1ef5c91..d01e7f39724 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -466,6 +466,12 @@ main (int argc, char ** argv) SetCurrentDirectory (modname); *progname = '\\'; + /* Due to problems with interaction between API functions that use "OEM" + codepage vs API functions that use the "ANSI" codepage, we need to + make things consistent by choosing one and sticking with it. */ + SetConsoleCP (GetACP()); + SetConsoleOutputCP (GetACP()); + /* Although Emacs always sets argv[0] to an absolute pathname, we might get run in other ways as well, so convert argv[0] to an absolute name before comparing to the module name. Don't get From 56f3136b14426dc58245c3f853740b3b6f68f9be Mon Sep 17 00:00:00 2001 From: YAMAMOTO Mitsuharu Date: Tue, 26 Jun 2007 03:29:25 +0000 Subject: [PATCH 025/163] [HAVE_GTK_AND_PTHREAD] Check this after including config.h. (_aligned_blocks_mutex) [USE_PTHREAD]: New variable. (LOCK_ALIGNED_BLOCKS, UNLOCK_ALIGNED_BLOCKS): New macros. (_free_internal, memalign): Use them. (_malloc_mutex, _aligned_blocks_mutex) [USE_PTHREAD]: Initialize to PTHREAD_MUTEX_INITIALIZER. (malloc_initialize_1) [USE_PTHREAD]: Don't use recursive mutex. (morecore_nolock): Rename from morecore. All uses changed. Use only nolock versions of internal allocation functions. (_malloc_internal_nolock, _realloc_internal_nolock) (_free_internal_nolock): New functions created from _malloc_internal, _realloc_internal, and _free_internal. (_malloc_internal, _realloc_internal, _free_internal): Use them. Copy hook value to automatic variable before its use. (memalign): Copy hook value to automatic variable before its use. --- src/ChangeLog | 18 ++++++ src/gmalloc.c | 175 +++++++++++++++++++++++++++++++++++--------------- 2 files changed, 141 insertions(+), 52 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index d0ac94b2e58..7d9b3a7790a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,21 @@ +2007-06-26 YAMAMOTO Mitsuharu + + * gmalloc.c [HAVE_GTK_AND_PTHREAD]: Check this after including config.h. + (_aligned_blocks_mutex) [USE_PTHREAD]: New variable. + (LOCK_ALIGNED_BLOCKS, UNLOCK_ALIGNED_BLOCKS): New macros. + (_free_internal, memalign): Use them. + (_malloc_mutex, _aligned_blocks_mutex) [USE_PTHREAD]: + Initialize to PTHREAD_MUTEX_INITIALIZER. + (malloc_initialize_1) [USE_PTHREAD]: Don't use recursive mutex. + (morecore_nolock): Rename from morecore. All uses changed. + Use only nolock versions of internal allocation functions. + (_malloc_internal_nolock, _realloc_internal_nolock) + (_free_internal_nolock): New functions created from + _malloc_internal, _realloc_internal, and _free_internal. + (_malloc_internal, _realloc_internal, _free_internal): Use them. + Copy hook value to automatic variable before its use. + (memalign): Copy hook value to automatic variable before its use. + 2007-06-21 Jason Rumney * image.c (convert_mono_to_color_image): Swap fore and background. diff --git a/src/gmalloc.c b/src/gmalloc.c index 50535d4940c..1e8b12c5c7f 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -1,9 +1,6 @@ /* This file is no longer automatically generated from libc. */ #define _MALLOC_INTERNAL -#ifdef HAVE_GTK_AND_PTHREAD -#define USE_PTHREAD -#endif /* The malloc headers and source files from the C library follow here. */ @@ -40,6 +37,10 @@ Fifth Floor, Boston, MA 02110-1301, USA. #include #endif +#ifdef HAVE_GTK_AND_PTHREAD +#define USE_PTHREAD +#endif + #if ((defined __cplusplus || (defined (__STDC__) && __STDC__) \ || defined STDC_HEADERS || defined PROTOTYPES) \ && ! defined (BROKEN_PROTOTYPES)) @@ -235,14 +236,21 @@ extern __malloc_size_t _bytes_free; extern __ptr_t _malloc_internal PP ((__malloc_size_t __size)); extern __ptr_t _realloc_internal PP ((__ptr_t __ptr, __malloc_size_t __size)); extern void _free_internal PP ((__ptr_t __ptr)); +extern __ptr_t _malloc_internal_nolock PP ((__malloc_size_t __size)); +extern __ptr_t _realloc_internal_nolock PP ((__ptr_t __ptr, __malloc_size_t __size)); +extern void _free_internal_nolock PP ((__ptr_t __ptr)); #ifdef USE_PTHREAD -extern pthread_mutex_t _malloc_mutex; +extern pthread_mutex_t _malloc_mutex, _aligned_blocks_mutex; #define LOCK() pthread_mutex_lock (&_malloc_mutex) #define UNLOCK() pthread_mutex_unlock (&_malloc_mutex) +#define LOCK_ALIGNED_BLOCKS() pthread_mutex_lock (&_aligned_blocks_mutex) +#define UNLOCK_ALIGNED_BLOCKS() pthread_mutex_unlock (&_aligned_blocks_mutex) #else #define LOCK() #define UNLOCK() +#define LOCK_ALIGNED_BLOCKS() +#define UNLOCK_ALIGNED_BLOCKS() #endif #endif /* _MALLOC_INTERNAL. */ @@ -554,7 +562,8 @@ register_heapinfo () #ifdef USE_PTHREAD static pthread_once_t malloc_init_once_control = PTHREAD_ONCE_INIT; -pthread_mutex_t _malloc_mutex; +pthread_mutex_t _malloc_mutex = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t _aligned_blocks_mutex = PTHREAD_MUTEX_INITIALIZER; #endif static void @@ -567,7 +576,9 @@ malloc_initialize_1 () if (__malloc_initialize_hook) (*__malloc_initialize_hook) (); -#ifdef USE_PTHREAD + /* We don't use recursive mutex because pthread_mutexattr_init may + call malloc internally. */ +#if 0 /* defined (USE_PTHREAD) */ { pthread_mutexattr_t attr; @@ -616,9 +627,9 @@ static int morecore_recursing; /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ -static __ptr_t morecore PP ((__malloc_size_t)); +static __ptr_t morecore_nolock PP ((__malloc_size_t)); static __ptr_t -morecore (size) +morecore_nolock (size) __malloc_size_t size; { __ptr_t result; @@ -661,7 +672,7 @@ morecore (size) `morecore_recursing' flag and return null. */ int save = errno; /* Don't want to clobber errno with ENOMEM. */ morecore_recursing = 1; - newinfo = (malloc_info *) _realloc_internal + newinfo = (malloc_info *) _realloc_internal_nolock (_heapinfo, newsize * sizeof (malloc_info)); morecore_recursing = 0; if (newinfo == NULL) @@ -717,7 +728,7 @@ morecore (size) /* Reset _heaplimit so _free_internal never decides it can relocate or resize the info table. */ _heaplimit = 0; - _free_internal (oldinfo); + _free_internal_nolock (oldinfo); PROTECT_MALLOC_STATE (0); /* The new heap limit includes the new table just allocated. */ @@ -732,7 +743,7 @@ morecore (size) /* Allocate memory from the heap. */ __ptr_t -_malloc_internal (size) +_malloc_internal_nolock (size) __malloc_size_t size; { __ptr_t result; @@ -752,7 +763,6 @@ _malloc_internal (size) return NULL; #endif - LOCK (); PROTECT_MALLOC_STATE (0); if (size < sizeof (struct list)) @@ -802,8 +812,10 @@ _malloc_internal (size) /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ #ifdef GC_MALLOC_CHECK - result = _malloc_internal (BLOCKSIZE); + result = _malloc_internal_nolock (BLOCKSIZE); PROTECT_MALLOC_STATE (0); +#elif defined (USE_PTHREAD) + result = _malloc_internal_nolock (BLOCKSIZE); #else result = malloc (BLOCKSIZE); #endif @@ -874,7 +886,7 @@ _malloc_internal (size) _heaplimit += wantblocks - lastblocks; continue; } - result = morecore (wantblocks * BLOCKSIZE); + result = morecore_nolock (wantblocks * BLOCKSIZE); if (result == NULL) goto out; block = BLOCK (result); @@ -932,7 +944,19 @@ _malloc_internal (size) PROTECT_MALLOC_STATE (1); out: + return result; +} + +__ptr_t +_malloc_internal (size) + __malloc_size_t size; +{ + __ptr_t result; + + LOCK (); + result = _malloc_internal_nolock (size); UNLOCK (); + return result; } @@ -940,10 +964,21 @@ __ptr_t malloc (size) __malloc_size_t size; { + __ptr_t (*hook) (__malloc_size_t); + if (!__malloc_initialized && !__malloc_initialize ()) return NULL; - return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size); + /* Copy the value of __malloc_hook to an automatic variable in case + __malloc_hook is modified in another thread between its + NULL-check and the use. + + Note: Strictly speaking, this is not a right solution. We should + use mutexes to access non-read-only variables that are shared + among multiple threads. We just leave it for compatibility with + glibc malloc (i.e., assignments to __malloc_hook) for now. */ + hook = __malloc_hook; + return (hook != NULL ? *hook : _malloc_internal) (size); } #ifndef _LIBC @@ -1024,9 +1059,9 @@ void (*__free_hook) PP ((__ptr_t __ptr)); struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. - Like `free' but don't call a __free_hook if there is one. */ + Like `_free_internal' but don't lock mutex. */ void -_free_internal (ptr) +_free_internal_nolock (ptr) __ptr_t ptr; { int type; @@ -1043,9 +1078,9 @@ _free_internal (ptr) if (ptr == NULL) return; - LOCK (); PROTECT_MALLOC_STATE (0); + LOCK_ALIGNED_BLOCKS (); for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { @@ -1053,6 +1088,7 @@ _free_internal (ptr) ptr = l->exact; break; } + UNLOCK_ALIGNED_BLOCKS (); block = BLOCK (ptr); @@ -1158,7 +1194,7 @@ _free_internal (ptr) table's blocks to the system before we have copied them to the new location. */ _heaplimit = 0; - _free_internal (_heapinfo); + _free_internal_nolock (_heapinfo); _heaplimit = oldlimit; /* Tell malloc to search from the beginning of the heap for @@ -1166,8 +1202,8 @@ _free_internal (ptr) _heapindex = 0; /* Allocate new space for the info table and move its data. */ - newinfo = (malloc_info *) _malloc_internal (info_blocks - * BLOCKSIZE); + newinfo = (malloc_info *) _malloc_internal_nolock (info_blocks + * BLOCKSIZE); PROTECT_MALLOC_STATE (0); memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE); _heapinfo = newinfo; @@ -1230,8 +1266,8 @@ _free_internal (ptr) _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; -#ifdef GC_MALLOC_CHECK - _free_internal (ADDRESS (block)); +#if defined (GC_MALLOC_CHECK) || defined (USE_PTHREAD) + _free_internal_nolock (ADDRESS (block)); #else free (ADDRESS (block)); #endif @@ -1269,6 +1305,16 @@ _free_internal (ptr) } PROTECT_MALLOC_STATE (1); +} + +/* Return memory to the heap. + Like `free' but don't call a __free_hook if there is one. */ +void +_free_internal (ptr) + __ptr_t ptr; +{ + LOCK (); + _free_internal_nolock (ptr); UNLOCK (); } @@ -1278,8 +1324,10 @@ FREE_RETURN_TYPE free (ptr) __ptr_t ptr; { - if (__free_hook != NULL) - (*__free_hook) (ptr); + void (*hook) (__ptr_t) = __free_hook; + + if (hook != NULL) + (*hook) (ptr); else _free_internal (ptr); } @@ -1415,7 +1463,7 @@ __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size)); new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t -_realloc_internal (ptr, size) +_realloc_internal_nolock (ptr, size) __ptr_t ptr; __malloc_size_t size; { @@ -1425,15 +1473,14 @@ _realloc_internal (ptr, size) if (size == 0) { - _free_internal (ptr); - return _malloc_internal (0); + _free_internal_nolock (ptr); + return _malloc_internal_nolock (0); } else if (ptr == NULL) - return _malloc_internal (size); + return _malloc_internal_nolock (size); block = BLOCK (ptr); - LOCK (); PROTECT_MALLOC_STATE (0); type = _heapinfo[block].busy.type; @@ -1443,11 +1490,11 @@ _realloc_internal (ptr, size) /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { - result = _malloc_internal (size); + result = _malloc_internal_nolock (size); if (result != NULL) { memcpy (result, ptr, size); - _free_internal (ptr); + _free_internal_nolock (ptr); goto out; } } @@ -1467,7 +1514,7 @@ _realloc_internal (ptr, size) Now we will free this chunk; increment the statistics counter so it doesn't become wrong when _free_internal decrements it. */ ++_chunks_used; - _free_internal (ADDRESS (block + blocks)); + _free_internal_nolock (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) @@ -1482,8 +1529,8 @@ _realloc_internal (ptr, size) /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; - _free_internal (ptr); - result = _malloc_internal (size); + _free_internal_nolock (ptr); + result = _malloc_internal_nolock (size); PROTECT_MALLOC_STATE (0); if (_heaplimit == 0) _heaplimit = oldlimit; @@ -1493,13 +1540,13 @@ _realloc_internal (ptr, size) the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) - (void) _malloc_internal (blocks * BLOCKSIZE); + (void) _malloc_internal_nolock (blocks * BLOCKSIZE); else { __ptr_t previous - = _malloc_internal ((block - _heapindex) * BLOCKSIZE); - (void) _malloc_internal (blocks * BLOCKSIZE); - _free_internal (previous); + = _malloc_internal_nolock ((block - _heapindex) * BLOCKSIZE); + (void) _malloc_internal_nolock (blocks * BLOCKSIZE); + _free_internal_nolock (previous); } goto out; } @@ -1519,18 +1566,31 @@ _realloc_internal (ptr, size) { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ - result = _malloc_internal (size); + result = _malloc_internal_nolock (size); if (result == NULL) goto out; memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); - _free_internal (ptr); + _free_internal_nolock (ptr); } break; } PROTECT_MALLOC_STATE (1); out: + return result; +} + +__ptr_t +_realloc_internal (ptr, size) + __ptr_t ptr; + __malloc_size_t size; +{ + __ptr_t result; + + LOCK(); + result = _realloc_internal_nolock (ptr, size); UNLOCK (); + return result; } @@ -1539,11 +1599,13 @@ realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { + __ptr_t (*hook) (__ptr_t, __malloc_size_t); + if (!__malloc_initialized && !__malloc_initialize ()) return NULL; - return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal) - (ptr, size); + hook = __realloc_hook; + return (hook != NULL ? *hook : _realloc_internal) (ptr, size); } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. @@ -1681,9 +1743,10 @@ memalign (alignment, size) { __ptr_t result; unsigned long int adj, lastadj; + __ptr_t (*hook) (__malloc_size_t, __malloc_size_t) = __memalign_hook; - if (__memalign_hook) - return (*__memalign_hook) (alignment, size); + if (hook) + return (*hook) (alignment, size); /* Allocate a block with enough extra space to pad the block with up to (ALIGNMENT - 1) bytes if necessary. */ @@ -1718,6 +1781,7 @@ memalign (alignment, size) of an allocated block. */ struct alignlist *l; + LOCK_ALIGNED_BLOCKS (); for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ @@ -1725,16 +1789,23 @@ memalign (alignment, size) if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); - if (l == NULL) + if (l != NULL) { - free (result); - return NULL; + l->next = _aligned_blocks; + _aligned_blocks = l; } - l->next = _aligned_blocks; - _aligned_blocks = l; } - l->exact = result; - result = l->aligned = (char *) result + alignment - adj; + if (l != NULL) + { + l->exact = result; + result = l->aligned = (char *) result + alignment - adj; + } + UNLOCK_ALIGNED_BLOCKS (); + if (l == NULL) + { + free (result); + result = NULL; + } } return result; From 251db0f475e5a9af9861be3b983bafbdf9afd403 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 27 Jun 2007 11:40:26 +0000 Subject: [PATCH 026/163] (syms_of_buffer) : Fix typo in docstring. --- src/ChangeLog | 10 +++++++--- src/buffer.c | 4 ++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 7d9b3a7790a..c87474ba4ca 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2007-06-27 Juanma Barranquero + + * buffer.c (syms_of_buffer) : Fix typo in docstring. + 2007-06-26 YAMAMOTO Mitsuharu * gmalloc.c [HAVE_GTK_AND_PTHREAD]: Check this after including config.h. @@ -10210,7 +10214,7 @@ (XTread_socket) [!MAC_OSX]: Don't pass keyboard events to TSM. [MAC_OS8] (make_mac_terminal_frame) [TARGET_API_MAC_CARBON]: Set default cursors. - (mac_initialize) [USE_CARBON_EVENTS && !MAC_OSX] : Don't call + (mac_initialize) [USE_CARBON_EVENTS && !MAC_OSX]: Don't call init_service_handler or init_quit_char_handler. (mac_initialize) [!MAC_OSX]: Don't call MakeMeTheFrontProcess. @@ -11147,7 +11151,7 @@ (install_window_handler) [TARGET_API_MAC_CARBON]: Register handlers for tracking/receiving drag-and-drop items. (do_ae_open_documents): Generate unibyte strings for filenames. - (mac_do_receive_drag) [TARGET_API_MAC_CARBON] : Likewise. + (mac_do_receive_drag) [TARGET_API_MAC_CARBON]: Likewise. Reject only non-filename items. Set event modifiers, and return value. 2004-12-28 Dan Nicolaescu @@ -15537,7 +15541,7 @@ * macgui.h [MAC_OSX]: Include Carbon/Carbon.h. (mktime, DEBUG, Z, free, malloc, realloc, max, min) - (init_process) [MAC_OSX] : Avoid conflicts with Carbon/Carbon.h. + (init_process) [MAC_OSX]: Avoid conflicts with Carbon/Carbon.h. [!MAC_OSX]: Include QDOffscreen.h and Controls.h. (INFINITY) [MAC_OSX]: Avoid conflict with definition in math.h. (Bitmap): Remove typedef. diff --git a/src/buffer.c b/src/buffer.c index 94955ed7c24..368da4763a5 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5652,8 +5652,8 @@ Backing up is done before the first time the file is saved. */); DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer->selective_display, Qnil, doc: /* Non-nil enables selective display. -An Integer N as value means display only lines -that start with less than n columns of space. +An integer N as value means display only lines +that start with less than N columns of space. A value of t means that the character ^M makes itself and all the rest of the line invisible; also, when saving the buffer in a file, save the ^M as a newline. */); From e5d2b9d41766cb2a7c9779da6751c3682594e715 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 28 Jun 2007 09:03:36 +0000 Subject: [PATCH 027/163] (speedbar-handle-delete-frame): Don't try to delete the speedbar frame if nil; that deletes the current frame or causes an error if it is the only frame. --- lisp/speedbar.el | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 87176d0c1c8..4ecb0ec7dd3 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -10,7 +10,7 @@ "The current version of speedbar.") (defvar speedbar-incompatible-version "0.14beta4" "This version of speedbar is incompatible with this version. -Due to massive API changes (removing the use of the word PATH) +Due to massive API changes (removing the use of the word PATH) this version is not backward compatible to 0.14 or earlier.") ;; This file is part of GNU Emacs. @@ -915,7 +915,7 @@ This basically creates a sparse keymap, and makes its parent be (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))] ) "Additional menu items while in file-mode.") - + (defvar speedbar-easymenu-definition-trailer (append (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) @@ -958,13 +958,13 @@ directories.") (defalias 'speedbar-make-overlay (if (featurep 'xemacs) 'make-extent 'make-overlay)) -(defalias 'speedbar-overlay-put +(defalias 'speedbar-overlay-put (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) -(defalias 'speedbar-delete-overlay +(defalias 'speedbar-delete-overlay (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) -(defalias 'speedbar-mode-line-update +(defalias 'speedbar-mode-line-update (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) ;;; Mode definitions/ user commands @@ -1053,10 +1053,10 @@ supported at a time. "Handle a delete frame event E. If the deleted frame is the frame SPEEDBAR is attached to, we need to delete speedbar also." - (let ((frame-to-be-deleted (car (car (cdr e))))) - (if (eq frame-to-be-deleted dframe-attached-frame) - (delete-frame speedbar-frame))) - ) + (when (and speedbar-frame + (eq (car (car (cdr e))) ;; frame to be deleted + dframe-attached-frame)) + (delete-frame speedbar-frame))) ;;;###autoload (defun speedbar-get-focus () @@ -1158,7 +1158,7 @@ return true without a query." ;; Backwards compatibility (defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer) (defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame) - + (defun speedbar-set-mode-line-format () "Set the format of the mode line based on the current speedbar environment. This gives visual indications of what is up. It EXPECTS the speedbar @@ -2055,7 +2055,7 @@ position to insert a new item, and that the new item will end with a CR." (if tag-button-function 'speedbar-highlight-face nil) tag-button-function tag-button-data)) )) - + (defun speedbar-change-expand-button-char (char) "Change the expansion button character to CHAR for the current line." (save-excursion @@ -2100,7 +2100,7 @@ cell of the form ( 'DIRLIST . 'FILELIST )." (defun speedbar-default-directory-list (directory index) "Insert files for DIRECTORY with level INDEX at point." - (speedbar-insert-files-at-point + (speedbar-insert-files-at-point (speedbar-file-lists directory) index) (speedbar-reset-scanners) (if (= index 0) @@ -2454,7 +2454,7 @@ name will have the function FIND-FUN and not token." (speedbar-insert-generic-list indent lst 'speedbar-tag-expand 'speedbar-tag-find)) - + (defun speedbar-insert-etags-list (indent lst) "At level INDENT, insert the etags generated LST." (speedbar-insert-generic-list indent lst @@ -2729,7 +2729,7 @@ If new functions are added, their state needs to be updated here." "Go to the line where FILE is." (set-buffer speedbar-buffer) - + (goto-char (point-min)) (let ((m nil)) (while (and (setq m (re-search-forward @@ -3220,7 +3220,7 @@ directory with these items. This function is replaceable in (widen) (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-directory))) (if rf (funcall rf depth) default-directory)))) - + (defun speedbar-files-line-directory (&optional depth) "Retrieve the directoryname associated with the current line. This may require traversing backwards from DEPTH and combining the default @@ -3305,12 +3305,12 @@ With universal argument ARG, flush cached data." (forward-char -2) (speedbar-do-function-pointer)) (error (speedbar-position-cursor-on-line))))) - + (defun speedbar-flush-expand-line () "Expand the line under the cursor and flush any cached information." (interactive) (speedbar-expand-line 1)) - + (defun speedbar-contract-line () "Contract the line under the cursor." (interactive) @@ -3559,11 +3559,11 @@ This assumes that the cursor is on a file, or tag of a file which the user is interested in." (save-selected-window - + (select-window (get-buffer-window speedbar-buffer t)) - + (set-buffer speedbar-buffer) - + (if (<= (count-lines (point-min) (point-max)) (1- (window-height (selected-window)))) ;; whole buffer fits From 339ed3defdabe534dfc9b67bd641bb8f54873cdd Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 28 Jun 2007 09:12:48 +0000 Subject: [PATCH 028/163] *** empty log message *** --- lisp/ChangeLog | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dedce43365f..b5526cecd42 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2007-06-28 Juanma Barranquero + + * speedbar.el (speedbar-handle-delete-frame): Don't try to delete + the speedbar frame if nil; that deletes the current frame or + causes an error if it is the only frame. + Reported by Angelo Graziosi . + 2007-06-24 Juanma Barranquero * desktop.el (desktop-read): Run `desktop-not-loaded-hook' in the @@ -1689,8 +1696,8 @@ North American rule. Replace "daylight savings" with "daylight saving" in doc. - * calendar/cal-china.el,cal-dst.el,calendar.el,diary-lib.el: - * calendar/lunar.el,solar.el: Replace "daylight savings" with + * calendar/cal-china.el, cal-dst.el, calendar.el, diary-lib.el: + * calendar/lunar.el, solar.el: Replace "daylight savings" with "daylight saving" in text. * woman.el (woman-change-fonts): Tweak previous change by using From 2a58c9dd3bab8323fa9bc0f7ab6ff372bac81c3c Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Thu, 28 Jun 2007 09:13:37 +0000 Subject: [PATCH 029/163] ($(lisp)/mh-e/mh-loaddefs.el): Depend on $(lisp)/subdirs.el. --- lisp/ChangeLog | 5 +++++ lisp/Makefile.in | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b5526cecd42..2a273b46166 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-28 Andreas Schwab + + * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Depend on + $(lisp)/subdirs.el. + 2007-06-28 Juanma Barranquero * speedbar.el (speedbar-handle-delete-frame): Don't try to delete diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 8adaa27e619..dff3009b215 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -239,7 +239,7 @@ MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \ $(lisp)/mh-e/mh-xface.el mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el -$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) +$(lisp)/mh-e/mh-loaddefs.el: $(lisp)/subdirs.el $(MH_E_SRC) echo ";;; mh-loaddefs.el --- automatically extracted autoloads" > $@ echo "" >> $@ echo ";; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc." >> $@ From de3f71d670b870a0bd3f10cbedb427c0d81f8dbc Mon Sep 17 00:00:00 2001 From: YAMAMOTO Mitsuharu Date: Thu, 28 Jun 2007 10:10:29 +0000 Subject: [PATCH 030/163] [USE_MAC_TSM] (mac_handle_text_input_event): Check WINDOWP before using XWINDOW. --- src/ChangeLog | 5 +++++ src/macterm.c | 3 +++ 2 files changed, 8 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index c87474ba4ca..190d6fb0e36 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2007-06-28 YAMAMOTO Mitsuharu + + * macterm.c [USE_MAC_TSM] (mac_handle_text_input_event): + Check WINDOWP before using XWINDOW. + 2007-06-27 Juanma Barranquero * buffer.c (syms_of_buffer) : Fix typo in docstring. diff --git a/src/macterm.c b/src/macterm.c index 32abee0bc10..372eff645fd 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -10244,6 +10244,9 @@ mac_handle_text_input_event (next_handler, event, data) previous events may change some states about display. */ if (NILP (Foverlay_get (Vmac_ts_active_input_overlay, Qbefore_string))) { + if (!WINDOWP (echo_area_window)) + return eventNotHandledErr; + /* Active input area is displayed in the echo area. */ w = XWINDOW (echo_area_window); f = WINDOW_XFRAME (w); From 12585bf2c462fe44a580d42587991a12ee930a06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Thu, 28 Jun 2007 19:07:32 +0000 Subject: [PATCH 031/163] (dnd-get-local-file-name): Set fixcase to t in call to replace-regexp-in-string. --- lisp/ChangeLog | 5 +++++ lisp/dnd.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2a273b46166..8beffcd2752 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-28 Jan Dj,Ad(Brv + + * dnd.el (dnd-get-local-file-name): Set fixcase to t in call to + replace-regexp-in-string. + 2007-06-28 Andreas Schwab * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Depend on diff --git a/lisp/dnd.el b/lisp/dnd.el index df081539cf0..193fa962ea7 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -149,7 +149,7 @@ Return nil if URI is not a local file." "%[A-Fa-f0-9][A-Fa-f0-9]" (lambda (arg) (format "%c" (string-to-number (substring arg 1) 16))) - f nil t)) + f t t)) (let* ((decoded-f (decode-coding-string f (or file-name-coding-system From 76ee7bd5140d78c00bb1998e07c3e238d1d14027 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Fri, 29 Jun 2007 11:15:58 +0000 Subject: [PATCH 032/163] (generic-define-mswindows-modes, generic-define-unix-modes, apache-log-generic-mode, bat-generic-mode-keymap, java-manifest-generic-mode, show-tabs-generic-mode): Fix typos in docstrings. --- lisp/ChangeLog | 7 +++++++ lisp/generic-x.el | 14 +++++++------- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8beffcd2752..dbc35487301 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2007-06-29 Juanma Barranquero + + * generic-x.el (generic-define-mswindows-modes) + (generic-define-unix-modes, apache-log-generic-mode) + (bat-generic-mode-keymap, java-manifest-generic-mode) + (show-tabs-generic-mode): Fix typos in docstrings. + 2007-06-28 Jan Dj,Ad(Brv * dnd.el (dnd-get-local-file-name): Set fixcase to t in call to diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 3136889c250..b60c59c0f70 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; -;; This file contains a collection generic modes. +;; This file contains a collection of generic modes. ;; ;; INSTALLATION: ;; @@ -244,7 +244,7 @@ This hook will be installed if the variable (memq system-type '(windows-nt ms-dos)) "*Non-nil means the modes in `generic-mswindows-modes' will be defined. This is a list of MS-Windows specific generic modes. This variable -only effects the default value of `generic-extras-enable-list'." +only affects the default value of `generic-extras-enable-list'." :group 'generic-x :type 'boolean :version "22.1") @@ -254,7 +254,7 @@ only effects the default value of `generic-extras-enable-list'." (not (memq system-type '(windows-nt ms-dos))) "*Non-nil means the modes in `generic-unix-modes' will be defined. This is a list of Unix specific generic modes. This variable only -effects the default value of `generic-extras-enable-list'." +affects the default value of `generic-extras-enable-list'." :group 'generic-x :type 'boolean :version "22.1") @@ -317,7 +317,7 @@ your changes into effect." (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Mode for Apache log files")) + "Mode for Apache log files.")) ;;; Samba (when (memq 'samba-generic-mode generic-extras-enable-list) @@ -522,7 +522,7 @@ like an INI file. You can add this hook to `find-file-hook'." "Syntax table in use in `bat-generic-mode' buffers.") (defvar bat-generic-mode-keymap (make-sparse-keymap) - "Keymap for bet-generic-mode.") + "Keymap for `bat-generic-mode'.") (defun bat-generic-mode-compile () "Run the current BAT file in a compilation buffer." @@ -784,7 +784,7 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Mode for Java Manifest files")) + "Mode for Java Manifest files.")) ;; Java properties files (when (memq 'java-properties-generic-mode generic-extras-enable-list) @@ -1776,7 +1776,7 @@ like an INI file. You can add this hook to `find-file-hook'." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces")) + "Generic mode to show tabs and trailing spaces.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes From 290c2be548f830c913cf8227a63b0d1b3dc547cc Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Sun, 1 Jul 2007 03:23:11 +0000 Subject: [PATCH 033/163] (find-file-visit-truename): Fix safe-local-variable value. --- lisp/ChangeLog | 4 ++++ lisp/files.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dbc35487301..ab4cdf34516 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-01 Richard Stallman + + * files.el (find-file-visit-truename): Fix safe-local-variable value. + 2007-06-29 Juanma Barranquero * generic-x.el (generic-define-mswindows-modes) diff --git a/lisp/files.el b/lisp/files.el index 5be738bd452..706b810fb0b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -162,7 +162,7 @@ The truename of a file is found by chasing all links both at the file level and at the levels of the containing directories." :type 'boolean :group 'find-file) -(put 'find-file-visit-truename 'safe-local-variable 'boolean) +(put 'find-file-visit-truename 'safe-local-variable 'booleanp) (defcustom revert-without-query nil "Specify which files should be reverted without query. From 20a65989fe617ef81420147ccdfb96c86b6e1b05 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 2 Jul 2007 05:40:12 +0000 Subject: [PATCH 034/163] (mouse-drag-mode-line-1): Quit mouse tracking when event is not a cons cell. Do not unread drag-mouse-1 events. Select right window in check whether space was stolen from window above. --- lisp/mouse.el | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 94d19d99a21..27b32e9f6f6 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -433,9 +433,8 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." ;; - there is a scroll-bar-movement event ;; (same as mouse movement for our purposes) ;; quit if - ;; - there is a keyboard event or some other unknown event - ;; unknown event. - (cond ((integerp event) + ;; - there is a keyboard event or some other unknown event. + (cond ((not (consp event)) (setq done t)) ((memq (car event) '(switch-frame select-window)) @@ -443,7 +442,11 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." ((not (memq (car event) '(mouse-movement scroll-bar-movement))) (when (consp event) - (push event unread-command-events)) + ;; Do not unread a drag-mouse-1 event since it will cause the + ;; selection of the window above when dragging the modeline + ;; above the selected window. + (unless (eq (car event) 'drag-mouse-1) + (push event unread-command-events))) (setq done t)) ((not (eq (car mouse) start-event-frame)) @@ -498,7 +501,10 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." (and (not should-enlarge-minibuffer) (> growth 0) mode-line-p - (/= top (nth 1 (window-edges))))) + (/= top + (nth 1 (window-edges + ;; Choose right window. + start-event-window))))) (set-window-configuration wconfig))))))))) (defun mouse-drag-mode-line (start-event) From f204ca2feb0e107476f73e9ae2b2524e5254968e Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 2 Jul 2007 05:46:19 +0000 Subject: [PATCH 035/163] (help-make-xrefs): Skip spaces too when skipping tabs. --- lisp/ChangeLog | 9 +++++++++ lisp/help-mode.el | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ab4cdf34516..129b9aab8e7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2007-07-02 Martin Rudalics + + * help-mode.el (help-make-xrefs): Skip spaces too when skipping tabs. + + * mouse.el (mouse-drag-mode-line-1): Quit mouse tracking when + event is not a cons cell. Do not unread drag-mouse-1 events. + Select right window in check whether space was stolen from + window above. + 2007-07-01 Richard Stallman * files.el (find-file-visit-truename): Fix safe-local-variable value. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index afaf06bec3c..3da2a23efc4 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -462,7 +462,7 @@ that." ;; Skip a single blank line. (and (eolp) (forward-line)) (end-of-line) - (skip-chars-backward "^\t\n") + (skip-chars-backward "^ \t\n") (if (and (>= (current-column) col) (looking-at "\\(\\sw\\|-\\)+$")) (let ((sym (intern-soft (match-string 0)))) From b0fa5db6f63cfcf26983ed506f2fe6798582b8d4 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Tue, 3 Jul 2007 21:30:56 +0000 Subject: [PATCH 036/163] (auto-mode-alist): Match more valid gdb init file names. --- lisp/ChangeLog | 5 +++++ lisp/progmodes/gud.el | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 129b9aab8e7..dee447a1720 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-03 Dan Nicolaescu + + * progmodes/gud.el (auto-mode-alist): Match more valid gdb init + file names. + 2007-07-02 Martin Rudalics * help-mode.el (help-make-xrefs): Skip spaces too when skipping tabs. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e557fdef843..536d8c4cfc1 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3193,8 +3193,12 @@ Treats actions as defuns." (goto-char (point-max))) t) +;; Besides .gdbinit, gdb documents other names to be usable for init +;; files, cross-debuggers can use something like +;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files +;; don't interfere with each other. ;;;###autoload -(add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode)) +(add-to-list 'auto-mode-alist '("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)) ;;;###autoload (define-derived-mode gdb-script-mode nil "GDB-Script" From 4dc4bb3072280a9c7a13ef9379b9c7688c7c816c Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Wed, 4 Jul 2007 16:18:49 +0000 Subject: [PATCH 037/163] *** empty log message *** --- lisp/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dee447a1720..c6e7ef04cee 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -80,7 +80,7 @@ * ls-lisp.el (insert-directory): Don't treat FILE as a wildcard if FILE exists as a directory. -2007-06-21 Reto Zimmermann +2007-06-21 Stefan Monnier * vera-mode.el (vera-mode): Fix `commend-end-skip' setting. (vera-font-lock-match-item): Fix doc string. From 325ba046131c3366eded009f5b472cbf5b594dd0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 6 Jul 2007 16:13:37 +0000 Subject: [PATCH 038/163] Document how to get back the old binding of SPC in file prompts. --- etc/NEWS | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 11e40efd4f6..5066cfac779 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -264,6 +264,14 @@ need to quote the space with a C-q. The underlying changes in the keymaps that are active in the minibuffer are described below under "New keymaps for typing file names". +If you want the old behavior back, put these two key bindings to your +~/.emacs init file: + + (define-key minibuffer-local-filename-completion-map + " " 'minibuffer-complete-word) + (define-key minibuffer-local-must-match-filename-map + " " 'minibuffer-complete-word) + ** The completion commands TAB, SPC and ? in the minibuffer apply only to the text before point. If there is text in the buffer after point, it remains unchanged. From 01d4effe81aa809fdab0c483371bf15356cc4c43 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Fri, 6 Jul 2007 17:30:06 +0000 Subject: [PATCH 039/163] (eval-last-sexp): Avoid introducing any dynamic bindings around the evaluation of the expression. --- lisp/ChangeLog | 6 ++++++ lisp/emacs-lisp/lisp-mode.el | 14 +++++++------- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c6e7ef04cee..adfef8ab290 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-07-06 Andreas Schwab + + * emacs-lisp/lisp-mode.el (eval-last-sexp): Avoid introducing any + dynamic bindings around the evaluation of the expression. + Reported by Jay Belanger . + 2007-07-03 Dan Nicolaescu * progmodes/gud.el (auto-mode-alist): Match more valid gdb init diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 164756dfdc3..73379a816d7 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -628,13 +628,13 @@ this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) (eval-last-sexp-1 eval-last-sexp-arg-internal) - (let ((old-value eval-last-sexp-fake-value) new-value value) - (let ((debug-on-error old-value)) - (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal)) - (setq new-value debug-on-error)) - (unless (eq old-value new-value) - (setq debug-on-error new-value)) - value))) + (let ((value + (let ((debug-on-error eval-last-sexp-fake-value)) + (cons (eval-last-sexp-1 eval-last-sexp-arg-internal) + debug-on-error)))) + (unless (eq (cdr value) eval-last-sexp-fake-value) + (setq debug-on-error (cdr value))) + (car value)))) (defun eval-defun-1 (form) "Treat some expressions specially. From 8b69ba6c417b8dd3419810db503db863914efd53 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Fri, 6 Jul 2007 21:24:38 +0000 Subject: [PATCH 040/163] vc-hg.el: New file. --- lisp/ChangeLog | 4 + lisp/vc-hg.el | 396 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 400 insertions(+) create mode 100644 lisp/vc-hg.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index adfef8ab290..9076e32c49b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-06 Dan Nicolaescu + + * vc-hg.el: New file. + 2007-07-06 Andreas Schwab * emacs-lisp/lisp-mode.el (eval-last-sexp): Avoid introducing any diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el new file mode 100644 index 00000000000..ec4f2e7d1ef --- /dev/null +++ b/lisp/vc-hg.el @@ -0,0 +1,396 @@ +;;; vc-hg.el --- VC backend for the mercurial version control system + +;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. + +;; Author: Ivan Kanis +;; Keywords: tools +;; Version: 1889 + +;; 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., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This is a mercurial version control backend + +;;; Thanks: + +;;; Bugs: + +;;; Installation: + +;;; Todo: + +;; Implement the rest of the vc interface. See the comment at the +;; beginning of vc.el. The current status is: + +;; FUNCTION NAME STATUS +;; * registered (file) OK +;; * state (file) OK +;; - state-heuristic (file) ?? PROBABLY NOT NEEDED +;; - dir-state (dir) NEEDED +;; * workfile-version (file) OK +;; - latest-on-branch-p (file) ?? +;; * checkout-model (file) OK +;; - workfile-unchanged-p (file) ?? +;; - mode-line-string (file) NOT NEEDED +;; - dired-state-info (file) NEEDED +;; STATE-CHANGING FUNCTIONS +;; * register (file &optional rev comment) OK +;; - init-version () NOT NEEDED +;; - responsible-p (file) OK +;; - could-register (file) OK +;; - receive-file (file rev) ?? PROBABLY NOT NEEDED +;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT +;; * checkin (file rev comment) OK +;; * find-version (file rev buffer) OK +;; * checkout (file &optional editable rev) NOT NEEDED, COMMENTED OUT +;; * revert (file &optional contents-done) OK +;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED +;; - merge (file rev1 rev2) NEEDED +;; - merge-news (file) NEEDED +;; - steal-lock (file &optional version) NOT NEEDED +;; HISTORY FUNCTIONS +;; * print-log (file &optional buffer) OK +;; - log-view-mode () OK +;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD +;; - wash-log (file) ?? +;; - logentry-check () NOT NEEDED +;; - comment-history (file) NOT NEEDED +;; - update-changelog (files) NOT NEEDED +;; * diff (file &optional rev1 rev2 buffer) OK +;; - revision-completion-table (file) ?? +;; - diff-tree (dir &optional rev1 rev2) TEST IT +;; - annotate-command (file buf &optional rev) OK +;; - annotate-time () OK +;; - annotate-current-time () ?? NOT NEEDED +;; - annotate-extract-revision-at-line () OK +;; SNAPSHOT SYSTEM +;; - create-snapshot (dir name branchp) NEEDED (probably branch?) +;; - assign-name (file name) NOT NEEDED +;; - retrieve-snapshot (dir name update) ?? NEEDED?? +;; MISCELLANEOUS +;; - make-version-backups-p (file) ?? +;; - repository-hostname (dirname) ?? +;; - previous-version (file rev) OK +;; - next-version (file rev) OK +;; - check-headers () ?? +;; - clear-headers () ?? +;; - delete-file (file) TEST IT +;; - rename-file (old new) OK +;; - find-file-hook () PROBABLY NOT NEEDED +;; - find-file-not-found-hook () PROBABLY NOT NEEDED + +;; Implement Stefan Monnier's advice: +;; vc-hg-registered and vc-hg-state +;; Both of those functions should be super extra careful to fail gracefully in +;; unexpected circumstances. The reason this is important is that any error +;; there will prevent the user from even looking at the file :-( +;; Ideally, just like in vc-arch and vc-cvs, checking that the file is under +;; mercurial's control and extracting the current revision should be done +;; without even using `hg' (this way even if you don't have `hg' installed, +;; Emacs is able to tell you this file is under mercurial's control). + +;;; History: +;; + +;;; Code: + +(eval-when-compile + (require 'vc)) + +;; XXX This should be moved to vc-hooks after this gets a bit more +;; testing in the trunk. +(add-to-list 'vc-handled-backends 'HG) + +;;; Customization options + +(defcustom vc-hg-global-switches nil + "*Global switches to pass to any Hg command." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" + :value ("") + string)) + :version "22.2" + :group 'vc) + +;;; State querying functions + +;;;###autoload (defun vc-hg-registered (file) +;;;###autoload "Return non-nil if FILE is registered with hg." +;;;###autoload (if (vc-find-root file ".hg") ; short cut +;;;###autoload (progn +;;;###autoload (load "vc-hg") +;;;###autoload (vc-hg-registered file)))) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-registered (file) + "Return non-nil if FILE is registered with hg." + (if (vc-hg-root file) ; short cut + (vc-hg-state file))) ; expensive + +(defun vc-hg-state (file) + "Hg-specific version of `vc-state'." + (let* + ((status nil) + (out + (with-output-to-string + (with-current-buffer + standard-output + (setq status + (condition-case nil + ;; Ignore all errors. + (call-process + "hg" nil t nil "--cwd" (file-name-directory file) + "status" (file-name-nondirectory file)) + ;; Some problem happened. E.g. We can't find an `hg' + ;; executable. + (error nil))))))) + (when (eq 0 status) + (if (eq 0 (length out)) 'up-to-date + (let ((state (aref out 0))) + (cond + ((eq state ?M) 'edited) + ((eq state ?A) 'edited) + ((eq state ?P) 'needs-patch) + ((eq state ??) nil) + (t 'up-to-date))))))) + +(defun vc-hg-workfile-version (file) + "Hg-specific version of `vc-workfile-version'." + (let* + ((status nil) + (out + (with-output-to-string + (with-current-buffer + standard-output + (setq status + (condition-case nil + ;; Ignore all errors. + (call-process + "hg" nil t nil "--cwd" (file-name-directory file) + "log" "-l1" (file-name-nondirectory file)) + ;; Some problem happened. E.g. We can't find an `hg' + ;; executable. + (error nil))))))) + (when (eq 0 status) + (if (string-match "changeset: *\\([0-9]*\\)" out) + (match-string 1 out) + "0")))) + +;;; History functions + +(defun vc-hg-print-log(file &optional buffer) + "Get change log associated with FILE." + ;; `log-view-mode' needs to have the file name in order to function + ;; correctly. "hg log" does not print it, so we insert it here by + ;; hand. + + ;; `vc-do-command' creates the buffer, but we need it before running + ;; the command. + (vc-setup-buffer buffer) + ;; If the buffer exists from a previous invocation it might be + ;; read-only. + (let ((inhibit-read-only t)) + (with-current-buffer + buffer + (insert "File: " (file-name-nondirectory file) "\n"))) + (vc-hg-command + buffer + (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) + file "log")) + +(defvar log-view-message-re) +(defvar log-view-file-re) +(defvar log-view-font-lock-keywords) + +(define-derived-mode vc-hg-log-view-mode log-view-mode "HG-Log-View" + (require 'add-log) ;; we need the faces add-log + ;; Don't have file markers, so use impossible regexp. + (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)") + (set (make-local-variable 'log-view-message-re) + "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)") + (set (make-local-variable 'log-view-font-lock-keywords) + (append + log-view-font-lock-keywords + ;; Handle the case: + ;; user: foo@bar + '(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" + (1 'change-log-email)) + ;; Handle the case: + ;; user: FirstName LastName + ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ("^date: \\(.+\\)" (1 'change-log-date)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) + +(defun vc-hg-diff (file &optional oldvers newvers buffer) + "Get a difference report using hg between two versions of FILE." + (let ((working (vc-workfile-version file))) + (if (and (equal oldvers working) (not newvers)) + (setq oldvers nil)) + (if (and (not oldvers) newvers) + (setq oldvers working)) + (apply 'call-process "hg" nil (or buffer "*vc-diff*") nil + "--cwd" (file-name-directory file) "diff" + (append + (if oldvers + (if newvers + (list "-r" oldvers "-r" newvers) + (list "-r" oldvers)) + (list "")) + (list (file-name-nondirectory file)))))) + +(defalias 'vc-hg-diff-tree 'vc-hg-diff) + +(defun vc-hg-annotate-command (file buffer &optional version) + "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. +Optional arg VERSION is a version to annotate from." + (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if version (concat "-r" version))) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^[0-9]") + (delete-region (point-min) (1- (point))))) + + +;; The format for one line output by "hg annotate -d -n" looks like this: +;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS +;; i.e: VERSION_NUMBER DATE: CONTENTS +(defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ") + +(defun vc-hg-annotate-time () + (when (looking-at vc-hg-annotate-re) + (goto-char (match-end 0)) + (vc-annotate-convert-time + (date-to-time (match-string-no-properties 2))))) + +(defun vc-hg-annotate-extract-revision-at-line () + (save-excursion + (beginning-of-line) + (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1)))) + +(defun vc-hg-previous-version (file rev) + (let ((newrev (1- (string-to-number rev)))) + (when (>= newrev 0) + (number-to-string newrev)))) + +(defun vc-hg-next-version (file rev) + (let ((newrev (1+ (string-to-number rev))) + (tip-version + (with-temp-buffer + (vc-hg-command t nil nil "tip") + (goto-char (point-min)) + (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") + (string-to-number (match-string-no-properties 1))))) + ;; We don't want to exceed the maximum possible version number, ie + ;; the tip version. + (when (<= newrev tip-version) + (number-to-string newrev)))) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-delete-file (file) + "Delete FILE and delete it in the hg repository." + (condition-case () + (delete-file file) + (file-error nil)) + (vc-hg-command nil nil file "remove" "--after" "--force")) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-rename-file (old new) + "Rename file from OLD to NEW using `hg mv'." + (vc-hg-command nil nil new old "mv")) + +(defun vc-hg-register (file &optional rev comment) + "Register FILE under hg. +REV is ignored. +COMMENT is ignored." + (vc-hg-command nil nil file "add")) + +(defalias 'vc-hg-responsible-p 'vc-hg-root) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-could-register (file) + "Return non-nil if FILE could be registered under hg." + (and (vc-hg-responsible-p file) ; shortcut + (condition-case () + (with-temp-buffer + (vc-hg-command t nil file "add" "--dry-run")) + ;; The command succeeds with no output if file is + ;; registered. + (error)))) + +;; XXX This would remove the file. Is that correct? +;; (defun vc-hg-unregister (file) +;; "Unregister FILE from hg." +;; (vc-hg-command nil nil file "remove")) + +(defun vc-hg-checkin (file rev comment) + "HG-specific version of `vc-backend-checkin'. +REV is ignored." + (vc-hg-command nil nil file "commit" "-m" comment)) + +(defun vc-hg-find-version (file rev buffer) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (if rev + (vc-hg-command buffer nil file "cat" "-r" rev) + (vc-hg-command buffer nil file "cat")))) + +;; Modelled after the similar function in vc-bzr.el +;; This should not be needed, `vc-hg-find-version' provides the same +;; functionality. +;; (defun vc-hg-checkout (file &optional editable rev workfile) +;; "Retrieve a revision of FILE into a WORKFILE. +;; EDITABLE is ignored. +;; REV is the revision to check out into WORKFILE." +;; (unless workfile +;; (setq workfile (vc-version-backup-file-name file rev))) +;; (let ((coding-system-for-read 'binary) +;; (coding-system-for-write 'binary)) +;; (with-temp-file workfile +;; (if rev +;; (vc-hg-command t nil file "cat" "-r" rev) +;; (vc-hg-command t nil file "cat"))))) + +(defun vc-hg-checkout-model (file) + 'implicit) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-revert (file &optional contents-done) + (unless contents-done + (with-temp-buffer (vc-hg-command t nil file "revert")))) + +;;; Internal functions + +(defun vc-hg-command (buffer okstatus file &rest flags) + "A wrapper around `vc-do-command' for use in vc-hg.el. +The difference to vc-do-command is that this function always invokes `hg', +and that it passes `vc-hg-global-switches' to it before FLAGS." + (apply 'vc-do-command buffer okstatus "hg" file + (if (stringp vc-hg-global-switches) + (cons vc-hg-global-switches flags) + (append vc-hg-global-switches + flags)))) + +(defun vc-hg-root (file) + (vc-find-root file ".hg")) + +(provide 'vc-hg) + +;;; vc-hg.el ends here From f24311feda8d0ffe222bf27c6f80d7fa8448d79d Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Sat, 7 Jul 2007 03:01:31 +0000 Subject: [PATCH 041/163] *** empty log message *** --- etc/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 5066cfac779..1ea5d4e1da4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -55,8 +55,14 @@ in to make it use the scrollbars from the system theme. ** The new package css-mode.el provides a major mode for editing CSS files. +** The new package vera-mode.el provides a major mode for editing Vera files. + ** The new package socks.el implements the SOCKS v5 protocol. +** VC + +*** VC has some support for Mercurial (hg). + * Installation Changes in Emacs 22.1 From e4b9bdc58fc8db56f3d004dfd93e01d3c22e0994 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Sat, 7 Jul 2007 03:42:40 +0000 Subject: [PATCH 042/163] (log-view-mode-menu): New menu. --- lisp/ChangeLog | 4 ++++ lisp/log-view.el | 14 ++++++++++++++ 2 files changed, 18 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9076e32c49b..319aacd11e6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-07 Dan Nicolaescu + + * log-view.el (log-view-mode-menu): New menu. + 2007-07-06 Dan Nicolaescu * vc-hg.el: New file. diff --git a/lisp/log-view.el b/lisp/log-view.el index e4f50c15351..b9368e24ebf 100644 --- a/lisp/log-view.el +++ b/lisp/log-view.el @@ -105,6 +105,20 @@ ;; or a minor-mode-map with lower precedence than the local map. :inherit (if (boundp 'cvs-mode-map) cvs-mode-map)) +(easy-menu-define log-view-mode-menu log-view-mode-map + "Log-View Display Menu" + `("Log-View" + ;; XXX Do we need menu entries for these? + ;; ["Quit" quit-window] + ;; ["Kill This Buffer" kill-this-buffer] + ["Mark Log Entry for Diff" set-mark-command] + ["Diff Revisions" log-view-diff] + ["Visit Version" log-view-find-version] + ["Next Log Entry" log-view-msg-next] + ["Previous Log Entry" log-view-msg-prev] + ["Next File" log-view-file-next] + ["Previous File" log-view-file-prev])) + (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") From ad1c463f79c2dc7757e9948f82fbd40b0cf8a097 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 7 Jul 2007 11:25:15 +0000 Subject: [PATCH 043/163] (menu-bar-open): New function. Bind to it. --- lisp/ChangeLog | 5 +++++ lisp/term/w32-win.el | 14 ++++++++++++-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 319aacd11e6..2e618aeb258 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-07 Eli Zaretskii + + * term/w32-win.el (menu-bar-open): New function. + Bind to it. + 2007-07-07 Dan Nicolaescu * log-view.el (log-view-mode-menu): New menu. diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 56dbf944dfe..fca3f9ce4d2 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -1041,8 +1041,18 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;; make f10 activate the real menubar rather than the mini-buffer menu ;;; navigation feature. -(global-set-key [f10] (lambda () - (interactive) (w32-send-sys-command ?\xf100))) +(defun menu-bar-open (&optional frame) + "Start key navigation of the menu bar in FRAME. + +This initially activates the first menu-bar item, and you can then navigate +with the arrow keys, select a menu entry with the Return key or cancel with +the Escape key. If FRAME has no menu bar, this function does nothing. + +If FRAME is nil or not given, use the selected frame." + (interactive "i") + (w32-send-sys-command ?\xf100 frame)) +; +(global-set-key [f10] 'menu-bar-open) (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) From a80a334ec31740354c57622739c681431830ade4 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Sun, 8 Jul 2007 06:44:45 +0000 Subject: [PATCH 044/163] *** empty log message *** --- lisp/ChangeLog | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2e618aeb258..f724b162617 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2007-07-08 Nick Roberts + + * pcvs-util.el (cvs-strings->string, cvs-string->strings): + Rename and move to... + + * subr.el (strings->string, string->strings): ...here. + + * pcvs.el (cvs-reread-cvsrc, cvs-header-msg, cvs-checkout) + (cvs-mode-checkout, cvs-execute-single-file): Use new function names. + + * progmodes/gud.el (gud-common-init): Call string->strings instead + of split-string. + 2007-07-07 Eli Zaretskii * term/w32-win.el (menu-bar-open): New function. From d0b15d36793fd0ecb79f8dec78afb46b7e674af1 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Sun, 8 Jul 2007 06:49:02 +0000 Subject: [PATCH 045/163] * pcvs-util.el (cvs-strings->string, cvs-string->strings): Rename and move to... * subr.el (strings->string, string->strings): ...here. --- lisp/pcvs-util.el | 31 +------------------------------ lisp/subr.el | 30 ++++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+), 30 deletions(-) diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 3945d7ba67c..58c605a19d2 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el @@ -186,35 +186,6 @@ arguments. If ARGS is not a list, no argument will be passed." "Tell whether STR1 is a prefix of STR2." (eq t (compare-strings str2 nil (length str1) str1 nil nil))) -;; (string->strings (strings->string X)) == X -(defun cvs-strings->string (strings &optional separator) - "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). -This tries to quote the strings to avoid ambiguity such that - (cvs-string->strings (cvs-strings->string strs)) == strs -Only some SEPARATORs will work properly." - (let ((sep (or separator " "))) - (mapconcat - (lambda (str) - (if (string-match "[\\\"]" str) - (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"") - str)) - strings sep))) - -;; (string->strings (strings->string X)) == X -(defun cvs-string->strings (string &optional separator) - "Split the STRING into a list of strings. -It understands elisp style quoting within STRING such that - (cvs-string->strings (cvs-strings->string strs)) == strs -The SEPARATOR regexp defaults to \"\\s-+\"." - (let ((sep (or separator "\\s-+")) - (i (string-match "[\"]" string))) - (if (null i) (split-string string sep t) ; no quoting: easy - (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) - (let ((rfs (read-from-string string i))) - (cons (car rfs) - (cvs-string->strings (substring string (cdr rfs)) - sep))))))) - ;;;; ;;;; file names ;;;; @@ -240,7 +211,7 @@ The SEPARATOR regexp defaults to \"\\s-+\"." (defconst cvs-qtypedesc-string1 (cvs-qtypedesc-create 'identity 'identity t)) (defconst cvs-qtypedesc-string (cvs-qtypedesc-create 'identity 'identity)) (defconst cvs-qtypedesc-strings - (cvs-qtypedesc-create 'cvs-string->strings 'cvs-strings->string nil)) + (cvs-qtypedesc-create 'string->strings 'strings->string nil)) (defun cvs-query-read (default prompt qtypedesc &optional hist-sym) (let* ((qtypedesc (or qtypedesc cvs-qtypedesc-strings)) diff --git a/lisp/subr.el b/lisp/subr.el index a05c1d15780..9ce4758a746 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2759,6 +2759,36 @@ Modifies the match data; use `save-match-data' if necessary." (cons (substring string start) list))) (nreverse list))) + +;; (string->strings (strings->string X)) == X +(defun strings->string (strings &optional separator) + "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). +This tries to quote the strings to avoid ambiguity such that + (string->strings (strings->string strs)) == strs +Only some SEPARATORs will work properly." + (let ((sep (or separator " "))) + (mapconcat + (lambda (str) + (if (string-match "[\\\"]" str) + (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"") + str)) + strings sep))) + +;; (string->strings (strings->string X)) == X +(defun string->strings (string &optional separator) + "Split the STRING into a list of strings. +It understands elisp style quoting within STRING such that + (string->strings (strings->string strs)) == strs +The SEPARATOR regexp defaults to \"\\s-+\"." + (let ((sep (or separator "\\s-+")) + (i (string-match "[\"]" string))) + (if (null i) (split-string string sep t) ; no quoting: easy + (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) + (let ((rfs (read-from-string string i))) + (cons (car rfs) + (string->strings (substring string (cdr rfs)) + sep))))))) + ;;;; Replacement in strings. From 24086dddf039f2c6e83fdb93f0ee76f8d6efbbc5 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Sun, 8 Jul 2007 06:51:48 +0000 Subject: [PATCH 046/163] (cvs-reread-cvsrc, cvs-header-msg, cvs-checkout) (cvs-mode-checkout, cvs-execute-single-file): Use new function names strings->string and string->strings. --- lisp/pcvs.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/pcvs.el b/lisp/pcvs.el index eb6e88e7f2f..006b2cd905b 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -182,7 +182,7 @@ (when (re-search-forward (concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t) (let* ((sym (intern (concat "cvs-" cmd "-flags"))) - (val (cvs-string->strings (or (match-string 2) "")))) + (val (string->strings (or (match-string 2) "")))) (cvs-flags-set sym 0 val)))) ;; ensure that cvs doesn't have -q or -Q (cvs-flags-set 'cvs-cvs-flags 0 @@ -607,7 +607,7 @@ If non-nil, NEW means to create a new buffer no matter what." (t arg))) args))) (concat cvs-program " " - (cvs-strings->string + (strings->string (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery) (if cvs-cvsroot (list "-d" cvs-cvsroot)) args @@ -936,7 +936,7 @@ With a prefix argument, prompt for cvs FLAGS to use." (let ((root (cvs-get-cvsroot))) (if (or (null root) current-prefix-arg) (setq root (read-string "CVS Root: "))) - (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module))) + (list (string->strings (read-string "Module(s): " (cvs-get-module))) (read-directory-name "CVS Checkout Directory: " nil default-directory nil) (cvs-add-branch-prefix @@ -959,7 +959,7 @@ The files are stored to DIR." (if branch (format " (branch: %s)" branch) "")))) (list (read-directory-name prompt nil default-directory nil)))) - (let ((modules (cvs-string->strings (cvs-get-module))) + (let ((modules (string->strings (cvs-get-module))) (flags (cvs-add-branch-prefix (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))) (cvs-cvsroot (cvs-get-cvsroot))) @@ -2244,7 +2244,7 @@ With prefix argument, prompt for cvs flags." (let* ((args (append constant-args arg-list))) (insert (format "=== %s %s\n\n" - program (cvs-strings->string args))) + program (strings->string args))) ;; FIXME: return the exit status? (apply 'call-process program nil t t args) From 053bb163b6279108ed9a3461d050be92bb1a1ab4 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Sun, 8 Jul 2007 06:54:40 +0000 Subject: [PATCH 047/163] (gud-common-init): Call string->strings instead of split-string. --- lisp/progmodes/gud.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 536d8c4cfc1..57eed959f8b 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2462,7 +2462,7 @@ comint mode, which see." ;; for local variables in the debugger buffer. (defun gud-common-init (command-line massage-args marker-filter &optional find-file) - (let* ((words (split-string command-line)) + (let* ((words (string->strings command-line)) (program (car words)) (dir default-directory) ;; Extract the file name from WORDS From c5748f4709791e726be3d547496a11bbe3e8a914 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Sun, 8 Jul 2007 08:18:12 +0000 Subject: [PATCH 048/163] * log-view.el (log-view-font-lock-keywords): Use `eval' to consult the buffer-local value of log-view-*-re if applicable. --- lisp/ChangeLog | 5 +++++ lisp/vc.el | 13 +++++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f724b162617..fe56cdb437c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-06-20 Stefan Monnier + + * vc.el (vc-default-log-view-mode): New function. + (vc-print-log): Add new `log-view-mode' VC operation. + 2007-07-08 Nick Roberts * pcvs-util.el (cvs-strings->string, cvs-string->strings): diff --git a/lisp/vc.el b/lisp/vc.el index 450bfb3c938..580f16ce87b 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -105,7 +105,9 @@ ;; ;; * registered (file) ;; -;; Return non-nil if FILE is registered in this backend. +;; Return non-nil if FILE is registered in this backend. Both this +;; function as well as `state' should be careful to fail gracefully in the +;; event that the backend executable is absent. ;; ;; * state (file) ;; @@ -270,6 +272,12 @@ ;; Insert the revision log of FILE into BUFFER, or the *vc* buffer ;; if BUFFER is nil. ;; +;; - log-view-mode () +;; +;; Mode to use for the output of print-log. This defaults to +;; `log-view-mode' and is expected to be changed (if at all) to a derived +;; mode of `log-view-mode'. +;; ;; - show-log-entry (version) ;; ;; If provided, search the log entry for VERSION in the current buffer, @@ -2449,7 +2457,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." (pop-to-buffer (current-buffer)) (vc-exec-after `(let ((inhibit-read-only t)) - (log-view-mode) + (vc-call-backend ',(vc-backend file) 'log-view-mode) (goto-char (point-max)) (forward-line -1) (while (looking-at "=*\n") (delete-char (- (match-end 0) (match-beginning 0))) @@ -2464,6 +2472,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." ',focus-rev) (set-buffer-modified-p nil))))) +(defun vc-default-log-view-mode (backend) (log-view-mode)) (defun vc-default-show-log-entry (backend rev) (with-no-warnings (log-view-goto-rev rev))) From 300e5e2274633324fecd782e98e89e4477cfe892 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Sun, 8 Jul 2007 11:32:07 +0000 Subject: [PATCH 049/163] Add arch tagline --- lisp/progmodes/vera-mode.el | 1 + lisp/vc-hg.el | 1 + 2 files changed, 2 insertions(+) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 124aaceb1f9..7117ffd15e8 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1483,4 +1483,5 @@ If `vera-intelligent-tab' is nil, always indent line." (provide 'vera-mode) +;; arch-tag: 22eae722-7ac5-47ac-a713-c4db1cf623a9 ;;; vera-mode.el ends here diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index ec4f2e7d1ef..31391f2d2c8 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -393,4 +393,5 @@ and that it passes `vc-hg-global-switches' to it before FLAGS." (provide 'vc-hg) +;; arch-tag: bd094dc5-715a-434f-a331-37b9fb7cd954 ;;; vc-hg.el ends here From 78862c5e9448f026030cedbd03613b512e873c5e Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 8 Jul 2007 18:07:19 +0000 Subject: [PATCH 050/163] * longlines.el (longlines-wrap-region): Avoid marking buffer as modified. (longlines-auto-wrap, longlines-window-change-function): Remove unnecessary calls to set-buffer-modified-p. --- lisp/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fe56cdb437c..f6121660708 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2007-07-08 Chong Yidong + + * longlines.el (longlines-wrap-region): Avoid marking buffer as + modified. + (longlines-auto-wrap, longlines-window-change-function): Remove + unnecessary calls to set-buffer-modified-p. + 2007-06-20 Stefan Monnier * vc.el (vc-default-log-view-mode): New function. From 85a0b368596336622765c279694529ed3558b488 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 8 Jul 2007 18:07:46 +0000 Subject: [PATCH 051/163] (longlines-wrap-region): Avoid marking buffer as modified. (longlines-auto-wrap, longlines-window-change-function): Remove unnecessary calls to set-buffer-modified-p. --- lisp/longlines.el | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/lisp/longlines.el b/lisp/longlines.el index 149f69c9f26..b75adb4f0d9 100644 --- a/lisp/longlines.el +++ b/lisp/longlines.el @@ -223,16 +223,18 @@ With optional argument ARG, make the hard newlines invisible again." "Wrap each successive line, starting with the line before BEG. Stop when we reach lines after END that don't need wrapping, or the end of the buffer." - (setq longlines-wrap-point (point)) - (goto-char beg) - (forward-line -1) - ;; Two successful longlines-wrap-line's in a row mean successive - ;; lines don't need wrapping. - (while (null (and (longlines-wrap-line) - (or (eobp) - (and (>= (point) end) - (longlines-wrap-line)))))) - (goto-char longlines-wrap-point)) + (let ((mod (buffer-modified-p))) + (setq longlines-wrap-point (point)) + (goto-char beg) + (forward-line -1) + ;; Two successful longlines-wrap-line's in a row mean successive + ;; lines don't need wrapping. + (while (null (and (longlines-wrap-line) + (or (eobp) + (and (>= (point) end) + (longlines-wrap-line)))))) + (goto-char longlines-wrap-point) + (set-buffer-modified-p mod))) (defun longlines-wrap-line () "If the current line needs to be wrapped, wrap it and return nil. @@ -372,10 +374,9 @@ If automatic line wrapping is turned on, wrap the entire buffer." (> (prefix-numeric-value arg) 0) (not longlines-auto-wrap))) (if arg - (let ((mod (buffer-modified-p))) + (progn (setq longlines-auto-wrap t) (longlines-wrap-region (point-min) (point-max)) - (set-buffer-modified-p mod) (message "Auto wrap enabled.")) (setq longlines-auto-wrap nil) (message "Auto wrap disabled."))) @@ -410,9 +411,7 @@ This is called by `post-command-hook' after each command." This is called by `window-configuration-change-hook'." (when (/= fill-column (- (window-width) window-min-width)) (setq fill-column (- (window-width) window-min-width)) - (let ((mod (buffer-modified-p))) - (longlines-wrap-region (point-min) (point-max)) - (set-buffer-modified-p mod)))) + (longlines-wrap-region (point-min) (point-max)))) ;; Isearch From f2a6c14abdd185dfb071dd9c263fb0d931933069 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Sun, 8 Jul 2007 23:41:36 +0000 Subject: [PATCH 052/163] (file-coding-system-alist): Fix custom type. --- lisp/ChangeLog | 4 ++++ lisp/cus-start.el | 29 ++++++++++++++++++++--------- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f6121660708..1505d43ee76 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-08 Katsumi Yamaoka + + * cus-start.el (file-coding-system-alist): Fix custom type. + 2007-07-08 Chong Yidong * longlines.el (longlines-wrap-region): Avoid marking buffer as diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 61f073119e7..38231f29a6c 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -116,15 +116,26 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of mule (alist :key-type (regexp :tag "File regexp") - :value-type (choice - :value (undecided . undecided) - (cons :tag "Encoding/decoding pair" - :value (undecided . undecided) - (coding-system :tag "Decoding") - (coding-system :tag "Encoding")) - (coding-system :tag "Single coding system" - :value undecided) - (function :value ignore)))) + :value-type + (choice + :value (undecided . undecided) + (cons :tag "Encoding/decoding pair" + :value (undecided . undecided) + (coding-system :tag "Decoding") + (coding-system :tag "Encoding")) + (coding-system + :tag "Single coding system" + :value undecided + :validate + (lambda (widget) + (unless (or (coding-system-p (widget-value widget)) + (functionp (widget-value widget))) + (widget-put + widget + :error (format "Invalid coding system: %S" + (widget-value widget))) + widget))) + (function :value ignore)))) (selection-coding-system mule coding-system) ;; dired.c (completion-ignored-extensions dired From 338f7c364d0906c395d5794a54de30a079cd8825 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Sun, 8 Jul 2007 23:44:03 +0000 Subject: [PATCH 053/163] Remove `tiny change' flags from my log entries. --- lisp/ChangeLog | 6 +++--- lisp/ChangeLog.10 | 4 ++-- lisp/ChangeLog.11 | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1505d43ee76..8d56fe69963 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -333,7 +333,7 @@ * hilit-chg.el (highlight-changes-rotate-faces): Don't set modified flag of buffer. Use `inhibit-modification-hooks'. -2007-06-04 Katsumi Yamaoka (tiny change) +2007-06-04 Katsumi Yamaoka * mail/mail-extr.el (mail-extract-address-components): Recognize non-ASCII characters except for NBSP as words. @@ -9396,7 +9396,7 @@ * term.el (term-handle-scroll, term-delete-lines) (term-insert-lines): Fix off by one errors. -2006-06-15 Katsumi Yamaoka (tiny change) +2006-06-15 Katsumi Yamaoka * net/tramp.el (tramp-touch): Use UTC to express time. @@ -23656,7 +23656,7 @@ * menu-bar.el (menu-bar-showhide-menu): Add `showhide-battery'. -2005-08-09 Katsumi Yamaoka (tiny change) +2005-08-09 Katsumi Yamaoka * net/ange-ftp.el (ange-ftp-send-cmd): Make it work properly with uploading files. diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index d6d69c52924..d63ef8fbbd7 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -1340,7 +1340,7 @@ (shell-directory-tracker): Make regexp used for skipping to next command correspond to one used for command itself. -2003-06-13 Katsumi Yamaoka (tiny change) +2003-06-13 Katsumi Yamaoka * textmodes/texinfmt.el (texinfo-format-scan): Silence `whitespace-cleanup'. @@ -11805,7 +11805,7 @@ * vc-hooks.el (vc-kill-buffer-hook): Add it to kill-buffer-hook again. -2002-08-22 Katsumi Yamaoka (tiny change) +2002-08-22 Katsumi Yamaoka * frame.el (select-frame-by-name, select-frame-set-input-focus): Always call x-focus-frame, if using x. diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index ac47f4eaeaa..0ef83a0ed9d 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -5295,7 +5295,7 @@ (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax. (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'. -2004-08-05 Katsumi Yamaoka (tiny change) +2004-08-05 Katsumi Yamaoka * mail/mail-extr.el (mail-extr-disable-voodoo): New variable. (mail-extr-voodoo): Check mail-extr-disable-voodoo. From 7d79b956dc1f33d744b14707f207259fe456b596 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Mon, 9 Jul 2007 01:27:20 +0000 Subject: [PATCH 054/163] (file-coding-system-alist): Fix previous commit. --- lisp/cus-start.el | 32 ++++++++++++-------------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 38231f29a6c..76a4710b846 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -116,26 +116,18 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of mule (alist :key-type (regexp :tag "File regexp") - :value-type - (choice - :value (undecided . undecided) - (cons :tag "Encoding/decoding pair" - :value (undecided . undecided) - (coding-system :tag "Decoding") - (coding-system :tag "Encoding")) - (coding-system - :tag "Single coding system" - :value undecided - :validate - (lambda (widget) - (unless (or (coding-system-p (widget-value widget)) - (functionp (widget-value widget))) - (widget-put - widget - :error (format "Invalid coding system: %S" - (widget-value widget))) - widget))) - (function :value ignore)))) + :value-type (choice + :value (undecided . undecided) + (cons :tag "Encoding/decoding pair" + :value (undecided . undecided) + (coding-system :tag "Decoding") + (coding-system :tag "Encoding")) + (coding-system + :tag "Single coding system" + :value undecided + :match (lambda (widget value) + (and value (not (functionp value))))) + (function :value ignore)))) (selection-coding-system mule coding-system) ;; dired.c (completion-ignored-extensions dired From 825906b8afc9f011ac6f7a16fcfbbafdf0226523 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Mon, 9 Jul 2007 12:00:56 +0000 Subject: [PATCH 055/163] (fit-window-to-buffer): Remove setting of window-min-height to 1 as enlarge-window uses the value to resize/shrink windows other than WINDOW if needed. --- lisp/ChangeLog | 6 ++++++ lisp/window.el | 5 +---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 25ed4c24e31..3f9d5b3bce1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-07-09 Jan Dj,Ad(Brv + + * window.el (fit-window-to-buffer): Remove setting of window-min-height + to 1 as enlarge-window uses the value to resize/shrink windows other than + WINDOW if needed. + 2007-07-08 Katsumi Yamaoka * cus-start.el (file-coding-system-alist): Fix custom type. diff --git a/lisp/window.el b/lisp/window.el index 921d84d6e7d..216e89249c6 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -645,10 +645,7 @@ header-line." ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT. (- (max (min desired-height max-height) (or min-height window-min-height)) - window-height)) - ;; We do our own height checking, so avoid any restrictions due to - ;; window-min-height. - (window-min-height 1)) + window-height))) ;; Don't try to redisplay with the cursor at the end ;; on its own line--that would force a scroll and spoil things. From ebcf866ed8fdb229678a21ec77af81d0da29af1d Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 9 Jul 2007 14:13:02 +0000 Subject: [PATCH 056/163] (Magic File Names): Rewrite previous change. --- lispref/ChangeLog | 4 ++++ lispref/files.texi | 9 ++++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/lispref/ChangeLog b/lispref/ChangeLog index d7295bd64b1..61bc10c1afc 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,7 @@ +2007-07-09 Richard Stallman + + * files.texi (Magic File Names): Rewrite previous change. + 2007-07-08 Michael Albinus * files.texi (Magic File Names): Introduce optional parameter diff --git a/lispref/files.texi b/lispref/files.texi index eacb641a8bb..343a6bc5e39 100644 --- a/lispref/files.texi +++ b/lispref/files.texi @@ -2786,11 +2786,10 @@ example, that it is possible to start a remote process accessing both files at the same time. Implementors of file handlers need to ensure this principle is valid. -The optional parameter @var{connected}, when passed non-@code{nil}, -triggers an additional check whether the remote system has been -connected already. The function returns then @code{nil} if there is -no corresponding open connection, even if @var{filename} is remote. -This can be used to avoid unnecessary connection attempts. +If @var{connected} is non-@code{nil}, this function returns @code{nil} +even if @var{filename} is remote, if Emacs has no network connection +to its host. This is useful when you want to avoid the delay of +making connections when they don't exist. @end defun @defun unhandled-file-name-directory filename From ccbbae2c439f132be89e4203cde8803da7beab25 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 9 Jul 2007 14:45:13 +0000 Subject: [PATCH 057/163] (isearch-edit-string): Call to isearch-push-state after the search. --- lisp/ChangeLog | 5 +++++ lisp/isearch.el | 1 + 2 files changed, 6 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3f9d5b3bce1..048c6634c83 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-09 Richard Stallman + + * isearch.el (isearch-edit-string): Call to isearch-push-state + after the search. + 2007-07-09 Jan Dj,Ad(Brv * window.el (fit-window-to-buffer): Remove setting of window-min-height diff --git a/lisp/isearch.el b/lisp/isearch.el index f5a063200f1..71e5e4bccd3 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1069,6 +1069,7 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst ;; Reinvoke the pending search. (isearch-search) + (isearch-push-state) (isearch-update) (if isearch-nonincremental (progn From 25c185dfe362957f9045602fa9644b0b554c6626 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 9 Jul 2007 14:46:56 +0000 Subject: [PATCH 058/163] (isearch-edit-string): Call to isearch-push-state after the search. --- lisp/ChangeLog | 5 +++++ lisp/isearch.el | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8d56fe69963..87e471753e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-09 Richard Stallman + + * isearch.el (isearch-edit-string): Call to isearch-push-state + after the search. + 2007-07-08 Katsumi Yamaoka * cus-start.el (file-coding-system-alist): Fix custom type. diff --git a/lisp/isearch.el b/lisp/isearch.el index f5a063200f1..770d607713e 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, 1993, 1994, 1995, 1996, 1997, 1999, 2000, ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. @@ -674,6 +674,8 @@ is treated as a regexp. See \\[isearch-forward] for more info." (make-local-variable 'input-method-function)) (setq input-method-function nil) + (setq cursor-in-echo-area t) + (looking-at "") (setq isearch-window-configuration (if isearch-slow-terminal-mode (current-window-configuration) nil)) @@ -798,6 +800,8 @@ NOPUSH is t and EDIT is t." (setq input-method-function isearch-input-method-function) (kill-local-variable 'input-method-function)) + (setq cursor-in-echo-area nil) + (force-mode-line-update) ;; If we ended in the middle of some intangible text, @@ -1069,6 +1073,7 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst ;; Reinvoke the pending search. (isearch-search) + (isearch-push-state) (isearch-update) (if isearch-nonincremental (progn From 2b1567a532c70cf9bd729aa0b5b0a2f8121ca78e Mon Sep 17 00:00:00 2001 From: Reiner Steib Date: Mon, 9 Jul 2007 19:14:48 +0000 Subject: [PATCH 059/163] (tex-fontify-script) (tex-font-script-display): New variables to make display of superscripts and subscripts customizable. (tex-font-lock-suscript, tex-font-lock-match-suscript): Use them. --- lisp/ChangeLog | 8 ++++++++ lisp/textmodes/tex-mode.el | 24 ++++++++++++++++++++---- 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 048c6634c83..f8d08998d6b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2007-07-09 Reiner Steib + + * textmodes/tex-mode.el (tex-fontify-script) + (tex-font-script-display): New variables to make display of + superscripts and subscripts customizable. + (tex-font-lock-suscript, tex-font-lock-match-suscript): Use them. + 2007-07-09 Richard Stallman * isearch.el (isearch-edit-string): Call to isearch-push-state @@ -372,6 +379,7 @@ * font-lock.el (lisp-font-lock-keywords-2): Recognize the new \(?1:..\) syntax as well. Reported by Juri Linkov . +>>>>>>> 1.11328 2007-06-28 Jan Dj,Ad(Brv * dnd.el (dnd-get-local-file-name): Set fixcase to t in call to diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5757100468b..034caeee702 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -243,6 +243,21 @@ Normally set to either `plain-tex-mode' or `latex-mode'." :options '("''" "\">" "\"'" ">>" "»") :group 'tex) +(defcustom tex-fontify-script t + "If non-nil, fontify subscript and superscript strings." + :type 'boolean + :group 'tex) +(put 'tex-fontify-script 'safe-local-variable 'booleanp) + +(defcustom tex-font-script-display '(-0.3 . 0.3) + "Display specification for subscript and superscript content. +The car is used for subscript, the cdr is used for superscripts." + :group 'tex + :type '(cons (choice (float :tag "Subscript") + (const :tag "No lowering" nil)) + (choice (float :tag "Superscript") + (const :tag "No raising" nil)))) + (defvar tex-last-temp-file nil "Latest temporary file generated by \\[tex-region] and \\[tex-buffer]. Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the @@ -593,13 +608,14 @@ An alternative value is \" . \", if you use a font with a narrow period." (setq pos (1- pos) odd (not odd))) odd)) (if (eq (char-after pos) ?_) - '(face subscript display (raise -0.3)) - '(face superscript display (raise +0.3))))) + `(face subscript display (raise ,(car tex-font-script-display))) + `(face superscript display (raise ,(cdr tex-font-script-display)))))) (defun tex-font-lock-match-suscript (limit) "Match subscript and superscript patterns up to LIMIT." - (when (re-search-forward "[_^] *\\([^\n\\{}]\\|\ -\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t) + (when (and tex-fontify-script + (re-search-forward "[_^] *\\([^\n\\{}]\\|\ +\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|\\({\\)\\)" limit t)) (when (match-end 3) (let ((beg (match-beginning 3)) (end (save-restriction From 3912763611584f887ce23730ffeda55e297b68ae Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Mon, 9 Jul 2007 20:49:25 +0000 Subject: [PATCH 060/163] *** empty log message *** --- lisp/ChangeLog | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f8d08998d6b..8a3e84fe12e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -13,8 +13,8 @@ 2007-07-09 Jan Dj,Ad(Brv * window.el (fit-window-to-buffer): Remove setting of window-min-height - to 1 as enlarge-window uses the value to resize/shrink windows other than - WINDOW if needed. + to 1 as enlarge-window uses the value to resize/shrink windows other + than WINDOW if needed. 2007-07-08 Katsumi Yamaoka @@ -78,20 +78,21 @@ (math-bignum-digit-power-of-two): Evaluate when compiled. * calc/calc-comb.el (math-small-factorial-table) - (math-init-random-base,math-prime-test): Remove unnecessary calls + (math-init-random-base, math-prime-test): Remove unnecessary calls to `math-read-number-simple'. - * calc/calc-ext.el (math-approx-pi,math-approx-sqrt-e) + * calc/calc-ext.el (math-approx-pi, math-approx-sqrt-e) (math-approx-gamma-const): Add docstrings. * calc/calc-forms.el (math-julian-date-beginning) (math-julian-date-beginning-int) New constants. - (math-format-date-part,math-parse-standard-date,calcFunc-julian): + (math-format-date-part, math-parse-standard-date, calcFunc-julian): Use the new constants. * calc/calc-funcs.el (math-gammap1-raw): Add docstring. - * calc/calc-math.el (math-approx-ln-10,math-approx-ln-2): Add docstrings. + * calc/calc-math.el (math-approx-ln-10, math-approx-ln-2): + Add docstrings. 2007-07-07 Tom Tromey @@ -168,8 +169,8 @@ * calc/calc-bin.el (math-bignum-logb-digit-size) (math-bignum-digit-power-of-two): New constants. - (math-and-bignum,math-or-bignum,math-xor-bignum,math-diff-bignum) - (math-not-bignum,math-clip-bignum): Use the constants + (math-and-bignum, math-or-bignum, math-xor-bignum, math-diff-bignum) + (math-not-bignum, math-clip-bignum): Use the constants `math-bignum-digit-power-of-two' and `math-bignum-logb-digit-size' instead of their values. (math-clip): Use math-small-integer-size instead of its value. @@ -323,7 +324,7 @@ 2007-07-02 Martin Rudalics - * help-mode.el (help-make-xrefs): Skip spaces too when + * help-mode.el (help-make-xrefs): Skip spaces too when skipping tabs. * ffap.el (dired-at-point-prompter): Improve prompt in @@ -379,7 +380,6 @@ * font-lock.el (lisp-font-lock-keywords-2): Recognize the new \(?1:..\) syntax as well. Reported by Juri Linkov . ->>>>>>> 1.11328 2007-06-28 Jan Dj,Ad(Brv * dnd.el (dnd-get-local-file-name): Set fixcase to t in call to From 2b6b226cf6346681c4d0cbe9b2876e1c6cbb942e Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 10 Jul 2007 01:05:49 +0000 Subject: [PATCH 061/163] (Defining Faces): Explain C-M-x feature for defface. --- lispref/ChangeLog | 4 ++++ lispref/display.texi | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 39f35d78ac4..0bd727f0748 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,7 @@ +2007-07-10 Richard Stallman + + * display.texi (Defining Faces): Explain C-M-x feature for defface. + 2007-06-24 Karl Berry * elisp.texi, vol1.texi, vol2.texi: new Back-Cover Text. diff --git a/lispref/display.texi b/lispref/display.texi index f644a02c2eb..8cf25110308 100644 --- a/lispref/display.texi +++ b/lispref/display.texi @@ -1760,6 +1760,11 @@ When @code{defface} executes, it defines the face according to @var{spec}, then uses any customizations that were read from the init file (@pxref{Init File}) to override that specification. +When you evaluate a @code{defcustom} form with @kbd{C-M-x} in Emacs +Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} +overrides any customizations of the face. This way, the face reflects +exactly what the @code{defcustom} says. + The purpose of @var{spec} is to specify how the face should appear on different kinds of terminals. It should be an alist whose elements have the form @code{(@var{display} @var{atts})}. Each element's From c40e86ef0a28ef43d849f39c1bb0d76bc43932bb Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 10 Jul 2007 01:07:09 +0000 Subject: [PATCH 062/163] (eval-defun): Explain special handling of `defface'. --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/lisp-mode.el | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 87e471753e5..dcdb04cc5fa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-10 Richard Stallman + + * emacs-lisp/lisp-mode.el (eval-defun): + Explain special handling of `defface'. + 2007-07-09 Richard Stallman * isearch.el (isearch-edit-string): Call to isearch-push-state diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 73379a816d7..374d3ae2327 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -730,7 +730,9 @@ If the current defun is actually a call to `defvar' or `defcustom', evaluating it this way resets the variable using its initial value expression even if the variable already has some other value. \(Normally `defvar' and `defcustom' do not alter the value if there -already is one.) +already is one.) In an analogous way, evaluating a `defface' +overrides any customizations of the face, so that it becomes +defined exactly as the `defface' expression says. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger. From 60b0b6685e16dd58897922e7cecd95a821aedc38 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Tue, 10 Jul 2007 01:54:34 +0000 Subject: [PATCH 063/163] Merge from gnus--rel--5.10 Patches applied: * emacs--devo--0 (patch 797, 800, 802) - Merge from emacs--rel--22 * gnus--rel--5.10 (patch 233-234) - Merge from emacs--devo--0 - Update from CVS 2007-07-04 Katsumi Yamaoka * lisp/gnus/gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles as unfetched articles. 2007-07-02 Reiner Steib * lisp/gnus/gnus-start.el (gnus-level-unsubscribed): Improve doc string. 2007-06-26 Katsumi Yamaoka * lisp/gnus/gnus-art.el (gnus-article-summary-command-nosave) (gnus-article-read-summary-keys): Don't set the 3rd arg of pop-to-buffer for XEmacs. 2007-07-02 Reiner Steib * man/gnus-faq.texi ([3.2]): Fix locating of environment variables in the Control Panel. * man/gnus.texi (Misc Article): Add index entry for gnus-single-article-buffer. 2007-06-27 Andreas Seltenreich * man/gnus.texi (Starting Up): Fix typo. 2007-06-25 Katsumi Yamaoka * man/gnus.texi (Asynchronous Fetching): Fix typo. Revision: emacs@sv.gnu.org/emacs--rel--22--patch-54 --- lisp/gnus/ChangeLog | 15 +++++++++++++++ lisp/gnus/gnus-art.el | 11 +++++++---- lisp/gnus/gnus-start.el | 9 +++++++-- lisp/gnus/gnus-sum.el | 3 ++- man/ChangeLog | 16 ++++++++++++++++ man/gnus-faq.texi | 11 +++++------ man/gnus.texi | 27 ++++++++++++++++----------- 7 files changed, 68 insertions(+), 24 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 0e9da63da1a..6ff604ab53f 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,18 @@ +2007-07-04 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles + as unfetched articles. + +2007-07-02 Reiner Steib + + * gnus-start.el (gnus-level-unsubscribed): Improve doc string. + +2007-06-26 Katsumi Yamaoka + + * gnus-art.el (gnus-article-summary-command-nosave) + (gnus-article-read-summary-keys): Don't set the 3rd arg of + pop-to-buffer for XEmacs. + 2007-06-14 Katsumi Yamaoka * gnus-agent.el (gnus-agent-fetch-headers) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 90af0740318..cbfa6bded93 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5607,7 +5607,7 @@ not have a face in `gnus-article-boring-faces'." "Execute the last keystroke in the summary buffer." (interactive) (let (func) - (pop-to-buffer gnus-article-current-summary nil 'norecord) + (pop-to-buffer gnus-article-current-summary nil (not (featurep 'xemacs))) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) @@ -5646,7 +5646,8 @@ not have a face in `gnus-article-boring-faces'." (member keys nosave-in-article)) (let (func) (save-window-excursion - (pop-to-buffer gnus-article-current-summary nil 'norecord) + (pop-to-buffer gnus-article-current-summary + nil (not (featurep 'xemacs))) ;; We disable the pick minor mode commands. (let (gnus-pick-mode) (setq func (lookup-key (current-local-map) keys)))) @@ -5658,14 +5659,16 @@ not have a face in `gnus-article-boring-faces'." (call-interactively func) (setq new-sum-point (point))) (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer nil 'norecord))) + (pop-to-buffer gnus-article-buffer + nil (not (featurep 'xemacs))))) ;; These commands should restore window configuration. (let ((obuf (current-buffer)) (owin (current-window-configuration)) (opoint (point)) win func in-buffer selected new-sum-start new-sum-hscroll) (cond (not-restore-window - (pop-to-buffer gnus-article-current-summary nil 'norecord)) + (pop-to-buffer gnus-article-current-summary + nil (not (featurep 'xemacs)))) ((setq win (get-buffer-window gnus-article-current-summary)) (select-window win)) (t diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index d906cec6c6a..01b320e7186 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -178,8 +178,13 @@ properly with all servers." (defconst gnus-level-unsubscribed 7 "Groups with levels less than or equal to this variable are unsubscribed. -Groups with levels less than `gnus-level-subscribed', which should be -less than this variable, are subscribed.") + +Groups with levels less than `gnus-level-subscribed', which +should be less than this variable, are subscribed. Groups with +levels from `gnus-level-subscribed' (exclusive) upto this +variable (inclusive) are unsubscribed. See also +`gnus-level-zombie', `gnus-level-killed' and the Info node `Group +Levels' for details.") (defconst gnus-level-zombie 8 "Groups with this level are zombie groups.") diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b1b6c8b760b..56c5fffb7e5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10514,7 +10514,8 @@ The number of articles marked as read is returned." (gnus-sorted-nunion (gnus-sorted-intersection gnus-newsgroup-unreads gnus-newsgroup-downloadable) - gnus-newsgroup-unfetched))) + (gnus-sorted-difference gnus-newsgroup-unfetched + gnus-newsgroup-cached)))) ;; We actually mark all articles as canceled, which we ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) diff --git a/man/ChangeLog b/man/ChangeLog index fcbeb4f03f8..131f02f5105 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,19 @@ +2007-07-02 Reiner Steib + + * gnus-faq.texi ([3.2]): Fix locating of environment variables in the + Control Panel. + + * gnus.texi (Misc Article): Add index entry for + gnus-single-article-buffer. + +2007-06-27 Andreas Seltenreich + + * gnus.texi (Starting Up): Fix typo. + +2007-06-25 Katsumi Yamaoka + + * gnus.texi (Asynchronous Fetching): Fix typo. + 2007-06-24 Karl Berry * emacs.texi: new Back-Cover Text. diff --git a/man/gnus-faq.texi b/man/gnus-faq.texi index 093cb4c289b..6bfb3477627 100644 --- a/man/gnus-faq.texi +++ b/man/gnus-faq.texi @@ -427,12 +427,11 @@ SET HOME=C:\myhome @end example @noindent -in your autoexec.bat and reboot. Under NT, 2000 and XP, -hit Winkey+Pause/Break to enter system options (if it -doesn't work, go to Control Panel -> System). There you'll -find the possibility to set environment variables, create -a new one with name HOME and value C:\myhome, a reboot is -not necessary. +in your autoexec.bat and reboot. Under NT, 2000 and XP, hit +Winkey+Pause/Break to enter system options (if it doesn't work, go to +Control Panel -> System -> Advanced). There you'll find the possibility +to set environment variables. Create a new one with name HOME and value +C:\myhome. Rebooting is not necessary. Now to create ~/.gnus.el, say @samp{C-x C-f ~/.gnus.el RET C-x C-s}. diff --git a/man/gnus.texi b/man/gnus.texi index 85167d53432..fe26aa5f662 100644 --- a/man/gnus.texi +++ b/man/gnus.texi @@ -947,8 +947,8 @@ Emacs for Heathens @chapter Starting Gnus @cindex starting up -If you are haven't used Emacs much before using Gnus, read @ref{Emacs -for Heathens} first. +If you haven't used Emacs much before using Gnus, read @ref{Emacs for +Heathens} first. @kindex M-x gnus @findex gnus @@ -7173,12 +7173,12 @@ pre-fetch all the articles it can without bound. If it is @code{nil}, no pre-fetching will be done. @vindex gnus-async-prefetch-article-p -@findex gnus-async-read-p +@findex gnus-async-unread-p There are probably some articles that you don't want to pre-fetch---read articles, for instance. The @code{gnus-async-prefetch-article-p} variable controls whether an article is to be pre-fetched. This function should return non-@code{nil} when the article in question is -to be pre-fetched. The default is @code{gnus-async-read-p}, which +to be pre-fetched. The default is @code{gnus-async-unread-p}, which returns @code{nil} on read articles. The function is called with an article data structure as the only parameter. @@ -11504,6 +11504,7 @@ region. @item gnus-single-article-buffer @vindex gnus-single-article-buffer +@cindex article buffers, several If non-@code{nil}, use the same article buffer for all the groups. (This is the default.) If @code{nil}, each group will have its own article buffer. @@ -13509,14 +13510,18 @@ Header lines longer than the value of @code{nnmail-split-header-length-limit} are excluded from the split function. -@vindex nnmail-mail-splitting-charset @vindex nnmail-mail-splitting-decodes -By default, splitting @acronym{MIME}-decodes headers so you -can match on non-@acronym{ASCII} strings. The -@code{nnmail-mail-splitting-charset} variable specifies the default -charset for decoding. The behavior can be turned off completely by -binding @code{nnmail-mail-splitting-decodes} to @code{nil}, which is -useful if you want to match articles based on the raw header data. +@vindex nnmail-mail-splitting-charset +By default, splitting does not decode headers, so you can not match on +non-@acronym{ASCII} strings. But it is useful if you want to match +articles based on the raw header data. To enable it, set the +@code{nnmail-mail-splitting-decodes} variable to a non-@code{nil} value. +In addition, the value of the @code{nnmail-mail-splitting-charset} +variable is used for decoding non-@acronym{MIME} encoded string when +@code{nnmail-mail-splitting-decodes} is non-@code{nil}. The default +value is @code{nil} which means not to decode non-@acronym{MIME} encoded +string. A suitable value for you will be @code{undecided} or be the +charset used normally in mails you are interested in. @vindex nnmail-resplit-incoming By default, splitting is performed on all incoming messages. If you From 5d27646d21eab1e70b58df3f5e27d87e34b43a89 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Tue, 10 Jul 2007 02:03:14 +0000 Subject: [PATCH 064/163] Changes from arch/CVS synchronization --- lisp/net/tramp-gw.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index d7317f6ae14..78f8040a909 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -320,5 +320,5 @@ password in password cache. This is done for the first try only." ;; * Provide descriptive Commentary. ;; * Enable it for several gateway processes in parallel. -;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 +;; arch-tag: 277e3a81-fdee-40cf-9e6b-59626292a5e0 ;;; tramp-gw.el ends here From ef8878109c47998abea49be9965c757af12cdd64 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 10 Jul 2007 03:49:44 +0000 Subject: [PATCH 065/163] (Vinhibit_changing_match_data, search_regs_1): New vars. (looking_at_1): Don't change search_regs and last_thing_searched if `inhibit-changing-match-data' is non-nil. (string_match_1, search_buffer, set_search_regs): Likewise. (syms_of_search): Add Lisp level definition for `inhibit-changing-match-data' and set it to nil. (boyer_moore): If `inhibit-changing-match-data' is non-nil, compute start and end of the match, instead of using values in search_regs. --- src/ChangeLog | 12 ++++ src/search.c | 179 ++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 143 insertions(+), 48 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index b87b05f8e27..489e68b37be 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2007-07-10 Guanpeng Xu + + * search.c (Vinhibit_changing_match_data, search_regs_1): New vars. + (looking_at_1): Don't change search_regs and last_thing_searched + if `inhibit-changing-match-data' is non-nil. + (string_match_1, search_buffer, set_search_regs): Likewise. + (syms_of_search): Add Lisp level definition for + `inhibit-changing-match-data' and set it to nil. + (boyer_moore): If `inhibit-changing-match-data' is non-nil, + compute start and end of the match, instead of using values in + search_regs. + 2007-07-01 Stefan Monnier * minibuf.c (Fcompleting_read): New value `confirm-only' diff --git a/src/search.c b/src/search.c index c9c6dfdd242..154f6c80e2d 100644 --- a/src/search.c +++ b/src/search.c @@ -92,6 +92,11 @@ Lisp_Object Qsearch_failed; Lisp_Object Vsearch_spaces_regexp; +/* If non-nil, the match data will not be changed during call to + searching or matching functions. This variable is for internal use + only. */ +Lisp_Object Vinhibit_changing_match_data; + static void set_search_regs (); static void save_search_regs (); static int simple_search (); @@ -321,7 +326,9 @@ looking_at_1 (string, posix) = current_buffer->case_eqv_table; CHECK_STRING (string); - bufp = compile_pattern (string, &search_regs, + bufp = compile_pattern (string, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), (!NILP (current_buffer->case_fold_search) ? current_buffer->case_canon_table : Qnil), posix, @@ -352,7 +359,9 @@ looking_at_1 (string, posix) re_match_object = Qnil; i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, - PT_BYTE - BEGV_BYTE, &search_regs, + PT_BYTE - BEGV_BYTE, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), ZV_BYTE - BEGV_BYTE); immediate_quit = 0; @@ -360,7 +369,7 @@ looking_at_1 (string, posix) matcher_overflow (); val = (0 <= i ? Qt : Qnil); - if (i >= 0) + if (NILP (Vinhibit_changing_match_data) && i >= 0) for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { @@ -369,7 +378,11 @@ looking_at_1 (string, posix) search_regs.end[i] = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); } - XSETBUFFER (last_thing_searched, current_buffer); + + /* Set last_thing_searched only when match data is changed. */ + if (NILP (Vinhibit_changing_match_data)) + XSETBUFFER (last_thing_searched, current_buffer); + return val; } @@ -431,7 +444,9 @@ string_match_1 (regexp, string, start, posix) XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] = current_buffer->case_eqv_table; - bufp = compile_pattern (regexp, &search_regs, + bufp = compile_pattern (regexp, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), (!NILP (current_buffer->case_fold_search) ? current_buffer->case_canon_table : Qnil), posix, @@ -442,21 +457,27 @@ string_match_1 (regexp, string, start, posix) val = re_search (bufp, (char *) SDATA (string), SBYTES (string), pos_byte, SBYTES (string) - pos_byte, - &search_regs); + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL)); immediate_quit = 0; - last_thing_searched = Qt; + + /* Set last_thing_searched only when match data is changed. */ + if (NILP (Vinhibit_changing_match_data)) + last_thing_searched = Qt; + if (val == -2) matcher_overflow (); if (val < 0) return Qnil; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = string_byte_to_char (string, search_regs.start[i]); - search_regs.end[i] - = string_byte_to_char (string, search_regs.end[i]); - } + if (NILP (Vinhibit_changing_match_data)) + for (i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = string_byte_to_char (string, search_regs.start[i]); + search_regs.end[i] + = string_byte_to_char (string, search_regs.end[i]); + } return make_number (string_byte_to_char (string, val)); } @@ -1074,6 +1095,11 @@ do \ } \ while (0) +/* Only used in search_buffer, to record the end position of the match + when searching regexps and SEARCH_REGS should not be changed + (i.e. Vinhibit_changing_match_data is non-nil). */ +static struct re_registers search_regs_1; + static int search_buffer (string, pos, pos_byte, lim, lim_byte, n, RE, trt, inverse_trt, posix) @@ -1109,7 +1135,10 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, int s1, s2; struct re_pattern_buffer *bufp; - bufp = compile_pattern (string, &search_regs, trt, posix, + bufp = compile_pattern (string, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : &search_regs_1), + trt, posix, !NILP (current_buffer->enable_multibyte_characters)); immediate_quit = 1; /* Quit immediately if user types ^G, @@ -1142,7 +1171,8 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, int val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, - &search_regs, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : &search_regs_1), /* Don't allow match past current point */ pos_byte - BEGV_BYTE); if (val == -2) @@ -1151,18 +1181,27 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, } if (val >= 0) { - pos_byte = search_regs.start[0] + BEGV_BYTE; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); - search_regs.end[i] - = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); - } - XSETBUFFER (last_thing_searched, current_buffer); - /* Set pos to the new position. */ - pos = search_regs.start[0]; + if (NILP (Vinhibit_changing_match_data)) + { + pos_byte = search_regs.start[0] + BEGV_BYTE; + for (i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); + search_regs.end[i] + = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); + } + XSETBUFFER (last_thing_searched, current_buffer); + /* Set pos to the new position. */ + pos = search_regs.start[0]; + } + else + { + pos_byte = search_regs_1.start[0] + BEGV_BYTE; + /* Set pos to the new position. */ + pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE); + } } else { @@ -1176,7 +1215,8 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, int val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, - &search_regs, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : &search_regs_1), lim_byte - BEGV_BYTE); if (val == -2) { @@ -1184,17 +1224,25 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, } if (val >= 0) { - pos_byte = search_regs.end[0] + BEGV_BYTE; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); - search_regs.end[i] - = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); - } - XSETBUFFER (last_thing_searched, current_buffer); - pos = search_regs.end[0]; + if (NILP (Vinhibit_changing_match_data)) + { + pos_byte = search_regs.end[0] + BEGV_BYTE; + for (i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); + search_regs.end[i] + = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); + } + XSETBUFFER (last_thing_searched, current_buffer); + pos = search_regs.end[0]; + } + else + { + pos_byte = search_regs_1.end[0] + BEGV_BYTE; + pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE); + } } else { @@ -1926,7 +1974,7 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, cursor += dirlen - i - direction; /* fix cursor */ if (i + direction == 0) { - int position; + int position, start, end; cursor -= direction; @@ -1934,11 +1982,24 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, ? 1 - len_byte : 0); set_search_regs (position, len_byte); + if (NILP (Vinhibit_changing_match_data)) + { + start = search_regs.start[0]; + end = search_regs.end[0]; + } + else + /* If Vinhibit_changing_match_data is non-nil, + search_regs will not be changed. So let's + compute start and end here. */ + { + start = BYTE_TO_CHAR (position); + end = BYTE_TO_CHAR (position + len_byte); + } + if ((n -= direction) != 0) cursor += dirlen; /* to resume search */ else - return ((direction > 0) - ? search_regs.end[0] : search_regs.start[0]); + return direction > 0 ? end : start; } else cursor += stride_for_teases; /* we lose - */ @@ -2003,18 +2064,30 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, pos_byte += dirlen - i- direction; if (i + direction == 0) { - int position; + int position, start, end; pos_byte -= direction; position = pos_byte + ((direction > 0) ? 1 - len_byte : 0); - set_search_regs (position, len_byte); + if (NILP (Vinhibit_changing_match_data)) + { + start = search_regs.start[0]; + end = search_regs.end[0]; + } + else + /* If Vinhibit_changing_match_data is non-nil, + search_regs will not be changed. So let's + compute start and end here. */ + { + start = BYTE_TO_CHAR (position); + end = BYTE_TO_CHAR (position + len_byte); + } + if ((n -= direction) != 0) pos_byte += dirlen; /* to resume search */ else - return ((direction > 0) - ? search_regs.end[0] : search_regs.start[0]); + return direction > 0 ? end : start; } else pos_byte += stride_for_teases; @@ -2037,6 +2110,9 @@ set_search_regs (beg_byte, nbytes) { int i; + if (!NILP (Vinhibit_changing_match_data)) + return; + /* Make sure we have registers in which to store the match position. */ if (search_regs.num_regs == 0) @@ -3167,6 +3243,13 @@ or other such regexp constructs are not replaced with this. A value of nil (which is the normal value) means treat spaces literally. */); Vsearch_spaces_regexp = Qnil; + DEFVAR_LISP ("inhibit-changing-match-data", &Vinhibit_changing_match_data, + doc: /* Internal use only. +If non-nil, the match data will not be changed during call to searching or +matching functions, such as `looking-at', `string-match', `re-search-forward' +etc. */); + Vinhibit_changing_match_data = Qnil; + defsubr (&Slooking_at); defsubr (&Sposix_looking_at); defsubr (&Sstring_match); From 45595a4fae2dd3c322bd8991dcc2bdc42dcb00bc Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 10 Jul 2007 03:54:30 +0000 Subject: [PATCH 066/163] (looking-at-p, string-match-p): New functions. --- etc/NEWS | 3 +++ lisp/ChangeLog | 22 +++++++++++++--------- lisp/subr.el | 12 ++++++++++++ 3 files changed, 28 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 290fe0f6c7b..4323f6ff1cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -131,6 +131,9 @@ but obeys file handlers. The file handler is chosen based on With this paramter passed non-nil, it is checked whether a remote connection has been established already. +** The two new functions `looking-at-p' and `string-match-p' can do +the same matching as `looking-at' and `string-match' without changing +the match data. * New Packages for Lisp Programming in Emacs 23.1 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 58cfca107cb..4a95fd8d96d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,13 +1,6 @@ -2007-07-08 Katsumi Yamaoka +2007-07-10 Guanpeng Xu - * cus-start.el (file-coding-system-alist): Fix custom type. - -2007-07-08 Chong Yidong - - * longlines.el (longlines-wrap-region): Avoid marking buffer as - modified. - (longlines-auto-wrap, longlines-window-change-function): Remove - unnecessary calls to set-buffer-modified-p. + * subr.el (looking-at-p, string-match-p): New functions. 2007-07-09 Reiner Steib @@ -31,6 +24,17 @@ * cus-start.el (file-coding-system-alist): Fix custom type. +2007-07-08 Chong Yidong + + * longlines.el (longlines-wrap-region): Avoid marking buffer as + modified. + (longlines-auto-wrap, longlines-window-change-function): Remove + unnecessary calls to set-buffer-modified-p. + +2007-07-08 Katsumi Yamaoka + + * cus-start.el (file-coding-system-alist): Fix custom type. + 2007-07-08 Stefan Monnier * vc-cvs.el (vc-cvs-revert): Use vc-default-revert. diff --git a/lisp/subr.el b/lisp/subr.el index f890caf66e4..3804624b0b9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2668,6 +2668,18 @@ of a match for REGEXP." (looking-at (concat "\\(?:" regexp "\\)\\'"))))) (not (null pos)))) +(defsubst looking-at-p (regexp) + "\ +Same as `looking-at' except this function does not change the match data." + (let ((inhibit-changing-match-data t)) + (looking-at regexp))) + +(defsubst string-match-p (regexp string &optional start) + "\ +Same as `string-match' except this function does not change the match data." + (let ((inhibit-changing-match-data t)) + (string-match regexp string start))) + (defun subregexp-context-p (regexp pos &optional start) "Return non-nil if POS is in a normal subregexp context in REGEXP. A subregexp context is one where a sub-regexp can appear. From f3850a5f263bb4c661683951d435f3fadba7643e Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 10 Jul 2007 07:22:39 +0000 Subject: [PATCH 067/163] *** empty log message *** --- lisp/ChangeLog | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4a95fd8d96d..59d6c7fa57e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,52 @@ +2007-07-10 Carsten Dominik + + * textmodes/org.el (org-agenda-day-view, org-agenda-week-view): + Remember span as default. + (org-columns-edit-value): Renamed from `org-column-edit'. + (org-columns-display-here-title): Renamed from + `org-overlay-columns-title'. + (org-columns-remove-overlays): ` Renamed from + org-remove-column-overlays'. + (org-columns-get-autowidth-alist): ` Renamed from + org-get-columns-autowidth-alist'. + (org-columns-display-here): Renamed from `org-overlay-columns'. + (org-columns-new-overlay): Renamed from `org-new-column-overlay'. + (org-columns-quit): Renamed from `org-column-quit'. + (org-columns-show-value): Renamed from `org-column-show-value'. + (org-columns-content, org-columns-widen) + (org-columns-next-allowed-value) + (org-columns-edit-allowed, org-columns-store-format) + (org-columns-uncompile-format, org-columns-redo) + (org-columns-edit-attributes, org-delete-property) + (org-set-property, org-columns-update) + (org-columns-compute, org-columns-eval) + (org-columns-not-in-agenda, org-columns-compute-all) + (org-property-next-allowed-value) + (org-columns-compile-format) + (org-fill-paragraph-experimental) + (org-string-to-number, org-property-action) + (org-columns-move-left, org-columns-new ) + (org-column-number-to-string) + (org-property-previous-allowed-value) + (org-at-property-p, org-columns-delete) + (org-columns-previous-allowed-value) + (org-columns-move-right, org-columns-narrow) + (org-property-get-allowed-values) + (org-verify-version, org-column-string-to-number) + (org-delete-property-globally): New functions. + (org-columns-current-fmt): Renamed from `org-current-columns-fmt'. + (org-columns-overlays): Renamed from `org-column-overlays'. + (org-columns-map): Renamed from `org-column-map'. + (org-columns-current-maxwidths): Renamed from + `org-current-columns-maxwidths'. + (org-columns-begin-marker, org-columns-current-fmt-compiled) + (org-previous-header-line-format) + (org-columns-inhibit-recalculation) + (org-columns-top-level-marker): New variables. + (org-columns-default-format): Renamed from + `org-default-columns-format'. + (org-property-re): New constant. + 2007-07-10 Guanpeng Xu * subr.el (looking-at-p, string-match-p): New functions. From 7d58338ef2bdcaaf3ff94f7472d01a49c65a232d Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 10 Jul 2007 07:24:08 +0000 Subject: [PATCH 068/163] * org.el (org-agenda-day-view, org-agenda-week-view): Remember span as default. (org-columns-edit-value): Renamed from `org-column-edit'. (org-columns-display-here-title): Renamed from `org-overlay-columns-title'. (org-columns-remove-overlays): ` Renamed from org-remove-column-overlays'. (org-columns-get-autowidth-alist): ` Renamed from org-get-columns-autowidth-alist'. (org-columns-display-here): Renamed from `org-overlay-columns'. (org-columns-new-overlay): Renamed from `org-new-column-overlay'. (org-columns-quit): Renamed from `org-column-quit'. (org-columns-show-value): Renamed from `org-column-show-value'. (org-columns-content, org-columns-widen) (org-columns-next-allowed-value) (org-columns-edit-allowed, org-columns-store-format) (org-columns-uncompile-format, org-columns-redo) (org-columns-edit-attributes, org-delete-property) (org-set-property, org-columns-update) (org-columns-compute, org-columns-eval) (org-columns-not-in-agenda, org-columns-compute-all) (org-property-next-allowed-value) (org-columns-compile-format) (org-fill-paragraph-experimental) (org-string-to-number, org-property-action) (org-columns-move-left, org-columns-new ) (org-column-number-to-string) (org-property-previous-allowed-value) (org-at-property-p, org-columns-delete) (org-columns-previous-allowed-value) (org-columns-move-right, org-columns-narrow) (org-property-get-allowed-values) (org-verify-version, org-column-string-to-number) (org-delete-property-globally): New functions. (org-columns-current-fmt): Renamed from `org-current-columns-fmt'. (org-columns-overlays): Renamed from `org-column-overlays'. (org-columns-map): Renamed from `org-column-map'. (org-columns-current-maxwidths): Renamed from `org-current-columns-maxwidths'. (org-columns-begin-marker, org-columns-current-fmt-compiled) (org-previous-header-line-format) (org-columns-inhibit-recalculation) (org-columns-top-level-marker): New variables. (org-columns-default-format): Renamed from `org-default-columns-format'. (org-property-re): New constant. --- lisp/textmodes/org.el | 1111 ++++++++++++++++++++++++++++++++--------- man/ChangeLog | 4 + 2 files changed, 867 insertions(+), 248 deletions(-) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 244f9bb0bce..0a7bfc7db0c 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 5.01 +;; Version: 5.02 ;; ;; This file is part of GNU Emacs. ;; @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "5.01" +(defconst org-version "5.02" "The version number of the file org.el.") (defun org-version () (interactive) @@ -1763,7 +1763,7 @@ lined-up with respect to each other." :group 'org-properties :type 'string) -(defcustom org-default-columns-format "%25ITEM %TODO %3PRIORITY %TAGS" +(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" "The default column format, if no other format has been defined. This variable can be set on the per-file basis by inserting a line @@ -3244,6 +3244,12 @@ color of the frame." "Face for column display of entry properties." :group 'org-faces) +(when (fboundp 'set-face-attribute) + ;; Make sure that a fixed-width face is used when we have a column table. + (set-face-attribute 'org-column nil + :height (face-attribute 'default :height) + :family (face-attribute 'default :family))) + (defface org-warning ;; font-lock-warning-face (org-compatible-face '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) @@ -3573,7 +3579,7 @@ means to push this value onto the list in the variable.") ((equal key "TAGS") (setq tags (append tags (org-split-string value splitre)))) ((equal key "COLUMNS") - (org-set-local 'org-default-columns-format value)) + (org-set-local 'org-columns-default-format value)) ((equal key "LINK") (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) (push (cons (match-string 1 value) @@ -3678,15 +3684,15 @@ means to push this value onto the list in the variable.") (mapconcat 'regexp-quote org-not-done-keywords "\\|") "\\)\\>") org-todo-line-regexp - (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" + (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") "\\)\\>\\)? *\\(.*\\)") org-nl-done-regexp - (concat "[\r\n]\\*+[ \t]+" + (concat "\n\\*+[ \t]+" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" "\\>") org-todo-line-tags-regexp - (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" + (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) @@ -3982,7 +3988,7 @@ The following commands are available: (org-add-to-invisibility-spec '(org-cwidth)) (when (featurep 'xemacs) (org-set-local 'line-move-ignore-invisible t)) - (setq outline-regexp "\\*+") + (setq outline-regexp "\\*+ ") (setq outline-level 'org-outline-level) (when (and org-ellipsis (stringp org-ellipsis) (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)) @@ -4412,17 +4418,20 @@ between words." (looking-at outline-regexp) (if (match-beginning 1) (+ (org-get-string-indentation (match-string 1)) 1000) - (- (match-end 0) (match-beginning 0))))) + (1- (- (match-end 0) (match-beginning 0)))))) (defvar org-font-lock-keywords nil) +(defconst org-property-re "^[ \t]*\\(:\\([a-zA-Z_0-9]+\\):\\)[ \t]*\\(\\S-.*\\)" + "Regular expression matching a property line.") + (defun org-set-font-lock-defaults () (let* ((em org-fontify-emphasized-text) (lk org-activate-links) (org-font-lock-extra-keywords ;; Headlines (list - '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) + '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table)) @@ -4436,7 +4445,7 @@ between words." '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) '(org-hide-wide-columns (0 nil append)) ;; TODO lines - (list (concat "^\\*+[ \t]*" org-not-done-regexp) + (list (concat "^\\*+[ \t]+" org-not-done-regexp) '(1 'org-todo t)) ;; Priorities (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) @@ -4458,7 +4467,7 @@ between words." '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; COMMENT - (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string + (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) @@ -4475,14 +4484,18 @@ between words." ;; Table stuff '("^[ \t]*\\(:.*\\)" (1 'org-table t)) '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) - '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) +; '("^[ \t]*| *\\([#!$*_^/]\\) *|" (1 'org-formula t)) + '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) + '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) ;; Drawers - (list org-drawer-regexp '(0 'org-drawer t)) - (list "^[ \t]*:END:" '(0 'org-drawer t)) +; (list org-drawer-regexp '(0 'org-drawer t)) +; (list "^[ \t]*:END:" '(0 'org-drawer t)) + (list org-drawer-regexp '(0 'org-special-keyword t)) + (list "^[ \t]*:END:" '(0 'org-special-keyword t)) ;; Properties - '("^[ \t]*\\(:[a-zA-Z0-9]+:\\)[ \t]*\\(\\S-.*\\)" - (1 'org-special-keyword t) (2 'org-property-value t)) -;FIXME (1 'org-tag t) (2 'org-property-value t)) + (list org-property-re + '(1 'org-special-keyword t) + '(3 'org-property-value t)) (if org-format-transports-properties-p '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) @@ -4499,7 +4512,7 @@ between words." (defvar org-f nil) (defun org-get-level-face (n) "Get the right face for match N in font-lock matching of healdines." - (setq org-l (- (match-end 2) (match-beginning 1))) + (setq org-l (- (match-end 2) (match-beginning 1) 1)) (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces)) (cond @@ -4559,7 +4572,7 @@ between words." (interactive "P") (let* ((outline-regexp (if (and (org-mode-p) org-cycle-include-plain-lists) - "\\(?:\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" + "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" outline-regexp)) (bob-special (and org-cycle-global-at-bob (bobp) (not (looking-at outline-regexp)))) @@ -5175,8 +5188,8 @@ If the region is active in `transient-mark-mode', promote all headings in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) - (up-head (make-string (org-get-legal-level level -1) ?*)) - (diff (abs (- level (length up-head))))) + (up-head (concat (make-string (org-get-legal-level level -1) ?*) " ")) + (diff (abs (- level (length up-head) -1)))) (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) (replace-match up-head nil t) ;; Fixup tag positioning @@ -5189,8 +5202,8 @@ If the region is active in `transient-mark-mode', demote all headings in the region." (org-back-to-heading t) (let* ((level (save-match-data (funcall outline-level))) - (down-head (make-string (org-get-legal-level level 1) ?*)) - (diff (abs (- level (length down-head))))) + (down-head (concat (make-string (org-get-legal-level level 1) ?*) " ")) + (diff (abs (- level (length down-head) -1)))) (replace-match down-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) @@ -5251,8 +5264,8 @@ level 5 etc." (let ((org-odd-levels-only nil) n) (save-excursion (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+" nil t) - (setq n (1- (length (match-string 0)))) + (while (re-search-forward "^\\*\\*+ " nil t) + (setq n (- (length (match-string 0)) 2)) (while (>= (setq n (1- n)) 0) (org-demote)) (end-of-line 1)))))) @@ -5266,15 +5279,15 @@ is signaled in this case." (interactive) (goto-char (point-min)) ;; First check if there are no even levels - (when (re-search-forward "^\\(\\*\\*\\)+[^*]" nil t) + (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) (org-show-context t) (error "Not all levels are odd in this file. Conversion not possible.")) (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") (let ((org-odd-levels-only nil) n) (save-excursion (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+" nil t) - (setq n (/ (length (match-string 0)) 2)) + (while (re-search-forward "^\\*\\*+ " nil t) + (setq n (/ (length (1- (match-string 0))) 2)) (while (>= (setq n (1- n)) 0) (org-promote)) (end-of-line 1)))))) @@ -6285,6 +6298,8 @@ C-c C-c Set tags / toggle checkbox" '([(meta shift down)] org-shiftmetadown) '([(meta shift left)] org-shiftmetaleft) '([(meta shift right)] org-shiftmetaright) + '([(shift up)] org-shiftup) + '([(shift down)] org-shiftdown) '("\M-q" fill-paragraph) '("\C-c^" org-sort) '("\C-c-" org-cycle-list-bullet))) @@ -6466,8 +6481,7 @@ this heading." (if heading (progn (if (re-search-forward - (concat "\\(^\\|\r\\)" - (regexp-quote heading) + (concat "^" (regexp-quote heading) (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) nil t) (goto-char (match-end 0)) @@ -7723,7 +7737,7 @@ should be done in reverse order." (setq beg (point-at-bol 1))) (goto-char pos) (if (re-search-forward org-table-hline-regexp tend t) - (setq end (point-at-bol 0)) + (setq end (point-at-bol 1)) (goto-char tend) (setq end (point-at-bol)))) (setq beg (move-marker (make-marker) beg) @@ -11015,12 +11029,14 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (switch-to-buffer-other-window (org-get-buffer-for-internal-link (current-buffer))) (org-mark-ring-push)) - (org-link-search - path - (cond ((equal in-emacs '(4)) 'occur) - ((equal in-emacs '(16)) 'org-occur) - (t nil)) - pos)) + (let ((cmd `(org-link-search + ,path + ,(cond ((equal in-emacs '(4)) 'occur) + ((equal in-emacs '(16)) 'org-occur) + (t nil)) + ,pos))) + (condition-case nil (eval cmd) + (error (progn (widen) (eval cmd)))))) ((string= type "tree-match") (org-occur (concat "\\[" (regexp-quote path) "\\]"))) @@ -11170,7 +11186,7 @@ in all files. If AVOID-POS is given, ignore matches near that position." (let ((case-fold-search t) (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) - (append '((" ") ("\t") ("\n")) + (append '(("") (" ") ("\t") ("\n")) org-emphasis-alist) "\\|") "\\)")) (pos (point)) @@ -11197,10 +11213,10 @@ in all files. If AVOID-POS is given, ignore matches near that position." ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) (t (org-do-occur (match-string 1 s))))) (t - ;; A normal search string + ;; A normal search strings (when (equal (string-to-char s) ?*) ;; Anchor on headlines, post may include tags. - (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*" + (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") s (substring s 1))) (remove-text-properties @@ -11707,6 +11723,7 @@ If the file does not exist, an error is thrown." ((or (stringp cmd) (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) + (widen) (if line (goto-line line) (if search (org-link-search search)))) ((consp cmd) @@ -11842,14 +11859,18 @@ to be run from that hook to fucntion properly." (let* ((org-last-tags-completion-table (org-global-tags-completion-table (if (equal char "G") (org-agenda-files) (and file (list file))))) + (org-add-colon-after-tag-completion t) (ins (completing-read (if prompt (concat prompt ": ") "Tags: ") 'org-tags-completion-function nil nil nil 'org-tags-history))) - (insert (concat ":" (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]]+")) - ":") - ":")))) + (setq ins (mapconcat 'identity + (org-split-string ins (org-re "[^[:alnum:]]+")) + ":")) + (when (string-match "\\S-" ins) + (or (equal (char-before) ?:) (insert ":")) + (insert ins) + (or (equal (char-after) ?:) (insert ":"))))) (char (setq org-time-was-given (equal (upcase char) char)) (setq time (org-read-date (equal (upcase char) "U") t nil @@ -11939,7 +11960,7 @@ See also the variable `org-reverse-note-order'." (let* ((lines (split-string txt "\n")) first) (setq first (car lines) lines (cdr lines)) - (if (string-match "^\\*+" first) + (if (string-match "^\\*+ " first) ;; Is already a headline (setq indent nil) ;; We need to add a headline: Use time and first buffer line @@ -11990,7 +12011,7 @@ See also the variable `org-reverse-note-order'." (save-restriction (widen) (goto-char (point-min)) - (re-search-forward "^\\*" nil t) + (re-search-forward "^\\*+ " nil t) (beginning-of-line 1) (org-paste-subtree 1 txt))) ((and (org-on-heading-p t) (not current-prefix-arg)) @@ -12197,7 +12218,7 @@ At all other locations, this simply calls `ispell-complete-word'." (texp (setq type :tex) org-html-entities) - ((string-match "\\`\\*+[ \t]*\\'" + ((string-match "\\`\\*+[ \t]+\\'" (buffer-substring (point-at-bol) beg)) (setq type :todo) (mapcar 'list org-todo-keywords-1)) @@ -12258,12 +12279,12 @@ At all other locations, this simply calls `ispell-complete-word'." (save-excursion (org-back-to-heading) (if (looking-at (concat outline-regexp - "\\( +\\<" org-comment-string "\\>\\)")) + "\\( *\\<" org-comment-string "\\>\\)")) (replace-match "" t t nil 1) (if (looking-at outline-regexp) (progn (goto-char (match-end 0)) - (insert " " org-comment-string)))))) + (insert org-comment-string " ")))))) (defvar org-last-todo-state-is-todo nil "This is non-nil when the last TODO state change led to a TODO state. @@ -12297,7 +12318,7 @@ For calling through lisp, arg is also interpreted in the following way: (interactive "P") (save-excursion (org-back-to-heading) - (if (looking-at outline-regexp) (goto-char (match-end 0))) + (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) (or (looking-at (concat " +" org-todo-regexp " *")) (looking-at " *")) (let* ((this (match-string 1)) @@ -12490,7 +12511,7 @@ of `org-todo-keywords-1'." org-todo-keywords-1))) (t (error "Invalid prefix argument: %s" arg))))) (message "%d TODO entries found" - (org-occur (concat "^" outline-regexp " +" kwd-re ))))) + (org-occur (concat "^" outline-regexp " *" kwd-re ))))) (defun org-deadline () "Insert the DEADLINE: string to make a deadline. @@ -13139,11 +13160,12 @@ With prefix ARG, realign all tags in headings in the current buffer." ;; try completion (setq rtn (try-completion s2 ctable confirm)) (if (stringp rtn) - (concat s1 s2 (substring rtn (length s2)) - (if (and org-add-colon-after-tag-completion - (assoc rtn ctable)) - ":" ""))) - ) + (setq rtn + (concat s1 s2 (substring rtn (length s2)) + (if (and org-add-colon-after-tag-completion + (assoc rtn ctable)) + ":" "")))) + rtn) ((eq flag t) ;; all-completions (all-completions s2 ctable confirm) @@ -13202,7 +13224,7 @@ Returns the new tags string, or nil to not change the current settings." (save-excursion (beginning-of-line 1) (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) + (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -13358,7 +13380,7 @@ Returns the new tags string, or nil to not change the current settings." (error "Not on a heading")) (save-excursion (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) + (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) (org-match-string-no-properties 1) ""))) @@ -13393,6 +13415,32 @@ but in some other way.") (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" "Regular expression matching the first line of a property drawer.") +(defun org-property-action () + "Do an action on properties." + (interactive) + (let (c prop) + (org-at-property-p) + (setq prop (match-string 2)) + (message "Property Action: [s]et [d]elete [D]delete globally") + (setq c (read-char-exclusive)) + (cond + ((equal c ?s) + (call-interactively 'org-set-property)) + ((equal c ?d) + (call-interactively 'org-delete-property)) + ((equal c ?D) + (call-interactively 'org-delete-property-globally)) + (t (error "No such property action %c" c))))) + +(defun org-at-property-p () + "Is the cursor in a property line?" + ;; FIXME: Does not check if we are actually in the drawer. + ;; FIXME: also returns true on any drawers..... + ;; This is used by C-c C-c for property action. + (save-excursion + (beginning-of-line 1) + (looking-at "^[ \t]*\\(:\\([a-zA-Z_0-9]+\\):\\)[ \t]*\\(.*\\)"))) + (defmacro org-with-point-at (pom &rest body) "Move to buffer and point of point-or-marker POM for the duration of BODY." (declare (indent 1) (debug t)) @@ -13406,7 +13454,7 @@ but in some other way.") "Return the (beg . end) range of the body of the property drawer. BEG and END can be beginning and end of subtree, if not given they will be found. -If the drawer does not exist and FORCE is non-nil, greater the drawer." +If the drawer does not exist and FORCE is non-nil, create the drawer." (catch 'exit (save-excursion (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) @@ -13414,18 +13462,14 @@ If the drawer does not exist and FORCE is non-nil, greater the drawer." (goto-char beg) (if (re-search-forward org-property-start-re end t) (setq beg (1+ (match-end 0))) - (or force (throw 'exit nil)) - (beginning-of-line 2) - (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) - (not (equal (match-string 1) org-clock-string))) - (beginning-of-line 2)) - (insert ":PROPERTIES:\n:END:\n") - (beginning-of-line -1) - (org-indent-line-function) - (setq beg (1+ (point-at-eol)) end beg) - (beginning-of-line 2) - (org-indent-line-function) - (throw 'exit (cons beg end))) + (if force + (save-excursion + (org-insert-property-drawer) + (setq end (progn (outline-next-heading) (point)))) + (throw 'exit nil)) + (goto-char beg) + (if (re-search-forward org-property-start-re end t) + (setq beg (1+ (match-end 0))))) (if (re-search-forward org-property-end-re end t) (setq end (match-beginning 0)) (or force (throw 'exit nil)) @@ -13448,10 +13492,11 @@ If WHICH is nil or `all', get all properties. If WHICH is (org-with-point-at pom (let ((clockstr (substring org-clock-string 0 -1)) (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) - beg end range props key value) + beg end range props sum-props key value) (save-excursion (when (condition-case nil (org-back-to-heading t) (error nil)) (setq beg (point)) + (setq sum-props (get-text-property (point) 'org-summaries)) (outline-next-heading) (setq end (point)) (when (memq which '(all special)) @@ -13483,18 +13528,20 @@ If WHICH is nil or `all', get all properties. If WHICH is (when range (goto-char (car range)) (while (re-search-forward - "^[ \t]*:\\([a-zA-Z][a-zA-Z0-9]*\\):[ \t]*\\(\\S-.*\\S-\\)" + "^[ \t]*:\\([a-zA-Z][a-zA-Z_0-9]*\\):[ \t]*\\(\\S-.*\\)?" (cdr range) t) (setq key (org-match-string-no-properties 1) - value (org-match-string-no-properties 2)) + value (org-trim (or (org-match-string-no-properties 2) ""))) (unless (member key excluded) - (push (cons key value) props))))) - (nreverse props)))))) + (push (cons key (or value "")) props))))) + (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit) "Get value of PROPERTY for entry at point-or-marker POM. If INHERIT is non-nil and the entry does not have the property, -then also check higher levels of the hierarchy." +then also check higher levels of the hierarchy. +If the property is present but empty, the return value is the empty string. +If the property is not present at all, nil is returned." (org-with-point-at pom (if inherit (org-entry-get-with-inheritance property) @@ -13505,10 +13552,12 @@ then also check higher levels of the hierarchy." (if (and range (goto-char (car range)) (re-search-forward - (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") + (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)?") (cdr range) t)) ;; Found the property, return it. - (org-match-string-no-properties 1))))))) + (if (match-end 1) + (org-match-string-no-properties 1) + ""))))))) (defun org-entry-delete (pom property) "Delete the property PROPERTY from entry at point-or-marker POM." @@ -13521,7 +13570,10 @@ then also check higher levels of the hierarchy." (re-search-forward (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") (cdr range) t)) - (delete-region (match-beginning 0) (1+ (point-at-eol)))))))) + (progn + (delete-region (match-beginning 0) (1+ (point-at-eol))) + t) + nil))))) (defvar org-entry-property-inherited-from (make-marker)) @@ -13575,7 +13627,8 @@ then also check higher levels of the hierarchy." (backward-char 1) (org-indent-line-function) (insert ":" property ":")) - (and value (insert " " value))))))) + (and value (insert " " value)) + (org-indent-line-function)))))) (defun org-buffer-property-keys (&optional include-specials) "Get all property keys in the current buffer." @@ -13594,56 +13647,195 @@ then also check higher levels of the hierarchy." (setq rtn (append org-special-properties rtn))) (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) -;; FIXME: This should automatically find the right place int he entry. -;; And then org-entry-put should use it. (defun org-insert-property-drawer () - "Insert a property drawer at point." + "Insert a property drawer into the current entry." (interactive) - (beginning-of-line 1) - (insert ":PROPERTIES:\n:END:\n") - (beginning-of-line -1) - (org-indent-line-function) - (beginning-of-line 2) - (org-indent-line-function) - (end-of-line 0)) + (org-back-to-heading t) + (let ((beg (point)) + (re (concat "^[ \t]*" org-keyword-time-regexp)) + end hiddenp) + (outline-next-heading) + (setq end (point)) + (goto-char beg) + (while (re-search-forward re end t)) + (setq hiddenp (org-invisible-p)) + (end-of-line 1) + (insert "\n:PROPERTIES:\n:END:") + (beginning-of-line 0) + (org-indent-line-function) + (beginning-of-line 2) + (org-indent-line-function) + (beginning-of-line 0) + (if hiddenp + (save-excursion + (org-back-to-heading t) + (hide-entry)) + (org-flag-drawer t)))) -(defvar org-column-overlays nil +(defun org-set-property (property value) + "In the current entry, set PROPERTY to VALUE." + (interactive + (let* ((prop (completing-read "Property: " + (mapcar 'list (org-buffer-property-keys)))) + (cur (org-entry-get nil prop)) + (allowed (org-property-get-allowed-values nil prop 'table)) + (val (if allowed + (completing-read "Value: " allowed nil 'req-match) + (read-string + (concat "Value" (if (and cur (string-match "\\S-" cur)) + (concat "[" cur "]") "") + ": ") + "" cur)))) + (list prop (if (equal val "") cur val)))) + (unless (equal (org-entry-get nil property) value) + (org-entry-put nil property value))) + +(defun org-delete-property (property) + "In the current entry, delete PROPERTY." + (interactive + (let* ((prop (completing-read + "Property: " (org-entry-properties nil 'standard)))) + (list prop))) + (message (concat "Property " property + (if (org-entry-delete nil property) + " deleted" + " was not present in the entry")))) + +(defun org-delete-property-globally (property) + "Remove PROPERTY globally, from all entries." + (interactive + (let* ((prop (completing-read + "Globally remove property: " + (mapcar 'list (org-buffer-property-keys))))) + (list prop))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((cnt 0)) + (while (re-search-forward + (concat "^[ \t]*:" (regexp-quote property) ":.*\n?") + nil t) + (setq cnt (1+ cnt)) + (replace-match "")) + (message "Property \"%s\" removed from %d entries" property cnt))))) + +(defun org-property-get-allowed-values (pom property &optional table) + "Get allowed values for the property PROPERTY. +When TABLE is non-nil, return an alist that can directly be used for +completion." + (let (vals) + (cond + ((equal property "TODO") + (setq vals (org-with-point-at pom + (append org-todo-keywords-1 '(""))))) + ((equal property "PRIORITY") + (let ((n org-lowest-priority)) + (while (>= n org-highest-priority) + (push (char-to-string n) vals) + (setq n (1- n))))) + ((member property org-special-properties)) + (t + (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) + (when (and vals (string-match "\\S-" vals)) + (setq vals (car (read-from-string (concat "(" vals ")")))) + (setq vals (mapcar (lambda (x) + (cond ((stringp x) x) + ((numberp x) (number-to-string x)) + ((symbolp x) (symbol-name x)) + (t "???"))) + vals))))) + (if table (mapcar 'list vals) vals))) + +;;; Column View + +(defvar org-columns-overlays nil "Holds the list of current column overlays.") -(defvar org-current-columns-fmt nil - "Loval variable, holds the currently active column format.") -(defvar org-current-columns-maxwidths nil +(defvar org-columns-current-fmt nil + "Local variable, holds the currently active column format.") +(defvar org-columns-current-fmt-compiled nil + "Local variable, holds the currently active column format. +This is the compiled version of the format.") +(defvar org-columns-current-maxwidths nil "Loval variable, holds the currently active maximum column widths.") +(defvar org-columns-begin-marker (make-marker) + "Points to the position where last a column creation command was called.") +(defvar org-columns-top-level-marker (make-marker) + "Points to the position where current columns region starts.") -(defvar org-column-map (make-sparse-keymap) +(defvar org-columns-map (make-sparse-keymap) "The keymap valid in column display.") -(define-key org-column-map "e" 'org-column-edit) -(define-key org-column-map "v" 'org-column-show-value) -(define-key org-column-map "q" 'org-column-quit) -(define-key org-column-map [left] 'backward-char) -(define-key org-column-map [right] 'forward-char) +(defun org-columns-content () + "Switch to contents view while in columns view." + (interactive) + (org-overview) + (org-content)) -(easy-menu-define org-column-menu org-column-map "Org Column Menu" +(org-defkey org-columns-map "c" 'org-columns-content) +(org-defkey org-columns-map "o" 'org-overview) +(org-defkey org-columns-map "e" 'org-columns-edit-value) +(org-defkey org-columns-map "v" 'org-columns-show-value) +(org-defkey org-columns-map "q" 'org-columns-quit) +(org-defkey org-columns-map "r" 'org-columns-redo) +(org-defkey org-columns-map [left] 'backward-char) +(org-defkey org-columns-map "a" 'org-columns-edit-allowed) +(org-defkey org-columns-map "s" 'org-columns-edit-attributes) +(org-defkey org-columns-map [right] 'forward-char) +(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) +(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value) +(org-defkey org-columns-map "n" 'org-columns-next-allowed-value) +(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) +(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value) +(org-defkey org-columns-map "<" 'org-columns-narrow) +(org-defkey org-columns-map ">" 'org-columns-widen) +(org-defkey org-columns-map [(meta right)] 'org-columns-move-right) +(org-defkey org-columns-map [(meta left)] 'org-columns-move-left) +(org-defkey org-columns-map [(shift meta right)] 'org-columns-new) +(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete) + +(easy-menu-define org-columns-menu org-columns-map "Org Column Menu" '("Column" - ["Edit property" org-column-edit t] - ["Show full value" org-column-show-value t] - ["Quit" org-column-quit t])) + ["Edit property" org-columns-edit-value t] + ["Next allowed value" org-columns-next-allowed-value t] + ["Previous allowed value" org-columns-previous-allowed-value t] + ["Show full value" org-columns-show-value t] + ["Edit allowed" org-columns-edit-allowed t] + "--" + ["Edit column attributes" org-columns-edit-attributes t] + ["Increase column width" org-columns-widen t] + ["Decrease column width" org-columns-narrow t] + "--" + ["Move column right" org-columns-move-right t] + ["Move column left" org-columns-move-left t] + ["Add column" org-columns-new t] + ["Delete column" org-columns-delete t] + "--" + ["CONTENTS" org-columns-content t] + ["OVERVIEW" org-overview t] + ["Refresh columns display" org-columns-redo t] + "--" + ["Quit" org-columns-quit t])) -(defun org-new-column-overlay (beg end &optional string face) - "Create a new column overlay an add it to the list." +(defun org-columns-new-overlay (beg end &optional string face) + "Create a new column overlay and add it to the list." (let ((ov (org-make-overlay beg end))) (org-overlay-put ov 'face (or face 'secondary-selection)) (org-overlay-display ov string face) - (push ov org-column-overlays) + (push ov org-columns-overlays) ov)) -(defun org-overlay-columns (&optional props) +(defun org-columns-display-here (&optional props) "Overlay the current line with column display." (interactive) - (let ((fmt (copy-sequence org-current-columns-fmt)) - (beg (point-at-bol)) - (start 0) props pom property ass width f string ov) + (let* ((fmt org-columns-current-fmt-compiled) + (beg (point-at-bol)) + (color (list :foreground + (face-attribute + (or (get-text-property beg 'face) 'default) + :foreground))) + props pom property ass width f string ov column) ;; Check if the entry is in another buffer. (unless props (if (eq major-mode 'org-agenda-mode) @@ -13651,11 +13843,9 @@ then also check higher levels of the hierarchy." (get-text-property (point) 'org-marker)) props (if pom (org-entry-properties pom) nil)) (setq props (org-entry-properties nil)))) - ;; Parse the format - (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" - fmt start) - (setq start (match-end 0) - property (match-string 2 fmt) + ;; Walk the format + (while (setq column (pop fmt)) + (setq property (car column) ass (if (equal property "ITEM") (cons "ITEM" (save-match-data @@ -13664,17 +13854,21 @@ then also check higher levels of the hierarchy." (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) (assoc property props)) - width (or (cdr (assoc property org-current-columns-maxwidths)) - (string-to-number (or (match-string 1 fmt) "10"))) + width (or (cdr (assoc property org-columns-current-maxwidths)) + (nth 2 column)) f (format "%%-%d.%ds | " width width) string (format f (or (cdr ass) ""))) ;; Create the overlay (org-unmodified - (setq ov (org-new-column-overlay - beg (setq beg (1+ beg)) string 'org-column)) - (org-overlay-put ov 'keymap org-column-map) - (org-overlay-put ov 'org-column-key property) - (org-overlay-put ov 'org-column-value (cdr ass))) + (setq ov (org-columns-new-overlay + beg (setq beg (1+ beg)) string + (list color 'org-column))) +;;; (list (get-text-property (point-at-bol) 'face) 'org-column))) + (org-overlay-put ov 'keymap org-columns-map) + (org-overlay-put ov 'org-columns-key property) + (org-overlay-put ov 'org-columns-value (cdr ass)) + (org-overlay-put ov 'org-columns-pom pom) + (org-overlay-put ov 'org-columns-format f)) (if (or (not (char-after beg)) (equal (char-after beg) ?\n)) (let ((inhibit-read-only t)) @@ -13682,64 +13876,72 @@ then also check higher levels of the hierarchy." (goto-char beg) (insert " "))))) ;; Make the rest of the line disappear. - ;; FIXME: put the keymap also at the end of the line! (org-unmodified - (setq ov (org-new-column-overlay beg (point-at-eol))) + (setq ov (org-columns-new-overlay beg (point-at-eol))) (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'keymap 'org-column-map) - (push ov org-column-overlays) + (org-overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays) (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (org-overlay-put ov 'keymap 'org-column-map) - (push ov org-column-overlays) + (org-overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays) (let ((inhibit-read-only t)) (put-text-property (1- (point-at-bol)) (min (point-max) (1+ (point-at-eol))) 'read-only "Type `e' to edit property"))))) -(defun org-overlay-columns-title () +(defvar org-previous-header-line-format nil + "The header line format before column view was turned on.") +(defvar org-columns-inhibit-recalculation nil + "Inhibit recomputing of columns on column view startup.") + +(defvar header-line-format) +(defun org-columns-display-here-title () "Overlay the newline before the current line with the table title." (interactive) - (let ((fmt (copy-sequence org-current-columns-fmt)) - (start 0) + (let ((fmt org-columns-current-fmt-compiled) string (title "") - property width f ov) - (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" - fmt start) - (setq start (match-end 0) - property (match-string 2 fmt) - width (or (cdr (assoc property org-current-columns-maxwidths)) - (string-to-number (or (match-string 1 fmt) "10"))) + property width f column str) + (while (setq column (pop fmt)) + (setq property (car column) + str (or (nth 1 column) property) + width (or (cdr (assoc property org-columns-current-maxwidths)) + (nth 2 column)) f (format "%%-%d.%ds | " width width) - string (format f property) + string (format f str) title (concat title string))) - (org-unmodified - (setq ov (org-new-column-overlay - (1- (point-at-bol)) (point-at-bol) - (concat "\n" (make-string (length title) ?-) "\n" - title "\n" (make-string (length title) ?-) "\n") - 'bold)) - (org-overlay-put ov 'keymap org-column-map)))) + (setq title (concat + (org-add-props " " nil 'display '(space :align-to 0)) + (org-add-props title nil 'face '(:weight bold :underline t)))) + (org-set-local 'org-previous-header-line-format header-line-format) + (setq header-line-format title))) -(defun org-remove-column-overlays () +(defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) - (org-unmodified - (mapc 'org-delete-overlay org-column-overlays) - (setq org-column-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t))))) + (when (marker-buffer org-columns-begin-marker) + (with-current-buffer (marker-buffer org-columns-begin-marker) + (when (local-variable-p 'org-previous-header-line-format) + (setq header-line-format org-previous-header-line-format) + (kill-local-variable 'org-previous-header-line-format)) + (move-marker org-columns-begin-marker nil) + (move-marker org-columns-top-level-marker nil) + (org-unmodified + (mapc 'org-delete-overlay org-columns-overlays) + (setq org-columns-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t))))))) -(defun org-column-show-value () +(defun org-columns-show-value () "Show the full value of the property." (interactive) - (let ((value (get-char-property (point) 'org-column-value))) + (let ((value (get-char-property (point) 'org-columns-value))) (message "Value is: %s" (or value "")))) -(defun org-column-quit () +(defun org-columns-quit () "Remove the column overlays and in this way exit column editing." (interactive) (org-unmodified - (org-remove-column-overlays) + (org-columns-remove-overlays) (let ((inhibit-read-only t)) ;; FIXME: is this safe??? ;; or are there other reasons why there may be a read-only property???? @@ -13747,13 +13949,13 @@ then also check higher levels of the hierarchy." (when (eq major-mode 'org-agenda-mode) (message "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) -(defun org-column-edit () +(defun org-columns-edit-value () "Edit the value of the property at point in column view. Where possible, use the standard interface for changing this line." (interactive) (let* ((col (current-column)) - (key (get-char-property (point) 'org-column-key)) - (value (get-char-property (point) 'org-column-value)) + (key (get-char-property (point) 'org-columns-key)) + (value (get-char-property (point) 'org-columns-value)) (bol (point-at-bol)) (eol (point-at-eol)) (pom (or (get-text-property bol 'org-hd-marker) (point))) ; keep despite of compiler waring @@ -13763,8 +13965,8 @@ Where possible, use the standard interface for changing this line." (>= (overlay-start x) bol) (<= (overlay-start x) eol) x)) - org-column-overlays))) - nval eval) + org-columns-overlays))) + nval eval allowed) (when (equal key "ITEM") (error "Cannot edit item headline from here")) @@ -13788,7 +13990,10 @@ Where possible, use the standard interface for changing this line." (setq eval '(org-with-point-at pom (call-interactively 'org-deadline)))) (t - (setq nval (read-string "Edit: " value)) + (setq allowed (org-property-get-allowed-values pom key 'table)) + (if allowed + (setq nval (completing-read "Value: " allowed nil t)) + (setq nval (read-string "Edit: " value))) (setq nval (org-trim nval)) (when (not (equal nval value)) (setq eval '(org-entry-put pom key nval))))) @@ -13797,67 +14002,272 @@ Where possible, use the standard interface for changing this line." (remove-text-properties (1- bol) eol '(read-only t)) (unwind-protect (progn - (setq org-column-overlays - (org-delete-all line-overlays org-column-overlays)) + (setq org-columns-overlays + (org-delete-all line-overlays org-columns-overlays)) (mapc 'org-delete-overlay line-overlays) - (eval eval)) - (org-overlay-columns)))) - (move-to-column col))) + (org-columns-eval eval)) + (org-columns-display-here)))) + (move-to-column col) + (if (nth 3 (assoc key org-columns-current-fmt-compiled)) + (org-columns-update key)))) + +(defun org-columns-edit-allowed () + "Edit the list of allowed values for the current property." + (interactive) + (let* ((col (current-column)) + (key (get-char-property (point) 'org-columns-key)) + (key1 (concat key "_ALL")) + (value (get-char-property (point) 'org-columns-value)) + (allowed (org-entry-get (point) key1 t)) + nval) + (setq nval (read-string "Allowed: " allowed)) + (org-entry-put + (cond ((marker-position org-entry-property-inherited-from) + org-entry-property-inherited-from) + ((marker-position org-columns-top-level-marker) + org-columns-top-level-marker)) + key1 nval))) + +(defun org-columns-eval (form) + (let (hidep) + (save-excursion + (beginning-of-line 1) + (next-line 1) + (setq hidep (org-on-heading-p 1))) + (eval form) + (and hidep (hide-entry)))) + +(defun org-columns-previous-allowed-value () + "Switch to the previous allowed value for this column." + (interactive) + (org-columns-next-allowed-value t)) + +(defun org-columns-next-allowed-value (&optional previous) + "Switch to the next allowed value for this column." + (interactive) + (let* ((col (current-column)) + (key (get-char-property (point) 'org-columns-key)) + (value (get-char-property (point) 'org-columns-value)) + (bol (point-at-bol)) (eol (point-at-eol)) + (pom (or (get-text-property bol 'org-hd-marker) + (point))) ; keep despite of compiler waring + (line-overlays + (delq nil (mapcar (lambda (x) + (and (eq (overlay-buffer x) (current-buffer)) + (>= (overlay-start x) bol) + (<= (overlay-start x) eol) + x)) + org-columns-overlays))) + (allowed (or (org-property-get-allowed-values pom key) + (and (equal + (nth 4 (assoc key org-columns-current-fmt-compiled)) + 'checkbox) '("[ ]" "[X]")))) + nval) + (when (equal key "ITEM") + (error "Cannot edit item headline from here")) + (unless allowed + (error "Allowed values for this property have not been defined")) + (if previous (setq allowed (reverse allowed))) + (if (member value allowed) + (setq nval (car (cdr (member value allowed))))) + (setq nval (or nval (car allowed))) + (if (equal nval value) + (error "Only one allowed value for this property")) + (let ((inhibit-read-only t)) + (remove-text-properties (1- bol) eol '(read-only t)) + (unwind-protect + (progn + (setq org-columns-overlays + (org-delete-all line-overlays org-columns-overlays)) + (mapc 'org-delete-overlay line-overlays) + (org-columns-eval '(org-entry-put pom key nval))) + (org-columns-display-here))) + (move-to-column col) + (if (nth 3 (assoc key org-columns-current-fmt-compiled)) + (org-columns-update key)))) + +(defun org-verify-version (task) + (cond + ((eq task 'columns) + (if (or (featurep 'xemacs) + (< emacs-major-version 22)) + (error "Emacs 22 is required for the columns feature"))))) (defun org-columns () "Turn on column view on an org-mode file." (interactive) - (org-remove-column-overlays) + (org-verify-version 'columns) + (org-columns-remove-overlays) + (move-marker org-columns-begin-marker (point)) (let (beg end fmt cache maxwidths) - (move-marker org-entry-property-inherited-from nil) - (setq fmt (org-entry-get nil "COLUMNS" t)) - (unless fmt - (message "No local columns format defined, using default")) - (org-set-local 'org-current-columns-fmt (or fmt org-default-columns-format)) - (org-back-to-heading) + (when (condition-case nil (org-back-to-heading) (error nil)) + (move-marker org-entry-property-inherited-from nil) + (setq fmt (org-entry-get nil "COLUMNS" t))) + (setq fmt (or fmt org-columns-default-format)) + (org-set-local 'org-columns-current-fmt fmt) + (org-columns-compile-format fmt) (save-excursion (if (marker-position org-entry-property-inherited-from) (goto-char org-entry-property-inherited-from)) - (setq beg (point) - end (org-end-of-subtree t t)) + (setq beg (point)) + (move-marker org-columns-top-level-marker (point)) + (unless org-columns-inhibit-recalculation + (org-columns-compute-all)) + (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) + (point-max))) (goto-char beg) ;; Get and cache the properties (while (re-search-forward (concat "^" outline-regexp) end t) (push (cons (org-current-line) (org-entry-properties)) cache)) (when cache - (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) - (org-set-local 'org-current-columns-maxwidths maxwidths) + (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) + (org-set-local 'org-columns-current-maxwidths maxwidths) (goto-line (car (org-last cache))) - (org-overlay-columns-title) + (org-columns-display-here-title) (mapc (lambda (x) (goto-line (car x)) - (org-overlay-columns (cdr x))) + (org-columns-display-here (cdr x))) cache))))) +(defun org-columns-new (&optional prop title width op fmt) + "Insert a new column, to the leeft o the current column." + (interactive) + (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) + cell) + (setq prop (completing-read + "Property: " (mapcar 'list (org-buffer-property-keys t)) + nil nil prop)) + (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) + (setq width (read-string "Column width: " (if width (number-to-string width)))) + (if (string-match "\\S-" width) + (setq width (string-to-number width)) + (setq width nil)) + (setq fmt (completing-read "Summary [none]: " + '(("none") ("add_numbers") ("add_times") ("checkbox")) + nil t)) + (if (string-match "\\S-" fmt) + (setq fmt (intern fmt)) + (setq fmt nil)) + (if (eq fmt 'none) (setq fmt nil)) + (if editp + (progn + (setcar editp prop) + (setcdr editp (list title width nil fmt))) + (setq cell (nthcdr (1- (current-column)) + org-columns-current-fmt-compiled)) + (setcdr cell (cons (list prop title width nil fmt) + (cdr cell)))) + (org-columns-store-format) + (org-columns-redo))) + +(defun org-columns-delete () + "Delete the column at point from columns view." + (interactive) + (let* ((n (current-column)) + (title (nth 1 (nth n org-columns-current-fmt-compiled)))) + (when (y-or-n-p + (format "Are you sure you want to remove column \"%s\"? " title)) + (setq org-columns-current-fmt-compiled + (delq (nth n org-columns-current-fmt-compiled) + org-columns-current-fmt-compiled)) + (org-columns-store-format) + (org-columns-redo) + (if (>= (current-column) (length org-columns-current-fmt-compiled)) + (backward-char 1))))) + +(defun org-columns-edit-attributes () + "Edit the attributes of the current column." + (interactive) + (let* ((n (current-column)) + (info (nth n org-columns-current-fmt-compiled))) + (apply 'org-columns-new info))) + +(defun org-columns-widen (arg) + "Make the column wider by ARG characters." + (interactive "p") + (let* ((n (current-column)) + (entry (nth n org-columns-current-fmt-compiled)) + (width (or (nth 2 entry) + (cdr (assoc (car entry) org-columns-current-maxwidths))))) + (setq width (max 1 (+ width arg))) + (setcar (nthcdr 2 entry) width) + (org-columns-store-format) + (org-columns-redo))) + +(defun org-columns-narrow (arg) + "Make the column nrrower by ARG characters." + (interactive "p") + (org-columns-widen (- arg))) + +(defun org-columns-move-right () + "Swap this column with the one to the right." + (interactive) + (let* ((n (current-column)) + (cell (nthcdr n org-columns-current-fmt-compiled)) + e) + (when (>= n (1- (length org-columns-current-fmt-compiled))) + (error "Cannot shift this column further to the right")) + (setq e (car cell)) + (setcar cell (car (cdr cell))) + (setcdr cell (cons e (cdr (cdr cell)))) + (org-columns-store-format) + (org-columns-redo) + (forward-char 1))) + +(defun org-columns-move-left () + "Swap this column with the one to the left." + (interactive) + (let* ((n (current-column))) + (when (= n 0) + (error "Cannot shift this column further to the left")) + (backward-char 1) + (org-columns-move-right) + (backward-char 1))) + +(defun org-columns-store-format () + "Store the text version of the current columns format in appropriate place. +This is either in the COLUMNS property of the node starting the current column +display, or in the #+COLUMNS line of the current buffer." + (let (fmt) + (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) + (if (marker-position org-columns-top-level-marker) + (save-excursion + (goto-char org-columns-top-level-marker) + (if (org-entry-get nil "COLUMNS") + (org-entry-put nil "COLUMNS" fmt) + (goto-char (point-min)) + (while (re-search-forward "^#\\+COLUMNS:.*" nil t) + (replace-match (concat "#+COLUMNS: " fmt t t))))) + (setq org-columns-current-fmt fmt)))) + (defvar org-overriding-columns-format nil - "FIXME:") + "When set, overrides any other definition.") (defvar org-agenda-view-columns-initially nil - "FIXME:") + "When set, switch to columns view immediately after creating the agenda.") (defun org-agenda-columns () "Turn on column view in the agenda." (interactive) - (let (fmt first-done cache maxwidths m) + (org-verify-version 'columns) + (org-columns-remove-overlays) + (move-marker org-columns-begin-marker (point)) + (let (fmt cache maxwidths m) (cond ((and (local-variable-p 'org-overriding-columns-format) org-overriding-columns-format) (setq fmt org-overriding-columns-format)) ((setq m (get-text-property (point-at-bol) 'org-hd-marker)) (setq fmt (org-entry-get m "COLUMNS" t))) - ((and (boundp 'org-current-columns-fmt) - (local-variable-p 'org-current-columns-fmt) - org-current-columns-fmt) - (setq fmt org-current-columns-fmt)) + ((and (boundp 'org-columns-current-fmt) + (local-variable-p 'org-columns-current-fmt) + org-columns-current-fmt) + (setq fmt org-columns-current-fmt)) ((setq m (next-single-property-change (point-min) 'org-hd-marker)) (setq m (get-text-property m 'org-hd-marker)) (setq fmt (org-entry-get m "COLUMNS" t)))) - (setq fmt (or fmt org-default-columns-format)) - (org-set-local 'org-current-columns-fmt fmt) + (setq fmt (or fmt org-columns-default-format)) + (org-set-local 'org-columns-current-fmt fmt) + (org-columns-compile-format fmt) (save-excursion ;; Get and cache the properties (goto-char (point-min)) @@ -13867,16 +14277,16 @@ Where possible, use the standard interface for changing this line." (push (cons (org-current-line) (org-entry-properties m)) cache)) (beginning-of-line 2)) (when cache - (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) - (org-set-local 'org-current-columns-maxwidths maxwidths) + (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) + (org-set-local 'org-columns-current-maxwidths maxwidths) (goto-line (car (org-last cache))) - (org-overlay-columns-title) + (org-columns-display-here-title) (mapc (lambda (x) (goto-line (car x)) - (org-overlay-columns (cdr x))) + (org-columns-display-here (cdr x))) cache))))) -(defun org-get-columns-autowidth-alist (s cache) +(defun org-columns-get-autowidth-alist (s cache) "Derive the maximum column widths from the format and the cache." (let ((start 0) rtn) (while (string-match "%\\([a-zA-Z]\\S-*\\)" s start) @@ -13891,6 +14301,167 @@ Where possible, use the standard interface for changing this line." rtn) rtn)) +(defun org-columns-compute-all () + "Compute all columns that have operators defined." + (remove-text-properties (point-min) (point-max) '(org-summaries t)) + (let ((columns org-columns-current-fmt-compiled) col) + (while (setq col (pop columns)) + (when (nth 3 col) + (save-excursion + (org-columns-compute (car col))))))) + +(defun org-columns-update (property) + "Recompute PROPERTY, and update the columns display for it." + (org-columns-compute property) + (let (fmt val pos) + (save-excursion + (mapc (lambda (ov) + (when (equal (org-overlay-get ov 'org-columns-key) property) + (setq pos (org-overlay-start ov)) + (goto-char pos) + (when (setq val (cdr (assoc property + (get-text-property (point-at-bol) 'org-summaries)))) + (setq fmt (org-overlay-get ov 'org-columns-format)) + (org-overlay-put ov 'display (format fmt val))))) + org-columns-overlays)))) + +(defun org-columns-compute (property) + "Sum the values of property PROPERTY hierarchically, for the entire buffer." + (interactive) + (let* ((re (concat "^" outline-regexp)) + (lmax 30) ; Does anyone use deeper levels??? + (lsum (make-vector lmax 0)) + (level 0) + (ass (assoc property org-columns-current-fmt-compiled)) + (format (nth 4 ass)) + (beg org-columns-top-level-marker) + last-level val end sumpos sum-alist sum str) + (save-excursion + ;; Find the region to compute + (goto-char beg) + (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) + (goto-char end) + ;; Walk the tree from the back and do the computations + (while (re-search-backward re beg t) + (setq sumpos (match-beginning 0) + last-level level + level (org-outline-level) + val (org-entry-get nil property)) + (cond + ((< level last-level) + ;; put the sum of lower levels here as a property + (setq sum (aref lsum last-level) + str (org-column-number-to-string sum format) + sum-alist (get-text-property sumpos 'org-summaries)) + (if (assoc property sum-alist) + (setcdr (assoc property sum-alist) str) + (push (cons property str) sum-alist) + (add-text-properties sumpos (1+ sumpos) + (list 'org-summaries sum-alist))) + (when val + (org-entry-put nil property str)) + ;; add current to current level accumulator + (aset lsum level (+ (aref lsum level) sum)) + ;; clear accumulators for deeper levels + (loop for l from (1+ level) to (1- lmax) do (aset lsum l 0))) + ((>= level last-level) + ;; add what we have here to the accumulator for this level + (aset lsum level (+ (aref lsum level) + (org-column-string-to-number (or val "0") format)))) + (t (error "This should not happen"))))))) + +(defun org-columns-redo () + "Construct the column display again." + (interactive) + (message "Recomputing columns...") + (save-excursion + (if (marker-position org-columns-begin-marker) + (goto-char org-columns-begin-marker)) + (org-columns-remove-overlays) + (if (org-mode-p) + (call-interactively 'org-columns) + (call-interactively 'org-agenda-columns))) + (message "Recomputing columns...done")) + +(defun org-columns-not-in-agenda () + (if (eq major-mode 'org-agenda-mode) + (error "This command is only allowed in Org-mode buffers"))) + + +(defun org-string-to-number (s) + "Convert string to number, and interpret hh:mm:ss." + (if (not (string-match ":" s)) + (string-to-number s) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum))) + +(defun org-column-number-to-string (n fmt) + "Convert a computed column number to a string value, according to FMT." + (cond + ((eq fmt 'add_times) + (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) + (format "%d:%02d" h m))) + ((eq fmt 'checkbox) + (cond ((= n (floor n)) "[X]") + ((> n 1.) "[-]") + (t "[ ]"))) + (t (number-to-string n)))) + +(defun org-column-string-to-number (s fmt) + "Convert a column value to a number that can be used for column computing." + (cond + ((string-match ":" s) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) + ((eq fmt 'checkbox) + (if (equal s "[X]") 1. 0.000001)) + (t (string-to-number s)))) + +(defun org-columns-uncompile-format (cfmt) + "Turn the compiled columns format back into a string representation." + (let ((rtn "") e s prop title op width fmt) + (while (setq e (pop cfmt)) + (setq prop (car e) + title (nth 1 e) + width (nth 2 e) + op (nth 3 e) + fmt (nth 4 e)) + (cond + ((eq fmt 'add_times) (setq op ":")) + ((eq fmt 'checkbox) (setq op "X")) + ((eq fmt 'add_numbers) (setq op "+"))) + (if (equal title prop) (setq title nil)) + (setq s (concat "%" (if width (number-to-string width)) + prop + (if title (concat "(" title ")")) + (if op (concat "{" op "}")))) + (setq rtn (concat rtn " " s))) + (org-trim rtn))) + +(defun org-columns-compile-format (fmt) + "FIXME" + (let ((start 0) width prop title op f) + (setq org-columns-current-fmt-compiled nil) + (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z_0-9]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*" + fmt start) + (setq start (match-end 0) + width (match-string 1 fmt) + prop (match-string 2 fmt) + title (or (match-string 3 fmt) prop) + op (match-string 4 fmt) + f nil) + (if width (setq width (string-to-number width))) + (cond + ((equal op "+") (setq f 'add_numbers)) + ((equal op ":") (setq f 'add_times)) + ((equal op "X") (setq f 'checkbox))) + (push (list prop title width op f) org-columns-current-fmt-compiled)) + (setq org-columns-current-fmt-compiled + (nreverse org-columns-current-fmt-compiled)))) ;;;; Timestamps @@ -14084,7 +14655,7 @@ used to insert the time stamp into the buffer to include the time." ;; Help matching am/pm times, because `parse-time-string' does not do that. ;; If there is a time with am/pm, and *no* time without it, we convert ;; so that matching will be successful. - ;; FIXME: make this replace twoce, so that we catch the end time. + ;; FIXME: make this replace twice, so that we catch the end time. (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) (setq hour (string-to-number (match-string 1 ans)) @@ -15308,8 +15879,7 @@ The following commands are available: (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) -; FIXME: other key? wtah about the menu???/ -;(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files) + (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) "Local keymap for agenda entries from Org-mode.") @@ -16555,7 +17125,6 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (mapcar 'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) (org-set-local 'org-last-arg arg) -;FIXME (org-set-local 'org-todo-keywords-for-agenda kwds) (setq org-agenda-redo-command '(org-todo-list (or current-prefix-arg org-last-arg))) (setq files (org-agenda-files) @@ -16581,7 +17150,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (mapc (lambda (x) (setq s (format "(%d)%s" (setq n (1+ n)) x)) (if (> (+ (current-column) (string-width s) 1) (frame-width)) - (insert "\n ")) + (insert "\n ")) (insert " " s)) kwds)) (insert "\n")) @@ -16705,8 +17274,8 @@ MATCH is being ignored." "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (org-re "^\\*+.*:[[:alnum:]_@]+:[ \t]*$") - (concat "^\\*+.*:\\(" + (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") + (concat "^\\*+ .*:\\(" (mapconcat 'identity tags "\\|") (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) (gen-re (nth 3 org-stuck-projects)) @@ -16951,7 +17520,7 @@ the documentation of `org-diary'." (defun org-entry-is-done-p () "Is the current entry marked DONE?" (save-excursion - (and (re-search-backward "[\r\n]\\*" nil t) + (and (re-search-backward "[\r\n]\\* " nil t) (looking-at org-nl-done-regexp)))) (defun org-at-date-range-p (&optional inactive-ok) @@ -16984,7 +17553,7 @@ the documentation of `org-diary'." (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) ;; FIXME: get rid of the \n at some point but watch out - (regexp (concat "[\n\r]\\*+ *\\(" + (regexp (concat "\n\\*+[ \t]+\\(" (if org-select-this-todo-keyword (if (equal org-select-this-todo-keyword "*") org-todo-regexp @@ -17093,12 +17662,12 @@ the documentation of `org-diary'." ;; substring should only run to end of time stamp (setq timestr (substring timestr 0 (match-end 0)))) (save-excursion - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (if (re-search-backward "^\\*+ " nil t) (progn - (goto-char (match-end 1)) + (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker) tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (org-format-agenda-item (format "%s%s" (if deadlinep "Deadline: " "") @@ -17202,12 +17771,12 @@ the documentation of `org-diary'." ;; substring should only run to end of time stamp (setq timestr (substring timestr 0 (match-end 0)))) (save-excursion - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (if (re-search-backward "^\\*+ " nil t) (progn - (goto-char (match-end 1)) + (goto-char (match-beginning 0)) (setq hdmarker (org-agenda-new-marker) tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (org-format-agenda-item (if closedp "Closed: " "Clocked: ") (match-string 1) category tags timestr))) @@ -17252,10 +17821,10 @@ the documentation of `org-diary'." (if (and (< diff wdays) todayp (not (= diff 0))) (save-excursion (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) + (if (re-search-backward "^\\*+[ \t]+" nil t) (progn (goto-char (match-end 0)) - (setq pos1 (match-end 1)) + (setq pos1 (match-beginning 0)) (setq tags (org-get-tags-at pos1)) (setq head (buffer-substring-no-properties (point) @@ -17311,10 +17880,10 @@ the documentation of `org-diary'." (if (and (< diff 0) todayp) (save-excursion (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) + (if (re-search-backward "^\\*+[ \t]+" nil t) (progn (goto-char (match-end 0)) - (setq pos1 (match-end 1)) + (setq pos1 (match-beginning 0)) (setq tags (org-get-tags-at)) (setq head (buffer-substring-no-properties (point) @@ -17364,12 +17933,12 @@ the documentation of `org-diary'." (save-excursion (setq marker (org-agenda-new-marker (point))) (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (if (re-search-backward "^\\*+ " nil t) (progn - (setq hdmarker (org-agenda-new-marker (match-end 1))) - (goto-char (match-end 1)) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker (point))) (setq tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (org-format-agenda-item (format (if (= d1 d2) "" "(%d/%d): ") (1+ (- d0 d1)) (1+ (- d2 d1))) @@ -17715,7 +18284,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (if (not (one-window-p)) (delete-window)) (kill-buffer buf) (org-agenda-maybe-reset-markers 'force) - (org-remove-column-overlays)) + (org-columns-remove-overlays)) ;; Maybe restore the pre-agenda window configuration. (and org-agenda-restore-windows-after-quit (not (eq org-agenda-window-setup 'other-frame)) @@ -17814,10 +18383,12 @@ With prefix ARG, go backward that many times the current span." (defun org-agenda-day-view () "Switch to daily view for agenda." (interactive) + (setq org-agenda-ndays 1) (org-agenda-change-time-span 'day)) (defun org-agenda-week-view () "Switch to daily view for agenda." (interactive) + (setq org-agenda-ndays 7) (org-agenda-change-time-span 'week)) (defun org-agenda-month-view () "Switch to daily view for agenda." @@ -17860,8 +18431,9 @@ so that the date SD will be in that range." ((eq span 'week) (let* ((nt (calendar-day-of-week (calendar-gregorian-from-absolute sd))) - (n1 org-agenda-start-on-weekday) - (d (- nt n1))) + (d (if org-agenda-start-on-weekday + (- nt org-agenda-start-on-weekday) + 0))) (setq sd (- sd (+ (if (< d 0) 7 0) d))) (setq nd 7))) ((eq span 'month) @@ -18329,7 +18901,7 @@ the tags of the current headline come last." (org-back-to-heading t) (condition-case nil (while t - (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")) + (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) (setq tags (append (org-split-string (org-match-string-no-properties 1) ":") tags))) @@ -19463,7 +20035,8 @@ translations. There is currently no way for users to extend this.") (re-archive (concat ":" org-archive-tag ":")) (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) (htmlp (plist-get parameters :for-html)) - (outline-regexp "\\*+") + (inhibit-read-only t) + (outline-regexp "\\*+ ") a b rtn p) (save-excursion @@ -19739,7 +20312,7 @@ underlined headlines. The default is 3." :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) :add-text (plist-get opt-plist :text)) - "[\r\n]"))) + "[\r\n]"))) ;; FIXME: why \r here???/ thetoc have-headings first-heading-pos table-open table-buffer) @@ -19846,7 +20419,7 @@ underlined headlines. The default is 3." (when custom-times (setq line (org-translate-time line))) (cond - ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) ;; a Headline (setq first-heading-pos (or first-heading-pos (point))) (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) @@ -19953,7 +20526,7 @@ underlined headlines. The default is 3." ;; find the indentation of the next non-empty line (catch 'stop (while lines - (if (string-match "^\\*" (car lines)) (throw 'stop nil)) + (if (string-match "^\\* " (car lines)) (throw 'stop nil)) (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) (throw 'stop (setq ind (org-get-indentation (car lines))))) (pop lines))) @@ -20145,12 +20718,12 @@ this line is also exported in fixed-width font." (save-excursion (org-back-to-heading) (if (looking-at (concat outline-regexp - "\\( +\\<" org-quote-string "\\>\\)")) + "\\( *\\<" org-quote-string "\\>\\)")) (replace-match "" t t nil 1) (if (looking-at outline-regexp) (progn (goto-char (match-end 0)) - (insert " " org-quote-string)))))))) + (insert org-quote-string " ")))))))) (defun org-export-as-html-and-open (arg) "Export the outline as HTML and immediately open it with a browser. @@ -20303,7 +20876,7 @@ the body tags themselves." (file-name-nondirectory buffer-file-name))) "UNTITLED")) (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) + (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) (inquote nil) (infixed nil) (in-local-list nil) @@ -20495,7 +21068,7 @@ lang=\"%s\" xml:lang=\"%s\"> (catch 'nextline ;; end of quote section? - (when (and inquote (string-match "^\\*+" line)) + (when (and inquote (string-match "^\\*+ " line)) (insert "\n") (setq inquote nil)) ;; inside a quote section? @@ -20672,7 +21245,7 @@ lang=\"%s\" xml:lang=\"%s\"> t t line))))) (cond - ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) ;; This is a headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) txt (match-string 2 line)) @@ -21595,7 +22168,7 @@ The XOXO buffer is named *xoxo-*" (with-current-buffer out (erase-buffer)) ;; Kick off the output (org-export-as-xoxo-insert-into out "
    \n") - (while (re-search-forward "^\\(\\*+\\) \\(.+\\)" (point-max) 't) + (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) (let* ((hd (match-string-no-properties 1)) (level (length hd)) (text (concat @@ -22052,6 +22625,7 @@ depending on context. See the individual commands for more information." (cond ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) + ((org-at-property-p) (call-interactively 'org-property-next-allowed-value)) (t (org-shiftcursor-error)))) (defun org-shiftleft () @@ -22060,6 +22634,8 @@ depending on context. See the individual commands for more information." (cond ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) + ((org-at-property-p) + (call-interactively 'org-property-previous-allowed-value)) (t (org-shiftcursor-error)))) (defun org-shiftcontrolright () @@ -22152,6 +22728,8 @@ This command does many different things, depending on context: ((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function)) (funcall org-finish-function)) + ((org-at-property-p) + (call-interactively 'org-property-action)) ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) ((org-on-heading-p) (call-interactively 'org-set-tags)) ((org-at-table.el-p) @@ -22361,17 +22939,7 @@ See the individual commands for more information." "--" ["Set Priority" org-priority t] ["Priority Up" org-shiftup t] - ["Priority Down" org-shiftdown t] - "--" - ;; FIXME: why is this still here???? -; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)] -; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)] -; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count)) -; (or (org-on-heading-p) (org-at-item-p))] -; ["Insert [%] cookie" (progn (insert "[%]") (org-update-checkbox-count)) -; (or (org-on-heading-p) (org-at-item-p))] -; ["Update Statistics" org-update-checkbox-count t] - ) + ["Priority Down" org-shiftdown t]) ("TAGS and Properties" ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] ["Column view of properties" org-columns t]) @@ -22811,16 +23379,16 @@ not an indirect buffer" ;; text in a line directly attached to a headline would otherwise ;; fill the headline as well. (org-set-local 'comment-start-skip "^#+[ \t]*") - (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") + (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") ;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$") ;; The paragraph starter includes hand-formatted lists. (org-set-local 'paragraph-start - "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") + "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") ;; Inhibit auto-fill for headers, tables and fixed-width lines. ;; But only if the user has not turned off tables or fixed-width regions (org-set-local 'auto-fill-inhibit-regexp - (concat "\\*\\|#\\+" + (concat "\\*+ \\|#\\+" "\\|[ \t]*" org-keyword-time-regexp (if (or org-enable-table-editor org-enable-fixed-width-editor) (concat @@ -23099,7 +23667,53 @@ Still experimental, may disappear in the furture." ;; make tree, check each match with the callback (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) +(defun org-fill-paragraph-experimental (&optional justify) + "Re-align a table, pass through to fill-paragraph if no table." + (let ((table-p (org-at-table-p)) + (table.el-p (org-at-table.el-p))) + (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines + (table.el-p t) ; skip table.el tables + (table-p (org-table-align) t) ; align org-mode tables + ((save-excursion + (let ((pos (1+ (point-at-eol)))) + (backward-paragraph 1) + (re-search-forward "\\\\\\\\[ \t]*$" pos t))) + (save-excursion + (save-restriction + (narrow-to-region (1+ (match-end 0)) (point-max)) + (fill-paragraph nil) + t))) + (t nil)))) ; call paragraph-fill +(defun org-property-previous-allowed-value (&optional previous) + "Switch to the next allowed value for this property." + (interactive) + (org-property-next-allowed-value t)) + +(defun org-property-next-allowed-value (&optional previous) + "Switch to the next allowed value for this property." + (interactive) + (unless (org-at-property-p) + (error "Not at a property")) + (let* ((key (match-string 2)) + (value (match-string 3)) + (allowed (or (org-property-get-allowed-values (point) key) + (and (member value '("[ ]" "[-]" "[X]")) + '("[ ]" "[X]")))) + nval) + (unless allowed + (error "Allowed values for this property have not been defined")) + (if previous (setq allowed (reverse allowed))) + (if (member value allowed) + (setq nval (car (cdr (member value allowed))))) + (setq nval (or nval (car allowed))) + (if (equal nval value) + (error "Only one allowed value for this property")) + (org-at-property-p) + (replace-match (concat " :" key ": " nval)) + (org-indent-line-function) + (beginning-of-line 1) + (skip-chars-forward " \t"))) ;;;; Finish up @@ -23109,3 +23723,4 @@ Still experimental, may disappear in the furture." ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here + diff --git a/man/ChangeLog b/man/ChangeLog index 13d4c7b1b29..65173aa2f5d 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,7 @@ +2007-07-10 Carsten Dominik + + * org.texi (Properties and columns): Chapter rewritten. + 2007-07-08 Michael Albinus * tramp.texi: From 4d1daf5961ef41f59713aabc3e044051ce78041b Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 10 Jul 2007 07:24:19 +0000 Subject: [PATCH 069/163] * org.texi (Properties and columns): Chapter rewritten. --- man/org.texi | 380 +++++++++++++++++++++++++++++++++++---------------- 1 file changed, 260 insertions(+), 120 deletions(-) diff --git a/man/org.texi b/man/org.texi index c82df74148b..a4a4a6e8f76 100644 --- a/man/org.texi +++ b/man/org.texi @@ -3,7 +3,7 @@ @setfilename ../info/org @settitle Org Mode Manual -@set VERSION 5.01 +@set VERSION 5.02 @set DATE July 2007 @dircategory Emacs @@ -81,7 +81,7 @@ Software Foundation raise funds for GNU development.'' * Hyperlinks:: Notes in context * TODO items:: Every tree branch can be a TODO item * Tags:: Tagging headlines and matching sets of tags -* Properties:: +* Properties and columns:: * Timestamps:: Assign date and time to items * Agenda views:: Collecting information into views * Embedded LaTeX:: LaTeX fragments and formulas @@ -113,7 +113,8 @@ Document Structure * Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context * Plain lists:: Additional structure within an entry -* Drawers:: +* Drawers:: Tucking stuff away +* orgstruct-mode:: Structure editing outside Org-mode Archiving @@ -181,7 +182,7 @@ Tags * Setting tags:: How to assign tags to a headline * Tag searches:: Searching for combinations of tags -Properties +Properties and Columns * Property syntax:: How properties are spelled out * Special properties:: Access to other Org-mode features @@ -194,6 +195,11 @@ Column View * Defining columns:: The COLUMNS format property * Using column view:: How to create and use column view +Defining Columns + +* Scope of column definitions:: +* Column attributes:: + Timestamps * Time stamps:: Assigning a time to a tree entry @@ -379,7 +385,7 @@ tags etc are created dynamically when you need them. Org-mode keeps simple things simple. When first fired up, it should feel like a straightforward, easy to use outliner. Complexity is not imposed, but a large amount of functionality is available when you need -it. Org-mode can be used on different levels and in different ways, for +it. Org-mode is a toolbox and can be used in different ways, for example as: @example @@ -389,6 +395,7 @@ example as: @r{@bullet{} TODO list editor} @r{@bullet{} full agenda and planner with deadlines and work scheduling} @r{@bullet{} environment to implement David Allen's GTD system} +@r{@bullet{} a basic database application} @r{@bullet{} simple hypertext system, with HTML export} @r{@bullet{} publishing tool to create a set of interlinked webpages} @end example @@ -396,7 +403,9 @@ example as: Org-mode's automatic, context sensitive table editor with spreadsheet capabilities can be integrated into any major mode by activating the minor Orgtbl-mode. Using a translation step, it can be used to maintain -tables in arbitrary file types, for example in LaTeX. +tables in arbitrary file types, for example in LaTeX. The structure +editing and list creation capabilities can be used outside Org-mode with +the minor Orgstruct-mode. @cindex FAQ There is a website for Org-mode which provides links to the newest @@ -468,9 +477,10 @@ make install-info @iftex @b{Important:} @i{If you use copy-and-paste to copy lisp code from the -PDF documentation to your .emacs file, the single quote character comes -out incorrectly and the code will not work. You need to fix the single -quotes by hand, or copy from Info documentation.} +PDF documentation as viewed by Acrobat reader to your .emacs file, the +single quote character comes out incorrectly and the code will not work. +You need to fix the single quotes by hand, or copy from Info +documentation.} @end iftex Add the following lines to your @file{.emacs} file. The last two lines @@ -580,7 +590,8 @@ edit the structure of the document. * Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context * Plain lists:: Additional structure within an entry -* Drawers:: +* Drawers:: Tucking stuff away +* orgstruct-mode:: Structure editing outside Org-mode @end menu @node Outlines, Headlines, Document structure, Document structure @@ -1121,14 +1132,15 @@ bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}). With prefix arg, select the nth bullet from this list. @end table -@node Drawers, , Plain lists, Document structure +@node Drawers, orgstruct-mode, Plain lists, Document structure @section Drawers @cindex drawers +@cindex visibility cycling, drawers Sometimes you want to keep information associated with an entry, but you -normally don't want to see it, except when explicitly asking for it. -For this, Org-mode has @emph{drawers}. Drawers need to be configured -with the variable @code{org-drawers}, and look like this: +normally don't want to see it. For this, Org-mode has @emph{drawers}. +Drawers need to be configured with the variable @code{org-drawers}, and +look like this: @example ** This is a headline @@ -1143,7 +1155,30 @@ Visibility cycling (@pxref{Visibility cycling}) on the headline will hide and show the entry, but keep the drawer collapsed to a single line. In order to look inside the drawer, you need to move the cursor to the drawer line and press @key{TAB} there. Org-mode uses a drawer for -storing properties (@pxref{Properties}). +storing properties (@pxref{Properties and columns}). + +@node orgstruct-mode, , Drawers, Document structure +@section The Orgstruct minor mode +@cindex orgstruct-mode +@cindex minor mode for structure editing + +If you like the intuitive way the Org-mode structure editing and list +formatting works, you might want to use these commands in other modes +like text-mode or mail-mode as well. The minor mode Orgstruct-mode +makes this possible. You can always toggle the mode with @kbd{M-x +orgstruct-mode}. To turn it on by default, for example in mail mode, +use + +@lisp +(add-hook 'mail-mode-hook 'turn-on-orgstruct) +@end lisp + +When this mode is active and the cursor is on a line that looks to +Org-mode like a headline of the first line of a list item, most +structure editing commands will work, even if the same keys normally +have different functionality in the major mode you are using. If the +cursor is not in one of those special lines, Orgstruct-mode lurks +silently in the shadow. @node Tables, Hyperlinks, Document structure, Top @chapter Tables @@ -1611,15 +1646,15 @@ line like @end example @noindent -Also properties (@pxref{Properties}) can be used as constants in table -formulas: For a property @samp{:XYZ:} use the name @samp{$PROP_XYZ}, and -the property will be searched in the current outline entry and in the -hierarchy above it. If you have the @file{constants.el} package, it -will also be used to resolve constants, including natural constants like -@samp{$h} for Planck's constant, and units like @samp{$km} for -kilometers@footnote{@file{Constant.el} can supply the values of -constants in two different unit systems, @code{SI} and @code{cgs}. -Which one is used depends on the value of the variable +Also properties (@pxref{Properties and columns}) can be used as +constants in table formulas: For a property @samp{:XYZ:} use the name +@samp{$PROP_XYZ}, and the property will be searched in the current +outline entry and in the hierarchy above it. If you have the +@file{constants.el} package, it will also be used to resolve constants, +including natural constants like @samp{$h} for Planck's constant, and +units like @samp{$km} for kilometers@footnote{@file{Constant.el} can +supply the values of constants in two different unit systems, @code{SI} +and @code{cgs}. Which one is used depends on the value of the variable @code{constants-unit-system}. You can use the @code{#+STARTUP} options @code{constSI} and @code{constcgs} to set this value for the current buffer.}. Column names and parameters can be specified in special table @@ -3030,7 +3065,7 @@ back into synch. Or simply toggle any checkbox twice with @kbd{C-c C-c}. @end table -@node Tags, Properties, TODO items, Top +@node Tags, Properties and columns, TODO items, Top @chapter Tags @cindex tags @cindex headline tagging @@ -3286,8 +3321,8 @@ instead of any TAG an expression like @samp{LEVEL=3}. For example, a search @samp{+LEVEL=3+BOSS/-DONE} lists all level three headlines that have the tag BOSS and are @emph{not} marked with the todo keyword DONE. -@node Properties, Timestamps, Tags, Top -@chapter Properties +@node Properties and columns, Timestamps, Tags, Top +@chapter Properties and Columns @cindex properties Properties are a set of key-value pairs associated with an entry. There @@ -3298,7 +3333,8 @@ tags like @code{:release_1:}, @code{:release_2:}, it can be more efficient to use a property @code{RELEASE} with a value @code{1.0} or @code{2.0}. Second, you can use properties to implement (very basic) database capabilities in an Org-mode buffer, for example to create a -list of Music CD's you own. +list of Music CD's you own. You can edit and view properties +conveniently in column view (@pxref{Column view}). @menu * Property syntax:: How properties are spelled out @@ -3308,8 +3344,10 @@ list of Music CD's you own. * Property API:: Properties for Lisp programmers @end menu -@node Property syntax, Special properties, Properties, Properties +@node Property syntax, Special properties, Properties and columns, Properties and columns @section Property Syntax +@cindex property syntax +@cindex drawer, for properties Properties are key-value pairs. They need to be inserted into a special drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property @@ -3324,26 +3362,65 @@ first, and the value after it. Here is an example: :Title: Goldberg Variations :Composer: J.S. Bach :Artist: Glen Gould - :END: + :Publisher: Deutsche Grammphon + :NDisks: 1 + :END: +@end example + +You may define the allowed values for a particular property @samp{XYZ} +by setting a property @samp{XYZ_ALL}. This special property is +@emph{inherited}, so if you set it in a level 1 entry, it will apply to +the entire tree. When allowed values are defined, setting the +corresponding property becomes easier and is less prone to typing +errors. For the example with the CD collection, we can predefine +publishers and the number of disks in a box like this: + +@example +* CD collection + :PROPERTIES: + :NDisks_ALL: 1 2 3 4 + :Publisher_ALL: "Deutsche Grammophon" Phillips EMI + :END: @end example @noindent -The following commands help to insert properties: +The following commands help to work with properties: @table @kbd @kindex M-@key{TAB} @item M-@key{TAB} After an initial colon in a line, complete property keys. All keys used in the current file will be offered as possible completions. +@item M-x org-insert-property-drawer +Insert a property drawer into the current entry. The drawer will be +inserted early in the entry, but after the lines with planning +information like deadlines. +@kindex C-c C-c +@item C-c C-c +With the cursor in a property drawer, this executes property commands. +@item C-c C-c s +Set a property in the current entry. Both the property and the value +can be inserted using completion. +@kindex S-@key{right} +@kindex S-@key{left} +@item S-@key{left}/@key{right} +Switch property at point to the next/previous allowed value. +@item C-c C-c d +Remove a property from the current entry. +@item C-c C-c D +Globally remove a property, from all entries in the current file. @end table - - -@node Special properties, Property searches, Property syntax, Properties +@node Special properties, Property searches, Property syntax, Properties and columns @section Special Properties +@cindex properties, special -Several properties are special, because they can be used to access other -features of Org-mode like the TODO status: +Special properties provide alternative access method to Org-mode +features discussed in the previous chapters, like the TODO state or the +priority of an entry. This interface exists so that you can include +these states into columns view (@pxref{Column view}). The following +property names are special and should not be used as keys in the +properties drawer: @example TODO @r{The TODO keyword of the entry.} @@ -3354,8 +3431,9 @@ DEADLINE @r{The deadline time string, without the angular brackets.} SCHEDULED @r{The scheduling time stamp, without the angular brackets.} @end example -@node Property searches, Column view, Special properties, Properties +@node Property searches, Column view, Special properties, Properties and columns @section Property searches +@cindex properties, searching To create sparse trees and special lists with selection based on properties, the same commands are used as for tag searches (@pxref{Tag @@ -3371,23 +3449,23 @@ also have a priority value @samp{A}, a @samp{:coffee:} property with the value @samp{unlimited}, and a @samp{:with:} property that is matched by the regular expression @samp{Sarah\|Denny}. -@node Column view, Property API, Property searches, Properties +@node Column view, Property API, Property searches, Properties and columns @section Column View -If different items in a document have similar properties, it can be nice -to view and edit those properties in a table-like format, in -@emph{column view}. Org-mode implements columns by overlaying a tabular -structure over the headline of an item. So the column view does not use -a special buffer, it happens in exactly the same buffer where the -outline is, and only temporarily changes the look of this buffer - not -the content. This has the advantage that you can still change the -visibility of the outline tree. For example, you get a compact table by -switching to CONTENTS view, but you can still open, read, and edit the -entry below each headline. Or, you can switch to column view after -executing a sparse tree command and in this way get a table only for the -selected items. Column view also works in agenda buffers (@pxref{Agenda -views}) where queries have collected selected items, possibly from a -number of files. +A great way to view and edit properties in aan outline tree is +@emph{column view}. In column view, each outline item is turned into a +table row. Columns in this table provide access to properties of the +entries. Org-mode implements columns by overlaying a tabular structure +over the headline of each item. While the headlines have been turned +into a table row, you can still change the visibility of the outline +tree. For example, you get a compact table by switching to CONTENTS +view (@kbd{S-@key{TAB} S-@key{TAB}}, or simple @kbd{c} while column view +is active), but you can still open, read, and +edit the entry below each headline. Or, you can switch to column view +after executing a sparse tree command and in this way get a table only +for the selected items. Column view also works in agenda buffers +(@pxref{Agenda views}) where queries have collected selected items, +possibly from a number of files. @menu * Defining columns:: The COLUMNS format property @@ -3396,81 +3474,122 @@ number of files. @node Defining columns, Using column view, Column view, Column view @subsection Defining Columns +@cindex column view, for properties +@cindex properties, column view -Setting up a column view first requires defining the columns. A column -definition is a property itself and looks like this: +Setting up a column view first requires defining the columns. This is +done by defining a column format line. + +@menu +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column +@end menu + +@node Scope of column definitions, Column attributes, Defining columns, Defining columns +@subsubsection Scope of column definitions + +To define a column format for an entire file, use a line like @example -:COLUMNS: %25ITEM %TAGS %PRIORITY %TODO +#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO @end example -This definition means that column 1 should be the first 25 characters of -the item itself, i.e. of the headline. You probably always should start -the column definition with the ITEM specifier - just select a useful -width for it. The other specifiers create columns for the local tags, -for the priority and for the TODO state. When no width is given after -the @samp{%} character, the column will be exactly as wide as it need to -be in order to fully display all values. - -If a @code{COLUMNS} property is present in an entry, it defines -columns for the entry itself, and for the entire subtree below it. -Since the column definition is part of the hierarchical structure of the -document, you can define columns on level 1 that are general enough for -all sublevels, and more specific columns further down, when you edit a deeper -part of the tree. Here is an example: - +To specify a format that only applies to a specific tree, add a COLUMNS +property to the top node of that tree, for example @example -* People - :PROPERTIES: - :COLUMNS: %25ITEM %Name - :END: -** Family +** Top node for columns view :PROPERTIES: - :COLUMNS: %25ITEM %Name %3Age + :COLUMNS: %25ITEM %TAGS %PRIORITY %TODO :END: -*** Sam - Info about Sam, including a property list with Name and Age. -*** Sarah - Info about Sarah, including a property list with Name and Age. -** Office - :PROPERTIES: - :COLUMNS: %25ITEM %Name %Function %Salary - :END: -*** Boss - Info about the Boss, including a property list with Name, - Function and Salary (if only we knew....). @end example -Now we have defined three different sets of columns. If you switch to -column view in the @emph{Family} section, you will get a different table -than if you do it in the @emph{Office} section. However, if you switch -to column view with the cursor on the @emph{People} section, the table -will cover all entries, but contain only the @emph{Name} column. +If a @code{COLUMNS} property is present in an entry, it defines columns +for the entry itself, and for the entire subtree below it. Since the +column definition is part of the hierarchical structure of the document, +you can define columns on level 1 that are general enough for all +sublevels, and more specific columns further down, when you edit a +deeper part of the tree. -If no COLUMNS property applies to a given location, Org-mode uses a -default format specified in the variable -@code{org-default-columns-format}. This format in particular also -applies when column view is invoked with the cursor before the first -headline. You can set the default format on a per-file basis with a -line (don't forget to press @kbd{C-c C-c} to activate any changes to -this line). +@node Column attributes, , Scope of column definitions, Defining columns +@subsubsection Column attributes +A column definition sets the attributes of a column. The general +definition looks like this: @example -#+COLUMNS: %25ITEM ....." + %[width]property[(title)][@{summary-type@}] @end example +@noindent +Except for the percent sign and the property name, all items are +optional. The individual parts have the following meaning: + +@example +width @r{An integer specifying the width of the column in characters.} + @r{If omitted, the width will be determined automatically.} +property @r{The property that should be edited in this column.} +(title) @r{The header text for the column. If omitted, the} + @r{property name is used.} +@{summary-type@} @r{The summary type. If specified, the column values for} + @r{parent nodes are computed from the children.} + @r{Supported summary types are:} + @{+@} @r{Sum numbers in this column.} + @{:@} @r{Sum times, HH:MM:SS, plain numbers are hours.} + @{X@} @r{Checkbox status, [X] if all children are [X].} +@end example + +@noindent +Here is an example for a complete columns definition, along with allowed +values. + +@example +:COLUMNS: %20ITEM %9Approved(Approved?)@{X@} %Owner %11Status %10Time_Spent@{:@} +:Owner_ALL: Tammy Mark Karl Lisa Don +:Status_ALL: "In progress" "Not started yet" "Finished" "" +:Approved_ALL: "[ ]" "[X]" +@end example + +The first column, @samp{%25ITEM}, means the first 25 characters of the +item itself, i.e. of the headline. You probably always should start the +column definition with the ITEM specifier. The other specifiers create +columns @samp{Owner} with a list of names as allowed values, for +@samp{Status} with four different possible values, and for a checkbox +field @samp{Approved}. When no width is given after the @samp{%} +character, the column will be exactly as wide as it needs to be in order +to fully display all values. The @samp{Approved} column does have a +modified title (@samp{Approved?}, with a question mark). Summaries will +be created for the @samp{Time_Spent} column by adding time duration +expressions like HH:MM, and for the @samp{Approved} column, by providing +an @samp{[X]} status if all children have been checked. + @node Using column view, , Defining columns, Column view @subsection Using Column View @table @kbd +@tsubheading{Turning column view on and off} @kindex C-c C-x C-c @item C-c C-x C-c Create the column view for the local environment. This command searches the hierarchy, up from point, for a @code{COLUMNS} property that defines a format. When one is found, the column view table is established for -the entire subtree. +the entire tree, starting from the entry that contains the @code{COLUMNS} +property. If none is found, the format is taken from the @code{#+COLUMNS} +line or from the variable @code{org-columns-default-format}, and column +view is established for the current entry and its subtree. +@kindex q +@item q +Exit column view. +@tsubheading{Editing values} @item @key{left} @key{right} @key{up} @key{down} Move through the column view from field to field. +@kindex S-@key{left} +@kindex S-@key{right} +@item S-@key{left}/@key{right} +Switch to the next/previous allowed value of the field. For this, you +have to have specified allowed values for a property. +@kindex n +@kindex p +@itemx n / p +Same as @kbd{S-@key{left}/@key{right}} @kindex e @item e Edit the property at point. For the special properties, this will @@ -3481,20 +3600,36 @@ or fast selection interface will pop up. @item v View the full value of this property. This is useful if the width of the column is smaller than that of the value. -@kindex q -@item q -Exit column view. +@kindex a +@item a +Edit the list of allowed values for this property. If the list is found +in the hierarchy, the modified values is stored there. If no list is +found, the new value is stored in the first entry that is part of the +current column view. +@tsubheading{Modifying the table structure} +@kindex < +@kindex > +@item < / > +Make the column narrower/wider by one character. +@kindex S-M-@key{right} +@item S-M-@key{right} +Insert a new column, to the right of the current column. +@kindex S-M-@key{left} +@item S-M-@key{left} +Delete the current column. @end table -@node Property API, , Column view, Properties +@node Property API, , Column view, Properties and columns @section The Property API +@cindex properties, API +@cindex API, for properties There is a full API for accessing and changing properties. This API can be used by Emacs Lisp programs to work with properties and to implement features based on them. For more information see @ref{Using the property API}. -@node Timestamps, Agenda views, Properties, Top +@node Timestamps, Agenda views, Properties and columns, Top @chapter Timestamps @cindex time stamps @cindex date stamps @@ -4604,7 +4739,9 @@ Delete other windows. @kindex m @kindex y @item d w m y -Switch to day/week/month/year view. +Switch to day/week/month/year view. When switching to day or week view, +this setting becomes the default for subseqent agenda commands. Since +month and year views are slow to create, the do not become the default. @c @kindex D @item D @@ -5947,16 +6084,15 @@ skip: @r{turn on/off skipping the text before the first heading} @chapter Publishing @cindex publishing -Org-mode includes@footnote{@file{org-publish.el} is not yet part of -Emacs, so if you are using @file{org.el} as it comes with Emacs, you -need to download this file separately. Also make sure org.el is at -least version 4.27.} a publishing management system -that allows you to configure automatic HTML conversion of -@emph{projects} composed of interlinked org files. This system is -called @emph{org-publish}. You can also configure org-publish to -automatically upload your exported HTML pages and related attachments, -such as images and source code files, to a web server. Org-publish turns -org-mode into a web-site authoring tool. +Org-mode includes@footnote{@file{org-publish.el} is not distributed with +Emacs 21, if you are still using Emacs 21, you need you need to download +this file separately.} a publishing management system that allows you to +configure automatic HTML conversion of @emph{projects} composed of +interlinked org files. This system is called @emph{org-publish}. You +can also configure org-publish to automatically upload your exported +HTML pages and related attachments, such as images and source code +files, to a web server. Org-publish turns org-mode into a web-site +authoring tool. Org-publish has been contributed to Org-mode by David O'Toole. @@ -6118,7 +6254,7 @@ respective variable for details. When a property is given a value in org-publish-project-alist, its setting overrides the value of the corresponding user variable (if any) -during publishing. options set within a file (@pxref{Export +during publishing. Options set within a file (@pxref{Export options}), however, override everything. @node Publishing links, Project page index, Publishing options, Configuration @@ -6445,8 +6581,8 @@ Logging TODO state changes and clock intervals (variable logging @r{record a timestamp when an item is marked DONE} nologging @r{don't record when items are marked DONE} lognotedone @r{record timestamp and a note when DONE} -lognotestate @r{record timestamp, note when TODO state changes} -logrepeat @r{record a not when re-instating a repeating item} +lognotestate @r{record timestamp and a note when TODO state changes} +logrepeat @r{record a note when re-instating a repeating item} nologrepeat @r{do not record when re-instating repeating item} lognoteclock-out @r{record timestamp and a note when clocking out} @end example @@ -6531,6 +6667,9 @@ default location. If the cursor is on a @code{<<>>}, update radio targets and corresponding links in this buffer. @item +If the cursor is in a property line or at the start or end of a property +drawer, offer property commands. +@item If the cursor is in a plain list item with a checkbox, toggle the status of the checkbox. @item @@ -7289,6 +7428,7 @@ MATCH is being ignored." @node Using the property API, , Special agenda views, Extensions and Hacking @section Using the property API @cindex API, for properties +@cindex properties, API Here is a description of the functions that can be used to work with properties. From 48df920c8702611c3b447856bdd8a97d68e38f93 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 14:13:16 +0000 Subject: [PATCH 070/163] (update-directory-autoloads): Remove duplicates without also removing entries from other directories. --- lisp/ChangeLog | 46 +++++++++++++++++-------------------- lisp/emacs-lisp/autoload.el | 10 ++++---- 2 files changed, 27 insertions(+), 29 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 59d6c7fa57e..2a9438965ed 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,18 +1,22 @@ +2007-07-10 Stefan Monnier + + * emacs-lisp/autoload.el (update-directory-autoloads): Remove + duplicates without also removing entries from other directories. + 2007-07-10 Carsten Dominik * textmodes/org.el (org-agenda-day-view, org-agenda-week-view): Remember span as default. - (org-columns-edit-value): Renamed from `org-column-edit'. - (org-columns-display-here-title): Renamed from + (org-columns-edit-value): Rename from `org-column-edit'. + (org-columns-display-here-title): Rename from `org-overlay-columns-title'. - (org-columns-remove-overlays): ` Renamed from - org-remove-column-overlays'. - (org-columns-get-autowidth-alist): ` Renamed from - org-get-columns-autowidth-alist'. - (org-columns-display-here): Renamed from `org-overlay-columns'. - (org-columns-new-overlay): Renamed from `org-new-column-overlay'. - (org-columns-quit): Renamed from `org-column-quit'. - (org-columns-show-value): Renamed from `org-column-show-value'. + (org-columns-remove-overlays): Rename from org-remove-column-overlays. + (org-columns-get-autowidth-alist): Rename from + `org-get-columns-autowidth-alist'. + (org-columns-display-here): Rename from `org-overlay-columns'. + (org-columns-new-overlay): Rename from `org-new-column-overlay'. + (org-columns-quit): Rename from `org-column-quit'. + (org-columns-show-value): Rename from `org-column-show-value'. (org-columns-content, org-columns-widen) (org-columns-next-allowed-value) (org-columns-edit-allowed, org-columns-store-format) @@ -34,17 +38,16 @@ (org-property-get-allowed-values) (org-verify-version, org-column-string-to-number) (org-delete-property-globally): New functions. - (org-columns-current-fmt): Renamed from `org-current-columns-fmt'. - (org-columns-overlays): Renamed from `org-column-overlays'. - (org-columns-map): Renamed from `org-column-map'. - (org-columns-current-maxwidths): Renamed from + (org-columns-current-fmt): Rename from `org-current-columns-fmt'. + (org-columns-overlays): Rename from `org-column-overlays'. + (org-columns-map): Rename from `org-column-map'. + (org-columns-current-maxwidths): Rename from `org-current-columns-maxwidths'. (org-columns-begin-marker, org-columns-current-fmt-compiled) (org-previous-header-line-format) (org-columns-inhibit-recalculation) (org-columns-top-level-marker): New variables. - (org-columns-default-format): Renamed from - `org-default-columns-format'. + (org-columns-default-format): Rename from `org-default-columns-format'. (org-property-re): New constant. 2007-07-10 Guanpeng Xu @@ -77,8 +80,8 @@ * longlines.el (longlines-wrap-region): Avoid marking buffer as modified. - (longlines-auto-wrap, longlines-window-change-function): Remove - unnecessary calls to set-buffer-modified-p. + (longlines-auto-wrap, longlines-window-change-function): + Remove unnecessary calls to set-buffer-modified-p. 2007-07-08 Katsumi Yamaoka @@ -89,13 +92,6 @@ * vc-cvs.el (vc-cvs-revert): Use vc-default-revert. (vc-cvs-checkout): Remove last arg now unused; simplify. -2007-07-08 Chong Yidong - - * longlines.el (longlines-wrap-region): Avoid marking buffer as - modified. - (longlines-auto-wrap, longlines-window-change-function): - Remove unnecessary calls to set-buffer-modified-p. - 2007-07-08 Michael Albinus * files.el (file-remote-p): Introduce optional parameter CONNECTED. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 30b7c7e1937..0fa89f2a173 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -559,6 +559,7 @@ directory or directories specified." (directory-files (expand-file-name dir) t files-re)) dirs))) + (done ()) (this-time (current-time)) ;; Files with no autoload cookies or whose autoloads go to other ;; files because of file-local autoload-generated-file settings. @@ -592,10 +593,10 @@ directory or directories specified." (push file no-autoloads) (setq files (delete file files))))))) ((not (stringp file))) - ((not (and (file-exists-p file) - ;; Remove duplicates as well, just in case. - (member file files))) - ;; Remove the obsolete section. + ((or (not (file-exists-p file)) + ;; Remove duplicates as well, just in case. + (member file done)) + ;; Remove the obsolete section. (autoload-remove-section (match-beginning 0))) ((not (time-less-p (nth 4 form) (nth 5 (file-attributes file)))) @@ -606,6 +607,7 @@ directory or directories specified." (if (autoload-generate-file-autoloads file (current-buffer) buffer-file-name) (push file no-autoloads)))) + (push file done) (setq files (delete file files))))) ;; Elements remaining in FILES have no existing autoload sections yet. (dolist (file files) From a1be1ce88b203a86b4f52b9f6e8360557098009a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 15:13:33 +0000 Subject: [PATCH 071/163] (map_keymap_function_t): More informative prototype. --- src/ChangeLog | 4 ++++ src/keymap.h | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 489e68b37be..5c8a1db1dc5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2007-07-10 Stefan Monnier + + * keymap.h (map_keymap_function_t): More informative prototype. + 2007-07-10 Guanpeng Xu * search.c (Vinhibit_changing_match_data, search_regs_1): New vars. diff --git a/src/keymap.h b/src/keymap.h index 185ae70d945..df135114c87 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -47,7 +47,7 @@ extern void syms_of_keymap P_ ((void)); extern void keys_of_keymap P_ ((void)); typedef void (*map_keymap_function_t) - P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*)); + P_ ((Lisp_Object key, Lisp_Object val, Lisp_Object args, void* data)); extern void map_keymap P_ ((Lisp_Object map, map_keymap_function_t fun, Lisp_Object largs, void* cargs, int autoload)); #endif From fab84e3cfb291680f863074023e29b8daea0ed82 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 15:20:15 +0000 Subject: [PATCH 072/163] (struct accessible_keymaps_data, struct where_is_internal_data): New structs. (accessible_keymaps_1, where_is_internal_1): Use them to change interface to adhere to the one used by map_keymap. (Faccessible_keymaps, where_is_internal): Use map_keymap. (accessible_keymaps_char_table, where_is_internal_2): Remove. --- src/ChangeLog | 7 + src/keymap.c | 384 ++++++++++++++++++-------------------------------- 2 files changed, 142 insertions(+), 249 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 5c8a1db1dc5..8c4cbe1c214 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,12 @@ 2007-07-10 Stefan Monnier + * keymap.c (struct accessible_keymaps_data) + (struct where_is_internal_data): New structures. + (accessible_keymaps_1, where_is_internal_1): Use them to change + interface to adhere to the one used by map_keymap. + (Faccessible_keymaps, where_is_internal): Use map_keymap. + (accessible_keymaps_char_table, where_is_internal_2): Remove. + * keymap.h (map_keymap_function_t): More informative prototype. 2007-07-10 Guanpeng Xu diff --git a/src/keymap.c b/src/keymap.c index f9071f9c633..e008fceed99 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1156,7 +1156,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); - meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key) + meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key)) ? meta_modifier : 0x80); if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) @@ -2046,12 +2046,23 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* Help functions for describing and documenting keymaps. */ +struct accessible_keymaps_data { + Lisp_Object maps, tail, thisseq; + /* Does the current sequence end in the meta-prefix-char? */ + int is_metized; +}; static void -accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) - Lisp_Object maps, tail, thisseq, key, cmd; - int is_metized; /* If 1, `key' is assumed to be INTEGERP. */ +accessible_keymaps_1 (key, cmd, args, data) + Lisp_Object key, cmd, args; + /* Use void* to be compatible with map_keymap_function_t. */ + void *data; { + struct accessible_keymaps_data *d = data; /* Cast! */ + Lisp_Object maps = d->maps; + Lisp_Object tail = d->tail; + Lisp_Object thisseq = d->thisseq; + int is_metized = d->is_metized && INTEGERP (key); Lisp_Object tem; cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); @@ -2105,17 +2116,6 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) } } -static void -accessible_keymaps_char_table (args, index, cmd) - Lisp_Object args, index, cmd; -{ - accessible_keymaps_1 (index, cmd, - XCAR (XCAR (args)), - XCAR (XCDR (args)), - XCDR (XCDR (args)), - XINT (XCDR (XCAR (args)))); -} - /* This function cannot GC. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, @@ -2130,13 +2130,10 @@ then the value includes only maps for prefixes that start with PREFIX. */) Lisp_Object keymap, prefix; { Lisp_Object maps, tail; - int prefixlen = 0; + int prefixlen = XINT (Flength (prefix)); /* no need for gcpro because we don't autoload any keymaps. */ - if (!NILP (prefix)) - prefixlen = XINT (Flength (prefix)); - if (!NILP (prefix)) { /* If a prefix was specified, start with the keymap (if any) for @@ -2147,7 +2144,9 @@ then the value includes only maps for prefixes that start with PREFIX. */) if the prefix is not defined in this particular map. It might even give us a list that isn't a keymap. */ tem = get_keymap (tem, 0, 0); - if (CONSP (tem)) + /* If the keymap is autoloaded `tem' is not a cons-cell, but we still + want to return it. */ + if (!NILP (tem)) { /* Convert PREFIX to a vector now, so that later on we don't have to deal with the possibility of a string. */ @@ -2187,57 +2186,26 @@ then the value includes only maps for prefixes that start with PREFIX. */) for (tail = maps; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object thisseq, thismap; + struct accessible_keymaps_data data; + register Lisp_Object thismap = Fcdr (XCAR (tail)); Lisp_Object last; - /* Does the current sequence end in the meta-prefix-char? */ - int is_metized; - thisseq = Fcar (Fcar (tail)); - thismap = Fcdr (Fcar (tail)); - last = make_number (XINT (Flength (thisseq)) - 1); - is_metized = (XINT (last) >= 0 + data.thisseq = Fcar (XCAR (tail)); + data.maps = maps; + data.tail = tail; + last = make_number (XINT (Flength (data.thisseq)) - 1); + /* Does the current sequence end in the meta-prefix-char? */ + data.is_metized = (XINT (last) >= 0 /* Don't metize the last char of PREFIX. */ && XINT (last) >= prefixlen - && EQ (Faref (thisseq, last), meta_prefix_char)); + && EQ (Faref (data.thisseq, last), meta_prefix_char)); - for (; CONSP (thismap); thismap = XCDR (thismap)) - { - Lisp_Object elt; - - elt = XCAR (thismap); - - QUIT; - - if (CHAR_TABLE_P (elt)) - { - Lisp_Object indices[3]; - - map_char_table (accessible_keymaps_char_table, Qnil, elt, - elt, Fcons (Fcons (maps, make_number (is_metized)), - Fcons (tail, thisseq)), - 0, indices); - } - else if (VECTORP (elt)) - { - register int i; - - /* Vector keymap. Scan all the elements. */ - for (i = 0; i < ASIZE (elt); i++) - accessible_keymaps_1 (make_number (i), AREF (elt, i), - maps, tail, thisseq, is_metized); - - } - else if (CONSP (elt)) - accessible_keymaps_1 (XCAR (elt), XCDR (elt), - maps, tail, thisseq, - is_metized && INTEGERP (XCAR (elt))); - - } + /* Since we can't run lisp code, we can't scan autoloaded maps. */ + if (CONSP (thismap)) + map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0); } - return maps; } - Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ @@ -2508,7 +2476,7 @@ around function keys and event symbols. */) { char buf[256]; - sprintf (buf, "Invalid char code %d", XINT (key)); + sprintf (buf, "Invalid char code %ld", XINT (key)); return build_string (buf); } else if (charset @@ -2651,8 +2619,8 @@ ascii_sequence_p (seq) /* where-is - finding a command in a set of keymaps. */ static Lisp_Object where_is_internal (); -static Lisp_Object where_is_internal_1 (); -static void where_is_internal_2 (); +static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding, + Lisp_Object args, void *data)); /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. Returns the first non-nil binding found in any of those maps. */ @@ -2681,6 +2649,12 @@ shadow_lookup (shadow, key, flag) static Lisp_Object Vmouse_events; +struct where_is_internal_data { + Lisp_Object definition, noindirect, this, last; + int last_is_meta; + Lisp_Object sequences; +}; + /* This function can GC if Flookup_key autoloads any keymaps. */ static Lisp_Object @@ -2718,6 +2692,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) { /* Key sequence to reach map, and the map that it reaches */ register Lisp_Object this, map, tem; + struct where_is_internal_data data; /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence @@ -2742,149 +2717,95 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) QUIT; - while (CONSP (map)) + data.definition = definition; + data.noindirect = noindirect; + data.this = this; + data.last = last; + data.last_is_meta = last_is_meta; + data.sequences = Qnil; + + if (CONSP (map)) + map_keymap (map, where_is_internal_1, Qnil, &data, 0); + + sequences = data.sequences; + + while (CONSP (sequences)) { - /* Because the code we want to run on each binding is rather - large, we don't want to have two separate loop bodies for - sparse keymap bindings and tables; we want to iterate one - loop body over both keymap and vector bindings. + Lisp_Object sequence, remapped, function; + + sequence = XCAR (sequences); + sequences = XCDR (sequences); - For this reason, if Fcar (map) is a vector, we don't - advance map to the next element until i indicates that we - have finished off the vector. */ - Lisp_Object elt, key, binding; - elt = XCAR (map); - map = XCDR (map); - - sequences = Qnil; - - QUIT; - - /* Set key and binding to the current key and binding, and - advance map and i to the next binding. */ - if (VECTORP (elt)) + /* If the current sequence is a command remapping with + format [remap COMMAND], find the key sequences + which run COMMAND, and use those sequences instead. */ + remapped = Qnil; + if (NILP (no_remap) + && VECTORP (sequence) && XVECTOR (sequence)->size == 2 + && EQ (AREF (sequence, 0), Qremap) + && (function = AREF (sequence, 1), SYMBOLP (function))) { - Lisp_Object sequence; - int i; - /* In a vector, look at each element. */ - for (i = 0; i < XVECTOR (elt)->size; i++) + Lisp_Object remapped1; + + remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); + if (CONSP (remapped1)) { - binding = AREF (elt, i); - XSETFASTINT (key, i); - sequence = where_is_internal_1 (binding, key, definition, - noindirect, this, - last, nomenus, last_is_meta); - if (!NILP (sequence)) - sequences = Fcons (sequence, sequences); - } - } - else if (CHAR_TABLE_P (elt)) - { - Lisp_Object indices[3]; - Lisp_Object args; - - args = Fcons (Fcons (Fcons (definition, noindirect), - Qnil), /* Result accumulator. */ - Fcons (Fcons (this, last), - Fcons (make_number (nomenus), - make_number (last_is_meta)))); - map_char_table (where_is_internal_2, Qnil, elt, elt, args, - 0, indices); - sequences = XCDR (XCAR (args)); - } - else if (CONSP (elt)) - { - Lisp_Object sequence; - - key = XCAR (elt); - binding = XCDR (elt); - - sequence = where_is_internal_1 (binding, key, definition, - noindirect, this, - last, nomenus, last_is_meta); - if (!NILP (sequence)) - sequences = Fcons (sequence, sequences); - } - - - while (!NILP (sequences)) - { - Lisp_Object sequence, remapped, function; - - sequence = XCAR (sequences); - sequences = XCDR (sequences); - - /* If the current sequence is a command remapping with - format [remap COMMAND], find the key sequences - which run COMMAND, and use those sequences instead. */ - remapped = Qnil; - if (NILP (no_remap) - && VECTORP (sequence) && XVECTOR (sequence)->size == 2 - && EQ (AREF (sequence, 0), Qremap) - && (function = AREF (sequence, 1), SYMBOLP (function))) - { - Lisp_Object remapped1; - - remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); - if (CONSP (remapped1)) - { - /* Verify that this key binding actually maps to the - remapped command (see below). */ - if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) - continue; - sequence = XCAR (remapped1); - remapped = XCDR (remapped1); - goto record_sequence; - } - } - - /* Verify that this key binding is not shadowed by another - binding for the same key, before we say it exists. - - Mechanism: look for local definition of this key and if - it is defined and does not match what we found then - ignore this key. - - Either nil or number as value from Flookup_key - means undefined. */ - if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) - continue; - - record_sequence: - /* Don't annoy user with strings from a menu such as - Select Paste. Change them all to "(any string)", - so that there seems to be only one menu item - to report. */ - if (! NILP (sequence)) - { - Lisp_Object tem; - tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); - if (STRINGP (tem)) - Faset (sequence, make_number (XVECTOR (sequence)->size - 1), - build_string ("(any string)")); - } - - /* It is a true unshadowed match. Record it, unless it's already - been seen (as could happen when inheriting keymaps). */ - if (NILP (Fmember (sequence, found))) - found = Fcons (sequence, found); - - /* If firstonly is Qnon_ascii, then we can return the first - binding we find. If firstonly is not Qnon_ascii but not - nil, then we should return the first ascii-only binding - we find. */ - if (EQ (firstonly, Qnon_ascii)) - RETURN_UNGCPRO (sequence); - else if (!NILP (firstonly) && ascii_sequence_p (sequence)) - RETURN_UNGCPRO (sequence); - - if (CONSP (remapped)) - { - sequence = XCAR (remapped); - remapped = XCDR (remapped); + /* Verify that this key binding actually maps to the + remapped command (see below). */ + if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) + continue; + sequence = XCAR (remapped1); + remapped = XCDR (remapped1); goto record_sequence; } } + + /* Verify that this key binding is not shadowed by another + binding for the same key, before we say it exists. + + Mechanism: look for local definition of this key and if + it is defined and does not match what we found then + ignore this key. + + Either nil or number as value from Flookup_key + means undefined. */ + if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) + continue; + + record_sequence: + /* Don't annoy user with strings from a menu such as + Select Paste. Change them all to "(any string)", + so that there seems to be only one menu item + to report. */ + if (! NILP (sequence)) + { + Lisp_Object tem; + tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); + if (STRINGP (tem)) + Faset (sequence, make_number (XVECTOR (sequence)->size - 1), + build_string ("(any string)")); + } + + /* It is a true unshadowed match. Record it, unless it's already + been seen (as could happen when inheriting keymaps). */ + if (NILP (Fmember (sequence, found))) + found = Fcons (sequence, found); + + /* If firstonly is Qnon_ascii, then we can return the first + binding we find. If firstonly is not Qnon_ascii but not + nil, then we should return the first ascii-only binding + we find. */ + if (EQ (firstonly, Qnon_ascii)) + RETURN_UNGCPRO (sequence); + else if (!NILP (firstonly) && ascii_sequence_p (sequence)) + RETURN_UNGCPRO (sequence); + + if (CONSP (remapped)) + { + sequence = XCAR (remapped); + remapped = XCDR (remapped); + goto record_sequence; + } } } @@ -3002,53 +2923,19 @@ remapped command in the returned list. */) return result; } -/* This is the function that Fwhere_is_internal calls using map_char_table. - ARGS has the form - (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT)) - . - ((THIS . LAST) . (NOMENUS . LAST_IS_META))) - Since map_char_table doesn't really use the return value from this function, - we the result append to RESULT, the slot in ARGS. - - This function can GC because it calls where_is_internal_1 which can - GC. */ - -static void -where_is_internal_2 (args, key, binding) - Lisp_Object args, key, binding; -{ - Lisp_Object definition, noindirect, this, last; - Lisp_Object result, sequence; - int nomenus, last_is_meta; - struct gcpro gcpro1, gcpro2, gcpro3; - - GCPRO3 (args, key, binding); - result = XCDR (XCAR (args)); - definition = XCAR (XCAR (XCAR (args))); - noindirect = XCDR (XCAR (XCAR (args))); - this = XCAR (XCAR (XCDR (args))); - last = XCDR (XCAR (XCDR (args))); - nomenus = XFASTINT (XCAR (XCDR (XCDR (args)))); - last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args)))); - - sequence = where_is_internal_1 (binding, key, definition, noindirect, - this, last, nomenus, last_is_meta); - - if (!NILP (sequence)) - XSETCDR (XCAR (args), Fcons (sequence, result)); - - UNGCPRO; -} - - /* This function can GC because get_keyelt can. */ -static Lisp_Object -where_is_internal_1 (binding, key, definition, noindirect, this, last, - nomenus, last_is_meta) - Lisp_Object binding, key, definition, noindirect, this, last; - int nomenus, last_is_meta; +static void +where_is_internal_1 (key, binding, args, data) + Lisp_Object key, binding, args; + void *data; { + struct where_is_internal_data *d = data; /* Cast! */ + Lisp_Object definition = d->definition; + Lisp_Object noindirect = d->noindirect; + Lisp_Object this = d->this; + Lisp_Object last = d->last; + int last_is_meta = d->last_is_meta; Lisp_Object sequence; /* Search through indirections unless that's not wanted. */ @@ -3062,7 +2949,7 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, || EQ (binding, definition) || (CONSP (definition) && !NILP (Fequal (binding, definition))))) /* Doesn't match. */ - return Qnil; + return; /* We have found a match. Construct the key sequence where we found it. */ if (INTEGERP (key) && last_is_meta) @@ -3077,10 +2964,9 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, { Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); Fputhash (binding, Fcons (sequence, sequences), where_is_cache); - return Qnil; } else - return sequence; + d->sequences = Fcons (sequence, d->sequences); } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ From d47ecf8be4c386627dca2f20d7bbba049740195f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 15:23:36 +0000 Subject: [PATCH 073/163] (Ftranspose_regions): Use EMACS_INT for positions. --- src/editfns.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index 5fd40ed51c7..f88d0a6b54c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4112,9 +4112,9 @@ Transposing beyond buffer boundaries is an error. */) (startr1, endr1, startr2, endr2, leave_markers) Lisp_Object startr1, endr1, startr2, endr2, leave_markers; { - register int start1, end1, start2, end2; - int start1_byte, start2_byte, len1_byte, len2_byte; - int gap, len1, len_mid, len2; + register EMACS_INT start1, end1, start2, end2; + EMACS_INT start1_byte, start2_byte, len1_byte, len2_byte; + EMACS_INT gap, len1, len_mid, len2; unsigned char *start1_addr, *start2_addr, *temp; INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3; From 8071c00f471b737c6f86255671705a2c40c189e4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 15:40:06 +0000 Subject: [PATCH 074/163] (map_char_table): Use an array of int for `indices' rather than an array of Lisp_Objects (which are only ever integers anyway). --- src/ChangeLog | 15 ++++++++++++--- src/casetab.c | 2 +- src/fns.c | 18 +++++++++--------- src/fontset.c | 2 +- src/keymap.c | 6 +++--- src/lisp.h | 4 +++- 6 files changed, 29 insertions(+), 18 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 8c4cbe1c214..e417ff9ee86 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,15 @@ 2007-07-10 Stefan Monnier + * fns.c (map_char_table): Use an array of int for `indices' rather than + an array of Lisp_Objects (which are only ever integers anyway). + (Fmap_char_table): Update caller. + * lisp.h: Update prototype. + * keymap.c (Fset_keymap_parent, map_keymap, Fcopy_keymap): + * fontset.c (Ffontset_info): + * casetab.c (set_case_table): Update callers. + + * editfns.c (Ftranspose_regions): Use EMACS_INT for positions. + * keymap.c (struct accessible_keymaps_data) (struct where_is_internal_data): New structures. (accessible_keymaps_1, where_is_internal_1): Use them to change @@ -17,9 +27,8 @@ (string_match_1, search_buffer, set_search_regs): Likewise. (syms_of_search): Add Lisp level definition for `inhibit-changing-match-data' and set it to nil. - (boyer_moore): If `inhibit-changing-match-data' is non-nil, - compute start and end of the match, instead of using values in - search_regs. + (boyer_moore): If `inhibit-changing-match-data' is non-nil, compute + start and end of the match, instead of using values in search_regs. 2007-07-01 Stefan Monnier diff --git a/src/casetab.c b/src/casetab.c index 42c268dd7c6..cc0e814c171 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -126,7 +126,7 @@ set_case_table (table, standard) int standard; { Lisp_Object up, canon, eqv; - Lisp_Object indices[3]; + int indices[3]; check_case_table (table); diff --git a/src/fns.c b/src/fns.c index 379b1321e08..3e0605bea29 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2825,8 +2825,8 @@ DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table, void map_char_table (c_function, function, table, subtable, arg, depth, indices) void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); - Lisp_Object function, table, subtable, arg, *indices; - int depth; + Lisp_Object function, table, subtable, arg; + int depth, *indices; { int i, to; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -2860,7 +2860,7 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) } else { - int charset = XFASTINT (indices[0]) - 128; + int charset = indices[0] - 128; i = 32; to = SUB_CHAR_TABLE_ORDINARY_SLOTS; @@ -2874,8 +2874,8 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) int charset; elt = XCHAR_TABLE (subtable)->contents[i]; - XSETFASTINT (indices[depth], i); - charset = XFASTINT (indices[0]) - 128; + indices[depth] = i; + charset = indices[0] - 128; if (depth == 0 && (!CHARSET_DEFINED_P (charset) || charset == CHARSET_8_BIT_CONTROL @@ -2892,8 +2892,8 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) { int c1, c2, c; - c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; - c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; + c1 = depth >= 1 ? indices[1] : 0; + c2 = depth >= 2 ? indices[2] : 0; c = MAKE_CHAR (charset, c1, c2); if (NILP (elt)) @@ -2927,14 +2927,14 @@ The key is always a possible IDX argument to `aref'. */) Lisp_Object function, char_table; { /* The depth of char table is at most 3. */ - Lisp_Object indices[3]; + int indices[3]; CHECK_CHAR_TABLE (char_table); /* When Lisp_Object is represented as a union, `call2' cannot directly be passed to map_char_table because it returns a Lisp_Object rather than returning nothing. - Casting leads to crashes on some architectures. -stef */ + Casting leads to crashes on some architectures. --Stef */ map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices); return Qnil; } diff --git a/src/fontset.c b/src/fontset.c index 2df60a5afcc..349603f7bb9 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1437,7 +1437,7 @@ If FRAME is omitted, it defaults to the currently selected frame. */) { Lisp_Object fontset; FRAME_PTR f; - Lisp_Object indices[3]; + int indices[3]; Lisp_Object val, tail, elt; Lisp_Object *realized; struct font_info *fontp = NULL; diff --git a/src/keymap.c b/src/keymap.c index e008fceed99..566ab41872f 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -429,7 +429,7 @@ Return PARENT. PARENT should be nil or another keymap. */) if (CHAR_TABLE_P (XCAR (list))) { - Lisp_Object indices[3]; + int indices[3]; map_char_table (fix_submap_inheritance, Qnil, XCAR (list), XCAR (list), @@ -728,7 +728,7 @@ map_keymap (map, fun, args, data, autoload) } else if (CHAR_TABLE_P (binding)) { - Lisp_Object indices[3]; + int indices[3]; map_char_table (map_keymap_char_table_item, Qnil, binding, binding, Fcons (make_save_value (fun, 0), Fcons (make_save_value (data, 0), @@ -1079,7 +1079,7 @@ is not copied. */) Lisp_Object elt = XCAR (keymap); if (CHAR_TABLE_P (elt)) { - Lisp_Object indices[3]; + int indices[3]; elt = Fcopy_sequence (elt); map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices); } diff --git a/src/lisp.h b/src/lisp.h index d380ba0d049..6e77bf3e1ac 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2428,7 +2428,7 @@ EXFUN (Fstring_lessp, 2); extern int char_table_translate P_ ((Lisp_Object, int)); extern void map_char_table P_ ((void (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int, - Lisp_Object *)); + int *)); extern Lisp_Object char_table_ref_and_index P_ ((Lisp_Object, int, int *)); extern void syms_of_fns P_ ((void)); @@ -3244,6 +3244,7 @@ EXFUN (Fx_file_dialog, 5); #endif /* Defined in xfaces.c */ +EXFUN (Fclear_face_cache, 1); extern void syms_of_xfaces P_ ((void)); #ifndef HAVE_GETLOADAVG @@ -3259,6 +3260,7 @@ extern void syms_of_xfns P_ ((void)); extern void syms_of_xsmfns P_ ((void)); /* Defined in xselect.c */ +EXFUN (Fx_send_client_event, 6); extern void syms_of_xselect P_ ((void)); /* Defined in xterm.c */ From 813fb3fe82c53a5586bcf4566da7bd3d15a87486 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 16:01:25 +0000 Subject: [PATCH 075/163] (compilation-auto-jump-to-first-error,compilation-auto-jump-to-next): New vars. (compilation-auto-jump): New function. (compilation-error-properties): Use them to jump to first error. (compilation-start): Set the var if requested. --- etc/NEWS | 3 +++ lisp/ChangeLog | 6 +++++ lisp/progmodes/compile.el | 51 ++++++++++++++++++++++++++++----------- 3 files changed, 46 insertions(+), 14 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 4323f6ff1cf..6d30e2a7b91 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -73,6 +73,9 @@ recenter the visited source file. Its value can be a number (for example, * Changes in Specialized Modes and Packages in Emacs 23.1 +** compilation-auto-jump-to-first-error tells `compile' to jump to +the first error encountered during compilations. + ** In the `copyright' package, you can specify your copyright holders's names. Only copyright lines with holders matching copyright-names-regexp will be considered for update. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2a9438965ed..ae0f9fe2247 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2007-07-10 Stefan Monnier + * progmodes/compile.el (compilation-auto-jump-to-first-error) + (compilation-auto-jump-to-next): New vars. + (compilation-auto-jump): New function. + (compilation-error-properties): Use them to jump to first error. + (compilation-start): Set the var if requested. + * emacs-lisp/autoload.el (update-directory-autoloads): Remove duplicates without also removing entries from other directories. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index ce73ef30ca0..0d08b755a9e 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -87,13 +87,13 @@ ;;;###autoload (defcustom compilation-mode-hook nil - "*List of hook functions run by `compilation-mode' (see `run-mode-hooks')." + "List of hook functions run by `compilation-mode' (see `run-mode-hooks')." :type 'hook :group 'compilation) ;;;###autoload (defcustom compilation-window-height nil - "*Number of lines in a compilation window. If nil, use Emacs default." + "Number of lines in a compilation window. If nil, use Emacs default." :type '(choice (const :tag "Default" nil) integer) :group 'compilation) @@ -442,7 +442,7 @@ Highlight entire line if t; don't highlight source lines if nil.") "Overlay used to temporarily highlight compilation matches.") (defcustom compilation-error-screen-columns t - "*If non-nil, column numbers in error messages are screen columns. + "If non-nil, column numbers in error messages are screen columns. Otherwise they are interpreted as character positions, with each character occupying one column. The default is to use screen columns, which requires that the compilation @@ -453,21 +453,21 @@ especially the TAB character." :version "20.4") (defcustom compilation-read-command t - "*Non-nil means \\[compile] reads the compilation command to use. + "Non-nil means \\[compile] reads the compilation command to use. Otherwise, \\[compile] just uses the value of `compile-command'." :type 'boolean :group 'compilation) ;;;###autoload (defcustom compilation-ask-about-save t - "*Non-nil means \\[compile] asks which buffers to save before compiling. + "Non-nil means \\[compile] asks which buffers to save before compiling. Otherwise, it saves all modified buffers without asking." :type 'boolean :group 'compilation) ;;;###autoload (defcustom compilation-search-path '(nil) - "*List of directories to search for source files named in error messages. + "List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. The value nil as an element means to try the default directory." :type '(repeat (choice (const :tag "Default" nil) @@ -476,7 +476,7 @@ The value nil as an element means to try the default directory." ;;;###autoload (defcustom compile-command "make -k " - "*Last shell command used to do a compilation; default for next compilation. + "Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. You might also use mode hooks to specify it in certain modes, like this: @@ -494,7 +494,7 @@ You might also use mode hooks to specify it in certain modes, like this: ;;;###autoload (defcustom compilation-disable-input nil - "*If non-nil, send end-of-file as compilation process input. + "If non-nil, send end-of-file as compilation process input. This only affects platforms that support asynchronous processes (see `start-process'); synchronous compilation processes never accept input." :type 'boolean @@ -605,6 +605,14 @@ Faces `compilation-error-face', `compilation-warning-face', (defvar compilation-error-list nil) (defvar compilation-old-error-list nil) +(defcustom compilation-auto-jump-to-first-error nil + "If non-nil, automatically jump to the first error after `compile'." + :type 'boolean) + +(defvar compilation-auto-jump-to-next nil + "If non-nil, automatically jump to the next error encountered.") +(make-variable-buffer-local 'compilation-auto-jump-to-next) + (defun compilation-face (type) (or (and (car type) (match-end (car type)) compilation-warning-face) (and (cdr type) (match-end (cdr type)) compilation-info-face) @@ -652,13 +660,18 @@ Faces `compilation-error-face', `compilation-warning-face', l2 (setcdr l1 (cons (list ,key) l2))))))) +(defun compilation-auto-jump (buffer pos) + (with-current-buffer buffer + (goto-char pos) + (compile-goto-error))) ;; This function is the central driver, called when font-locking to gather ;; all information needed to later jump to corresponding source code. ;; Return a property list with all meta information on this error location. (defun compilation-error-properties (file line end-line col end-col type fmt) - (unless (< (next-single-property-change (match-beginning 0) 'directory nil (point)) + (unless (< (next-single-property-change (match-beginning 0) + 'directory nil (point)) (point)) (if file (if (functionp file) @@ -710,6 +723,13 @@ Faces `compilation-error-face', `compilation-warning-face', (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) 2))) + + (when (and compilation-auto-jump-to-next + (>= type compilation-skip-threshold)) + (kill-local-variable 'compilation-auto-jump-to-next) + (run-with-timer 0 nil 'compilation-auto-jump + (current-buffer) (match-beginning 0))) + (compilation-internal-error-properties file line end-line col end-col type fmt))) (defun compilation-move-to-column (col screen) @@ -932,7 +952,7 @@ original use. Otherwise, recompile using `compile-command'." `(,(eval compile-command)))))) (defcustom compilation-scroll-output nil - "*Non-nil to scroll the *compilation* buffer window as output appears. + "Non-nil to scroll the *compilation* buffer window as output appears. Setting it causes the Compilation mode commands to put point at the end of their output window so that the end of the output is always @@ -1026,8 +1046,9 @@ Returns the compilation buffer created." ;; Clear out the compilation buffer. (let ((inhibit-read-only t) (default-directory thisdir)) - ;; Then evaluate a cd command if any, but don't perform it yet, else start-command - ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" + ;; Then evaluate a cd command if any, but don't perform it yet, else + ;; start-command would do it again through the shell: (cd "..") AND + ;; sh -c "cd ..; make" (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) (if (match-end 1) (substitute-env-vars (match-string 1 command)) @@ -1043,6 +1064,8 @@ Returns the compilation buffer created." (if highlight-regexp (set (make-local-variable 'compilation-highlight-regexp) highlight-regexp)) + (if compilation-auto-jump-to-first-error + (set (make-local-variable 'compilation-auto-jump-to-next) t)) ;; Output a mode setter, for saving and later reloading this buffer. (insert "-*- mode: " name-of-mode "; default-directory: " (prin1-to-string default-directory) @@ -1244,7 +1267,7 @@ Returns the compilation buffer created." "*If non-nil, skip multiple error messages for the same source location.") (defcustom compilation-skip-threshold 1 - "*Compilation motion commands skip less important messages. + "Compilation motion commands skip less important messages. The value can be either 2 -- skip anything less than error, 1 -- skip anything less than warning or 0 -- don't skip any messages. Note that all messages not positively identified as warning or @@ -1256,7 +1279,7 @@ info, are considered errors." :version "22.1") (defcustom compilation-skip-visited nil - "*Compilation motion commands skip visited messages if this is t. + "Compilation motion commands skip visited messages if this is t. Visited messages are ones for which the file, line and column have been jumped to from the current content in the current compilation buffer, even if it was from a different message." From d3883360012de25fbf4654deb0a37a0919ab830a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 16:35:24 +0000 Subject: [PATCH 076/163] (easy-menu-binding): New function. (easy-menu-do-define): Use it. (easy-menu-do-add-item): Inline into easy-menu-add-item and then remove. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/easymenu.el | 40 ++++++++++++++++++++++--------------- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ae0f9fe2247..0c85aa3bfcb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2007-07-10 Stefan Monnier + * emacs-lisp/easymenu.el (easy-menu-binding): New function. + (easy-menu-do-define): Use it. + (easy-menu-do-add-item): Inline into easy-menu-add-item and then remove. + * progmodes/compile.el (compilation-auto-jump-to-first-error) (compilation-auto-jump-to-next): New vars. (compilation-auto-jump): New function. diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index d1ec5a1fe39..19df1a16a11 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -152,6 +152,21 @@ A menu item can be a list with the same format as MENU. This is a submenu." ,(if symbol `(defvar ,symbol nil ,doc)) (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) +(defun easy-menu-binding (menu &optional item-name) + "Return a binding suitable to pass to `define-key'. +This is expected to be bound to a mouse event." + ;; Under Emacs this is almost trivial, whereas under XEmacs this may + ;; involve defining a function that calls popup-menu. + (let ((props (if (symbolp menu) + (prog1 (get menu 'menu-prop) + (setq menu (symbol-function menu)))))) + (cons 'menu-item + (cons (or item-name + (if (keymapp menu) + (keymap-prompt menu)) + "") + (cons menu props))))) + ;;;###autoload (defun easy-menu-do-define (symbol maps doc menu) ;; We can't do anything that might differ between Emacs dialects in @@ -173,15 +188,10 @@ A menu item can be a list with the same format as MENU. This is a submenu." 'identity) (symbol-function ,symbol))) ,symbol))))) - (mapcar (lambda (map) - (define-key map (vector 'menu-bar (easy-menu-intern (car menu))) - (cons 'menu-item - (cons (car menu) - (if (not (symbolp keymap)) - (list keymap) - (cons (symbol-function keymap) - (get keymap 'menu-prop))))))) - (if (keymapp maps) (list maps) maps)))) + (dolist (map (if (keymapp maps) (list maps) maps)) + (define-key map + (vector 'menu-bar (easy-menu-intern (car menu))) + (easy-menu-binding keymap (car menu)))))) (defun easy-menu-filter-return (menu &optional name) "Convert MENU to the right thing to return from a menu filter. @@ -249,10 +259,6 @@ possibly preceded by keyword pairs as described in `easy-menu-define'." (defvar easy-menu-button-prefix '((radio . :radio) (toggle . :toggle))) -(defun easy-menu-do-add-item (menu item &optional before) - (setq item (easy-menu-convert-item item)) - (easy-menu-define-key menu (easy-menu-intern (car item)) (cdr item) before)) - (defvar easy-menu-converted-items-table (make-hash-table :test 'equal)) (defun easy-menu-convert-item (item) @@ -269,7 +275,7 @@ would always fail because the key is `equal' but not `eq'." (defun easy-menu-convert-item-1 (item) "Parse an item description and convert it to a menu keymap element. ITEM defines an item as in `easy-menu-define'." - (let (name command label prop remove help) + (let (name command label prop remove) (cond ((stringp item) ; An item or separator. (setq label item)) @@ -536,7 +542,8 @@ earlier by `easy-menu-define' or `easy-menu-create-menu'." (setq item (symbol-value item)))) ;; Item is a keymap, find the prompt string and use as item name. (setq item (cons (keymap-prompt item) item))) - (easy-menu-do-add-item map item before))) + (setq item (easy-menu-convert-item item)) + (easy-menu-define-key map (easy-menu-intern (car item)) (cdr item) before))) (defun easy-menu-item-present-p (map path name) "In submenu of MAP with path PATH, return non-nil iff item NAME is present. @@ -615,7 +622,8 @@ In some cases we use that to select between the local and global maps." (catch 'found (if (and map (symbolp map) (not (keymapp map))) (setq map (symbol-value map))) - (let ((maps (if map (list map) (current-active-maps)))) + (let ((maps (if map (if (keymapp map) (list map) map) + (current-active-maps)))) ;; Look for PATH in each map. (unless map (push 'menu-bar path)) (dolist (name path) From 7dcef48dd27e6d41b1d9cfab9d33160a15f4fe55 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 17:47:32 +0000 Subject: [PATCH 077/163] Don't change the global map from the follow-mode-map defvar, but from the toplevel. Use easy-menu to unify the Emacs and XEmacs code. (turn-on-follow-mode, turn-off-follow-mode): Remove interactive spec since `follow-mode' should be used instead for that. --- lisp/ChangeLog | 6 ++ lisp/follow.el | 168 +++++++++++++------------------------------------ 2 files changed, 50 insertions(+), 124 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0c85aa3bfcb..babcb63d9c8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2007-07-10 Stefan Monnier + * follow.el: Don't change the global map from the follow-mode-map + defvar, but from the toplevel. Use easy-menu to unify the Emacs and + XEmacs code. + (turn-on-follow-mode, turn-off-follow-mode): Remove interactive spec + since `follow-mode' should be used instead for that. + * emacs-lisp/easymenu.el (easy-menu-binding): New function. (easy-menu-do-define): Use it. (easy-menu-do-add-item): Inline into easy-menu-add-item and then remove. diff --git a/lisp/follow.el b/lisp/follow.el index 048db9bf11a..15d263d300d 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -336,123 +336,45 @@ After that, changing the prefix key requires manipulating keymaps." ;; the look and feel of Follow mode.) (define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer) - ;; - ;; The menu. - ;; - - (if (not (featurep 'xemacs)) - - ;; - ;; Emacs - ;; - (let ((menumap (funcall (symbol-function 'make-sparse-keymap) - "Follow")) - (count 0) - id) - (mapcar - (function - (lambda (item) - (setq id - (or (cdr item) - (progn - (setq count (+ count 1)) - (intern (format "separator-%d" count))))) - (define-key menumap (vector id) item) - (or (eq id 'follow-mode) - (put id 'menu-enable 'follow-mode)))) - ;; In reverse order: - '(("Toggle Follow mode" . follow-mode) - ("--") - ("Recenter" . follow-recenter) - ("--") - ("Previous Window" . follow-previous-window) - ("Next Windows" . follow-next-window) - ("Last Window" . follow-last-window) - ("First Window" . follow-first-window) - ("--") - ("Switch To Buffer (all windows)" - . follow-switch-to-buffer-all) - ("Switch To Buffer" . follow-switch-to-buffer) - ("--") - ("Delete Other Windows and Split" - . follow-delete-other-windows-and-split) - ("--") - ("Scroll Down" . follow-scroll-down) - ("Scroll Up" . follow-scroll-up))) - - ;; If there is a `tools' menu, we use it. However, we can't add a - ;; minor-mode specific item to it (it's broken), so we make the - ;; contents ghosted when not in use, and add ourselves to the - ;; global map. If no `tools' menu is present, just make a - ;; top-level menu visible when the mode is activated. - - (let ((tools-map (lookup-key (current-global-map) [menu-bar tools])) - (last nil)) - (if (sequencep tools-map) - (progn - ;; Find the last entry in the menu and store it in `last'. - (mapcar (function - (lambda (x) - (setq last (or (cdr-safe - (cdr-safe - (cdr-safe x))) - last)))) - tools-map) - (if last - (progn - (funcall (symbol-function 'define-key-after) - tools-map [separator-follow] '("--") last) - (funcall (symbol-function 'define-key-after) - tools-map [follow] (cons "Follow" menumap) - 'separator-follow)) - ;; Didn't find the last item, Adding to the top of - ;; tools. (This will probably never happend...) - (define-key (current-global-map) [menu-bar tools follow] - (cons "Follow" menumap)))) - ;; No tools menu, add "Follow" to the menubar. - (define-key mainmap [menu-bar follow] - (cons "Follow" menumap))))) - - ;; - ;; XEmacs. - ;; - - ;; place the menu in the `Tools' menu. - (let ((menu '("Follow" - :filter follow-menu-filter - ["Scroll Up" follow-scroll-up t] - ["Scroll Down" follow-scroll-down t] - ["Delete Other Windows and Split" - follow-delete-other-windows-and-split t] - ["Switch To Buffer" follow-switch-to-buffer t] - ["Switch To Buffer (all windows)" - follow-switch-to-buffer-all t] - ["First Window" follow-first-window t] - ["Last Window" follow-last-window t] - ["Next Windows" follow-next-window t] - ["Previous Window" follow-previous-window t] - ["Recenter" follow-recenter t] - ["Deactivate" follow-mode t]))) - - ;; Why not just `(set-buffer-menubar current-menubar)'? The - ;; question is a very good question. The reason is that under - ;; Emacs, neither `set-buffer-menubar' nor - ;; `current-menubar' is defined, hence the byte-compiler will - ;; warn. - (funcall (symbol-function 'set-buffer-menubar) - (symbol-value 'current-menubar)) - (funcall (symbol-function 'add-submenu) '("Tools") menu)) - - ;; When the mode is not activated, only one item is visible: - ;; "Activate". - (defun follow-menu-filter (menu) - (if follow-mode - menu - '(["Activate " follow-mode t])))) - mainmap) "Minor mode keymap for Follow mode.") +;; When the mode is not activated, only one item is visible to activate +;; the mode. +(defun follow-menu-filter (menu) + (if (bound-and-true-p 'follow-mode) + menu + '(["Follow mode " follow-mode + :style toggle :selected follow-mode]))) + +;; If there is a `tools' menu, we use it. However, we can't add a +;; minor-mode specific item to it (it's broken), so we make the +;; contents ghosted when not in use, and add ourselves to the +;; global map. +(easy-menu-add-item nil '("Tools") + '("Follow" + ;; The Emacs code used to just grey out operations when follow-mode was + ;; not enabled, whereas the XEmacs code used to remove it altogether. + ;; Not sure which is preferable, but clearly the preference should not + ;; depend on the flavor. + :filter follow-menu-filter + ["Scroll Up" follow-scroll-up follow-mode] + ["Scroll Down" follow-scroll-down follow-mode] + "--" + ["Delete Other Windows and Split" follow-delete-other-windows-and-split follow-mode] + "--" + ["Switch To Buffer" follow-switch-to-buffer follow-mode] + ["Switch To Buffer (all windows)" follow-switch-to-buffer-all follow-mode] + "--" + ["First Window" follow-first-window follow-mode] + ["Last Window" follow-last-window follow-mode] + ["Next Window" follow-next-window follow-mode] + ["Previous Window" follow-previous-window follow-mode] + "--" + ["Recenter" follow-recenter follow-mode] + "--" + ["Follow mode" follow-mode :style toggle :selected follow-mode])) + ;;}}} (defcustom follow-mode-line-text " Follow" @@ -553,14 +475,12 @@ Used by `follow-window-size-change'.") ;;;###autoload (defun turn-on-follow-mode () "Turn on Follow mode. Please see the function `follow-mode'." - (interactive) (follow-mode 1)) ;;;###autoload (defun turn-off-follow-mode () "Turn off Follow mode. Please see the function `follow-mode'." - (interactive) (follow-mode -1)) (put 'follow-mode 'permanent-local t) @@ -2084,8 +2004,8 @@ report this using the `report-emacs-bug' function." (defun follow-window-size-change (frame) "Redraw all windows in FRAME, when in Follow mode." - ;; Below, we call `post-command-hook'. This makes sure that we - ;; doesn't start a mutally recursive endless loop. + ;; Below, we call `post-command-hook'. This makes sure that we + ;; don't start a mutually recursive endless loop. (if follow-inside-post-command-hook nil (let ((buffers '()) @@ -2109,12 +2029,12 @@ report this using the `report-emacs-bug' function." (setq windows (follow-all-followers win)) (if (memq orig-window windows) (progn - ;; Make sure we're redrawing around the - ;; selected window. - ;; - ;; We must be really careful not to do this - ;; when we are (indirectly) called by - ;; `post-command-hook'. + ;; Make sure we're redrawing around the + ;; selected window. + ;; + ;; We must be really careful not to do this + ;; when we are (indirectly) called by + ;; `post-command-hook'. (select-window orig-window) (follow-post-command-hook) (setq orig-window (selected-window))) From 5045e68e7015710cc94ee6cbbd8bc81bad67d625 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 18:00:44 +0000 Subject: [PATCH 078/163] (mark_maybe_pointer): Enforce mult-of-8 alignment when using USE_LSB_TAG. Suggested by Dmitry Antipov . --- src/ChangeLog | 3 +++ src/alloc.c | 11 ++++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index e417ff9ee86..ed9053e851a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,8 @@ 2007-07-10 Stefan Monnier + * alloc.c (mark_maybe_pointer): Enforce mult-of-8 alignment when using + USE_LSB_TAG. Suggested by Dmitry Antipov . + * fns.c (map_char_table): Use an array of int for `indices' rather than an array of Lisp_Objects (which are only ever integers anyway). (Fmap_char_table): Update caller. diff --git a/src/alloc.c b/src/alloc.c index 7668309e59c..f3140da1ddc 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4263,9 +4263,14 @@ mark_maybe_pointer (p) { struct mem_node *m; - /* Quickly rule out some values which can't point to Lisp data. We - assume that Lisp data is aligned on even addresses. */ - if ((EMACS_INT) p & 1) + /* Quickly rule out some values which can't point to Lisp data. */ + if ((EMACS_INT) p % +#ifdef USE_LSB_TAG + 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */ +#else + 2 /* We assume that Lisp data is aligned on even addresses. */ +#endif + ) return; m = mem_find (p); From b1b1e473bb08b505c265e18aecb9ba33395b8ff8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 18:03:43 +0000 Subject: [PATCH 079/163] *** empty log message *** --- lisp/emacs-lisp/cl-loaddefs.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 65cb0754446..1589e19cbb2 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,8 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" (18050 -;;;;;; 46455)) +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "47c92504dda976a632c2c10bedd4b6a4") ;;; Generated autoloads from cl-extra.el (autoload (quote coerce) "cl-extra" "\ @@ -284,7 +283,7 @@ Not documented ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* ;;;;;; defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs" -;;;;;; "cl-macs.el" (18051 52572)) +;;;;;; "cl-macs.el" "7ccc827d272482ca276937ca18a7895a") ;;; Generated autoloads from cl-macs.el (autoload (quote cl-compile-time-init) "cl-macs" "\ @@ -746,7 +745,7 @@ Not documented ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not ;;;;;; substitute-if substitute delete-duplicates remove-duplicates ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* -;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" (18050 45841)) +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "8805f76626399794931f5db36ddf855f") ;;; Generated autoloads from cl-seq.el (autoload (quote reduce) "cl-seq" "\ From 563cfbf7a755bbbb06191997cb28332bf8f4c237 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 18:05:36 +0000 Subject: [PATCH 080/163] (autoload-generate-file-autoloads): Be careful with EOLs when generating MD5 checksums. --- lisp/emacs-lisp/autoload.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 0fa89f2a173..d057ee028dc 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -432,7 +432,10 @@ Return non-nil iff FILE adds no autoloads to OUTFILE ;; checksum in secondary autoload files where we do ;; not need the time-stamp optimization because it is ;; already provided by the primary autoloads file. - (md5 secondary-autoloads-file-buf nil nil 'emacs-mule) + (md5 secondary-autoloads-file-buf + ;; We'd really want to just use + ;; `emacs-internal' instead. + nil nil 'emacs-mule-unix) (nth 5 (file-attributes relfile)))) (insert ";;; Generated autoloads from " relfile "\n")) (insert generate-autoload-section-trailer)))) From 4b29e550e628763797dac6f7c51a31816d2c500c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 10 Jul 2007 19:52:11 +0000 Subject: [PATCH 081/163] * comint.el (make-comint, make-comint-in-buffer) (comint-exec-1): Replace `start-process' by `start-file-process'. * progmodes/compile.el (compilation-start): Revert redefining `start-process'. --- lisp/ChangeLog | 8 ++++++ lisp/comint.el | 20 +++++++-------- lisp/progmodes/compile.el | 54 +++++++++++++++------------------------ 3 files changed, 38 insertions(+), 44 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index babcb63d9c8..2c0e79bb75f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2007-07-10 Michael Albinus + + * comint.el (make-comint, make-comint-in-buffer) + (comint-exec-1): Replace `start-process' by `start-file-process'. + + * progmodes/compile.el (compilation-start): Revert redefining + `start-process'. + 2007-07-10 Stefan Monnier * follow.el: Don't change the global map from the follow-mode-map diff --git a/lisp/comint.el b/lisp/comint.el index 7d81f357e22..bf53741f658 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -670,13 +670,13 @@ BUFFER can be either a buffer or the name of one." "Make a Comint process NAME in BUFFER, running PROGRAM. If BUFFER is nil, it defaults to NAME surrounded by `*'s. PROGRAM should be either a string denoting an executable program to create -via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP -connection to be opened via `open-network-stream'. If there is already a -running process in that buffer, it is not restarted. Optional fourth arg +via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting +a TCP connection to be opened via `open-network-stream'. If there is already +a running process in that buffer, it is not restarted. Optional fourth arg STARTFILE is the name of a file to send the contents of to the process. If PROGRAM is a string, any more args are arguments to PROGRAM." - (or (fboundp 'start-process) + (or (fboundp 'start-file-process) (error "Multi-processing is not supported for this system")) (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in @@ -693,9 +693,9 @@ If PROGRAM is a string, any more args are arguments to PROGRAM." "Make a Comint process NAME in a buffer, running PROGRAM. The name of the buffer is made by surrounding NAME with `*'s. PROGRAM should be either a string denoting an executable program to create -via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP -connection to be opened via `open-network-stream'. If there is already a -running process in that buffer, it is not restarted. Optional third arg +via `start-file-process', or a cons pair of the form (HOST . SERVICE) denoting +a TCP connection to be opened via `open-network-stream'. If there is already +a running process in that buffer, it is not restarted. Optional third arg STARTFILE is the name of a file to send the contents of the process to. If PROGRAM is a string, any more args are arguments to PROGRAM." @@ -781,17 +781,17 @@ buffer. The hook `comint-exec-hook' is run after each exec." ;; If the command has slashes, make sure we ;; first look relative to the current directory. (cons default-directory exec-path) exec-path))) - (setq proc (apply 'start-process name buffer command switches))) + (setq proc (apply 'start-file-process name buffer command switches))) (let ((coding-systems (process-coding-system proc))) (setq decoding (car coding-systems) encoding (cdr coding-systems))) - ;; If start-process decided to use some coding system for decoding + ;; If start-file-process decided to use some coding system for decoding ;; data sent from the process and the coding system doesn't ;; specify EOL conversion, we had better convert CRLF to LF. (if (vectorp (coding-system-eol-type decoding)) (setq decoding (coding-system-change-eol-conversion decoding 'dos) changed t)) - ;; Even if start-process left the coding system for encoding data + ;; Even if start-file-process left the coding system for encoding data ;; sent from the process undecided, we had better use the same one ;; as what we use for decoding. But, we should suppress EOL ;; conversion. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 0d08b755a9e..31fd7741a25 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1098,8 +1098,7 @@ Returns the compilation buffer created." (unless (getenv "EMACS") (list "EMACS=t")) (list "INSIDE_EMACS=t") - (copy-sequence process-environment))) - (start-process (symbol-function 'start-process))) + (copy-sequence process-environment)))) (set (make-local-variable 'compilation-arguments) (list command mode name-function highlight-regexp)) (set (make-local-variable 'revert-buffer-function) @@ -1114,39 +1113,26 @@ Returns the compilation buffer created." (if compilation-process-setup-function (funcall compilation-process-setup-function)) (compilation-set-window-height outwin) - ;; Redefine temporarily `start-process' in order to handle - ;; remote compilation. - (fset 'start-process - (lambda (name buffer program &rest program-args) - (apply - (if (file-remote-p default-directory) - 'start-file-process - start-process) - name buffer program program-args))) ;; Start the compilation. - (unwind-protect - (let ((proc (if (eq mode t) - (get-buffer-process - (with-no-warnings - (comint-exec outbuf (downcase mode-name) - shell-file-name nil - `("-c" ,command)))) - (start-process-shell-command (downcase mode-name) - outbuf command)))) - ;; Make the buffer's mode line show process state. - (setq mode-line-process '(":%s")) - (set-process-sentinel proc 'compilation-sentinel) - (set-process-filter proc 'compilation-filter) - (set-marker (process-mark proc) (point) outbuf) - (when compilation-disable-input - (condition-case nil - (process-send-eof proc) - ;; The process may have exited already. - (error nil))) - (setq compilation-in-progress - (cons proc compilation-in-progress))) - ;; Unwindform: Reset original definition of `start-process' - (fset 'start-process start-process))) + (let ((proc (if (eq mode t) + (get-buffer-process + (with-no-warnings + (comint-exec outbuf (downcase mode-name) + shell-file-name nil `("-c" ,command)))) + (start-process-shell-command (downcase mode-name) + outbuf command)))) + ;; Make the buffer's mode line show process state. + (setq mode-line-process '(":%s")) + (set-process-sentinel proc 'compilation-sentinel) + (set-process-filter proc 'compilation-filter) + (set-marker (process-mark proc) (point) outbuf) + (when compilation-disable-input + (condition-case nil + (process-send-eof proc) + ;; The process may have exited already. + (error nil))) + (setq compilation-in-progress + (cons proc compilation-in-progress)))) ;; Now finally cd to where the shell started make/grep/... (setq default-directory thisdir)) (if (buffer-local-value 'compilation-scroll-output outbuf) From cc213f24d734e938cf975d8dd57a3ef244307529 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 10 Jul 2007 19:52:37 +0000 Subject: [PATCH 082/163] * NEWS: Add Tramp and comint-mode changes. --- etc/ChangeLog | 4 ++++ etc/NEWS | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+) diff --git a/etc/ChangeLog b/etc/ChangeLog index f735a2df019..e2c951c187e 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2007-07-10 Michael Albinus + + * NEWS: Add Tramp and comint-mode changes. + 2007-07-08 Michael Albinus * NEWS: `file-remote-p' has a new optional parameter CONNECTED. diff --git a/etc/NEWS b/etc/NEWS index 6d30e2a7b91..d05495ac7e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -98,6 +98,39 @@ identify cited keys in BibTeX entries, used by `bibtex-find-crossref. *** Command `bibtex-url' now allows multiple URLs per entry. ++++ +** Tramp + +*** New connection methods. +The new methods "plinkx", "plink2", "psftp", "sftp" and "fish" have +been introduced. There are also new so-called gateway methods +"tunnel" and "socks". + +*** Multihop syntax has been removed. +The pseudo-method "multi" has been removed. Instead of, multi hops +can be specified by the new variable `tramp-default-proxies-alist'. + +*** More default settings. +Default values can be set via the variables `tramp-default-user', +`tramp-default-user-alist' and `tramp-default-host'. + +*** Connection information is cached. +In order to reduce connection setup, information about used +connections are kept persistent in a file. The name of this file is +defined in the variable `tramp-persistency-file-name'. + +*** Control of remote processes. +Running processes on a remote host can be controlled by settings in +`tramp-remote-path' and `tramp-remote-process-environment'. + +*** Success of remote copy is checked. +When the variable `file-precious-flag' is set, the success of a remote +file copy is checked via the file's checksum. + +** comint-mode uses `start-file-process' now (see Lisp Changes). +If `default-directory' is a remote file name, subprocesses are started +on the corresponding remote system. + * Changes in Emacs 23.1 on non-free operating systems From 47ccb9932969a69ba424464047e56c9bf77b33fb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 19:54:43 +0000 Subject: [PATCH 083/163] *** empty log message *** --- lisp/subr.el | 43 +++++++++++++++++++++++++++++++++++++++---- 1 file changed, 39 insertions(+), 4 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 3804624b0b9..185b9031d27 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -510,6 +510,7 @@ Don't call this function; it is for internal use only." (if (integerp b) (< a b) t) (if (integerp b) t + ;; string< also accepts symbols. (string< a b)))))) (dolist (p list) (funcall function (car p) (cdr p)))) @@ -2485,6 +2486,29 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced." (or (input-pending-p) ,@body)))))) +(defmacro condition-case-no-debug (var bodyform &rest handlers) + "Like `condition-case' except that it does not catch anything when debugging. +More specifically if `debug-on-error' is set, then it does not catch any signal." + (declare (debug condition-case) (indent 2)) + (let ((bodysym (make-symbol "body"))) + `(let ((,bodysym (lambda () ,bodyform))) + (if debug-on-error + (funcall ,bodysym) + (condition-case ,var + (funcall ,bodysym) + ,@handlers))))) + +(defmacro with-demoted-errors (&rest body) + "Run BODY and demote any errors to simple messages. +If `debug-on-error' is non-nil, run BODY without catching its errors. +This is to be used around code which is not expected to signal an error +but which should be robust in the unexpected case that an error is signalled." + (declare (debug t) (indent 0)) + (let ((err (make-symbol "err"))) + `(condition-case-no-debug ,err + (progn ,@body) + (error (message "Error: %s" ,err) nil)))) + (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. If BODY makes changes in the buffer, they are recorded @@ -2519,6 +2543,20 @@ The value returned is the value of the last form in BODY." ;;;; Constructing completion tables. +(defun complete-with-action (action table string pred) + "Perform completion ACTION. +STRING is the string to complete. +TABLE is the completion table, which should not be a function. +PRED is a completion predicate. +ACTION can be one of nil, t or `lambda'." + ;; (assert (not (functionp table))) + (funcall + (cond + ((null action) 'try-completion) + ((eq action t) 'all-completions) + (t 'test-completion)) + string table pred)) + (defmacro dynamic-completion-table (fun) "Use function FUN as a dynamic completion table. FUN is called with one argument, the string for which completion is required, @@ -2540,10 +2578,7 @@ that can be used as the ALIST argument to `try-completion' and (with-current-buffer (let ((,win (minibuffer-selected-window))) (if (window-live-p ,win) (window-buffer ,win) (current-buffer))) - (cond - ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate)) - ((not ,mode) (try-completion ,string (,fun ,string) ,predicate)) - (t (test-completion ,string (,fun ,string) ,predicate))))))) + (complete-with-action ,mode (,fun ,string) ,string ,predicate))))) (defmacro lazy-completion-table (var fun) ;; We used to have `&rest args' where `args' were evaluated late (at the From ebaba1bd737729891542bdfc8e38a31ceba90e6f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 19:55:12 +0000 Subject: [PATCH 084/163] (vc-arch-complete): Remove. (vc-arch-revision-completion-table): Use complete-with-action. --- lisp/ChangeLog | 9 +++++++++ lisp/vc-arch.el | 14 +++----------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2c0e79bb75f..2123e07d766 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2007-07-10 Stefan Monnier + + * vc-arch.el (vc-arch-complete): Remove. + (vc-arch-revision-completion-table): Use complete-with-action. + + * subr.el (condition-case-no-debug, with-demoted-errors): New macros. + (complete-with-action): New function. + (dynamic-completion-table): Use it. + 2007-07-10 Michael Albinus * comint.el (make-comint, make-comint-in-buffer) diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index e4c13d3039a..c6aaa6c8c0b 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -424,13 +424,6 @@ Return non-nil if FILE is unchanged." ;;; Completion of versions and revisions. -(defun vc-arch-complete (table string pred action) - (assert (not (functionp table))) - (cond - ((null action) (try-completion string table pred)) - ((eq action t) (all-completions string table pred)) - (t (test-completion string table pred)))) - (defun vc-arch--version-completion-table (root string) (delq nil (mapcar @@ -450,10 +443,9 @@ Return non-nil if FILE is unchanged." (lexical-let ((file file)) (lambda (string pred action) ;; FIXME: complete revision patches as well. - (let ((root (expand-file-name "{arch}" (vc-arch-root file)))) - (vc-arch-complete - (vc-arch--version-completion-table root string) - string pred action))))) + (let* ((root (expand-file-name "{arch}" (vc-arch-root file))) + (table (vc-arch--version-completion-table root string))) + (complete-with-action action table string pred))))) ;;; Trimming revision libraries. From 1cd643e793fc948e63c02ae8241f2d20d4fa068d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Jul 2007 21:01:20 +0000 Subject: [PATCH 085/163] Load cl-loaddefs.el quietly. --- lisp/ChangeLog | 2 ++ lisp/emacs-lisp/cl.el | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2123e07d766..a7cf4d23121 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2007-07-10 Stefan Monnier + * emacs-lisp/cl.el: Load cl-loaddefs.el quietly. + * vc-arch.el (vc-arch-complete): Remove. (vc-arch-revision-completion-table): Use complete-with-action. diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 233df65ac91..f8b178ac07c 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -628,7 +628,7 @@ If ALIST is non-nil, the new pairs are prepended to it." (fmakunbound 'dolist) (fmakunbound 'dotimes) (fmakunbound 'declare) -(load "cl-loaddefs") +(load "cl-loaddefs" nil 'quiet) ;; This goes here so that cl-macs can find it if it loads right now. (provide 'cl-19) ; usage: (require 'cl-19 "cl") From c636ecc62cda9120a84645e5698c381939484fe8 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 10 Jul 2007 23:28:04 +0000 Subject: [PATCH 086/163] *** empty log message *** --- lisp/ChangeLog | 6 ++++++ lisp/autoinsert.el | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a7cf4d23121..07bdcb37dbc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-07-10 Jim Meyering (tiny change) + + * emacs-lisp/copyright.el (copyright-current-gpl-version): Set to 3. + + * autoinsert.el (auto-insert-alist): s/2/3/ in the generated comment. + 2007-07-10 Stefan Monnier * emacs-lisp/cl.el: Load cl-loaddefs.el quietly. diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 3f615dcfbd3..dcacc6a99ff 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -188,7 +188,7 @@ If this contains a %s, that will be replaced by the matching rule." \;; This file 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) +\;; the Free Software Foundation; either version 3, or (at your option) \;; any later version. \;; This file is distributed in the hope that it will be useful, From 948d9b97fc2edc08887a6886d69891a757cdfe09 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 10 Jul 2007 23:30:18 +0000 Subject: [PATCH 087/163] (copyright-current-gpl-version): Set to 3. --- lisp/emacs-lisp/copyright.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index ac61c5a9ada..facdf9e9aae 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -79,7 +79,7 @@ When this is `function', only ask when called non-interactively." ;; when modifying this, also modify the comment generated by autoinsert.el -(defconst copyright-current-gpl-version "2" +(defconst copyright-current-gpl-version "3" "String representing the current version of the GPL or nil.") (defvar copyright-update t) From d7f5fd0778c2603d2e4903c76f2328379cd81fd7 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Wed, 11 Jul 2007 01:48:50 +0000 Subject: [PATCH 088/163] *** empty log message *** --- lisp/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dcdb04cc5fa..f757ead626d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-07-10 Jim Meyering (tiny change) + + * emacs-lisp/copyright.el (copyright-current-gpl-version): Set to 3. + + * autoinsert.el (auto-insert-alist): s/2/3/ in the generated comment. + 2007-07-10 Richard Stallman * emacs-lisp/lisp-mode.el (eval-defun): From fec50ededb0da99b2984b04188f02b98f1c75f2a Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Wed, 11 Jul 2007 01:52:25 +0000 Subject: [PATCH 089/163] (copyright-current-gpl-version): Set to 3. --- lisp/emacs-lisp/copyright.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 5f5aecea97a..dd01e7a448d 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -72,7 +72,7 @@ When this is `function', only ask when called non-interactively." ;; when modifying this, also modify the comment generated by autoinsert.el -(defconst copyright-current-gpl-version "2" +(defconst copyright-current-gpl-version "3" "String representing the current version of the GPL or nil.") (defvar copyright-update t) From 10b84c37fe38d1dac913081493ca090fc3f84320 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Wed, 11 Jul 2007 01:54:24 +0000 Subject: [PATCH 090/163] (auto-insert-alist): s/2/3/ in the generated comment. --- lisp/autoinsert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 7540ad78bcd..2dad1fc2ed9 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -188,7 +188,7 @@ If this contains a %s, that will be replaced by the matching rule." ;; This file 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, From 1a98ebdffb144238b530c68d7ee0b62b891afcd1 Mon Sep 17 00:00:00 2001 From: Bill Wohler Date: Wed, 11 Jul 2007 05:58:45 +0000 Subject: [PATCH 091/163] (mh-display-color-cells): Fix on XEmacs 21.5b28. Thanks to Henrique Martins for the help (closes SF #1749774). --- lisp/mh-e/ChangeLog | 5 +++++ lisp/mh-e/mh-compat.el | 12 ++++++++---- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 3d3a08e0528..97ccda6e048 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,8 @@ +2007-07-11 Bill Wohler + + * mh-compat.el (mh-display-color-cells): Fix on XEmacs 21.5b28. + Thanks to Henrique Martins for the help (closes SF #1749774). + 2007-06-06 Juanma Barranquero * mh-mime.el (mh-mh-directive-present-p): diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 2f57e1763ab..a1382a8298e 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -77,13 +77,17 @@ introduced in Emacs 22." 'cancel-timer 'delete-itimer)) -(defun-mh mh-display-color-cells display-color-cells (&optional display) +(defun mh-display-color-cells (&optional display) "Return the number of color cells supported by DISPLAY. -This function is used by XEmacs to return 2 when -`device-color-cells' returns nil. This happens when compiling or +This function is used by XEmacs to return 2 when `device-color-cells' +or `display-color-cells' returns nil. This happens when compiling or running on a tty and causes errors since `display-color-cells' is expected to return an integer." - (or (device-color-cells display) 2)) + (cond ((fboundp 'display-color-cells) ; GNU Emacs, XEmacs 21.5b28 + (or (display-color-cells display) 2)) + ((fboundp 'device-color-cells) ; XEmacs 21.4 + (or (device-color-cells display) 2)) + (t 2))) (defmacro mh-display-completion-list (completions &optional common-substring) "Display the list of COMPLETIONS. From a71f59c1fafa38f9eb0137c88ea879fb3718bdc1 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Wed, 11 Jul 2007 14:41:22 +0000 Subject: [PATCH 092/163] (OLE32): New library to link. --- nt/ChangeLog | 6 ++++++ nt/gmake.defs | 3 ++- nt/nmake.defs | 3 ++- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index cf6b3e9984f..7f44ccbc008 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,9 @@ +2007-07-11 Jason Rumney + + * gmake.defs (OLE32): New library to link. + + * nmake.defs (OLE32): Likewise. + 2007-06-25 Jason Rumney * cmdproxy.c (main): Set console codepages to "ANSI". diff --git a/nt/gmake.defs b/nt/gmake.defs index 15ec2bf0ea3..c08ca32200f 100644 --- a/nt/gmake.defs +++ b/nt/gmake.defs @@ -176,8 +176,9 @@ MPR = -lmpr SHELL32 = -lshell32 USER32 = -luser32 WSOCK32 = -lwsock32 -WINMM = -lwinmm +WINMM = -lwinmm WINSPOOL = -lwinspool +OLE32 = -lole32 ifdef NOOPT DEBUG_CFLAGS = -DEMACSDEBUG diff --git a/nt/nmake.defs b/nt/nmake.defs index 5f52bc18c62..03ae2f851fa 100644 --- a/nt/nmake.defs +++ b/nt/nmake.defs @@ -123,8 +123,9 @@ MPR = mpr.lib SHELL32 = shell32.lib USER32 = user32.lib WSOCK32 = wsock32.lib -WINMM = winmm.lib +WINMM = winmm.lib WINSPOOL = winspool.lib +OLE32 = ole32.lib !ifdef NOOPT DEBUG_CFLAGS = -DEMACSDEBUG From c1c5c06dc3dec634ff0dbda889f357f9e5b582e7 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Wed, 11 Jul 2007 14:41:44 +0000 Subject: [PATCH 093/163] (LIBS): Include OLE32. --- src/makefile.w32-in | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 4dad03f4c0c..ccb0dcf9f5f 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -138,7 +138,7 @@ LIBS = $(TLIB0) \ $(TLIB1) \ $(TLIBW32) \ $(TLASTLIB) \ - $(WINMM) \ + $(WINMM) \ $(ADVAPI32) \ $(GDI32) \ $(COMDLG32) \ @@ -146,6 +146,7 @@ LIBS = $(TLIB0) \ $(MPR) \ $(SHELL32) \ $(WINSPOOL) \ + $(OLE32) \ $(libc) # From d5781bb682510e348cf86ba0073cffa75c50a073 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Wed, 11 Jul 2007 14:43:07 +0000 Subject: [PATCH 094/163] (w32_msg_pump) : Initialize COM. (w32_msg_pump) : Uninitialize COM. --- src/ChangeLog | 7 +++++++ src/w32fns.c | 12 ++++++++++++ 2 files changed, 19 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 190d6fb0e36..d112f7297bf 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2007-07-11 Jason Rumney + + * makefile.w32-in (LIBS): Include OLE32. + + * w32fns.c (w32_msg_pump) : Initialize COM. + (w32_msg_pump) : Uninitialize COM. + 2007-06-28 YAMAMOTO Mitsuharu * macterm.c [USE_MAC_TSM] (mac_handle_text_input_event): diff --git a/src/w32fns.c b/src/w32fns.c index fd8df29affa..47ca9157623 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -52,6 +52,7 @@ Boston, MA 02110-1301, USA. */ #include #include #include +#include #include #define FILE_NAME_TEXT_FIELD edt1 @@ -2514,6 +2515,13 @@ w32_msg_pump (deferred_msg * msg_buf) /* Produced by complete_deferred_msg; just ignore. */ break; case WM_EMACS_CREATEWINDOW: + /* Initialize COM for this window. Even though we don't use it, + some third party shell extensions can cause it to be used in + system dialogs, which causes a crash if it is not initialized. + This is a known bug in Windows, which was fixed long ago, but + the patch for XP is not publically available until XP SP3, + and older versions will never be patched. */ + CoInitialize (NULL); w32_createwindow ((struct frame *) msg.wParam); if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0)) abort (); @@ -3660,6 +3668,10 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) my_post_msg (&wmsg, hwnd, msg, wParam, lParam); goto dflt; + case WM_DESTROY: + CoUninitialize (); + return 0; + case WM_CLOSE: wmsg.dwModifiers = w32_get_modifiers (); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); From 1ec5dc773ad07a1577f4970bf211a3d4bf460fda Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 11 Jul 2007 15:22:11 +0000 Subject: [PATCH 095/163] Include unistd.h for ttyname, used in handle_one_term_event. (term_show_mouse_face): Remove unused var `j'. (handle_one_term_event): Remove unused vars `i' and `j'. Don't cast return value of ttyname since it's not necessary. --- src/term.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/term.c b/src/term.c index 20d3024bd6d..41ccfb0dd1f 100644 --- a/src/term.c +++ b/src/term.c @@ -25,6 +25,7 @@ Boston, MA 02110-1301, USA. */ #include #include #include +#include #include "termchar.h" #include "termopts.h" @@ -2381,9 +2382,9 @@ set_tty_color_mode (f, val) void term_mouse_moveto (int x, int y) { + /* TODO: how to set mouse position? const char *name; int fd; - /* TODO: how to set mouse position? name = (const char *) ttyname (0); fd = open (name, O_WRONLY); SOME_FUNCTION (x, y, fd); @@ -2397,7 +2398,7 @@ term_show_mouse_face (enum draw_glyphs_face draw) { struct window *w = XWINDOW (Qmouse_face_window); int save_x, save_y; - int i, j; + int i; if (/* If window is in the process of being destroyed, don't bother to do anything. */ @@ -2917,7 +2918,7 @@ int handle_one_term_event (Gpm_Event *event, struct input_event* hold_quit) { struct frame *f = SELECTED_FRAME (); - int i, j, fd; + int fd; struct input_event ie; int do_help = 0; int count = 0; @@ -2941,7 +2942,7 @@ handle_one_term_event (Gpm_Event *event, struct input_event* hold_quit) arg[1] = arg[3] = (unsigned short) event->y + gpm_zerobased; arg[4] = (unsigned short) 3; - name = (const char *) ttyname (0); + name = ttyname (0); fd = open (name, O_WRONLY); ioctl (fd, TIOCLINUX, buf + sizeof (short) - 1); close (fd); From 8991fa8fd3a215489a4e41182c35fd4a228f0f7a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 11 Jul 2007 15:23:37 +0000 Subject: [PATCH 096/163] (emacs_blocked_free): Remove unused var `bytes_used_now'. --- src/alloc.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index f3140da1ddc..3497234234d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1179,8 +1179,6 @@ emacs_blocked_free (ptr, ptr2) void *ptr; const void *ptr2; { - EMACS_INT bytes_used_now; - BLOCK_INPUT_ALLOC; #ifdef GC_MALLOC_CHECK From 5bb7dfee821bc910d9848085b2ab6b78c70330f6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 11 Jul 2007 15:26:31 +0000 Subject: [PATCH 097/163] * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer. * fns.c (weak_hash_tables): Rename from Vweak_hash_tables and turned from a Lisp_Object into a bare pointer. (make_hash_table, copy_hash_table, sweep_weak_hash_tables, init_fns): Adjust the code correspondingly. --- src/ChangeLog | 15 +++++++++++++++ src/fns.c | 29 +++++++++++++---------------- src/lisp.h | 10 +++++----- 3 files changed, 33 insertions(+), 21 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index ed9053e851a..df9ae72e2b8 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,18 @@ +2007-07-11 Stefan Monnier + + * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer. + * fns.c (weak_hash_tables): Rename from Vweak_hash_tables and turned + from a Lisp_Object into a bare pointer. + (make_hash_table, copy_hash_table, sweep_weak_hash_tables, init_fns): + Adjust the code correspondingly. + + * alloc.c (emacs_blocked_free): Remove unused var `bytes_used_now'. + + * term.c: Include unistd.h for ttyname, used in handle_one_term_event. + (term_show_mouse_face): Remove unused var `j'. + (handle_one_term_event): Remove unused vars `i' and `j'. + Don't cast return value of ttyname since it's not necessary. + 2007-07-10 Stefan Monnier * alloc.c (mark_maybe_pointer): Enforce mult-of-8 alignment when using diff --git a/src/fns.c b/src/fns.c index 3e0605bea29..fb9c446e35e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4268,7 +4268,7 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) /* The list of all weak hash tables. Don't staticpro this one. */ -Lisp_Object Vweak_hash_tables; +struct Lisp_Hash_Table *weak_hash_tables; /* Various symbols. */ @@ -4614,11 +4614,11 @@ make_hash_table (test, size, rehash_size, rehash_threshold, weak, /* Maybe add this hash table to the list of all weak hash tables. */ if (NILP (h->weak)) - h->next_weak = Qnil; + h->next_weak = NULL; else { - h->next_weak = Vweak_hash_tables; - Vweak_hash_tables = table; + h->next_weak = weak_hash_tables; + weak_hash_tables = h; } return table; @@ -4649,8 +4649,8 @@ copy_hash_table (h1) /* Maybe add this hash table to the list of all weak hash tables. */ if (!NILP (h2->weak)) { - h2->next_weak = Vweak_hash_tables; - Vweak_hash_tables = table; + h2->next_weak = weak_hash_tables; + weak_hash_tables = h2; } return table; @@ -4969,13 +4969,12 @@ sweep_weak_table (h, remove_entries_p) /* Remove elements from weak hash tables that don't survive the current garbage collection. Remove weak tables that don't survive - from Vweak_hash_tables. Called from gc_sweep. */ + from weak_hash_tables. Called from gc_sweep. */ void sweep_weak_hash_tables () { - Lisp_Object table, used, next; - struct Lisp_Hash_Table *h; + struct Lisp_Hash_Table *h, *used, *next; int marked; /* Mark all keys and values that are in use. Keep on marking until @@ -4987,9 +4986,8 @@ sweep_weak_hash_tables () do { marked = 0; - for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak) + for (h = weak_hash_tables; h; h = h->next_weak) { - h = XHASH_TABLE (table); if (h->size & ARRAY_MARK_FLAG) marked |= sweep_weak_table (h, 0); } @@ -4997,9 +4995,8 @@ sweep_weak_hash_tables () while (marked); /* Remove tables and entries that aren't used. */ - for (table = Vweak_hash_tables, used = Qnil; !GC_NILP (table); table = next) + for (h = weak_hash_tables, used = NULL; h; h = next) { - h = XHASH_TABLE (table); next = h->next_weak; if (h->size & ARRAY_MARK_FLAG) @@ -5010,11 +5007,11 @@ sweep_weak_hash_tables () /* Add table to the list of used weak hash tables. */ h->next_weak = used; - used = table; + used = h; } } - Vweak_hash_tables = used; + weak_hash_tables = used; } @@ -5915,7 +5912,7 @@ used if both `use-dialog-box' and this variable are non-nil. */); void init_fns () { - Vweak_hash_tables = Qnil; + weak_hash_tables = NULL; } /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31 diff --git a/src/lisp.h b/src/lisp.h index 6e77bf3e1ac..7cdd5536bb8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -56,7 +56,7 @@ Boston, MA 02110-1301, USA. */ #ifdef GC_CHECK_CONS_LIST #define CHECK_CONS_LIST() check_cons_list() #else -#define CHECK_CONS_LIST() 0 +#define CHECK_CONS_LIST() ((void)0) #endif /* These are default choices for the types to use. */ @@ -1041,16 +1041,16 @@ struct Lisp_Hash_Table hash table size to reduce collisions. */ Lisp_Object index; - /* Next weak hash table if this is a weak hash table. The head - of the list is in Vweak_hash_tables. */ - Lisp_Object next_weak; - /* User-supplied hash function, or nil. */ Lisp_Object user_hash_function; /* User-supplied key comparison function, or nil. */ Lisp_Object user_cmp_function; + /* Next weak hash table if this is a weak hash table. The head + of the list is in weak_hash_tables. */ + struct Lisp_Hash_Table *next_weak; + /* C function to compare two keys. */ int (* cmpfn) P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, Lisp_Object, unsigned)); From 82c4728d3b54cd752853c9a24c3bd7a1f507b68b Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Wed, 11 Jul 2007 18:37:38 +0000 Subject: [PATCH 098/163] * vc-hooks.el (vc-default-mode-line-string): Add a mouse face, mouse binding and a tooltip. * menu-bar.el (vc-menu-map): New defalias. --- lisp/ChangeLog | 9 +++++++++ lisp/menu-bar.el | 1 + lisp/vc-hooks.el | 30 ++++++++++++++++++++---------- 3 files changed, 30 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 07bdcb37dbc..2bf592f7acd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2007-07-11 Dan Nicolaescu + + * vc-hooks.el (vc-default-mode-line-string): Add a mouse face, + mouse binding and a tooltip. + +2007-07-11 Stefan Monnier + + * menu-bar.el (vc-menu-map): New defalias. + 2007-07-10 Jim Meyering (tiny change) * emacs-lisp/copyright.el (copyright-current-gpl-version): Set to 3. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 7ad91dffa9f..5fae6382e28 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1161,6 +1161,7 @@ mail status in mode line")) '("--")) (defvar vc-menu-map (make-sparse-keymap "Version Control")) +(defalias 'vc-menu-map vc-menu-map) (define-key menu-bar-tools-menu [pcl-cvs] '(menu-item "PCL-CVS" cvs-global-menu)) (define-key menu-bar-tools-menu [vc] diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 89d271431fa..6ab95b333c6 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -742,17 +742,27 @@ Format: This function assumes that the file is registered." (setq backend (symbol-name backend)) (let ((state (vc-state file)) + (state-echo nil) (rev (vc-workfile-version file))) - (cond ((or (eq state 'up-to-date) - (eq state 'needs-patch)) - (concat backend "-" rev)) - ((stringp state) - (concat backend ":" state ":" rev)) - (t - ;; Not just for the 'edited state, but also a fallback - ;; for all other states. Think about different symbols - ;; for 'needs-patch and 'needs-merge. - (concat backend ":" rev))))) + (propertize + (cond ((or (eq state 'up-to-date) + (eq state 'needs-patch)) + (setq state-echo "Up to date file") + (concat backend "-" rev)) + ((stringp state) + (setq state-echo (concat "File locked by" state)) + (concat backend ":" state ":" rev)) + (t + ;; Not just for the 'edited state, but also a fallback + ;; for all other states. Think about different symbols + ;; for 'needs-patch and 'needs-merge. + (setq state-echo "Edited file") + (concat backend ":" rev))) + 'mouse-face 'mode-line-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] 'vc-menu-map) map) + 'help-echo (concat state-echo " under the " backend + " version control system\nmouse-1: VC Menu")))) (defun vc-follow-link () "If current buffer visits a symbolic link, visit the real file. From db8af973954fda8e7204929b6efbd82f41ca05f8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 11 Jul 2007 19:38:21 +0000 Subject: [PATCH 099/163] * progmodes/compile.el (compilation-start): `start-process' must still be redefined when calling `start-process-shell-command'. * progmodes/gud.el (gud-file-name): When `default-directory' is a remote file name, prepend its remote part to the filename. (gud-common-init): When `default-directory' is a remote file name, make the filename relative to it. Based on a patch by Nick Roberts . --- lisp/ChangeLog | 11 +++++++++++ lisp/progmodes/compile.el | 31 +++++++++++++++++++++++-------- lisp/progmodes/gud.el | 14 +++++++++++--- 3 files changed, 45 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2bf592f7acd..b4ca74d8198 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2007-07-11 Michael Albinus + + * progmodes/compile.el (compilation-start): `start-process' must + still be redefined when calling `start-process-shell-command'. + + * progmodes/gud.el (gud-file-name): When `default-directory' is a + remote file name, prepend its remote part to the filename. + (gud-common-init): When `default-directory' is a remote file name, + make the filename relative to it. + Based on a patch by Nick Roberts . + 2007-07-11 Dan Nicolaescu * vc-hooks.el (vc-default-mode-line-string): Add a mouse face, diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 31fd7741a25..94def936fb9 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1098,7 +1098,8 @@ Returns the compilation buffer created." (unless (getenv "EMACS") (list "EMACS=t")) (list "INSIDE_EMACS=t") - (copy-sequence process-environment)))) + (copy-sequence process-environment))) + (start-process (symbol-function 'start-process))) (set (make-local-variable 'compilation-arguments) (list command mode name-function highlight-regexp)) (set (make-local-variable 'revert-buffer-function) @@ -1114,13 +1115,27 @@ Returns the compilation buffer created." (funcall compilation-process-setup-function)) (compilation-set-window-height outwin) ;; Start the compilation. - (let ((proc (if (eq mode t) - (get-buffer-process - (with-no-warnings - (comint-exec outbuf (downcase mode-name) - shell-file-name nil `("-c" ,command)))) - (start-process-shell-command (downcase mode-name) - outbuf command)))) + (let ((proc + (if (eq mode t) + ;; comint uses `start-file-process'. + (get-buffer-process + (with-no-warnings + (comint-exec outbuf (downcase mode-name) + shell-file-name nil `("-c" ,command)))) + ;; Redefine temporarily `start-process' in order to + ;; handle remote compilation. + (fset 'start-process + (lambda (name buffer program &rest program-args) + (apply + (if (file-remote-p default-directory) + 'start-file-process + start-process) + name buffer program program-args))) + (unwind-protect + (start-process-shell-command (downcase mode-name) + outbuf command) + ;; Unwindform: Reset original definition of `start-process'. + (fset 'start-process start-process))))) ;; Make the buffer's mode line show process state. (setq mode-line-process '(":%s")) (set-process-sentinel proc 'compilation-sentinel) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 57eed959f8b..97144fec83b 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -237,7 +237,7 @@ Used to grey out relevant toolbar icons.") ([menu-bar run] menu-item ,(propertize "run" 'face 'font-lock-doc-face) gud-run :visible (memq gud-minor-mode '(gdbmi gdb dbx jdb))) - ([menu-bar go] menu-item + ([menu-bar go] menu-item ,(propertize " go " 'face 'font-lock-doc-face) gud-go :visible (and (not gud-running) (eq gud-minor-mode 'gdba))) @@ -292,6 +292,11 @@ Used to grey out relevant toolbar icons.") (defun gud-file-name (f) "Transform a relative file name to an absolute file name. Uses `gud--directories' to find the source files." + ;; When `default-directory' is a remote file name, prepend its + ;; remote part to f, which is the local file name. Fortunately, + ;; `file-remote-p' returns exactly this remote file name part (or + ;; nil otherwise). + (setq f (concat (or (file-remote-p default-directory) "") f)) (if (file-exists-p f) (expand-file-name f) (let ((directories (gud-val 'directories)) (result nil)) @@ -2510,7 +2515,10 @@ comint mode, which see." (while (and w (not (eq (car w) t))) (setq w (cdr w))) (if w - (setcar w file))) + (setcar w + (if (file-remote-p default-directory) + (setq file (file-name-nondirectory file)) + file)))) (apply 'make-comint (concat "gud" filepart) program nil (if massage-args (funcall massage-args file args) args)) ;; Since comint clobbered the mode, we don't set it until now. @@ -3114,7 +3122,7 @@ class of the file (using s to separate nested class ids)." 'syntax-table (eval-when-compile (string-to-syntax "> b"))) ;; Make sure that rehighlighting the previous line won't erase our - ;; syntax-table property. + ;; syntax-table property. (put-text-property (1- (match-beginning 0)) (match-end 0) 'font-lock-multiline t) nil))))) From d8b180437fc649520fae0afea113590224948fc9 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 12 Jul 2007 01:41:38 +0000 Subject: [PATCH 100/163] Include unistd.h only if HAVE_UNISTD_H. --- src/ChangeLog | 4 ++++ src/term.c | 2 ++ 2 files changed, 6 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index df9ae72e2b8..e920eb57437 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2007-07-12 Richard Stallman + + * term.c: Include unistd.h only if HAVE_UNISTD_H. + 2007-07-11 Stefan Monnier * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer. diff --git a/src/term.c b/src/term.c index 41ccfb0dd1f..b88448fc446 100644 --- a/src/term.c +++ b/src/term.c @@ -25,7 +25,9 @@ Boston, MA 02110-1301, USA. */ #include #include #include +#ifdef HAVE_UNISTD_H #include +#endif #include "termchar.h" #include "termopts.h" From 1bed504abe704d9ddb2b6a68c86b8569ed05860e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 01:51:52 +0000 Subject: [PATCH 101/163] (eldoc-last-data): Revise documentation. (eldoc-print-current-symbol-info): Adjust for changed helper function signatures. (eldoc-get-fnsym-args-string): Add `args' argument. Use new `eldoc-highlight-function-argument'. (eldoc-highlight-function-argument): New function. (eldoc-get-var-docstring): Format documentation with `font-lock-variable-name-face'. (eldoc-docstring-format-sym-doc): Add `face' argument and apply it where suited. (eldoc-fnsym-in-current-sexp): Return a list with argument index. (eldoc-beginning-of-sexp): Return number of skipped sexps. --- lisp/ChangeLog | 19 +++++++ lisp/emacs-lisp/eldoc.el | 118 +++++++++++++++++++++++++++++---------- 2 files changed, 108 insertions(+), 29 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b4ca74d8198..69c7f3fb0be 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2007-07-12 Paul Pogonyshev + + * emacs-lisp/eldoc.el (eldoc-last-data): Revise documentation. + (eldoc-print-current-symbol-info): Adjust for changed helper + function signatures. + (eldoc-get-fnsym-args-string): Add `args' argument. Use new + `eldoc-highlight-function-argument'. + (eldoc-highlight-function-argument): New function. + (eldoc-get-var-docstring): Format documentation with + `font-lock-variable-name-face'. + (eldoc-docstring-format-sym-doc): Add `face' argument and apply it + where suited. + (eldoc-fnsym-in-current-sexp): Return a list with argument index. + (eldoc-beginning-of-sexp): Return number of skipped sexps. + 2007-07-11 Michael Albinus * progmodes/compile.el (compilation-start): `start-process' must @@ -45,6 +60,10 @@ 2007-07-10 Stefan Monnier + * emacs-lisp/autoload.el (autoload-generate-file-autoloads): Be careful + with EOLs when generating MD5 checksums. + + * follow.el: Don't change the global map from the follow-mode-map defvar, but from the toplevel. Use easy-menu to unify the Emacs and XEmacs code. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 85b150b6ae5..37e2eb351f2 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -124,8 +124,8 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.") (defconst eldoc-last-data (make-vector 3 nil) "Bookkeeping; elements are as follows: 0 - contains the last symbol read from the buffer. - 1 - contains the string last displayed in the echo area for that - symbol, so it can be printed again if necessary without reconsing. + 1 - contains the string last displayed in the echo area for variables, + or argument string for functions. 2 - 'function if function args, 'variable if variable documentation.") (defvar eldoc-last-message nil) @@ -249,12 +249,16 @@ Emacs Lisp mode) that support Eldoc.") (let* ((current-symbol (eldoc-current-symbol)) (current-fnsym (eldoc-fnsym-in-current-sexp)) (doc (cond - ((eq current-symbol current-fnsym) - (or (eldoc-get-fnsym-args-string current-fnsym) + ((null current-fnsym) + nil) + ((eq current-symbol (car current-fnsym)) + (or (apply 'eldoc-get-fnsym-args-string + current-fnsym) (eldoc-get-var-docstring current-symbol))) (t (or (eldoc-get-var-docstring current-symbol) - (eldoc-get-fnsym-args-string current-fnsym)))))) + (apply 'eldoc-get-fnsym-args-string + current-fnsym)))))) (eldoc-message doc)))) ;; This is run from post-command-hook or some idle timer thing, ;; so we need to be careful that errors aren't ignored. @@ -263,24 +267,62 @@ Emacs Lisp mode) that support Eldoc.") ;; Return a string containing the function parameter list, or 1-line ;; docstring if function is a subr and no arglist is obtainable from the ;; docstring or elsewhere. -(defun eldoc-get-fnsym-args-string (sym) +(defun eldoc-get-fnsym-args-string (sym argument-index) (let ((args nil) (doc nil)) (cond ((not (and sym (symbolp sym) (fboundp sym)))) ((and (eq sym (aref eldoc-last-data 0)) (eq 'function (aref eldoc-last-data 2))) - (setq doc (aref eldoc-last-data 1))) + (setq args (aref eldoc-last-data 1))) ((setq doc (help-split-fundoc (documentation sym t) sym)) (setq args (car doc)) (string-match "\\`[^ )]* ?" args) - (setq args (concat "(" (substring args (match-end 0))))) + (setq args (concat "(" (substring args (match-end 0)))) + (eldoc-last-data-store sym args 'function)) (t (setq args (eldoc-function-argstring sym)))) - (cond (args - (setq doc (eldoc-docstring-format-sym-doc sym args)) - (eldoc-last-data-store sym doc 'function))) + (when args + (setq doc (eldoc-highlight-function-argument sym args argument-index))) doc)) +;; Highlight argument INDEX in ARGS list for SYM. +(defun eldoc-highlight-function-argument (sym args index) + (let ((start nil) + (end 0) + (argument-face 'bold)) + ;; Find the current argument in the argument string. We need to + ;; handle `&rest' and informal `...' properly. + ;; + ;; FIXME: What to do with optional arguments, like in + ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case? + ;; The problem is there is no robust way to determine if + ;; the current argument is indeed a docstring. + (while (>= index 1) + (if (string-match "[^ ()]+" args end) + (progn + (setq start (match-beginning 0) + end (match-end 0)) + (let ((argument (match-string 0 args))) + (cond ((string= argument "&rest") + ;; All the rest arguments are the same. + (setq index 1)) + ((string= argument "&optional")) + ((string-match "\\.\\.\\.$" argument) + (setq index 0)) + (t + (setq index (1- index)))))) + (setq end (length args) + start (1- end) + argument-face 'font-lock-warning-face + index 0))) + (let ((doc args)) + (when start + (setq doc (copy-sequence args)) + (add-text-properties start end (list 'face argument-face) doc)) + (setq doc (eldoc-docstring-format-sym-doc + sym doc 'font-lock-function-name-face)) + doc))) + ;; Return a string containing a brief (one-line) documentation string for ;; the variable. (defun eldoc-get-var-docstring (sym) @@ -292,7 +334,8 @@ Emacs Lisp mode) that support Eldoc.") (let ((doc (documentation-property sym 'variable-documentation t))) (cond (doc (setq doc (eldoc-docstring-format-sym-doc - sym (eldoc-docstring-first-line doc))) + sym (eldoc-docstring-first-line doc) + 'font-lock-variable-name-face)) (eldoc-last-data-store sym doc 'variable))) doc))))) @@ -316,7 +359,7 @@ Emacs Lisp mode) that support Eldoc.") ;; If the entire line cannot fit in the echo area, the symbol name may be ;; truncated or eliminated entirely from the output to make room for the ;; description. -(defun eldoc-docstring-format-sym-doc (sym doc) +(defun eldoc-docstring-format-sym-doc (sym doc face) (save-match-data (let* ((name (symbol-name sym)) (ea-multi eldoc-echo-area-use-multiline-p) @@ -328,7 +371,7 @@ Emacs Lisp mode) that support Eldoc.") (cond ((or (<= strip 0) (eq ea-multi t) (and ea-multi (> (length doc) ea-width))) - (format "%s: %s" sym doc)) + (format "%s: %s" (propertize name 'face face) doc)) ((> (length doc) ea-width) (substring (format "%s" doc) 0 ea-width)) ((>= strip (length name)) @@ -338,27 +381,44 @@ Emacs Lisp mode) that support Eldoc.") ;; than the beginning, since the former is more likely ;; to be unique given package namespace conventions. (setq name (substring name strip)) - (format "%s: %s" name doc)))))) + (format "%s: %s" (propertize name 'face face) doc)))))) +;; Return a list of current function name and argument index. (defun eldoc-fnsym-in-current-sexp () - (let ((p (point))) - (eldoc-beginning-of-sexp) - (prog1 - ;; Don't do anything if current word is inside a string. - (if (= (or (char-after (1- (point))) 0) ?\") - nil - (eldoc-current-symbol)) - (goto-char p)))) + (save-excursion + (let ((argument-index (1- (eldoc-beginning-of-sexp)))) + ;; If we are at the beginning of function name, this will be -1. + (when (< argument-index 0) + (setq argument-index 0)) + ;; Don't do anything if current word is inside a string. + (if (= (or (char-after (1- (point))) 0) ?\") + nil + (list (eldoc-current-symbol) argument-index))))) +;; Move to the beginnig of current sexp. Return the number of nested +;; sexp the point was over or after. (defun eldoc-beginning-of-sexp () - (let ((parse-sexp-ignore-comments t)) + (let ((parse-sexp-ignore-comments t) + (num-skipped-sexps 0)) (condition-case err - (while (progn - (forward-sexp -1) - (or (= (char-before) ?\") - (> (point) (point-min))))) - (error nil)))) + (progn + ;; First account for the case the point is directly over a + ;; beginning of a nested sexp. + (condition-case err + (let ((p (point))) + (forward-sexp -1) + (forward-sexp 1) + (when (< (point) p) + (setq num-skipped-sexps 1))) + (error)) + (while + (let ((p (point))) + (forward-sexp -1) + (when (< (point) p) + (setq num-skipped-sexps (1+ num-skipped-sexps)))))) + (error)) + num-skipped-sexps)) ;; returns nil unless current word is an interned symbol. (defun eldoc-current-symbol () From 98ad325cb3594f67360210e7c29238d4f8fdb970 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 03:10:45 +0000 Subject: [PATCH 102/163] (vc-functions): Clear up the cache when reloading the file. (vc-cvs-annotate-first-line-re): New const. (vc-cvs-annotate-process-filter): New fun. (vc-cvs-annotate-command): Use them and run the command asynchronously. --- lisp/vc-cvs.el | 36 +++++++++++++++++++++++++++++++----- 1 file changed, 31 insertions(+), 5 deletions(-) diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index 3b35efe47c3..f5afcca581d 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -32,6 +32,10 @@ (eval-when-compile (require 'vc)) +;; Clear up the cache to force vc-call to check again and discover +;; new functions when we reload this file. +(put 'CVS 'vc-functions nil) + ;;; ;;; Customization options ;;; @@ -534,14 +538,36 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (and rev2 (concat "-r" rev2)) (vc-switches 'CVS 'diff)))))) +(defconst vc-cvs-annotate-first-line-re "^[0-9]") + +(defun vc-cvs-annotate-process-filter (process string) + (setq string (concat (process-get process 'output) string)) + (if (not (string-match vc-cvs-annotate-first-line-re string)) + ;; Still waiting for the first real line. + (process-put process 'output string) + (let ((vc-filter (process-get process 'vc-filter))) + (set-process-filter process vc-filter) + (funcall vc-filter process (substring string (match-beginning 0)))))) + (defun vc-cvs-annotate-command (file buffer &optional version) "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. Optional arg VERSION is a version to annotate from." - (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version))) - (with-current-buffer buffer - (goto-char (point-min)) - (re-search-forward "^[0-9]") - (delete-region (point-min) (1- (point))))) + (vc-cvs-command buffer + (if (and (vc-stay-local-p file) (fboundp 'start-process)) + 'async 0) + file "annotate" + (if version (concat "-r" version))) + ;; Strip the leading few lines. + (let ((proc (get-buffer-process buffer))) + (if proc + ;; If running asynchronously, use a process filter. + (progn + (process-put proc 'vc-filter (process-filter proc)) + (set-process-filter proc 'vc-cvs-annotate-process-filter)) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward vc-cvs-annotate-first-line-re) + (delete-region (point-min) (1- (point))))))) (defun vc-cvs-annotate-current-time () "Return the current time, based at midnight of the current day, and From 2346acf6ba2016deecfa5c7dba3de75a7c9289ae Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 03:13:37 +0000 Subject: [PATCH 103/163] Require CL. (vc-cvs-revision-table, vc-cvs-revision-completion-table): New functions to provide completion of revision names. --- lisp/ChangeLog | 11 +++++++++++ lisp/vc-cvs.el | 32 +++++++++++++++++++++++++++++--- 2 files changed, 40 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 69c7f3fb0be..e5273d5e7d9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2007-07-12 Stefan Monnier + + * vc-cvs.el: Require CL. + (vc-cvs-revision-table, vc-cvs-revision-completion-table): + New functions to provide completion of revision names. + + * vc-cvs.el (vc-functions): Clear up the cache when reloading the file. + (vc-cvs-annotate-first-line-re): New const. + (vc-cvs-annotate-process-filter): New fun. + (vc-cvs-annotate-command): Use them and run the command asynchronously. + 2007-07-12 Paul Pogonyshev * emacs-lisp/eldoc.el (eldoc-last-data): Revise documentation. diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index f5afcca581d..22ed10d1286 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -29,8 +29,7 @@ ;;; Code: -(eval-when-compile - (require 'vc)) +(eval-when-compile (require 'cl) (require 'vc)) ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -932,7 +931,34 @@ is non-nil." (vc-file-setprop file 'vc-checkout-time 0) (if set-state (vc-file-setprop file 'vc-state 'edited))))))))) +;; Completion of revision names. +;; Just so I don't feel like I'm duplicating code from pcl-cvs, I'll use +;; `cvs log' so I can list all the revision numbers rather than only +;; tag names. + +(defun vc-cvs-revision-table (file) + (let ((default-directory (file-name-directory file)) + (res nil)) + (with-temp-buffer + (vc-cvs-command t nil file "log") + (goto-char (point-min)) + (when (re-search-forward "^symbolic names:\n" nil t) + (while (looking-at "^ \\(.*\\): \\(.*\\)") + (push (cons (match-string 1) (match-string 2)) res) + (forward-line 1))) + (while (re-search-forward "^revision \\([0-9.]+\\)" nil t) + (push (match-string 1) res)) + res))) + +(defun vc-cvs-revision-completion-table (file) + (lexical-let ((file file) + table) + (setq table (lazy-completion-table + table (lambda () (vc-cvs-revision-table file)))) + table)) + + (provide 'vc-cvs) -;;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432 +;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432 ;;; vc-cvs.el ends here From c788d366815aba6e70d2786d1bf5894a45e8b326 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 04:14:48 +0000 Subject: [PATCH 104/163] (comint-dynamic-complete-as-filename,comint-dynamic-list-filename-completions): Use read-file-name-completion-ignore-case. --- lisp/ChangeLog | 10 ++++++++++ lisp/comint.el | 4 ++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e5273d5e7d9..e21e1ce5bcd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,15 @@ +2007-07-12 Sean O'Rourke (tiny change) + + * pcomplete.el (pcomplete-entries): Obey pcomplete-ignore-case. + + * comint.el (comint-dynamic-complete-as-filename): + Use read-file-name-completion-ignore-case. + 2007-07-12 Stefan Monnier + * comint.el (comint-dynamic-list-filename-completions): + Use read-file-name-completion-ignore-case. + * vc-cvs.el: Require CL. (vc-cvs-revision-table, vc-cvs-revision-completion-table): New functions to provide completion of revision names. diff --git a/lisp/comint.el b/lisp/comint.el index bf53741f658..ddc3a2f503b 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2805,7 +2805,7 @@ Returns t if successful." (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." - (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) + (let* ((completion-ignore-case read-file-name-completion-ignore-case) (completion-ignored-extensions comint-completion-fignore) ;; If we bind this, it breaks remote directory tracking in rlogin.el. ;; I think it was originally bound to solve file completion problems, @@ -2934,7 +2934,7 @@ See also `comint-dynamic-complete-filename'." (defun comint-dynamic-list-filename-completions () "List in help buffer possible completions of the filename at point." (interactive) - (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) + (let* ((completion-ignore-case read-file-name-completion-ignore-case) ;; If we bind this, it breaks remote directory tracking in rlogin.el. ;; I think it was originally bound to solve file completion problems, ;; but subsequent changes may have made this unnecessary. sm. From 8b9571399325e40c53e193178f29a2a94594421c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 04:15:55 +0000 Subject: [PATCH 105/163] (pcomplete-entries): Obey pcomplete-ignore-case. --- lisp/pcomplete.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index efb5980766d..86d930127b5 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -711,6 +711,7 @@ If PREDICATE is non-nil, it will also be used to refine the match If no directory information can be extracted from the completed component, `default-directory' is used as the basis for completion." (let* ((name (substitute-env-vars pcomplete-stub)) + (completion-ignore-case pcomplete-ignore-case) (default-directory (expand-file-name (or (file-name-directory name) default-directory))) From 4f7a582baa73efb4e6d4cbe7205572b6f03a15eb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 04:36:48 +0000 Subject: [PATCH 106/163] (python-which-func-length-limit): New var. (python-which-func): New function. (python-current-defun): Add optional `length-limit' and try to fit computed function name to that length. (python-mode): Hook `python-which-func' up. --- lisp/ChangeLog | 10 ++++++++++ lisp/progmodes/python.el | 34 ++++++++++++++++++++++++++-------- 2 files changed, 36 insertions(+), 8 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e21e1ce5bcd..0792291a4a3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2007-07-12 Paul Pogonyshev + + * progmodes/which-func.el (which-func-modes): Add `python-mode'. + + * progmodes/python.el (python-which-func-length-limit): New var. + (python-which-func): New function. + (python-current-defun): Add optional `length-limit' and try to fit + computed function name to that length. + (python-mode): Hook `python-which-func' up. + 2007-07-12 Sean O'Rourke (tiny change) * pcomplete.el (pcomplete-entries): Obey pcomplete-ignore-case. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5c117dffd5d..26fc122631d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -996,7 +996,16 @@ don't move and return nil. Otherwise return t." (throw 'done t))))))) (setq arg (1- arg))) (zerop arg))) - + +(defvar python-which-func-length-limit 40 + "Non-strict length limit for `python-which-func' output.") + +(defun python-which-func () + (let ((function-name (python-current-defun python-which-func-length-limit))) + (set-text-properties 0 (length function-name) nil function-name) + function-name)) + + ;;;; Imenu. (defvar python-recursing) @@ -1814,22 +1823,30 @@ of current line." (1+ (/ (current-indentation) python-indent))) ;; Fixme: Consider top-level assignments, imports, &c. -(defun python-current-defun () +(defun python-current-defun (&optional length-limit) "`add-log-current-defun-function' for Python." (save-excursion ;; Move up the tree of nested `class' and `def' blocks until we ;; get to zero indentation, accumulating the defined names. (let ((start t) - accum) - (while (or start (> (current-indentation) 0)) + (accum) + (length -1)) + (while (and (or start (> (current-indentation) 0)) + (or (null length-limit) + (null (cdr accum)) + (< length length-limit))) (setq start nil) (python-beginning-of-block) (end-of-line) (beginning-of-defun) - (if (looking-at (rx (0+ space) (or "def" "class") (1+ space) - (group (1+ (or word (syntax symbol)))))) - (push (match-string 1) accum))) - (if accum (mapconcat 'identity accum "."))))) + (when (looking-at (rx (0+ space) (or "def" "class") (1+ space) + (group (1+ (or word (syntax symbol)))))) + (push (match-string 1) accum) + (setq length (+ length 1 (length (car accum)))))) + (when accum + (when (and length-limit (> length length-limit)) + (setcar accum "..")) + (mapconcat 'identity accum "."))))) (defun python-mark-block () "Mark the block around point. @@ -2248,6 +2265,7 @@ with skeleton expansions for compound statement templates. (set (make-local-variable 'beginning-of-defun-function) 'python-beginning-of-defun) (set (make-local-variable 'end-of-defun-function) 'python-end-of-defun) + (add-hook 'which-func-functions 'python-which-func nil t) (setq imenu-create-index-function #'python-imenu-create-index) (set (make-local-variable 'eldoc-documentation-function) #'python-eldoc-function) From d1947d4c8f91b75bde4e57323d57098e321d60fa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 04:37:06 +0000 Subject: [PATCH 107/163] (which-func-modes): Add `python-mode'. --- lisp/progmodes/which-func.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 43c70f67dfb..5b5c13342ad 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -76,8 +76,8 @@ :version "20.3") (defcustom which-func-modes - '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode makefile-mode - sh-mode fortran-mode f90-mode ada-mode) + '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode python-mode + makefile-mode sh-mode fortran-mode f90-mode ada-mode) "List of major modes for which Which Function mode should be used. For other modes it is disabled. If this is equal to t, then Which Function mode is enabled in any major mode that supports it." From 60f0fb11dda9422e50dd58fb1e4dff76a960a107 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Jul 2007 06:36:57 +0000 Subject: [PATCH 108/163] (struct Lisp_Process): Turn slots infd, outfd, kill_without_query, pty_flag, tick, update_tick, decoding_carryover, inherit_coding_system_flag, filter_multibyte, adaptive_read_buffering, read_output_delay, and read_output_skip from Lisp_Objects to ints. Remove unused encoding_carryover. --- src/ChangeLog | 9 ++ src/process.c | 303 +++++++++++++++++++++++++------------------------- src/process.h | 76 ++++++------- 3 files changed, 197 insertions(+), 191 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index e920eb57437..80871a10449 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2007-07-12 Stefan Monnier + + * process.h (struct Lisp_Process): Turn slots infd, outfd, + kill_without_query, pty_flag, tick, update_tick, decoding_carryover, + inherit_coding_system_flag, filter_multibyte, adaptive_read_buffering, + read_output_delay, and read_output_skip from Lisp_Objects to ints. + Remove unused encoding_carryover. + * process.c: Adjust all functions accordingly. + 2007-07-12 Richard Stallman * term.c: Include unistd.h only if HAVE_UNISTD_H. diff --git a/src/process.c b/src/process.c index c248a8144db..90d0ee34024 100644 --- a/src/process.c +++ b/src/process.c @@ -393,7 +393,7 @@ struct sockaddr_and_len { int len; } datagram_address[MAXDESC]; #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0) -#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0) +#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0) #else #define DATAGRAM_CHAN_P(chan) (0) #define DATAGRAM_CONN_P(proc) (0) @@ -628,19 +628,19 @@ make_process (name) p = allocate_process (); - XSETINT (p->infd, -1); - XSETINT (p->outfd, -1); - XSETFASTINT (p->tick, 0); - XSETFASTINT (p->update_tick, 0); + p->infd = -1; + p->outfd = -1; + p->tick = 0; + p->update_tick = 0; p->pid = 0; p->raw_status_new = 0; p->status = Qrun; p->mark = Fmake_marker (); #ifdef ADAPTIVE_READ_BUFFERING - p->adaptive_read_buffering = Qnil; - XSETFASTINT (p->read_output_delay, 0); - p->read_output_skip = Qnil; + p->adaptive_read_buffering = 0; + p->read_output_delay = 0; + p->read_output_skip = 0; #endif /* If name is already in use, modify it until it is unused. */ @@ -679,8 +679,8 @@ setup_process_coding_systems (process) Lisp_Object process; { struct Lisp_Process *p = XPROCESS (process); - int inch = XINT (p->infd); - int outch = XINT (p->outfd); + int inch = p->infd; + int outch = p->outfd; if (inch < 0 || outch < 0) return; @@ -692,7 +692,7 @@ setup_process_coding_systems (process) proc_decode_coding_system[inch]); if (! NILP (p->filter)) { - if (NILP (p->filter_multibyte)) + if (!p->filter_multibyte) setup_raw_text_coding_system (proc_decode_coding_system[inch]); } else if (BUFFERP (p->buffer)) @@ -815,10 +815,10 @@ nil, indicating the current buffer's process. */) if (NETCONN1_P (p)) { p->status = Fcons (Qexit, Fcons (make_number (0), Qnil)); - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; status_notify (p); } - else if (XINT (p->infd) >= 0) + else if (p->infd >= 0) { #ifdef SIGCHLD Lisp_Object symbol; @@ -846,7 +846,7 @@ nil, indicating the current buffer's process. */) /* Do this now, since remove_process will make sigchld_handler do nothing. */ p->status = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; status_notify (p); } } @@ -1038,18 +1038,18 @@ The string argument is normally a multibyte string, except: (debug) (set-process-filter process ...) */ - if (XINT (p->infd) >= 0) + if (p->infd >= 0) { if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) { - FD_CLR (XINT (p->infd), &input_wait_mask); - FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } else if (EQ (p->filter, Qt) && !EQ (p->command, Qt)) /* Network process not stopped. */ { - FD_SET (XINT (p->infd), &input_wait_mask); - FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + FD_SET (p->infd, &input_wait_mask); + FD_SET (p->infd, &non_keyboard_wait_mask); } } @@ -1111,8 +1111,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size, CHECK_NATNUM (height); CHECK_NATNUM (width); - if (XINT (XPROCESS (process)->infd) < 0 - || set_window_size (XINT (XPROCESS (process)->infd), + if (XPROCESS (process)->infd < 0 + || set_window_size (XPROCESS (process)->infd, XINT (height), XINT (width)) <= 0) return Qnil; else @@ -1140,7 +1140,7 @@ for the process which will run. */) register Lisp_Object process, flag; { CHECK_PROCESS (process); - XPROCESS (process)->inherit_coding_system_flag = flag; + XPROCESS (process)->inherit_coding_system_flag = !NILP (flag); return flag; } @@ -1155,7 +1155,7 @@ the process output. */) register Lisp_Object process; { CHECK_PROCESS (process); - return XPROCESS (process)->inherit_coding_system_flag; + return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil; } DEFUN ("set-process-query-on-exit-flag", @@ -1168,7 +1168,7 @@ exiting if PROCESS is running. */) register Lisp_Object process, flag; { CHECK_PROCESS (process); - XPROCESS (process)->kill_without_query = Fnull (flag); + XPROCESS (process)->kill_without_query = NILP (flag); return flag; } @@ -1180,7 +1180,7 @@ DEFUN ("process-query-on-exit-flag", register Lisp_Object process; { CHECK_PROCESS (process); - return Fnull (XPROCESS (process)->kill_without_query); + return (XPROCESS (process)->kill_without_query ? Qnil : Qt); } #ifdef DATAGRAM_SOCKETS @@ -1355,7 +1355,7 @@ list_processes_1 (query_only) p = XPROCESS (proc); if (NILP (p->childp)) continue; - if (!NILP (query_only) && !NILP (p->kill_without_query)) + if (!NILP (query_only) && p->kill_without_query) continue; if (STRINGP (p->name) && ( i = SCHARS (p->name), (i > w_proc))) @@ -1418,7 +1418,7 @@ list_processes_1 (query_only) p = XPROCESS (proc); if (NILP (p->childp)) continue; - if (!NILP (query_only) && !NILP (p->kill_without_query)) + if (!NILP (query_only) && p->kill_without_query) continue; Finsert (1, &p->name); @@ -1494,7 +1494,7 @@ list_processes_1 (query_only) if (NILP (port)) port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil); sprintf (tembuf, "(network %s server on %s)\n", - (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), + (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), (STRINGP (port) ? (char *)SDATA (port) : "?")); insert_string (tembuf); } @@ -1512,7 +1512,7 @@ list_processes_1 (query_only) if (NILP (host)) host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil); sprintf (tembuf, "(network %s connection to %s)\n", - (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), + (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), (STRINGP (host) ? (char *)SDATA (host) : "?")); insert_string (tembuf); } @@ -1643,11 +1643,13 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) XPROCESS (proc)->sentinel = Qnil; XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->filter_multibyte - = buffer_defaults.enable_multibyte_characters; + = !NILP (buffer_defaults.enable_multibyte_characters); XPROCESS (proc)->command = Flist (nargs - 2, args + 2); #ifdef ADAPTIVE_READ_BUFFERING - XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering; + XPROCESS (proc)->adaptive_read_buffering + = (NILP (Vprocess_adaptive_read_buffering) ? 0 + : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); #endif /* Make the process marker point into the process buffer (if any). */ @@ -1778,13 +1780,11 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) #endif /* not VMS */ XPROCESS (proc)->decoding_buf = make_uninit_string (0); - XPROCESS (proc)->decoding_carryover = make_number (0); + XPROCESS (proc)->decoding_carryover = 0; XPROCESS (proc)->encoding_buf = make_uninit_string (0); - XPROCESS (proc)->encoding_carryover = make_number (0); XPROCESS (proc)->inherit_coding_system_flag - = (NILP (buffer) || !inherit_process_coding_system - ? Qnil : Qt); + = (NILP (buffer) || !inherit_process_coding_system); create_process (proc, (char **) new_argv, current_dir); @@ -1956,15 +1956,15 @@ create_process (process, new_argv, current_dir) /* Record this as an active process, with its channels. As a result, child_setup will close Emacs's side of the pipes. */ chan_process[inchannel] = process; - XSETINT (XPROCESS (process)->infd, inchannel); - XSETINT (XPROCESS (process)->outfd, outchannel); + XPROCESS (process)->infd = inchannel; + XPROCESS (process)->outfd = outchannel; /* Previously we recorded the tty descriptor used in the subprocess. It was only used for getting the foreground tty process, so now we just reopen the device (see emacs_get_tty_pgrp) as this is more portable (see USG_SUBTTY_WORKS above). */ - XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); + XPROCESS (process)->pty_flag = pty_flag; XPROCESS (process)->status = Qrun; setup_process_coding_systems (process); @@ -2481,7 +2481,7 @@ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_ if (!DATAGRAM_CONN_P (process)) return Qnil; - channel = XINT (XPROCESS (process)->infd); + channel = XPROCESS (process)->infd; return conv_sockaddr_to_lisp (datagram_address[channel].sa, datagram_address[channel].len); } @@ -2501,7 +2501,7 @@ Returns nil upon error setting address, ADDRESS otherwise. */) if (!DATAGRAM_CONN_P (process)) return Qnil; - channel = XINT (XPROCESS (process)->infd); + channel = XPROCESS (process)->infd; len = get_lisp_to_sockaddr_size (address, &family); if (datagram_address[channel].len != len) @@ -2666,7 +2666,7 @@ OPTION is not a supported option, return nil instead; otherwise return t. */) if (!NETCONN1_P (p)) error ("Process is not a network process"); - s = XINT (p->infd); + s = p->infd; if (s < 0) error ("Process is not running"); @@ -3420,18 +3420,18 @@ usage: (make-network-process &rest ARGS) */) p->buffer = buffer; p->sentinel = sentinel; p->filter = filter; - p->filter_multibyte = buffer_defaults.enable_multibyte_characters; + p->filter_multibyte = !NILP (buffer_defaults.enable_multibyte_characters); /* Override the above only if :filter-multibyte is specified. */ if (! NILP (Fplist_member (contact, QCfilter_multibyte))) - p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte); + p->filter_multibyte = !NILP (Fplist_get (contact, QCfilter_multibyte)); p->log = Fplist_get (contact, QClog); if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) - p->kill_without_query = Qt; + p->kill_without_query = 1; if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) p->command = Qt; p->pid = 0; - XSETINT (p->infd, inch); - XSETINT (p->outfd, outch); + p->infd = inch; + p->outfd = outch; if (is_server && socktype == SOCK_STREAM) p->status = Qlisten; @@ -3552,13 +3552,11 @@ usage: (make-network-process &rest ARGS) */) setup_process_coding_systems (proc); p->decoding_buf = make_uninit_string (0); - p->decoding_carryover = make_number (0); + p->decoding_carryover = 0; p->encoding_buf = make_uninit_string (0); - p->encoding_carryover = make_number (0); p->inherit_coding_system_flag - = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system - ? Qnil : Qt); + = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system); UNGCPRO; return proc; @@ -3821,16 +3819,16 @@ deactivate_process (proc) register int inchannel, outchannel; register struct Lisp_Process *p = XPROCESS (proc); - inchannel = XINT (p->infd); - outchannel = XINT (p->outfd); + inchannel = p->infd; + outchannel = p->outfd; #ifdef ADAPTIVE_READ_BUFFERING - if (XINT (p->read_output_delay) > 0) + if (p->read_output_delay > 0) { if (--process_output_delay_count < 0) process_output_delay_count = 0; - XSETINT (p->read_output_delay, 0); - p->read_output_skip = Qnil; + p->read_output_delay = 0; + p->read_output_skip = 0; } #endif @@ -3852,8 +3850,8 @@ deactivate_process (proc) emacs_close (outchannel); #endif - XSETINT (p->infd, -1); - XSETINT (p->outfd, -1); + p->infd = -1; + p->outfd = -1; #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CHAN_P (inchannel)) { @@ -3901,8 +3899,8 @@ close_process_descs () process = chan_process[i]; if (!NILP (process)) { - int in = XINT (XPROCESS (process)->infd); - int out = XINT (XPROCESS (process)->outfd); + int in = XPROCESS (process)->infd; + int out = XPROCESS (process)->outfd; if (in >= 0) emacs_close (in); if (out >= 0 && in != out) @@ -4146,8 +4144,8 @@ server_accept_connection (server, channel) p->filter = ps->filter; p->command = Qnil; p->pid = 0; - XSETINT (p->infd, s); - XSETINT (p->outfd, s); + p->infd = s; + p->outfd = s; p->status = Qrun; /* Client processes for accepted connections are not stopped initially. */ @@ -4170,12 +4168,11 @@ server_accept_connection (server, channel) setup_process_coding_systems (proc); p->decoding_buf = make_uninit_string (0); - p->decoding_carryover = make_number (0); + p->decoding_carryover = 0; p->encoding_buf = make_uninit_string (0); - p->encoding_carryover = make_number (0); p->inherit_coding_system_flag - = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag); + = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag); if (!NILP (ps->log)) call3 (ps->log, server, proc, @@ -4300,7 +4297,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, /* If wait_proc is a process to watch, set wait_channel accordingly. */ if (wait_proc != NULL) - wait_channel = XINT (wait_proc->infd); + wait_channel = wait_proc->infd; record_unwind_protect (wait_reading_process_output_unwind, make_number (waiting_for_user_input_p)); @@ -4485,9 +4482,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, XSETPROCESS (proc, wait_proc); /* Read data from the process, until we exhaust it. */ - while (XINT (wait_proc->infd) >= 0) + while (wait_proc->infd >= 0) { - nread = read_process_output (proc, XINT (wait_proc->infd)); + nread = read_process_output (proc, wait_proc->infd); if (nread == 0) break; @@ -4517,9 +4514,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, if (wait_proc && just_wait_proc) { - if (XINT (wait_proc->infd) < 0) /* Terminated */ + if (wait_proc->infd < 0) /* Terminated */ break; - FD_SET (XINT (wait_proc->infd), &Available); + FD_SET (wait_proc->infd, &Available); check_delay = 0; IF_NON_BLOCKING_CONNECT (check_connect = 0); } @@ -4567,7 +4564,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, #ifdef ADAPTIVE_READ_BUFFERING /* Set the timeout for adaptive read buffering if any - process has non-nil read_output_skip and non-zero + process has non-zero read_output_skip and non-zero read_output_delay, and we are not reading output for a specific wait_channel. It is not executed if Vprocess_adaptive_read_buffering is nil. */ @@ -4582,16 +4579,16 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, if (NILP (proc)) continue; /* Find minimum non-zero read_output_delay among the - processes with non-nil read_output_skip. */ - if (XINT (XPROCESS (proc)->read_output_delay) > 0) + processes with non-zero read_output_skip. */ + if (XPROCESS (proc)->read_output_delay > 0) { check_delay--; - if (NILP (XPROCESS (proc)->read_output_skip)) + if (!XPROCESS (proc)->read_output_skip) continue; FD_CLR (channel, &Available); - XPROCESS (proc)->read_output_skip = Qnil; - if (XINT (XPROCESS (proc)->read_output_delay) < usecs) - usecs = XINT (XPROCESS (proc)->read_output_delay); + XPROCESS (proc)->read_output_skip = 0; + if (XPROCESS (proc)->read_output_delay < usecs) + usecs = XPROCESS (proc)->read_output_delay; } } EMACS_SET_SECS_USECS (timeout, 0, usecs); @@ -4864,7 +4861,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, else { /* Preserve status of processes already terminated. */ - XSETINT (XPROCESS (proc)->tick, ++process_tick); + XPROCESS (proc)->tick = ++process_tick; deactivate_process (proc); if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); @@ -4916,7 +4913,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, #endif if (xerrno) { - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)); deactivate_process (proc); } @@ -4929,8 +4926,8 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, exec_sentinel (proc, build_string ("open\n")); if (!EQ (p->filter, Qt) && !EQ (p->command, Qt)) { - FD_SET (XINT (p->infd), &input_wait_mask); - FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + FD_SET (p->infd, &input_wait_mask); + FD_SET (p->infd, &non_keyboard_wait_mask); } } } @@ -5004,7 +5001,7 @@ read_process_output (proc, channel) register struct Lisp_Process *p = XPROCESS (proc); register int opoint; struct coding_system *coding = proc_decode_coding_system[channel]; - int carryover = XINT (p->decoding_carryover); + int carryover = p->decoding_carryover; int readmax = 4096; #ifdef VMS @@ -5057,9 +5054,9 @@ read_process_output (proc, channel) { nbytes = emacs_read (channel, chars + carryover, readmax); #ifdef ADAPTIVE_READ_BUFFERING - if (nbytes > 0 && !NILP (p->adaptive_read_buffering)) + if (nbytes > 0 && p->adaptive_read_buffering) { - int delay = XINT (p->read_output_delay); + int delay = p->read_output_delay; if (nbytes < 256) { if (delay < READ_OUTPUT_DELAY_MAX_MAX) @@ -5075,10 +5072,10 @@ read_process_output (proc, channel) if (delay == 0) process_output_delay_count--; } - XSETINT (p->read_output_delay, delay); + p->read_output_delay = delay; if (delay) { - p->read_output_skip = Qt; + p->read_output_skip = 1; process_output_skip = 1; } } @@ -5096,7 +5093,7 @@ read_process_output (proc, channel) } #endif /* not VMS */ - XSETINT (p->decoding_carryover, 0); + p->decoding_carryover = 0; /* At this point, NBYTES holds number of bytes just received (including the one in proc_buffered_char[channel]). */ @@ -5170,14 +5167,14 @@ read_process_output (proc, channel) valid memory because p->outfd will be changed once EOF is sent to the process. */ if (NILP (p->encode_coding_system) - && proc_encode_coding_system[XINT (p->outfd)]) + && proc_encode_coding_system[p->outfd]) { p->encode_coding_system = coding->symbol; setup_coding_system (coding->symbol, - proc_encode_coding_system[XINT (p->outfd)]); - if (proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]); + if (proc_encode_coding_system[p->outfd]->eol_type == CODING_EOL_UNDECIDED) - proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]->eol_type = system_eol_type; } } @@ -5190,9 +5187,9 @@ read_process_output (proc, channel) p->decoding_buf = make_uninit_string (carryover); bcopy (chars + coding->consumed, SDATA (p->decoding_buf), carryover); - XSETINT (p->decoding_carryover, carryover); + p->decoding_carryover = carryover; /* Adjust the multibyteness of TEXT to that of the filter. */ - if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text)) + if (p->filter_multibyte != STRING_MULTIBYTE (text)) text = (STRING_MULTIBYTE (text) ? Fstring_as_unibyte (text) : Fstring_to_multibyte (text)); @@ -5284,14 +5281,14 @@ read_process_output (proc, channel) { p->decode_coding_system = coding->symbol; if (NILP (p->encode_coding_system) - && proc_encode_coding_system[XINT (p->outfd)]) + && proc_encode_coding_system[p->outfd]) { p->encode_coding_system = coding->symbol; setup_coding_system (coding->symbol, - proc_encode_coding_system[XINT (p->outfd)]); - if (proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]); + if (proc_encode_coding_system[p->outfd]->eol_type == CODING_EOL_UNDECIDED) - proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]->eol_type = system_eol_type; } } @@ -5303,7 +5300,7 @@ read_process_output (proc, channel) p->decoding_buf = make_uninit_string (carryover); bcopy (chars + coding->consumed, SDATA (p->decoding_buf), carryover); - XSETINT (p->decoding_carryover, carryover); + p->decoding_carryover = carryover; /* Adjust the multibyteness of TEXT to that of the buffer. */ if (NILP (current_buffer->enable_multibyte_characters) @@ -5422,10 +5419,10 @@ send_process (proc, buf, len, object) update_status (p); if (! EQ (p->status, Qrun)) error ("Process %s not running", SDATA (p->name)); - if (XINT (p->outfd) < 0) + if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); - coding = proc_encode_coding_system[XINT (p->outfd)]; + coding = proc_encode_coding_system[p->outfd]; Vlast_coding_system_used = coding->symbol; if ((STRINGP (object) && STRING_MULTIBYTE (object)) @@ -5518,7 +5515,7 @@ send_process (proc, buf, len, object) if (pty_max_bytes == 0) { #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) - pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON); + pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON); if (pty_max_bytes < 0) pty_max_bytes = 250; #else @@ -5540,7 +5537,7 @@ send_process (proc, buf, len, object) /* Decide how much data we can send in one batch. Long lines need to be split into multiple batches. */ - if (!NILP (p->pty_flag)) + if (p->pty_flag) { /* Starting this at zero is always correct when not the first iteration because the previous iteration ended by sending C-d. @@ -5569,7 +5566,7 @@ send_process (proc, buf, len, object) /* Send this batch, using one or more write calls. */ while (this > 0) { - int outfd = XINT (p->outfd); + int outfd = p->outfd; old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CHAN_P (outfd)) @@ -5589,12 +5586,12 @@ send_process (proc, buf, len, object) { rv = emacs_write (outfd, (char *) buf, this); #ifdef ADAPTIVE_READ_BUFFERING - if (XINT (p->read_output_delay) > 0 - && EQ (p->adaptive_read_buffering, Qt)) + if (p->read_output_delay > 0 + && p->adaptive_read_buffering == 1) { - XSETFASTINT (p->read_output_delay, 0); + p->read_output_delay = 0; process_output_delay_count--; - p->read_output_skip = Qnil; + p->read_output_skip = 0; } #endif } @@ -5637,7 +5634,7 @@ send_process (proc, buf, len, object) if (errno == EAGAIN) { int flags = FWRITE; - ioctl (XINT (p->outfd), TIOCFLUSH, &flags); + ioctl (p->outfd, TIOCFLUSH, &flags); } #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ @@ -5686,7 +5683,7 @@ send_process (proc, buf, len, object) #endif p->raw_status_new = 0; p->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; deactivate_process (proc); #ifdef VMS error ("Error writing to process %s; closed it", SDATA (p->name)); @@ -5738,10 +5735,10 @@ send_process_object (proc, start, end) update_status (p); if (! EQ (p->status, Qrun)) error ("Process %s not running", SDATA (p->name)); - if (XINT (p->outfd) < 0) + if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); - coding = proc_encode_coding_system[XINT (p->outfd)]; + coding = proc_encode_coding_system[p->outfd]; if (! EQ (coding->symbol, p->encode_coding_system)) /* The coding system for encoding was changed to raw-text because we sent a unibyte text previously. Now we are @@ -5830,7 +5827,7 @@ emacs_get_tty_pgrp (p) int gid = -1; #ifdef TIOCGPGRP - if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) + if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) { int fd; /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the @@ -5868,7 +5865,7 @@ return t unconditionally. */) if (!EQ (p->childp, Qt)) error ("Process %s is not a subprocess", SDATA (p->name)); - if (XINT (p->infd) < 0) + if (p->infd < 0) error ("Process %s is not active", SDATA (p->name)); @@ -5911,11 +5908,11 @@ process_send_signal (process, signo, current_group, nomsg) if (!EQ (p->childp, Qt)) error ("Process %s is not a subprocess", SDATA (p->name)); - if (XINT (p->infd) < 0) + if (p->infd < 0) error ("Process %s is not active", SDATA (p->name)); - if (NILP (p->pty_flag)) + if (!p->pty_flag) current_group = Qnil; /* If we are using pgrps, get a pgrp number and make it negative. */ @@ -5934,7 +5931,7 @@ process_send_signal (process, signo, current_group, nomsg) struct termios t; cc_t *sig_char = NULL; - tcgetattr (XINT (p->infd), &t); + tcgetattr (p->infd, &t); switch (signo) { @@ -5974,16 +5971,16 @@ process_send_signal (process, signo, current_group, nomsg) switch (signo) { case SIGINT: - ioctl (XINT (p->infd), TIOCGETC, &c); + ioctl (p->infd, TIOCGETC, &c); send_process (proc, &c.t_intrc, 1, Qnil); return; case SIGQUIT: - ioctl (XINT (p->infd), TIOCGETC, &c); + ioctl (p->infd, TIOCGETC, &c); send_process (proc, &c.t_quitc, 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: - ioctl (XINT (p->infd), TIOCGLTC, &lc); + ioctl (p->infd, TIOCGLTC, &lc); send_process (proc, &lc.t_suspc, 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ @@ -5998,16 +5995,16 @@ process_send_signal (process, signo, current_group, nomsg) switch (signo) { case SIGINT: - ioctl (XINT (p->infd), TCGETA, &t); + ioctl (p->infd, TCGETA, &t); send_process (proc, &t.c_cc[VINTR], 1, Qnil); return; case SIGQUIT: - ioctl (XINT (p->infd), TCGETA, &t); + ioctl (p->infd, TCGETA, &t); send_process (proc, &t.c_cc[VQUIT], 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: - ioctl (XINT (p->infd), TCGETA, &t); + ioctl (p->infd, TCGETA, &t); send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ @@ -6065,7 +6062,7 @@ process_send_signal (process, signo, current_group, nomsg) case SIGCONT: p->raw_status_new = 0; p->status = Qrun; - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; if (!nomsg) status_notify (NULL); break; @@ -6085,7 +6082,7 @@ process_send_signal (process, signo, current_group, nomsg) sys$forcex (&(p->pid), 0, 1); whoosh: #endif - flush_pending_output (XINT (p->infd)); + flush_pending_output (p->infd); break; } @@ -6102,7 +6099,7 @@ process_send_signal (process, signo, current_group, nomsg) #ifdef TIOCSIGSEND if (!NILP (current_group)) { - if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1) + if (ioctl (p->infd, TIOCSIGSEND, signo) == -1) EMACS_KILLPG (gid, signo); } else @@ -6168,10 +6165,10 @@ If PROCESS is a network process, inhibit handling of incoming traffic. */) p = XPROCESS (process); if (NILP (p->command) - && XINT (p->infd) >= 0) + && p->infd >= 0) { - FD_CLR (XINT (p->infd), &input_wait_mask); - FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } p->command = Qt; return process; @@ -6199,11 +6196,11 @@ If PROCESS is a network process, resume handling of incoming traffic. */) p = XPROCESS (process); if (EQ (p->command, Qt) - && XINT (p->infd) >= 0 + && p->infd >= 0 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten))) { - FD_SET (XINT (p->infd), &input_wait_mask); - FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + FD_SET (p->infd, &input_wait_mask); + FD_SET (p->infd, &non_keyboard_wait_mask); } p->command = Qnil; return process; @@ -6400,7 +6397,7 @@ text to PROCESS after you call this function. */) return process; proc = get_process (process); - coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; + coding = proc_encode_coding_system[XPROCESS (proc)->outfd]; /* Make sure the process is really alive. */ if (XPROCESS (proc)->raw_status_new) @@ -6417,7 +6414,7 @@ text to PROCESS after you call this function. */) #ifdef VMS send_process (proc, "\032", 1, Qnil); /* ^z */ #else - if (!NILP (XPROCESS (proc)->pty_flag)) + if (XPROCESS (proc)->pty_flag) send_process (proc, "\004", 1, Qnil); else { @@ -6429,18 +6426,18 @@ text to PROCESS after you call this function. */) (In some old system, shutdown to socketpair doesn't work. Then we just can't win.) */ if (XPROCESS (proc)->pid == 0 - || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd)) - shutdown (XINT (XPROCESS (proc)->outfd), 1); + || XPROCESS (proc)->outfd == XPROCESS (proc)->infd) + shutdown (XPROCESS (proc)->outfd, 1); /* In case of socketpair, outfd == infd, so don't close it. */ - if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd)) - emacs_close (XINT (XPROCESS (proc)->outfd)); + if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd) + emacs_close (XPROCESS (proc)->outfd); #else /* not HAVE_SHUTDOWN */ - emacs_close (XINT (XPROCESS (proc)->outfd)); + emacs_close (XPROCESS (proc)->outfd); #endif /* not HAVE_SHUTDOWN */ new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0); if (new_outfd < 0) abort (); - old_outfd = XINT (XPROCESS (proc)->outfd); + old_outfd = XPROCESS (proc)->outfd; if (!proc_encode_coding_system[new_outfd]) proc_encode_coding_system[new_outfd] @@ -6451,7 +6448,7 @@ text to PROCESS after you call this function. */) bzero (proc_encode_coding_system[old_outfd], sizeof (struct coding_system)); - XSETINT (XPROCESS (proc)->outfd, new_outfd); + XPROCESS (proc)->outfd = new_outfd; } #endif /* VMS */ return process; @@ -6474,7 +6471,7 @@ kill_buffer_processes (buffer) { if (NETCONN_P (proc)) Fdelete_process (proc); - else if (XINT (XPROCESS (proc)->infd) >= 0) + else if (XPROCESS (proc)->infd >= 0) process_send_signal (proc, SIGHUP, Qnil, 1); } } @@ -6604,21 +6601,21 @@ sigchld_handler (signo) union { int i; WAITTYPE wt; } u; int clear_desc_flag = 0; - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; u.wt = w; p->raw_status = u.i; p->raw_status_new = 1; /* If process has terminated, stop waiting for its output. */ if ((WIFSIGNALED (w) || WIFEXITED (w)) - && XINT (p->infd) >= 0) + && p->infd >= 0) clear_desc_flag = 1; /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ if (clear_desc_flag) { - FD_CLR (XINT (p->infd), &input_wait_mask); - FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } /* Tell wait_reading_process_output that it needs to wake up and @@ -6795,18 +6792,18 @@ status_notify (deleting_process) proc = Fcdr (Fcar (tail)); p = XPROCESS (proc); - if (XINT (p->tick) != XINT (p->update_tick)) + if (p->tick != p->update_tick) { - XSETINT (p->update_tick, XINT (p->tick)); + p->update_tick = p->tick; /* If process is still active, read any output that remains. */ while (! EQ (p->filter, Qt) && ! EQ (p->status, Qconnect) && ! EQ (p->status, Qlisten) && ! EQ (p->command, Qt) /* Network process not stopped. */ - && XINT (p->infd) >= 0 + && p->infd >= 0 && p != deleting_process - && read_process_output (proc, XINT (p->infd)) > 0); + && read_process_output (proc, p->infd) > 0); buffer = p->buffer; @@ -6833,7 +6830,7 @@ status_notify (deleting_process) So set p->update_tick again so that an error in the sentinel will not cause this code to be run again. */ - XSETINT (p->update_tick, XINT (p->tick)); + p->update_tick = p->tick; /* Now output the message suitably. */ if (!NILP (p->sentinel)) exec_sentinel (proc, msg); @@ -6906,9 +6903,9 @@ encode subprocess input. */) CHECK_PROCESS (process); p = XPROCESS (process); - if (XINT (p->infd) < 0) + if (p->infd < 0) error ("Input file descriptor of %s closed", SDATA (p->name)); - if (XINT (p->outfd) < 0) + if (p->outfd < 0) error ("Output file descriptor of %s closed", SDATA (p->name)); Fcheck_coding_system (decoding); Fcheck_coding_system (encoding); @@ -6945,7 +6942,7 @@ suppressed. */) CHECK_PROCESS (process); p = XPROCESS (process); - p->filter_multibyte = flag; + p->filter_multibyte = !NILP (flag); setup_process_coding_systems (process); return Qnil; @@ -6962,7 +6959,7 @@ DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p, CHECK_PROCESS (process); p = XPROCESS (process); - return (NILP (p->filter_multibyte) ? Qnil : Qt); + return (p->filter_multibyte ? Qt : Qnil); } diff --git a/src/process.h b/src/process.h index 718d2a70ea8..fd7847b5e29 100644 --- a/src/process.h +++ b/src/process.h @@ -36,10 +36,6 @@ struct Lisp_Process { EMACS_INT size; struct Lisp_Vector *v_next; - /* Descriptor by which we read from this process */ - Lisp_Object infd; - /* Descriptor by which we write to this process */ - Lisp_Object outfd; /* Name of subprocess terminal. */ Lisp_Object tty_name; /* Name of this process */ @@ -64,61 +60,65 @@ struct Lisp_Process Lisp_Object plist; /* Marker set to end of last buffer-inserted output from this process */ Lisp_Object mark; - /* Non-nil means kill silently if Emacs is exited. - This is the inverse of the `query-on-exit' flag. */ - Lisp_Object kill_without_query; /* Symbol indicating status of process. This may be a symbol: run, open, or closed. Or it may be a list, whose car is stop, exit or signal and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG) or (SIGNAL_NUMBER . COREDUMP_FLAG). */ Lisp_Object status; - /* Non-nil if communicating through a pty. */ - Lisp_Object pty_flag; - /* Event-count of last event in which this process changed status. */ - Lisp_Object tick; - /* Event-count of last such event reported. */ - Lisp_Object update_tick; /* Coding-system for decoding the input from this process. */ Lisp_Object decode_coding_system; /* Working buffer for decoding. */ Lisp_Object decoding_buf; - /* Size of carryover in decoding. */ - Lisp_Object decoding_carryover; /* Coding-system for encoding the output to this process. */ Lisp_Object encode_coding_system; /* Working buffer for encoding. */ Lisp_Object encoding_buf; - /* Size of carryover in encoding. */ - Lisp_Object encoding_carryover; - /* Flag to set coding-system of the process buffer from the - coding_system used to decode process output. */ - Lisp_Object inherit_coding_system_flag; - /* Flat to decide the multibyteness of a string given to the - filter (if any). It is initialized to the value of - `default-enable-multibyte-characters' when the process is - generated, and can be changed by the function - `set-process-fileter-multibyte'. */ - Lisp_Object filter_multibyte; - /* Should we delay reading output from this process. - Initialized from `Vprocess_adaptive_read_buffering'. */ - Lisp_Object adaptive_read_buffering; - /* Hysteresis to try to read process output in larger blocks. - On some systems, e.g. GNU/Linux, Emacs is seen as - an interactive app also when reading process output, meaning - that process output can be read in as little as 1 byte at a - time. Value is micro-seconds to delay reading output from - this process. Range is 0 .. 50000. */ - Lisp_Object read_output_delay; - /* Skip reading this process on next read. */ - Lisp_Object read_output_skip; /* After this point, there are no Lisp_Objects any more. */ + /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ /* Number of this process. allocate_process assumes this is the first non-Lisp_Object field. A value 0 is used for pseudo-processes such as network connections. */ pid_t pid; + /* Descriptor by which we read from this process */ + int infd; + /* Descriptor by which we write to this process */ + int outfd; + /* Event-count of last event in which this process changed status. */ + int tick; + /* Event-count of last such event reported. */ + int update_tick; + /* Size of carryover in decoding. */ + int decoding_carryover; + /* Hysteresis to try to read process output in larger blocks. + On some systems, e.g. GNU/Linux, Emacs is seen as + an interactive app also when reading process output, meaning + that process output can be read in as little as 1 byte at a + time. Value is micro-seconds to delay reading output from + this process. Range is 0 .. 50000. */ + int read_output_delay; + /* Should we delay reading output from this process. + Initialized from `Vprocess_adaptive_read_buffering'. + 0 = nil, 1 = t, 2 = other. */ + int adaptive_read_buffering : 2; + /* Skip reading this process on next read. */ + int read_output_skip : 1; + /* Non-nil means kill silently if Emacs is exited. + This is the inverse of the `query-on-exit' flag. */ + int kill_without_query : 1; + /* Non-nil if communicating through a pty. */ + int pty_flag : 1; + /* Flag to set coding-system of the process buffer from the + coding_system used to decode process output. */ + int inherit_coding_system_flag : 1; + /* Flag to decide the multibyteness of a string given to the + filter (if any). It is initialized to the value of + `default-enable-multibyte-characters' when the process is + generated, and can be changed by the function + `set-process-filter-multibyte'. */ + int filter_multibyte : 1; /* Record the process status in the raw form in which it comes from `wait'. This is to avoid consing in a signal handler. The `raw_status_new' flag indicates that `raw_status' contains a new status that still From 88a337ec3ddd28d9c108d411a155018e773960b2 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Thu, 12 Jul 2007 10:43:46 +0000 Subject: [PATCH 109/163] Remove dashes from front of first line. --- lisp/isearch.el | 2 +- src/ChangeLog | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index 770d607713e..1804233847f 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, 1993, 1994, 1995, 1996, 1997, 1999, 2000, ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. diff --git a/src/ChangeLog b/src/ChangeLog index d112f7297bf..e507754c0ba 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -703,13 +703,13 @@ when popup menu finishes. * w32fns.c (menubar_in_use): New flag. - (w32_wnd_proc) [WM_INITMENU, WM_EXITMENULOOP, WM_TIMER, WM_COMMAND]: + (w32_wnd_proc) : Use it. * w32menu.c (Fx_popup_menu): Don't free menu strings here. (w32_menu_show): Do it here instead. - * w32fns.c (w32_wnd_proc) [WM_INITMENU]: Set menubar_active frame + * w32fns.c (w32_wnd_proc) : Set menubar_active frame parameter. * w32menu.c (current_popup_menu): Make available globally. @@ -717,7 +717,7 @@ menu event into the keyboard buffer. Remove menu_command_in_progress. * w32fns.c (current_popup_menu): Use from w32menu.c. - (w32_wnd_proc) [WM_EXITMENULOOP, WM_TIMER]: Use menubar_active + (w32_wnd_proc) : Use menubar_active and current_popup_menu to determine whether a menubar menu has been cancelled. @@ -9827,7 +9827,7 @@ * w32term.h (x_output): Add focus_state. * w32term.c (x_focus_changed, w32_detect_focus_change): New functions. - (w32_read_socket) [WM_SETFOCUS]: Call w32_detect_focus_change. + (w32_read_socket) : Call w32_detect_focus_change. 2005-03-25 Stefan Monnier @@ -13120,7 +13120,7 @@ * w32term.h (AppendMenuW_Proc): Move declaration from w32menu.c. - * w32fns.c (w32_wnd_proc) [WM_MEASUREITEM, WM_DRAWITEM]: + * w32fns.c (w32_wnd_proc) : Handle Unicode menu titles. 2004-09-07 Kim F. Storm From 9c0a6042d2d9ad43dc2bc1f66f969ca35963003d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 12 Jul 2007 21:13:06 +0000 Subject: [PATCH 110/163] * tramp.texi (Remote processes): Don't call it "experimental" any longer. Add subsection about running a debugger on a remote host. --- man/ChangeLog | 5 +++++ man/tramp.texi | 58 ++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 49 insertions(+), 14 deletions(-) diff --git a/man/ChangeLog b/man/ChangeLog index 65173aa2f5d..2509f926f58 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,8 @@ +2007-07-12 Michael Albinus + + * tramp.texi (Remote processes): Don't call it "experimental" any + longer. Add subsection about running a debugger on a remote host. + 2007-07-10 Carsten Dominik * org.texi (Properties and columns): Chapter rewritten. diff --git a/man/tramp.texi b/man/tramp.texi index fbcce166636..de72b6abaf3 100644 --- a/man/tramp.texi +++ b/man/tramp.texi @@ -212,7 +212,7 @@ Using @value{tramp} * Filename Syntax:: @value{tramp} filename conventions. * Alternative Syntax:: URL-like filename syntax. * Filename completion:: Filename completion. -* Remote processes:: Integration with other @value{emacsname} packages (@sc{experimental}). +* Remote processes:: Integration with other @value{emacsname} packages. The inner workings of remote version control @@ -2019,7 +2019,7 @@ minute you have already forgotten that you hit that key! * Filename Syntax:: @value{tramp} filename conventions. * Alternative Syntax:: URL-like filename syntax. * Filename completion:: Filename completion. -* Remote processes:: Integration with other @value{emacsname} packages (@sc{experimental}). +* Remote processes:: Integration with other @value{emacsname} packages. @end menu @@ -2228,17 +2228,14 @@ contents to @file{/}. @node Remote processes -@section Integration with other @value{emacsname} packages (@sc{experimental}). +@section Integration with other @value{emacsname} packages. @cindex compile @cindex recompile -@cindex gud -@cindex gdb -@cindex perldb -@value{tramp} has an @sc{experimental} implementation for running -processes on a remote host. This allows to exploit @value{emacsname} -packages without modification for remote file names. It does not work -for the @option{ftp} and @option{smb} methods. +@value{tramp} supports running processes on a remote host. This +allows to exploit @value{emacsname} packages without modification for +remote file names. It does not work for the @option{ftp} and +@option{smb} methods. Remote processes are started when a corresponding command is executed from a buffer belonging to a remote file or directory. Up to now, the @@ -2298,17 +2295,50 @@ After you have started @code{eshell}, you could perform commands like this: @example -@b{~ $} cd @trampfnmhl{sudo, , /etc} -@b{@trampfn{sudo, root, host, /etc} $} hostname +@b{~ $} cd @trampfnmhl{sudo, , /etc} @key{RET} +@b{@trampfn{sudo, root, host, /etc} $} hostname @key{RET} host -@b{@trampfn{sudo, root, host, /etc} $} id +@b{@trampfn{sudo, root, host, /etc} $} id @key{RET} uid=0(root) gid=0(root) groups=0(root) -@b{@trampfn{sudo, root, host, /etc} $} find-file shadow +@b{@trampfn{sudo, root, host, /etc} $} find-file shadow @key{RET} # @b{@trampfn{sudo, root, host, /etc} $} @end example +@subsection Running a debugger on a remote host +@cindex gud +@cindex gdb +@cindex perldb + +@file{gud.el} offers an unified interface to several symbolic +debuggers +@ifset emacs +@ifinfo +(@ref{Debuggers, , , @value{emacsdir}}). +@end ifinfo +@end ifset +With @value{tramp}, it is possible to debug programs on +remote hosts. You can call @code{gdb} with a remote file name: + +@example +@kbd{M-x gdb @key{RET}} +@b{Run gdb (like this):} gdb --annotate=3 @trampfnmhl{ssh, host, ~/myprog} @key{RET} +@end example + +The file name can also be relative to a remote default directory. +Given you are in a buffer that belongs to the remote directory +@trampfnmhl{ssh, host, /home/user}, you could call + +@example +@kbd{M-x perldb @key{RET}} +@b{Run perldb (like this):} perl -d myprog.pl @key{RET} +@end example + +It is not possible to use just the absolute local part of a remote +file name, like @kbd{perl -d /home/user/myprog.pl}, though. + + @node Bug Reports @chapter Reporting Bugs and Problems @cindex bug reports From 9e29c91ca36289e7aee08b739fcaf3877b63d82f Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 12 Jul 2007 22:40:00 +0000 Subject: [PATCH 111/163] (desktop-buffer-info, desktop-save): Use `desktop-dirname' instead of `dirname'. --- lisp/ChangeLog | 6 +++++- lisp/desktop.el | 6 +++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0792291a4a3..2e3d60d70e1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-12 Davis Herring + + * desktop.el (desktop-buffer-info, desktop-save): + Use `desktop-dirname' instead of `dirname'. + 2007-07-12 Paul Pogonyshev * progmodes/which-func.el (which-func-modes): Add `python-mode'. @@ -94,7 +99,6 @@ * emacs-lisp/autoload.el (autoload-generate-file-autoloads): Be careful with EOLs when generating MD5 checksums. - * follow.el: Don't change the global map from the follow-mode-map defvar, but from the toplevel. Use easy-menu to unify the Emacs and XEmacs code. diff --git a/lisp/desktop.el b/lisp/desktop.el index e709a6394e3..4ee378adb06 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -652,7 +652,7 @@ is nil, ask the user where to save the desktop." (set-buffer buffer) (list ;; basic information - (desktop-file-name (buffer-file-name) dirname) + (desktop-file-name (buffer-file-name) desktop-dirname) (buffer-name) major-mode ;; minor modes @@ -673,7 +673,7 @@ is nil, ask the user where to save the desktop." buffer-read-only ;; auxiliary information (when (functionp desktop-save-buffer) - (funcall desktop-save-buffer dirname)) + (funcall desktop-save-buffer desktop-dirname)) ;; local variables (let ((locals desktop-locals-to-save) (loclist (buffer-local-variables)) @@ -896,7 +896,7 @@ See also `desktop-base-file-name'." (insert "\n " (desktop-value-to-string e))) (insert ")\n\n"))) - (setq default-directory dirname) + (setq default-directory desktop-dirname) (let ((coding-system-for-write 'emacs-mule)) (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) ;; We remember when it was modified (which is presumably just now). From eca04a35d2f9d7c77222de475fe0a9c9c6a3fe7c Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 12 Jul 2007 22:47:51 +0000 Subject: [PATCH 112/163] (desktop-buffer-info, desktop-save): Use `desktop-dirname' instead of `dirname'. --- lisp/ChangeLog | 5 +++++ lisp/desktop.el | 6 +++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f757ead626d..b9ecf4798b7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-12 Davis Herring + + * desktop.el (desktop-buffer-info, desktop-save): + Use `desktop-dirname' instead of `dirname'. + 2007-07-10 Jim Meyering (tiny change) * emacs-lisp/copyright.el (copyright-current-gpl-version): Set to 3. diff --git a/lisp/desktop.el b/lisp/desktop.el index d9939ac0b85..cafa1868b33 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -652,7 +652,7 @@ is nil, ask the user where to save the desktop." (set-buffer buffer) (list ;; basic information - (desktop-file-name (buffer-file-name) dirname) + (desktop-file-name (buffer-file-name) desktop-dirname) (buffer-name) major-mode ;; minor modes @@ -673,7 +673,7 @@ is nil, ask the user where to save the desktop." buffer-read-only ;; auxiliary information (when (functionp desktop-save-buffer) - (funcall desktop-save-buffer dirname)) + (funcall desktop-save-buffer desktop-dirname)) ;; local variables (let ((locals desktop-locals-to-save) (loclist (buffer-local-variables)) @@ -896,7 +896,7 @@ See also `desktop-base-file-name'." (insert "\n " (desktop-value-to-string e))) (insert ")\n\n"))) - (setq default-directory dirname) + (setq default-directory desktop-dirname) (let ((coding-system-for-write 'emacs-mule)) (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) ;; We remember when it was modified (which is presumably just now). From 49cc054dd963cebccd04febcdf67923c033e2b5f Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Thu, 12 Jul 2007 23:53:28 +0000 Subject: [PATCH 113/163] *** empty log message *** --- man/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/man/ChangeLog b/man/ChangeLog index 2509f926f58..70919de707e 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,10 @@ +2007-07-12 Nick Roberts + + * tramp.texi (Remote processes): Add an anchor to the subsection + "Running a debugger on a remote host". + + * building.texi (Starting GUD): Add xref to this anchor. + 2007-07-12 Michael Albinus * tramp.texi (Remote processes): Don't call it "experimental" any From 6108a728e425b6506fed52be926551c2786d03b1 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Thu, 12 Jul 2007 23:55:04 +0000 Subject: [PATCH 114/163] (Remote processes): Add an anchor to the subsection "Running a debugger on a remote host". --- man/tramp.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/man/tramp.texi b/man/tramp.texi index de72b6abaf3..950b4055912 100644 --- a/man/tramp.texi +++ b/man/tramp.texi @@ -2306,6 +2306,7 @@ uid=0(root) gid=0(root) groups=0(root) @end example +@anchor{Running a debugger on a remote host} @subsection Running a debugger on a remote host @cindex gud @cindex gdb From aed1e85923939a63d172e486b889721b1c4ce116 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Thu, 12 Jul 2007 23:56:37 +0000 Subject: [PATCH 115/163] (Starting GUD): Add xref to this anchor. --- man/building.texi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/building.texi b/man/building.texi index 402b433204e..112c5d0a18b 100644 --- a/man/building.texi +++ b/man/building.texi @@ -527,6 +527,9 @@ debugger supports. However, shell wildcards and variables are not allowed. GUD assumes that the first argument not starting with a @samp{-} is the executable file name. +Tramp provides a facility to debug programs on remote hosts. +@xref{Running a debugger on a remote host, Running a debugger on a remote host,, tramp, The Tramp Manual}. +@c Running a debugger on a remote host @node Debugger Operation @subsection Debugger Operation From be436d23c712135e935bd7af3950d8de15b150e8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 13 Jul 2007 01:06:36 +0000 Subject: [PATCH 116/163] (init_eval_once): Bump max_lisp_eval_depth to 400. --- src/ChangeLog | 4 ++++ src/eval.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 80871a10449..c7cf6d241fc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2007-07-13 Stefan Monnier + + * eval.c (init_eval_once): Bump max_lisp_eval_depth to 400. + 2007-07-12 Stefan Monnier * process.h (struct Lisp_Process): Turn slots infd, outfd, diff --git a/src/eval.c b/src/eval.c index 6707849a840..f899e250ead 100644 --- a/src/eval.c +++ b/src/eval.c @@ -220,7 +220,7 @@ init_eval_once () specpdl_ptr = specpdl; /* Don't forget to update docs (lispref node "Local Variables"). */ max_specpdl_size = 1000; - max_lisp_eval_depth = 300; + max_lisp_eval_depth = 400; Vrun_hooks = Qnil; } From 5183d4c9a916b8b8ffaeaa287447953842822588 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Fri, 13 Jul 2007 02:50:19 +0000 Subject: [PATCH 117/163] * replace.el (match): Use yellow1 instead of yellow. * progmodes/gdb-ui.el (breakpoint-enabled): Use red1 instead of red. * pcvs-info.el (cvs-unknown): Likewise. --- lisp/ChangeLog | 9 +++++++++ lisp/pcvs-info.el | 4 ++-- lisp/progmodes/gdb-ui.el | 2 +- lisp/replace.el | 2 +- 4 files changed, 13 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b9ecf4798b7..644636076c3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2007-07-13 Dan Nicolaescu + + * replace.el (match): Use yellow1 instead of yellow. + + * progmodes/gdb-ui.el (breakpoint-enabled): Use red1 instead of + red. + + * pcvs-info.el (cvs-unknown): Likewise. + 2007-07-12 Davis Herring * desktop.el (desktop-buffer-info, desktop-save): diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el index 6e36b5a93e3..880972bff9d 100644 --- a/lisp/pcvs-info.el +++ b/lisp/pcvs-info.el @@ -85,9 +85,9 @@ to confuse some users sometimes." (defface cvs-unknown '((((class color) (background dark)) - (:foreground "red")) + (:foreground "red1")) (((class color) (background light)) - (:foreground "red")) + (:foreground "red1")) (t (:slant italic))) "PCL-CVS face used to highlight unknown file status." :group 'pcl-cvs) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 4dbc9893f61..7bc904f8319 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -1765,7 +1765,7 @@ static char *magick[] = { (defface breakpoint-enabled '((t - :foreground "red" + :foreground "red1" :weight bold)) "Face for enabled breakpoint icon in fringe." :group 'gud) diff --git a/lisp/replace.el b/lisp/replace.el index ed1fa9a6b59..5d4c2a2eba6 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -860,7 +860,7 @@ Compatibility function for \\[next-error] invocations." (defface match '((((class color) (min-colors 88) (background light)) - :background "yellow") + :background "yellow1") (((class color) (min-colors 88) (background dark)) :background "RoyalBlue3") (((class color) (min-colors 8) (background light)) From fc8b8d0fb5751ee5e4363648519f2ec85e0132af Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 13 Jul 2007 04:46:37 +0000 Subject: [PATCH 118/163] (vc-find-file-hook): Use with-demoted-errors. --- lisp/ChangeLog | 4 ++++ lisp/vc-hooks.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2e3d60d70e1..a353b168976 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-13 Stefan Monnier + + * vc-hooks.el (vc-find-file-hook): Use with-demoted-errors. + 2007-07-12 Davis Herring * desktop.el (desktop-buffer-info, desktop-save): diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 6ab95b333c6..02679136bc6 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -793,7 +793,7 @@ current, and kill the buffer that visits the link." (when buffer-file-name (vc-file-clearprops buffer-file-name) (cond - ((vc-backend buffer-file-name) + ((with-demoted-errors (vc-backend buffer-file-name)) ;; Compute the state and put it in the modeline. (vc-mode-line buffer-file-name) (unless vc-make-backup-files From e5162bc170d1c9db6433876320b381f605fba0d3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 13 Jul 2007 04:49:30 +0000 Subject: [PATCH 119/163] Remove spurious * in docstrings. (vc-handled-backends): Add BZR. --- lisp/ChangeLog | 3 +++ lisp/vc-hooks.el | 20 ++++++++++---------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a353b168976..f82b195f006 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2007-07-13 Stefan Monnier + * vc-hooks.el: Remove spurious * in docstrings. + (vc-handled-backends): Add BZR. + * vc-hooks.el (vc-find-file-hook): Use with-demoted-errors. 2007-07-12 Davis Herring diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 02679136bc6..9fbf4db3160 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -62,9 +62,9 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS HG Arch MCVS) +(defcustom vc-handled-backends '(RCS CVS BZR SVN SCCS HG Arch MCVS) ;; Arch and MCVS come last because they are per-tree rather than per-dir. - "*List of version control backends for which VC will be used. + "List of version control backends for which VC will be used. Entries in this list will be tried in order to determine whether a file is under that sort of version control. Removing an entry from the list prevents VC from being activated @@ -78,19 +78,19 @@ An empty list disables VC altogether." (if (file-directory-p "/usr/sccs") '("/usr/sccs") nil) - "*List of extra directories to search for version control commands." + "List of extra directories to search for version control commands." :type '(repeat directory) :group 'vc) (defcustom vc-make-backup-files nil - "*If non-nil, backups of registered files are made as with other files. + "If non-nil, backups of registered files are made as with other files. If nil (the default), files covered by version control don't get backups." :type 'boolean :group 'vc :group 'backup) (defcustom vc-follow-symlinks 'ask - "*What to do if visiting a symbolic link to a file under version control. + "What to do if visiting a symbolic link to a file under version control. Editing such a file through the link bypasses the version control system, which is dangerous and probably not what you want. @@ -104,26 +104,26 @@ visited and a warning displayed." :group 'vc) (defcustom vc-display-status t - "*If non-nil, display revision number and lock status in modeline. + "If non-nil, display revision number and lock status in modeline. Otherwise, not displayed." :type 'boolean :group 'vc) (defcustom vc-consult-headers t - "*If non-nil, identify work files by searching for version headers." + "If non-nil, identify work files by searching for version headers." :type 'boolean :group 'vc) (defcustom vc-keep-workfiles t - "*If non-nil, don't delete working files after registering changes. + "If non-nil, don't delete working files after registering changes. If the back-end is CVS, workfiles are always kept, regardless of the value of this flag." :type 'boolean :group 'vc) (defcustom vc-mistrust-permissions nil - "*If non-nil, don't assume permissions/ownership track version-control status. + "If non-nil, don't assume permissions/ownership track version-control status. If nil, do rely on the permissions. See also variable `vc-consult-headers'." :type 'boolean @@ -137,7 +137,7 @@ See also variable `vc-consult-headers'." (vc-backend-subdirectory-name file))))) (defcustom vc-stay-local t - "*Non-nil means use local operations when possible for remote repositories. + "Non-nil means use local operations when possible for remote repositories. This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. From d72dd6bc4605c54a6faa19d27f712692d5ed5c01 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 13 Jul 2007 13:13:55 +0000 Subject: [PATCH 120/163] *** empty log message *** --- lisp/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f82b195f006..b6c852e82c9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-13 Carsten Dominik + + * textmodes/org.el: Bug fixes. + 2007-07-13 Stefan Monnier * vc-hooks.el: Remove spurious * in docstrings. From 1e8fbb6d6d3416ded4347463db7330f01dad07b7 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 13 Jul 2007 13:14:11 +0000 Subject: [PATCH 121/163] Bug fixes. --- lisp/textmodes/org.el | 185 +++++++++++++++++++++++++++++------------- 1 file changed, 129 insertions(+), 56 deletions(-) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 0a7bfc7db0c..22bc3f12bb3 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 5.02 +;; Version: 5.03 ;; ;; This file is part of GNU Emacs. ;; @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "5.02" +(defconst org-version "5.03" "The version number of the file org.el.") (defun org-version () (interactive) @@ -489,15 +489,22 @@ the values `folded', `children', or `subtree'." :tag "Org Edit Structure" :group 'org-structure) -(defcustom org-special-ctrl-a nil - "Non-nil means `C-a' behaves specially in headlines. + +(defcustom org-special-ctrl-a/e nil + "Non-nil means `C-a' and `C-e' behave specially in headlines. When set, `C-a' will bring back the cursor to the beginning of the headline text, i.e. after the stars and after a possible TODO keyword. When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line." +it to the beginning of the line. +`C-e' will jump to the end of the headline, ignoring the presence of tags +in the headline. A second `C-e' will then jump to the true end of the +line, after any tags." :group 'org-edit-structure :type 'boolean) +(if (fboundp 'defvaralias) + (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) + (defcustom org-odd-levels-only nil "Non-nil means, skip even levels and only use odd levels for the outline. This has the effect that two stars are being added/taken away in @@ -3408,8 +3415,13 @@ to the part of the headline after the DONE keyword." '(org-level-1 org-level-2 org-level-3 org-level-4 org-level-5 org-level-6 org-level-7 org-level-8 )) -(defconst org-n-levels (length org-level-faces)) +(defcustom org-n-level-faces (length org-level-faces) + "The number different faces to be used for headlines. +Org-mode defines 8 different headline faces, so this can be at most 8. +If it is less than 8, the level-1 face gets re-used for level N+1 etc." + :type 'number + :group 'org-faces) ;;; Variables for pre-computed regular expressions, all buffer local @@ -3686,7 +3698,7 @@ means to push this value onto the list in the variable.") org-todo-line-regexp (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)? *\\(.*\\)") + "\\)\\>\\)?[ \t]*\\(.*\\)") org-nl-done-regexp (concat "\n\\*+[ \t]+" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") @@ -4461,7 +4473,7 @@ between words." '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes, similar to Frank Ruell's org-checklet.el - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" 2 'bold prepend) (if org-provide-checkbox-statistics '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" @@ -4514,7 +4526,7 @@ between words." "Get the right face for match N in font-lock matching of healdines." (setq org-l (- (match-end 2) (match-beginning 1) 1)) (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces)) + (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) (cond ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) ((eq n 2) org-f) @@ -5412,7 +5424,7 @@ If optional TREE is given, use this text instead of the kill ring." (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) (old-level (if (string-match ^re txt) - (- (match-end 0) (match-beginning 0)) + (- (match-end 0) (match-beginning 0) 1) -1)) (force-level (cond (level (prefix-numeric-value level)) ((string-match @@ -5706,7 +5718,7 @@ Return t when things worked, nil when we are not in an item." (save-excursion (goto-char (match-end 0)) (skip-chars-forward " \t") - (looking-at "\\[[ X]\\]")))) + (looking-at "\\[[- X]\\]")))) (defun org-toggle-checkbox (&optional arg) "Toggle the checkbox in the current line." @@ -5720,7 +5732,11 @@ Return t when things worked, nil when we are not in an item." (setq beg (point) end (save-excursion (outline-next-heading) (point)))) ((org-at-item-checkbox-p) (save-excursion - (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t)) + (replace-match + (cond (arg "[-]") + ((member (match-string 0) '("[ ]" "[-]")) "[X]") + (t "[ ]")) + t t)) (throw 'exit t)) (t (error "Not at a checkbox or heading, and no active region"))) (save-excursion @@ -5754,7 +5770,7 @@ the whole buffer." (end (move-marker (make-marker) (progn (outline-next-heading) (point)))) (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)") + (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") b1 e1 f1 c-on c-off lim (cstat 0)) (when all (goto-char (point-min)) @@ -5774,7 +5790,7 @@ the whole buffer." (goto-char e1) (when lim (while (re-search-forward re-box lim t) - (if (equal (match-string 2) "[ ]") + (if (member (match-string 2) '("[ ]" "[-]")) (setq c-off (1+ c-off)) (setq c-on (1+ c-on)))) (delete-region b1 e1) @@ -7145,7 +7161,7 @@ Optional argument NEW may specify text to replace the current field content." (setq n (concat new "|") org-table-may-need-update t))) (or (equal n o) (let (org-table-may-need-update) - (replace-match n)))) + (replace-match n t t)))) (setq org-table-may-need-update t)) (goto-char pos)))))) @@ -7316,7 +7332,6 @@ is always the old value." val) (forward-char 1) "")) - (defun org-table-field-info (arg) "Show info about the current field, and highlight any reference at point." (interactive "P") @@ -8723,7 +8738,7 @@ HIGHLIGHT means, just highlight the range." (goto-line r1) (while (not (looking-at org-table-dataline-regexp)) (beginning-of-line 2)) - (prog1 (org-table-get-field c1) + (prog1 (org-trim (org-table-get-field c1)) (if highlight (org-table-highlight-rectangle (point) (point))))) ;; A range, return a vector ;; First sort the numbers to get a regular ractangle @@ -8743,7 +8758,8 @@ HIGHLIGHT means, just highlight the range." (org-table-highlight-rectangle beg (progn (skip-chars-forward "^|\n") (point)))) ;; return string representation of calc vector - (apply 'append (org-table-copy-region beg end)))))) + (mapcar 'org-trim + (apply 'append (org-table-copy-region beg end))))))) (defun org-table-get-descriptor-line (desc &optional cline bline table) "Analyze descriptor DESC and retrieve the corresponding line number. @@ -9327,10 +9343,10 @@ With prefix ARG, apply the new formulas to the table." ((looking-at "[ \t]") (goto-char pos) (call-interactively 'lisp-indent-line)) - ((looking-at "[$@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) + ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) ((not (fboundp 'pp-buffer)) (error "Cannot pretty-print. Command `pp-buffer' is not available.")) - ((looking-at "[$@0-9a-zA-Z]+ *= *'(") + ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") (goto-char (- (match-end 0) 2)) (setq beg (point)) (setq ind (make-string (current-column) ?\ )) @@ -10814,9 +10830,10 @@ With three \\[universal-argument] prefixes, negate the meaning of (setq link (org-completing-read "Link: " (append - (mapcar (lambda (x) (concat (car x) ":")) + (mapcar (lambda (x) (list (concat (car x) ":"))) (append org-link-abbrev-alist-local org-link-abbrev-alist)) - (mapcar (lambda (x) (concat x ":")) org-link-types)) + (mapcar (lambda (x) (list (concat x ":"))) + org-link-types)) nil nil nil 'tmphist (or (car (car org-stored-links))))) @@ -11810,7 +11827,8 @@ to be run from that hook to fucntion properly." (org-startup-folded nil) org-time-was-given org-end-time-was-given x prompt char time) (setq org-store-link-plist - (append (list :annotation v-a :initial v-i))) + (append (list :annotation v-a :initial v-i) + org-store-link-plist)) (unless tpl (setq tpl "") (message "No template") (ding)) (erase-buffer) (insert (substitute-command-keys @@ -13085,6 +13103,29 @@ also TODO lines." (defvar org-tags-overlay (org-make-overlay 1 1)) (org-detach-overlay org-tags-overlay) +(defun org-align-tags-here (to-col) + ;; Assumes that this is a headline + (let ((pos (point)) (col (current-column)) tags) + (beginning-of-line 1) + (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (< pos (match-beginning 2))) + (progn + (setq tags (match-string 2)) + (goto-char (match-beginning 1)) + (insert " ") + (delete-region (point) (1+ (match-end 0))) + (backward-char 1) + (move-to-column + (max (1+ (current-column)) + (1+ col) + (if (> to-col 0) + to-col + (- (abs to-col) (length tags)))) + t) + (insert tags) + (move-to-column (min (current-column) col) t)) + (goto-char pos)))) + (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." @@ -13123,30 +13164,31 @@ With prefix ARG, realign all tags in headings in the current buffer." (while (string-match "[-+&]+" tags) ;; No boolean logic, just a list (setq tags (replace-match ":" t t tags)))) - + (if (string-match "\\`[\t ]*\\'" tags) (setq tags "") (unless (string-match ":$" tags) (setq tags (concat tags ":"))) (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) - + ;; Insert new tags at the correct column (beginning-of-line 1) - (if (re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (point-at-eol) t) - (progn - (if (equal tags "") - (setq rpl "") - (goto-char (match-beginning 0)) - (setq c0 (current-column) p0 (point) - c1 (max (1+ c0) (if (> org-tags-column 0) - org-tags-column - (- (- org-tags-column) (length tags)))) - rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) - (replace-match rpl t t) - (and (not (featurep 'xemacs)) c0 (tabify p0 (point))) - tags) - (error "Tags alignment failed"))))) + (cond + ((and (equal current "") (equal tags ""))) + ((re-search-forward + (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") + (point-at-eol) t) + (if (equal tags "") + (setq rpl "") + (goto-char (match-beginning 0)) + (setq c0 (current-column) p0 (point) + c1 (max (1+ c0) (if (> org-tags-column 0) + org-tags-column + (- (- org-tags-column) (length tags)))) + rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) + (replace-match rpl t t) + (and (not (featurep 'xemacs)) c0 (tabify p0 (point))) + tags) + (t (error "Tags alignment failed")))))) (defun org-tags-completion-function (string predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) @@ -13831,10 +13873,12 @@ This is the compiled version of the format.") (interactive) (let* ((fmt org-columns-current-fmt-compiled) (beg (point-at-bol)) + (level-face (save-excursion + (beginning-of-line 1) + (looking-at "\\(\\**\\)\\(\\* \\)") + (org-get-level-face 2))) (color (list :foreground - (face-attribute - (or (get-text-property beg 'face) 'default) - :foreground))) + (face-attribute (or level-face 'default) :foreground))) props pom property ass width f string ov column) ;; Check if the entry is in another buffer. (unless props @@ -18224,8 +18268,8 @@ HH:MM." (defsubst org-cmp-category (a b) "Compare the string values of categories of strings A and B." - (let ((ca (or (get-text-property 1 'category a) "")) - (cb (or (get-text-property 1 'category b) ""))) + (let ((ca (or (get-text-property 1 'org-category a) "")) + (cb (or (get-text-property 1 'org-category b) ""))) (cond ((string-lessp ca cb) -1) ((string-lessp cb ca) +1) (t nil)))) @@ -22400,7 +22444,13 @@ overwritten, and the table is not marked as requiring realignment." (goto-char (match-beginning 0)) (self-insert-command N)) (setq org-table-may-need-update t) - (self-insert-command N))) + (self-insert-command N) + (org-fix-tags-on-the-fly))) + +(defun org-fix-tags-on-the-fly () + (when (and (equal (char-after (point-at-bol)) ?*) + (org-on-heading-p)) + (org-align-tags-here org-tags-column))) (defun org-delete-backward-char (N) "Like `delete-backward-char', insert whitespace at field end in tables. @@ -22423,7 +22473,8 @@ because, in this case the deletion might narrow the column." ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. (if noalign (setq org-table-may-need-update c))) - (backward-delete-char N))) + (backward-delete-char N) + (org-fix-tags-on-the-fly))) (defun org-delete-char (N) "Like `delete-char', but insert whitespace at field end in tables. @@ -22448,7 +22499,8 @@ because, in this case the deletion might narrow the column." ;; does not determine the width of the column. (if noalign (setq org-table-may-need-update c))) (delete-char N)) - (delete-char N))) + (delete-char N) + (org-fix-tags-on-the-fly))) ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode (put 'org-self-insert-command 'delete-selection t) @@ -22884,9 +22936,9 @@ See the individual commands for more information." "--" ["Jump" org-goto t] "--" - ["C-a finds headline start" - (setq org-special-ctrl-a (not org-special-ctrl-a)) - :style toggle :selected org-special-ctrl-a]) + ["C-a/e find headline start/end" + (setq org-special-ctrl-a/e (not org-special-ctrl-a/e)) + :style toggle :selected org-special-ctrl-a/e]) ("Edit Structure" ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] @@ -23434,10 +23486,13 @@ work correctly." ;; C-a should go to the beginning of a *visible* line, also in the ;; new outline.el. I guess this should be patched into Emacs? -(defun org-beginning-of-line () +(defun org-beginning-of-line (&optional arg) "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive." - (interactive) +to a visible line beginning. This makes the function of C-a more intuitive. +If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the +first attempt, and only move to after the tags when the cursor is already +beyond the end of the headline." + (interactive "P") (let ((pos (point))) (beginning-of-line 1) (if (bobp) @@ -23448,14 +23503,32 @@ to a visible line beginning. This makes the function of C-a more intuitive." (backward-char 1) (beginning-of-line 1)) (forward-char 1))) - (when (and org-special-ctrl-a (looking-at org-todo-line-regexp) + (when (and org-special-ctrl-a/e (looking-at org-todo-line-regexp) (= (char-after (match-end 1)) ?\ )) (goto-char (cond ((> pos (match-beginning 3)) (match-beginning 3)) ((= pos (point)) (match-beginning 3)) (t (point))))))) +(defun org-end-of-line (&optional arg) + "Go to the end of the line. +If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the +first attempt, and only move to after the tags when the cursor is already +beyond the end of the headline." + (interactive "P") + (if (or (not org-special-ctrl-a/e) + (not (org-on-heading-p))) + (end-of-line arg) + (let ((pos (point))) + (beginning-of-line 1) + (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (or (< pos (match-beginning 1)) + (= pos (match-end 0))) + (goto-char (match-beginning 1)) + (goto-char (match-end 0))))))) + (define-key org-mode-map "\C-a" 'org-beginning-of-line) +(define-key org-mode-map "\C-e" 'org-end-of-line) (defun org-invisible-p () "Check if point is at a character currently not visible." From fecda3e83191e28a654e6a3f375b7b29dff9d6e2 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 13 Jul 2007 13:15:05 +0000 Subject: [PATCH 122/163] *** empty log message *** --- etc/orgcard.tex | 56 +++++++++++++++++++++++++++++++++---------------- man/org.texi | 26 +++++++++++------------ 2 files changed, 51 insertions(+), 31 deletions(-) diff --git a/etc/orgcard.tex b/etc/orgcard.tex index d9f60f62f8c..588d4523206 100644 --- a/etc/orgcard.tex +++ b/etc/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{5.01} +\def\orgversionnumber{5.03} \def\versionyear{2007} % latest update \def\year{2007} % latest copyright year @@ -544,6 +544,24 @@ \section{Tags} \key{create sparse tree with matching tags}{C-c \\} \key{globally (agenda) match tags at cursor}{C-c C-o} +\section{Properties and Column View} + +\key{special commands in property lines}{C-c C-c} +\key{next/previous allowed value}{S-left/right} +\key{turn on column view}{C-c C-x C-c} + +\key{quit column view}{q} +\key{next/previous allowed value}{S-left/right} +\key{next/previous allowed value}{n / p} +\key{edit value}{e} +\key{edit allowed values list}{a} +\key{show value}{v} +\key{make column wider/narrower}{> / <} +\key{move column left/right}{M-left/right} +\key{add new column}{M-S-right} +\key{Delete current column}{M-S-left} + + \section{Timestamps} \key{prompt for date and insert timestamp}{C-c .} @@ -566,6 +584,8 @@ \section{Timestamps} %\key{... forward/backward one month}{M-S-LEFT/RIGT} \key{Toggle custom format display for dates/times}{C-c C-x C-t} +\newcolumn + {\bf Clocking time} \key{start clock on current item}{C-c C-x C-i} @@ -575,12 +595,6 @@ \section{Timestamps} \key{remove displayed times}{C-c C-c} \key{insert/update table with clock report}{C-c C-x C-r} -\section{LaTeX and cdlatex-mode} - -\key{preview LaTeX fragment}{C-c C-x C-l} -\key{Expand abbreviation (cdlatex-mode)}{TAB} -\key{Insert/modify math symbol (cdlatex-mode)}{` / '} - \section{Agenda Views} \key{add/move current file to front of agenda}{C-c [} @@ -648,6 +662,7 @@ \section{Agenda Views} \key{change timestamp to today}{>} \key{insert new entry into diary}{i} +\newcolumn \key{start the clock on current item (clock-in)}{I} \key{stop the clock (clock-out)}{O} \key{cancel current clock}{X} @@ -656,7 +671,6 @@ \section{Agenda Views} \key{Open link in current line}{C-c C-o} -\newcolumn {\bf Calendar commands} \key{find agenda cursor date in calendar}{c} @@ -678,6 +692,12 @@ \section{Calendar and Diary Integration} (setq org-agenda-include-diary t) \endexample +\section{LaTeX and cdlatex-mode} + +\key{preview LaTeX fragment}{C-c C-x C-l} +\key{Expand abbreviation (cdlatex-mode)}{TAB} +\key{Insert/modify math symbol (cdlatex-mode)}{` / '} + \section{Exporting and Publishing} Exporting creates files with extensions {\it .txt\/} and {\it .html\/} @@ -690,17 +710,17 @@ \section{Exporting and Publishing} \key{insert template of export options}{C-c C-x t} \key{toggle fixed width for entry or region}{C-c :} -{\bf HTML formatting} +%{\bf HTML formatting} -\key{make words {\bf bold}}{*bold*} -\key{make words {\it italic}}{/italic/} -\key{make words \underbar{underlined}}{_underlined_} -\key{sub- and superscripts}{x\^{}3, J_dust} -\key{\TeX{}-like macros}{\\alpha, \\to} -\key{typeset lines in fixed width font}{start with :} -\key{tables are exported as HTML tables}{start with |} -\key{links become HTML links}{http:... etc} -\key{include html tags}{@...@} +%\key{make words {\bf bold}}{*bold*} +%\key{make words {\it italic}}{/italic/} +%\key{make words \underbar{underlined}}{_underlined_} +%\key{sub- and superscripts}{x\^{}3, J_dust} +%\key{\TeX{}-like macros}{\\alpha, \\to} +%\key{typeset lines in fixed width font}{start with :} +%\key{tables are exported as HTML tables}{start with |} +%\key{links become HTML links}{http:... etc} +%\key{include html tags}{@...@} %{\bf Export options} % diff --git a/man/org.texi b/man/org.texi index a4a4a6e8f76..6be2a165ff4 100644 --- a/man/org.texi +++ b/man/org.texi @@ -3,7 +3,7 @@ @setfilename ../info/org @settitle Org Mode Manual -@set VERSION 5.02 +@set VERSION 5.03 @set DATE July 2007 @dircategory Emacs @@ -616,8 +616,8 @@ key. Headlines define the structure of an outline tree. The headlines in Org-mode start with one or more stars, on the left margin@footnote{See -the variable @code{org-special-ctrl-a} to configure special behavior of -@kbd{C-a} in headlines.}. For example: +the variable @code{org-special-ctrl-a/e} to configure special behavior +of @kbd{C-a} and @kbd{C-e} in headlines.}. For example: @example * Top level headline @@ -3033,7 +3033,8 @@ percentage of checkboxes checked (in the above example, this would be @table @kbd @kindex C-c C-c @item C-c C-c -Toggle checkbox at point. +Toggle checkbox at point. With prefix argument, set it to @samp{[-]}, +which is considered to be an intermediate state. @kindex C-c C-x C-b @item C-c C-x C-b Toggle checkbox at point. @@ -3452,20 +3453,19 @@ the regular expression @samp{Sarah\|Denny}. @node Column view, Property API, Property searches, Properties and columns @section Column View -A great way to view and edit properties in aan outline tree is +A great way to view and edit properties in an outline tree is @emph{column view}. In column view, each outline item is turned into a table row. Columns in this table provide access to properties of the entries. Org-mode implements columns by overlaying a tabular structure over the headline of each item. While the headlines have been turned into a table row, you can still change the visibility of the outline tree. For example, you get a compact table by switching to CONTENTS -view (@kbd{S-@key{TAB} S-@key{TAB}}, or simple @kbd{c} while column view -is active), but you can still open, read, and -edit the entry below each headline. Or, you can switch to column view -after executing a sparse tree command and in this way get a table only -for the selected items. Column view also works in agenda buffers -(@pxref{Agenda views}) where queries have collected selected items, -possibly from a number of files. +view (@kbd{S-@key{TAB} S-@key{TAB}}, or simply @kbd{c} while column view +is active), but you can still open, read, and edit the entry below each +headline. Or, you can switch to column view after executing a sparse +tree command and in this way get a table only for the selected items. +Column view also works in agenda buffers (@pxref{Agenda views}) where +queries have collected selected items, possibly from a number of files. @menu * Defining columns:: The COLUMNS format property @@ -4490,7 +4490,7 @@ file in a @emph{time-sorted view}. The main purpose of this command is to give an overview over events in a project. @table @kbd -@kindex C-a a L +@kindex C-c a L @item C-c a L Show a time-sorted view of the org file, with all time-stamped items. When called with a @kbd{C-u} prefix, all unfinished TODO entries From 1bedaec120776a661fbc80b06a1b3a7022f54cf8 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 13 Jul 2007 16:08:21 +0000 Subject: [PATCH 123/163] *** empty log message *** --- lisp/ChangeLog | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b6c852e82c9..b6cc633b153 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,6 +1,8 @@ 2007-07-13 Carsten Dominik * textmodes/org.el: Bug fixes. + (org-end-of-line): Move to end of line if in headline without + tags. 2007-07-13 Stefan Monnier From 8ca3a1ea8446b3daf4717dd8ea6fb153cbfba5b9 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 13 Jul 2007 16:08:46 +0000 Subject: [PATCH 124/163] Move to end of line if in headline without tags. --- lisp/textmodes/org.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 22bc3f12bb3..a7eb10dbb4f 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 5.03 +;; Version: 5.03b ;; ;; This file is part of GNU Emacs. ;; @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "5.03" +(defconst org-version "5.03b" "The version number of the file org.el.") (defun org-version () (interactive) @@ -23525,7 +23525,8 @@ beyond the end of the headline." (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) (goto-char (match-beginning 1)) - (goto-char (match-end 0))))))) + (goto-char (match-end 0))) + (end-of-line arg))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) From e4f6f302a59b097dd77bc6f2328f5eb6e239ea1a Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Fri, 13 Jul 2007 18:16:17 +0000 Subject: [PATCH 125/163] * bookmark.el: Don't define bookmark keys under the "C-xr" map; instead, make "C-xp" a prefix for bookmark-map. Patch by Drew Adams , mildly tweaked by me. See http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html. --- lisp/ChangeLog | 7 +++++++ lisp/bookmark.el | 6 ++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b6cc633b153..942f4468451 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2007-07-13 Karl Fogel + + * bookmark.el: Don't define bookmark keys under the "C-xr" map; + instead, make "C-xp" a prefix for bookmark-map. Patch by Drew + Adams , mildly tweaked by me. See + http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html. + 2007-07-13 Carsten Dominik * textmodes/org.el: Bug fixes. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 3c1469fef97..156e8affaa5 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -224,10 +224,6 @@ following in your `.emacs' file: ;; Set up these bindings dumping time *only*; ;; if the user alters them, don't override the user when loading bookmark.el. -;;;###autoload (define-key ctl-x-map "rb" 'bookmark-jump) -;;;###autoload (define-key ctl-x-map "rm" 'bookmark-set) -;;;###autoload (define-key ctl-x-map "rl" 'bookmark-bmenu-list) - ;;;###autoload (defvar bookmark-map nil "Keymap containing bindings to bookmark functions. @@ -238,6 +234,8 @@ functions have a binding in this keymap.") ;;;###autoload (define-prefix-command 'bookmark-map) +;;;###autoload (define-key ctl-x-map "p" bookmark-map) + ;; Read the help on all of these functions for details... ;;;###autoload (define-key bookmark-map "x" 'bookmark-set) ;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark" From d14c45f7aaeef1b453131de8f9743d66484ccce4 Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Fri, 13 Jul 2007 18:18:04 +0000 Subject: [PATCH 126/163] * bookmark.el: Shorten some comments to fit within 80 lines. --- lisp/ChangeLog | 4 ++++ lisp/bookmark.el | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 942f4468451..010b2db64c1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-13 Karl Fogel + + * bookmark.el: Shorten some comments to fit within 80 lines. + 2007-07-13 Karl Fogel * bookmark.el: Don't define bookmark keys under the "C-xr" map; diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 156e8affaa5..ba0f93854b3 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -238,12 +238,12 @@ functions have a binding in this keymap.") ;; Read the help on all of these functions for details... ;;;###autoload (define-key bookmark-map "x" 'bookmark-set) -;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark" +;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ;"m"ark ;;;###autoload (define-key bookmark-map "j" 'bookmark-jump) -;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go" +;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ;"g"o ;;;###autoload (define-key bookmark-map "i" 'bookmark-insert) ;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks) -;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find" +;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ;"f"ind ;;;###autoload (define-key bookmark-map "r" 'bookmark-rename) ;;;###autoload (define-key bookmark-map "d" 'bookmark-delete) ;;;###autoload (define-key bookmark-map "l" 'bookmark-load) From 241ab2b5f97c33e43ac73be9a170a2d4c6c1d8a6 Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Fri, 13 Jul 2007 18:20:55 +0000 Subject: [PATCH 127/163] * bookmark.el (bookmark-jump-other-window): New function. (bookmark-map): Bind it to "o". Patch by Drew Adams . See http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html. --- lisp/ChangeLog | 8 ++++++++ lisp/bookmark.el | 22 ++++++++++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 010b2db64c1..209174beddb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2007-07-13 Karl Fogel + + * bookmark.el (bookmark-jump-other-window): New function. + (bookmark-map): Bind it to "o". + + Patch by Drew Adams . See + http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html. + 2007-07-13 Karl Fogel * bookmark.el: Shorten some comments to fit within 80 lines. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index ba0f93854b3..6ef2ea198d3 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -241,6 +241,7 @@ functions have a binding in this keymap.") ;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ;"m"ark ;;;###autoload (define-key bookmark-map "j" 'bookmark-jump) ;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ;"g"o +;;;###autoload (define-key bookmark-map "o" 'bookmark-jump-other-window) ;;;###autoload (define-key bookmark-map "i" 'bookmark-insert) ;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks) ;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ;"f"ind @@ -1081,6 +1082,27 @@ of the old one in the permanent bookmark record." (bookmark-show-annotation bookmark))))) +;;;###autoload +(defun bookmark-jump-other-window (bookmark) + "Jump to BOOKMARK (a point in some file) in another window. +See `bookmark-jump'." + (interactive + (let ((bkm (bookmark-completing-read "Jump to bookmark (in another window)" + bookmark-current-bookmark))) + (if (> emacs-major-version 21) + (list bkm) bkm))) + (when bookmark + (bookmark-maybe-historicize-string bookmark) + (let ((cell (bookmark-jump-noselect bookmark))) + (and cell + (switch-to-buffer-other-window (car cell)) + (goto-char (cdr cell)) + (if bookmark-automatically-show-annotations + ;; if there is an annotation for this bookmark, + ;; show it in a buffer. + (bookmark-show-annotation bookmark)))))) + + (defun bookmark-file-or-variation-thereof (file) "Return FILE (a string) if it exists, or return a reasonable variation of FILE if that exists. Reasonable variations are checked From a5b18336b615a6fb4438e31c1558417014e9de46 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 19:44:45 +0000 Subject: [PATCH 128/163] Add @documentencoding directive. --- man/emacs-mime.texi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/emacs-mime.texi b/man/emacs-mime.texi index 56f130b67fb..0f3c141c792 100644 --- a/man/emacs-mime.texi +++ b/man/emacs-mime.texi @@ -32,6 +32,9 @@ license to the document, as described in section 6 of the license. @end quotation @end copying +@c Node ``Interface Functions'' uses Latin-1 characters +@documentencoding ISO-8859-1 + @dircategory Emacs @direntry * Emacs MIME: (emacs-mime). Emacs MIME de/composition library. From 1342bb6b64e7dfe7c8419dc9696172e2b1db41cc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 19:45:55 +0000 Subject: [PATCH 129/163] (../info/emacs-mime): Use --enable-encoding. --- man/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/Makefile.in b/man/Makefile.in index 9810bf27fa5..94ace126537 100644 --- a/man/Makefile.in +++ b/man/Makefile.in @@ -217,7 +217,7 @@ sieve.dvi: sieve.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi ../info/emacs-mime: emacs-mime.texi - cd $(srcdir); $(MAKEINFO) emacs-mime.texi + cd $(srcdir); $(MAKEINFO) --enable-encoding emacs-mime.texi emacs-mime.dvi: emacs-mime.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi From 3fc750390ca615aa353da08361b8cdc0ad578052 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 19:47:02 +0000 Subject: [PATCH 130/163] ($(infodir)/emacs-mime): Use --enable-encoding. --- man/ChangeLog | 8 ++++++++ man/makefile.w32-in | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/man/ChangeLog b/man/ChangeLog index 70919de707e..ad39b9fce15 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,11 @@ +2007-07-13 Eli Zaretskii + + * Makefile.in (../info/emacs-mime): Use --enable-encoding. + + * makefile.w32-in ($(infodir)/emacs-mime): Ditto. + + * emacs-mime.texi: Add @documentencoding directive. + 2007-07-12 Nick Roberts * tramp.texi (Remote processes): Add an anchor to the subsection diff --git a/man/makefile.w32-in b/man/makefile.w32-in index 0112040ee51..2e559a62906 100644 --- a/man/makefile.w32-in +++ b/man/makefile.w32-in @@ -217,7 +217,7 @@ message.dvi: message.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/message.texi # $(infodir)/emacs-mime: emacs-mime.texi - $(MAKEINFO) emacs-mime.texi + $(MAKEINFO) --enable-encoding emacs-mime.texi emacs-mime.dvi: emacs-mime.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-mime.texi # From 564a3032f90e492446ff149e6afcc32c0371f749 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 20:23:12 +0000 Subject: [PATCH 131/163] (install-lisp-SH, install-lisp-CMD): New targets. (install): Use them to copy all *.el files before *.elc. --- lisp/ChangeLog | 5 +++++ lisp/makefile.w32-in | 15 ++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 209174beddb..0f550312912 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-13 Eli Zaretskii + + * makefile.w32-in (install-lisp-SH, install-lisp-CMD): New targets. + (install): Use them to copy all *.el files before *.elc. + 2007-07-13 Karl Fogel * bookmark.el (bookmark-jump-other-window): New function. diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 29b3a185fb5..6e8a3f5d39a 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -408,7 +408,7 @@ install: - $(DEL) "$(INSTALL_DIR)/same-dir.tst" echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst" #ifdef COPY_LISP_SOURCE - $(IFNOTSAMEDIR) $(CP_DIR) . "$(INSTALL_DIR)/lisp" $(ENDIF) + $(IFNOTSAMEDIR) $(MAKE) $(MFLAGS) install-lisp-$(SHELLTYPE) $(ENDIF) #else # $(IFNOTSAMEDIR) $(CP_DIR) *.elc "$(INSTALL_DIR)/lisp" $(ENDIF) # $(IFNOTSAMEDIR) $(CP) cus-load.el "$(INSTALL_DIR)/lisp" $(ENDIF) @@ -425,6 +425,19 @@ install: - $(DEL) ../same-dir.tst - $(DEL) "$(INSTALL_DIR)/same-dir.tst" +# Need to copy *.el files first, to avoid "source file is newer" annoyance +# since cp does not preserve time stamps +install-lisp-SH: + cp -f *.el "$(INSTALL_DIR)/lisp" + for dir in $(WINS); do mkdir "$(INSTALL_DIR)/lisp/$$dir" && cp -f $$dir/*.el "$(INSTALL_DIR)/lisp/$$dir"; done + for dir in . $(WINS); do cp $$dir/*.elc "$(INSTALL_DIR)/lisp/$$dir"; done + +install-lisp-CMD: + cp -f *.el "$(INSTALL_DIR)/lisp" + for %%f in ($(WINS)) do mkdir "$(INSTALL_DIR)/lisp/%%f" + for %%f in ($(WINS)) do cp -f %%f/*.el "$(INSTALL_DIR)/lisp/%%f" + for %%f in (. $(WINS)) do cp -f %%f/*.elc "$(INSTALL_DIR)/lisp/%%f" + # # Maintenance # From 78ffd1eaf1877db1984d3d12d6366690aa0c6238 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 20:35:27 +0000 Subject: [PATCH 132/163] (../info/emacs-mime): Use --enable-encoding. --- man/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/Makefile.in b/man/Makefile.in index 9810bf27fa5..94ace126537 100644 --- a/man/Makefile.in +++ b/man/Makefile.in @@ -217,7 +217,7 @@ sieve.dvi: sieve.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/sieve.texi ../info/emacs-mime: emacs-mime.texi - cd $(srcdir); $(MAKEINFO) emacs-mime.texi + cd $(srcdir); $(MAKEINFO) --enable-encoding emacs-mime.texi emacs-mime.dvi: emacs-mime.texi $(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi From cc446013c1d4004b307d6a7d645bbd7e4ec3c8d9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 20:36:29 +0000 Subject: [PATCH 133/163] ($(infodir)/emacs-mime): Use --enable-encoding. --- man/ChangeLog | 8 ++++++++ man/makefile.w32-in | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/man/ChangeLog b/man/ChangeLog index 131f02f5105..287c095a473 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,11 @@ +2007-07-13 Eli Zaretskii + + * Makefile.in (../info/emacs-mime): Use --enable-encoding. + + * makefile.w32-in ($(infodir)/emacs-mime): Ditto. + + * emacs-mime.texi: Add @documentencoding directive. + 2007-07-02 Reiner Steib * gnus-faq.texi ([3.2]): Fix locating of environment variables in the diff --git a/man/makefile.w32-in b/man/makefile.w32-in index 0112040ee51..2e559a62906 100644 --- a/man/makefile.w32-in +++ b/man/makefile.w32-in @@ -217,7 +217,7 @@ message.dvi: message.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/message.texi # $(infodir)/emacs-mime: emacs-mime.texi - $(MAKEINFO) emacs-mime.texi + $(MAKEINFO) --enable-encoding emacs-mime.texi emacs-mime.dvi: emacs-mime.texi $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-mime.texi # From 47f88b0058bd7349bfab19d109991a47e08167bf Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 20:37:05 +0000 Subject: [PATCH 134/163] Add @documentencoding directive. --- man/emacs-mime.texi | 2 ++ 1 file changed, 2 insertions(+) diff --git a/man/emacs-mime.texi b/man/emacs-mime.texi index 56f130b67fb..5cf17e7d54b 100644 --- a/man/emacs-mime.texi +++ b/man/emacs-mime.texi @@ -32,6 +32,8 @@ license to the document, as described in section 6 of the license. @end quotation @end copying +@documentencoding ISO-8859-1 + @dircategory Emacs @direntry * Emacs MIME: (emacs-mime). Emacs MIME de/composition library. From 86d925186186ba058663ad42328a42dca07e637f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Jul 2007 20:42:01 +0000 Subject: [PATCH 135/163] (install-lisp-SH, install-lisp-CMD): New targets. (install): Use them to copy all *.el files before *.elc. --- lisp/ChangeLog | 5 +++++ lisp/makefile.w32-in | 15 ++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 644636076c3..3fb9fc4cb42 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-13 Eli Zaretskii + + * makefile.w32-in (install-lisp-SH, install-lisp-CMD): New targets. + (install): Use them to copy all *.el files before *.elc. + 2007-07-13 Dan Nicolaescu * replace.el (match): Use yellow1 instead of yellow. diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 29b3a185fb5..6e8a3f5d39a 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -408,7 +408,7 @@ install: - $(DEL) "$(INSTALL_DIR)/same-dir.tst" echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst" #ifdef COPY_LISP_SOURCE - $(IFNOTSAMEDIR) $(CP_DIR) . "$(INSTALL_DIR)/lisp" $(ENDIF) + $(IFNOTSAMEDIR) $(MAKE) $(MFLAGS) install-lisp-$(SHELLTYPE) $(ENDIF) #else # $(IFNOTSAMEDIR) $(CP_DIR) *.elc "$(INSTALL_DIR)/lisp" $(ENDIF) # $(IFNOTSAMEDIR) $(CP) cus-load.el "$(INSTALL_DIR)/lisp" $(ENDIF) @@ -425,6 +425,19 @@ install: - $(DEL) ../same-dir.tst - $(DEL) "$(INSTALL_DIR)/same-dir.tst" +# Need to copy *.el files first, to avoid "source file is newer" annoyance +# since cp does not preserve time stamps +install-lisp-SH: + cp -f *.el "$(INSTALL_DIR)/lisp" + for dir in $(WINS); do mkdir "$(INSTALL_DIR)/lisp/$$dir" && cp -f $$dir/*.el "$(INSTALL_DIR)/lisp/$$dir"; done + for dir in . $(WINS); do cp $$dir/*.elc "$(INSTALL_DIR)/lisp/$$dir"; done + +install-lisp-CMD: + cp -f *.el "$(INSTALL_DIR)/lisp" + for %%f in ($(WINS)) do mkdir "$(INSTALL_DIR)/lisp/%%f" + for %%f in ($(WINS)) do cp -f %%f/*.el "$(INSTALL_DIR)/lisp/%%f" + for %%f in (. $(WINS)) do cp -f %%f/*.elc "$(INSTALL_DIR)/lisp/%%f" + # # Maintenance # From 488eebbd19e1c078931b663628407fe493d6e747 Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Fri, 13 Jul 2007 23:20:21 +0000 Subject: [PATCH 136/163] * NEWS: Update for recent bookmark keybinding changes. --- etc/ChangeLog | 4 ++++ etc/NEWS | 3 +++ 2 files changed, 7 insertions(+) diff --git a/etc/ChangeLog b/etc/ChangeLog index e2c951c187e..a0441065d63 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2007-07-13 Karl Fogel + + * NEWS: Update for recent bookmark keybinding changes. + 2007-07-10 Michael Albinus * NEWS: Add Tramp and comint-mode changes. diff --git a/etc/NEWS b/etc/NEWS index d05495ac7e3..2549282e2b1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -57,6 +57,9 @@ recenter the visited source file. Its value can be a number (for example, ** New command kill-matching-buffers kills buffers whose name matches a regexp. +** Bookmark commands live under prefix C-x p now, instead of C-x r. Some of + the individual bindings have changed; do C-x p C-h for details. + * New Modes and Packages in Emacs 23.1 From d143e2a56fd35df248656dbe7dfdbdb292aa5a80 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Fri, 13 Jul 2007 23:38:31 +0000 Subject: [PATCH 137/163] Whitespace change. --- man/building.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/man/building.texi b/man/building.texi index 112c5d0a18b..82ee57e8592 100644 --- a/man/building.texi +++ b/man/building.texi @@ -530,6 +530,7 @@ allowed. GUD assumes that the first argument not starting with a Tramp provides a facility to debug programs on remote hosts. @xref{Running a debugger on a remote host, Running a debugger on a remote host,, tramp, The Tramp Manual}. @c Running a debugger on a remote host + @node Debugger Operation @subsection Debugger Operation From f6021509c5beb6fc4fcf2a490710b7814b9e5d36 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Sat, 14 Jul 2007 09:02:06 +0000 Subject: [PATCH 138/163] Mention gtk-engines-qt problem. --- etc/ChangeLog | 4 ++++ etc/PROBLEMS | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/etc/ChangeLog b/etc/ChangeLog index a14e58d9f7f..d7b971e81bf 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2007-07-14 Jan Dj,Ad(Brv + + * PROBLEMS: Mention gtk-engines-qt problem. + 2007-06-07 Glenn Morris * images/cancel.pbm: Convert from PGM to PBM. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 04466f2b421..a40c9a890e0 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1160,6 +1160,10 @@ present or commented out: Emacs*Foreground Emacs*Background +It is also reported that a bug in the gtk-engines-qt engine can cause this if +Emacs is compiled with Gtk+. +The bug is fixed in version 0.7 or newer of gtk-engines-qt. + *** KDE: Emacs hangs on KDE when a large portion of text is killed. This is caused by a bug in the KDE applet `klipper' which periodically From a34756594c103fb8ed8b119d2d7cac311465ba83 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Sat, 14 Jul 2007 09:02:35 +0000 Subject: [PATCH 139/163] (bugzilla): Mention gtk-engines-qt bug. --- etc/ChangeLog | 4 ++++ etc/PROBLEMS | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/etc/ChangeLog b/etc/ChangeLog index a0441065d63..be966266ee0 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2007-07-14 Jan Dj,Ad(Brv + + * PROBLEMS: Mention gtk-engines-qt problem. + 2007-07-13 Karl Fogel * NEWS: Update for recent bookmark keybinding changes. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 04466f2b421..a40c9a890e0 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1160,6 +1160,10 @@ present or commented out: Emacs*Foreground Emacs*Background +It is also reported that a bug in the gtk-engines-qt engine can cause this if +Emacs is compiled with Gtk+. +The bug is fixed in version 0.7 or newer of gtk-engines-qt. + *** KDE: Emacs hangs on KDE when a large portion of text is killed. This is caused by a bug in the KDE applet `klipper' which periodically From 016d1c7104117802a7c66d834624e7cbe65da0a3 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Sat, 14 Jul 2007 09:12:16 +0000 Subject: [PATCH 140/163] (gnus-mime-delete-part): Don't go through article-edit finishing actions if we did not edit the article. --- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/gnus-art.el | 10 +++++----- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6ff604ab53f..30b787acf41 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2007-07-14 David Kastrup + + * gnus-art.el (gnus-mime-delete-part): Don't go through article-edit + finishing actions if we did not edit the article. + 2007-07-04 Katsumi Yamaoka * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index cbfa6bded93..020bd283189 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4408,11 +4408,11 @@ Deleting parts may malfunction or destroy the article; continue? ") (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight))))) - ;; Not in `gnus-mime-save-part-and-strip': - (gnus-article-edit-done) - (gnus-summary-expand-window) - (gnus-summary-show-article)) + ,gnus-summary-buffer no-highlight)))) + ;; Not in `gnus-mime-save-part-and-strip': + (gnus-article-edit-done) + (gnus-summary-expand-window) + (gnus-summary-show-article))) (defun gnus-mime-save-part () "Save the MIME part under point." From 5b4a1f50d353a3ef7857bd43027580831195fc24 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 14 Jul 2007 10:54:09 +0000 Subject: [PATCH 141/163] (Fprogn): Doc fix. --- src/eval.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/eval.c b/src/eval.c index f899e250ead..355ed30066a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -433,7 +433,7 @@ usage: (cond CLAUSES...) */) DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, doc: /* Eval BODY forms sequentially and return value of last one. -usage: (progn BODY ...) */) +usage: (progn BODY...) */) (args) Lisp_Object args; { From d514369d905fbc9d3d16799db41e744b71056b99 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 14 Jul 2007 10:55:50 +0000 Subject: [PATCH 142/163] (Ftrack_mouse): Doc fix. --- src/keyboard.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index 1837958dcfd..2c838d9a311 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1422,7 +1422,7 @@ DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, Within a `track-mouse' form, mouse motion generates input events that you can read with `read-event'. Normally, mouse motion is ignored. -usage: (track-mouse BODY ...) */) +usage: (track-mouse BODY...) */) (args) Lisp_Object args; { From f0005db530c0f83b18cff945cd847ad1b6cfc217 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 14 Jul 2007 10:56:33 +0000 Subject: [PATCH 143/163] (Fwith_output_to_temp_buffer): Doc fix. --- src/print.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/print.c b/src/print.c index 533d0a82cc4..76716fe7c24 100644 --- a/src/print.c +++ b/src/print.c @@ -690,7 +690,7 @@ If variable `temp-buffer-show-function' is non-nil, call it at the end to get the buffer displayed instead of just displaying the non-selected buffer and calling the hook. It gets one argument, the buffer to display. -usage: (with-output-to-temp-buffer BUFNAME BODY ...) */) +usage: (with-output-to-temp-buffer BUFNAME BODY...) */) (args) Lisp_Object args; { From 7254a30ca9cbde2a4338e357f8ee203b94899303 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 14 Jul 2007 10:57:49 +0000 Subject: [PATCH 144/163] (Fsave_window_excursion): Doc fix. --- src/window.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 8a5137f2044..3cb4292d346 100644 --- a/src/window.c +++ b/src/window.c @@ -6643,7 +6643,7 @@ and the value of point and mark for each window. Also restore the choice of selected window. Also restore which buffer is current. Does not restore the value of point in current buffer. -usage: (save-window-excursion BODY ...) */) +usage: (save-window-excursion BODY...) */) (args) Lisp_Object args; { From 1bab435a3e51e7a8442847679cb9daf68bf4f264 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 14 Jul 2007 11:04:31 +0000 Subject: [PATCH 145/163] *** empty log message *** --- src/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index c7cf6d241fc..547d1ee130f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2007-07-14 Juanma Barranquero + + * eval.c (Fprogn): + * keyboard.c (Ftrack_mouse): + * print.c (Fwith_output_to_temp_buffer): + * window.c (Fsave_window_excursion): Doc fix. + 2007-07-13 Stefan Monnier * eval.c (init_eval_once): Bump max_lisp_eval_depth to 400. From ebc3ae141e844a7fe108b4e7d019a45c0f581429 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sat, 14 Jul 2007 11:11:43 +0000 Subject: [PATCH 146/163] (when, unless): Doc fix. --- lisp/ChangeLog | 9 ++++++--- lisp/subr.el | 4 ++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0f550312912..d4133f6fae2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-14 Juanma Barranquero + + * subr.el (when, unless): Doc fix. + 2007-07-13 Eli Zaretskii * makefile.w32-in (install-lisp-SH, install-lisp-CMD): New targets. @@ -25,8 +29,7 @@ 2007-07-13 Carsten Dominik * textmodes/org.el: Bug fixes. - (org-end-of-line): Move to end of line if in headline without - tags. + (org-end-of-line): Move to end of line if in headline without tags. 2007-07-13 Stefan Monnier @@ -297,7 +300,7 @@ (math-approx-gamma-const): Add docstrings. * calc/calc-forms.el (math-julian-date-beginning) - (math-julian-date-beginning-int) New constants. + (math-julian-date-beginning-int): New constants. (math-format-date-part, math-parse-standard-date, calcFunc-julian): Use the new constants. diff --git a/lisp/subr.el b/lisp/subr.el index 185b9031d27..c4816f5d134 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -103,7 +103,7 @@ change the list." When COND yields non-nil, eval BODY forms sequentially and return value of last one, or nil if there are none. -\(fn COND BODY ...)" +\(fn COND BODY...)" (declare (indent 1) (debug t)) (list 'if cond (cons 'progn body))) @@ -112,7 +112,7 @@ value of last one, or nil if there are none. When COND yields nil, eval BODY forms sequentially and return value of last one, or nil if there are none. -\(fn COND BODY ...)" +\(fn COND BODY...)" (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) From 287a387cf53cc7e17142733660b959b34a8bfd0c Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Sat, 14 Jul 2007 16:14:58 +0000 Subject: [PATCH 147/163] (defadvice): Doc fix. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/advice.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d4133f6fae2..3a40e1fec6c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-07-14 David Kastrup + + * emacs-lisp/advice.el (defadvice): Doc fix. + 2007-07-14 Juanma Barranquero * subr.el (when, unless): Doc fix. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 8023bc58a53..0123124b26d 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -3759,7 +3759,7 @@ The syntax of `defadvice' is as follows: \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] - BODY... ) + BODY...) FUNCTION ::= Name of the function to be advised. CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. From eac3f1eb3e19b828f4d24af480f2781998f86f8d Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Sat, 14 Jul 2007 18:06:09 +0000 Subject: [PATCH 148/163] * regs.texi (Bookmarks): Adjust for recent keybinding changes in bookmark.el, namely 2007-07-13T18:16:17Z!kfogel@red-bean.com and 2007-07-13T18:20:55Z!kfogel@red-bean.com. --- man/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/man/ChangeLog b/man/ChangeLog index ad39b9fce15..8afb01ed216 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,9 @@ +2007-07-13 Karl Fogel + + * regs.texi (Bookmarks): Adjust for recent keybinding changes in + bookmark.el, namely 2007-07-13T18:16:17Z!kfogel@red-bean.com and + 2007-07-13T18:20:55Z!kfogel@red-bean.com. + 2007-07-13 Eli Zaretskii * Makefile.in (../info/emacs-mime): Use --enable-encoding. From f8b7331d235756948f33d96a917a5844c480dd1d Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Sat, 14 Jul 2007 18:10:17 +0000 Subject: [PATCH 149/163] * lisp/ChangeLog: Put main author of change in the ChangeLog entry header; rewrite entry accordingly. --- lisp/ChangeLog | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3a40e1fec6c..f8628f540d5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -11,13 +11,15 @@ * makefile.w32-in (install-lisp-SH, install-lisp-CMD): New targets. (install): Use them to copy all *.el files before *.elc. -2007-07-13 Karl Fogel +2007-07-13 Drew Adams * bookmark.el (bookmark-jump-other-window): New function. (bookmark-map): Bind it to "o". - Patch by Drew Adams . See - http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html. + http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html + and its thread contains discussion about this change. The + original patch was slightly tweaked by Karl Fogel + before committing. 2007-07-13 Karl Fogel From 8d3719940eb01f6a63cfe2b6e05bb97b85627e3a Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Sat, 14 Jul 2007 18:31:40 +0000 Subject: [PATCH 150/163] *** empty log message *** --- etc/NEWS | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 2549282e2b1..34e09f83fc3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -146,6 +146,16 @@ on the corresponding remote system. * Lisp Changes in Emacs 23.1 ++++ +** In `condition-case', a handler can specify "let the debugger run first". + +You do this by writing `debug' in the list of conditions to be handled, +like this: + + (condition-case nil + (foo bar) + ((debug error) nil)) + ** The `require-match' argument to `completing-read' accepts a new value `confirm-only'. From be44b862badaad8cc0a498c0f5dc9cce2a352e61 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Sat, 14 Jul 2007 18:34:22 +0000 Subject: [PATCH 151/163] (Handling Errors): Document `debug' in handler list. --- lispref/ChangeLog | 4 ++++ lispref/control.texi | 49 ++++++++++++++++++++++++++++++-------------- 2 files changed, 38 insertions(+), 15 deletions(-) diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 61bc10c1afc..6a824f8deaf 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,7 @@ +2007-07-14 Richard Stallman + + * control.texi (Handling Errors): Document `debug' in handler list. + 2007-07-09 Richard Stallman * files.texi (Magic File Names): Rewrite previous change. diff --git a/lispref/control.texi b/lispref/control.texi index 4c469a10368..e99a6329f3e 100644 --- a/lispref/control.texi +++ b/lispref/control.texi @@ -893,6 +893,12 @@ establishing an error handler, with the special form This deletes the file named @var{filename}, catching any error and returning @code{nil} if an error occurs. + The @code{condition-case} construct is often used to trap errors that +are predictable, such as failure to open a file in a call to +@code{insert-file-contents}. It is also used to trap errors that are +totally unpredictable, such as when the program evaluates an expression +read from the user. + The second argument of @code{condition-case} is called the @dfn{protected form}. (In the example above, the protected form is a call to @code{delete-file}.) The error handlers go into effect when @@ -920,15 +926,33 @@ the two gets to handle it. If an error is handled by some @code{condition-case} form, this ordinarily prevents the debugger from being run, even if @code{debug-on-error} says this error should invoke the debugger. -@xref{Error Debugging}. If you want to be able to debug errors that are -caught by a @code{condition-case}, set the variable -@code{debug-on-signal} to a non-@code{nil} value. - When an error is handled, control returns to the handler. Before this -happens, Emacs unbinds all variable bindings made by binding constructs -that are being exited and executes the cleanups of all -@code{unwind-protect} forms that are exited. Once control arrives at -the handler, the body of the handler is executed. + If you want to be able to debug errors that are caught by a +@code{condition-case}, set the variable @code{debug-on-signal} to a +non-@code{nil} value. You can also specify that a particular handler +should let the debugger run first, by writing @code{debug} among the +conditions, like this: + +@example +@group +(condition-case nil + (delete-file filename) + ((debug error) nil)) +@end group +@end example + +@noindent +The effect of @code{debug} here is only to prevent +@code{condition-case} from suppressing the call to the debugger. Any +given error will invoke the debugger only if @code{debug-on-error} and +the other usual filtering mechanisms say it should. @xref{Error Debugging}. + + Once Emacs decides that a certain handler handles the error, it +returns control to that handler. To do so, Emacs unbinds all variable +bindings made by binding constructs that are being exited, and +executes the cleanups of all @code{unwind-protect} forms that are +being exited. Once control arrives at the handler, the body of the +handler executes normally. After execution of the handler body, execution returns from the @code{condition-case} form. Because the protected form is exited @@ -937,12 +961,6 @@ execution at the point of the error, nor can it examine variable bindings that were made within the protected form. All it can do is clean up and proceed. - The @code{condition-case} construct is often used to trap errors that -are predictable, such as failure to open a file in a call to -@code{insert-file-contents}. It is also used to trap errors that are -totally unpredictable, such as when the program evaluates an expression -read from the user. - Error signaling and handling have some resemblance to @code{throw} and @code{catch} (@pxref{Catch and Throw}), but they are entirely separate facilities. An error cannot be caught by a @code{catch}, and a @@ -960,7 +978,8 @@ error occurs during @var{protected-form}. Each of the @var{handlers} is a list of the form @code{(@var{conditions} @var{body}@dots{})}. Here @var{conditions} is an error condition name -to be handled, or a list of condition names; @var{body} is one or more +to be handled, or a list of condition names (which can include @code{debug} +to allow the debugger to run before the handler); @var{body} is one or more Lisp expressions to be executed when this handler handles an error. Here are examples of handlers: From f01cbfdda1a3bc60da7b22d7ee19cc3ae2927f1d Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Sat, 14 Jul 2007 18:43:58 +0000 Subject: [PATCH 152/163] (maybe_call_debugger): New function. (find_handler_clause): Use maybe_call_debugger. Call it when the handler says `debug'. Eliminate DEBUGGER_VALUE_PTR. (Fsignal): Eliminate debugger_value. (Qdebug): New variable. (syms_of_eval): Initialize it. --- src/ChangeLog | 10 +++++ src/eval.c | 119 +++++++++++++++++++++++++++++--------------------- 2 files changed, 79 insertions(+), 50 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 547d1ee130f..112450d7b15 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2007-07-14 Richard Stallman + + * eval.c (maybe_call_debugger): New function. + (find_handler_clause): Use maybe_call_debugger. + Call it when the handler says `debug'. + Eliminate DEBUGGER_VALUE_PTR. + (Fsignal): Eliminate debugger_value. + (Qdebug): New variable. + (syms_of_eval): Initialize it. + 2007-07-14 Juanma Barranquero * eval.c (Fprogn): diff --git a/src/eval.c b/src/eval.c index 355ed30066a..cd0d0fc1c5c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -97,6 +97,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; +Lisp_Object Qdebug; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs @@ -1585,8 +1586,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun) static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, - Lisp_Object *)); + Lisp_Object, Lisp_Object)); DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. @@ -1612,7 +1612,6 @@ See also the function `condition-case'. */) Lisp_Object conditions; extern int gc_in_progress; extern int waiting_for_input; - Lisp_Object debugger_value; Lisp_Object string; Lisp_Object real_error_symbol; struct backtrace *bp; @@ -1670,7 +1669,7 @@ See also the function `condition-case'. */) register Lisp_Object clause; clause = find_handler_clause (handlerlist->handler, conditions, - error_symbol, data, &debugger_value); + error_symbol, data); if (EQ (clause, Qlambda)) { @@ -1701,7 +1700,7 @@ See also the function `condition-case'. */) handlerlist = allhandlers; /* If no handler is present now, try to run the debugger, and if that fails, throw to top level. */ - find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value); + find_handler_clause (Qerror, conditions, error_symbol, data); if (catchlist != 0) Fthrow (Qtop_level, Qt); @@ -1853,75 +1852,54 @@ skip_debugger (conditions, data) = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). This is for memory-full errors only. - Store value returned from debugger into *DEBUGGER_VALUE_PTR. - We need to increase max_specpdl_size temporarily around anything we do that can push on the specpdl, so as not to get a second error here in case we're handling specpdl overflow. */ static Lisp_Object -find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) +find_handler_clause (handlers, conditions, sig, data) Lisp_Object handlers, conditions, sig, data; - Lisp_Object *debugger_value_ptr; { register Lisp_Object h; register Lisp_Object tem; + int debugger_called = 0; + int debugger_considered = 0; - if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ + /* t is used by handlers for all conditions, set up by C code. */ + if (EQ (handlers, Qt)) return Qt; + + /* Don't run the debugger for a memory-full error. + (There is no room in memory to do that!) */ + if (NILP (sig)) + debugger_considered = 1; + /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ if (EQ (handlers, Qerror) || !NILP (Vdebug_on_signal)) /* This says call debugger even if there is a handler. */ { - int debugger_called = 0; - Lisp_Object sig_symbol, combined_data; - /* This is set to 1 if we are handling a memory-full error, - because these must not run the debugger. - (There is no room in memory to do that!) */ - int no_debugger = 0; - - if (NILP (sig)) - { - combined_data = data; - sig_symbol = Fcar (data); - no_debugger = 1; - } - else - { - combined_data = Fcons (sig, data); - sig_symbol = sig; - } - - if (wants_debugger (Vstack_trace_on_error, conditions)) + if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) { max_specpdl_size++; -#ifdef PROTOTYPES + #ifdef PROTOTYPES internal_with_output_to_temp_buffer ("*Backtrace*", (Lisp_Object (*) (Lisp_Object)) Fbacktrace, Qnil); -#else + #else internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil); -#endif + #endif max_specpdl_size--; } - if (! no_debugger - /* Don't try to run the debugger with interrupts blocked. - The editing loop would return anyway. */ - && ! INPUT_BLOCKED_P - && (EQ (sig_symbol, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_error, conditions)) - && ! skip_debugger (conditions, combined_data) - && when_entered_debugger < num_nonmacro_input_events) + + if (!debugger_considered) { - *debugger_value_ptr - = call_debugger (Fcons (Qerror, - Fcons (combined_data, Qnil))); - debugger_called = 1; + debugger_considered = 1; + debugger_called = maybe_call_debugger (conditions, sig, data); } + /* If there is no handler, return saying whether we ran the debugger. */ if (EQ (handlers, Qerror)) { @@ -1930,6 +1908,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) return Qt; } } + for (h = handlers; CONSP (h); h = Fcdr (h)) { Lisp_Object handler, condit; @@ -1948,18 +1927,55 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) /* Handle a list of condition names in handler HANDLER. */ else if (CONSP (condit)) { - while (CONSP (condit)) + Lisp_Object tail; + for (tail = condit; CONSP (tail); tail = XCDR (tail)) { - tem = Fmemq (Fcar (condit), conditions); + tem = Fmemq (Fcar (tail), conditions); if (!NILP (tem)) - return handler; - condit = XCDR (condit); + { + /* This handler is going to apply. + Does it allow the debugger to run first? */ + if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) + maybe_call_debugger (conditions, sig, data); + return handler; + } } } } + return Qnil; } +/* Call the debugger if calling it is currently enabled for CONDITIONS. + SIG and DATA describe the signal, as in find_handler_clause. */ + +int +maybe_call_debugger (conditions, sig, data) + Lisp_Object conditions, sig, data; +{ + Lisp_Object combined_data; + + combined_data = Fcons (sig, data); + + if ( + /* Don't try to run the debugger with interrupts blocked. + The editing loop would return anyway. */ + ! INPUT_BLOCKED_P + /* Does user wants to enter debugger for this kind of error? */ + && (EQ (sig, Qquit) + ? debug_on_quit + : wants_debugger (Vdebug_on_error, conditions)) + && ! skip_debugger (conditions, combined_data) + /* rms: what's this for? */ + && when_entered_debugger < num_nonmacro_input_events) + { + call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); + return 1; + } + + return 0; +} + /* dump an error message; called like printf */ /* VARARGS 1 */ @@ -3600,6 +3616,9 @@ before making `inhibit-quit' nil. */); Qand_optional = intern ("&optional"); staticpro (&Qand_optional); + Qdebug = intern ("debug"); + staticpro (&Qdebug); + DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, doc: /* *Non-nil means errors display a backtrace buffer. More precisely, this happens for any error that is handled From a25beddb336ccc3f7d40dc7e9c73e042bf1da366 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 14 Jul 2007 19:03:22 +0000 Subject: [PATCH 153/163] (generated-autoload-file): Autoload the safe-local-variable setting. --- lisp/ChangeLog | 11 ++++++++--- lisp/emacs-lisp/autoload.el | 1 + 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f8628f540d5..bc94864ac44 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-14 Stefan Monnier + + * emacs-lisp/autoload.el (generated-autoload-file): Autoload the + safe-local-variable setting. + 2007-07-14 David Kastrup * emacs-lisp/advice.el (defadvice): Doc fix. @@ -17,8 +22,8 @@ (bookmark-map): Bind it to "o". http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html - and its thread contains discussion about this change. The - original patch was slightly tweaked by Karl Fogel + and its thread contains discussion about this change. + The original patch was slightly tweaked by Karl Fogel before committing. 2007-07-13 Karl Fogel @@ -29,7 +34,7 @@ * bookmark.el: Don't define bookmark keys under the "C-xr" map; instead, make "C-xp" a prefix for bookmark-map. Patch by Drew - Adams , mildly tweaked by me. See + Adams , mildly tweaked by me. See http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html. 2007-07-13 Carsten Dominik diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d057ee028dc..90943b33e49 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -41,6 +41,7 @@ A `.el' file can set this in its local variables section to make its autoloads go somewhere else. The autoload file is assumed to contain a trailer starting with a FormFeed character.") +;;;###autoload (put 'generated-autoload-file 'safe-local-variable 'stringp) ;; This feels like it should be a defconst, but MH-E sets it to From a2dcccd99e11e8155b42111148909967e58d71c6 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sat, 14 Jul 2007 23:03:37 +0000 Subject: [PATCH 154/163] Include winsock2.h and ws2tcpip.h instead of winsock.h. --- nt/ChangeLog | 5 +++++ nt/inc/sys/socket.h | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index 65f3bc7b622..c23d65d48e5 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,8 @@ +2007-07-14 Jason Rumney + + * inc/sys/socket.h: Include winsock2.h and ws2tcpip.h instead + of winsock.h. + 2007-06-25 Jason Rumney * cmdproxy.c (main): Set console codepages to "ANSI". diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h index 0923dd9246b..2e52c74691e 100644 --- a/nt/inc/sys/socket.h +++ b/nt/inc/sys/socket.h @@ -51,7 +51,8 @@ Boston, MA 02110-1301, USA. */ #define timeval ws_timeval #endif -#include +#include +#include /* redefine select to reference our version */ #ifdef MUST_REDEF_SELECT From 5e1ab613687b178ef514a553c08056f8f904c7db Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sat, 14 Jul 2007 23:04:56 +0000 Subject: [PATCH 155/163] Don't undefine AF_INET6. --- src/ChangeLog | 4 ++++ src/process.c | 8 -------- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 112450d7b15..4694c984f2d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2007-07-14 Jason Rumney + + * process.c [WINDOWSNT]: Don't undefine AF_INET6. + 2007-07-14 Richard Stallman * eval.c (maybe_call_debugger): New function. diff --git a/src/process.c b/src/process.c index 90d0ee34024..5f96467a681 100644 --- a/src/process.c +++ b/src/process.c @@ -121,14 +121,6 @@ Boston, MA 02110-1301, USA. */ #include #endif -/* Disable IPv6 support for w32 until someone figures out how to do it - properly. */ -#ifdef WINDOWSNT -# ifdef AF_INET6 -# undef AF_INET6 -# endif -#endif - #include "lisp.h" #include "systime.h" #include "systty.h" From 672f99b69b10cf2ad23df60076f9239d0ab88910 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sat, 14 Jul 2007 23:15:49 +0000 Subject: [PATCH 156/163] IPv6 support on MS-Windows --- etc/NEWS | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 34e09f83fc3..9f46b982483 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -137,6 +137,13 @@ on the corresponding remote system. * Changes in Emacs 23.1 on non-free operating systems +--- +** IPv6 is supported on MS-Windows. +Emacs now supports IPv6 on Windows XP and later, and earlier versions +of Windows with third party IPv6 stacks installed. Previously IPv6 was +supported on other platforms, but not on Windows due to using the winsock +1.1 header file, even though Emacs was linking to the winsock 2 library. + * Incompatible Lisp Changes in Emacs 23.1 From a272a739555b7ad66b13e905b23747aa5f179e47 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sun, 15 Jul 2007 00:59:43 +0000 Subject: [PATCH 157/163] (set-default-process-coding-system): Use dos line ends for input to cmdproxy on all versions of Windows. Use dos line ends for input to plink. --- lisp/w32-fns.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 26aafeb27fc..fc5afd76664 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -149,14 +149,19 @@ You should set this to t when using a non-system shell.\n\n")))) (if default-enable-multibyte-characters '(undecided-dos . undecided-unix) '(raw-text-dos . raw-text-unix))) - (or (w32-using-nt) - ;; On Windows 9x, make cmdproxy default to using DOS line endings - ;; for input, because command.com requires this. - (setq process-coding-system-alist - `(("[cC][mM][dD][pP][rR][oO][xX][yY]" - . ,(if default-enable-multibyte-characters - '(undecided-dos . undecided-dos) - '(raw-text-dos . raw-text-dos))))))) + ;; Make cmdproxy default to using DOS line endings for input, + ;; because some Windows programs (including command.com) require it. + (add-to-list 'process-coding-system-alist + `("[cC][mM][dD][pP][rR][oO][xX][yY]" + . ,(if default-enable-multibyte-characters + '(undecided-dos . undecided-dos) + '(raw-text-dos . raw-text-dos)))) + ;; plink needs DOS input when entering the password. + (add-to-list 'process-coding-system-alist + `("[pP][lL][iI][nN][kK]" + . ,(if default-enable-multibyte-characters + '(undecided-dos . undecided-dos) + '(raw-text-dos . raw-text-dos))))) (add-hook 'before-init-hook 'set-default-process-coding-system) From 3af378034d580f0844be9bd6d4dfb264a239741d Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Sun, 15 Jul 2007 01:00:55 +0000 Subject: [PATCH 158/163] (comint-simple-send): Concat newline before sending. (comint-password-prompt-regexp): Recognize plink's passphrase prompt. --- lisp/ChangeLog | 9 +++++++++ lisp/comint.el | 18 ++++++++++++------ 2 files changed, 21 insertions(+), 6 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bc94864ac44..61448396b13 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2007-07-15 Jason Rumney + + * w32-fns.el (set-default-process-coding-system): Use dos line ends + for input to cmdproxy on all versions of Windows. + Use dos line ends for input to plink. + + * comint.el (comint-simple-send): Concat newline before sending. + (comint-password-prompt-regexp): Recognize plink's passphrase prompt. + 2007-07-14 Stefan Monnier * emacs-lisp/autoload.el (generated-autoload-file): Autoload the diff --git a/lisp/comint.el b/lisp/comint.el index ddc3a2f503b..17ab13337aa 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -333,12 +333,13 @@ This variable is buffer-local." ;; kinit prints a prompt like `Password for devnull@GNU.ORG: '. ;; ksu prints a prompt like `Kerberos password for devnull/root@GNU.ORG: '. ;; ssh-add prints a prompt like `Enter passphrase: '. +;; plink prints a prompt like `Passphrase for key "root@GNU.ORG": '. ;; Some implementations of passwd use "Password (again)" as the 2nd prompt. (defcustom comint-password-prompt-regexp "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|login \\|\ Kerberos \\|CVS \\|UNIX \\| SMB \\|^\\)\ \[Pp]assword\\( (again)\\)?\\|\ -pass phrase\\|\\(Enter\\|Repeat\\|Bad\\) passphrase\\)\ +pass phrase\\|\\(Enter \\|Repeat \\|Bad \\)?[Pp]assphrase\\)\ \\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'" "*Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." @@ -1953,11 +1954,16 @@ If this takes us past the end of the current line, don't skip at all." "Default function for sending to PROC input STRING. This just sends STRING plus a newline. To override this, set the hook `comint-input-sender'." - (comint-send-string proc string) - (if comint-input-sender-no-newline - (if (not (string-equal string "")) - (process-send-eof)) - (comint-send-string proc "\n"))) + (let ((send-string + (if comint-input-sender-no-newline + string + ;; Sending as two separate strings does not work + ;; on Windows, so concat the \n before sending. + (concat string "\n")))) + (comint-send-string proc send-string)) + (if (and comint-input-sender-no-newline + (not (string-equal string ""))) + (process-send-eof))) (defun comint-line-beginning-position () "Return the buffer position of the beginning of the line, after any prompt. From 4207db9aafd92bd6d03c994f18390a58d278210d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 15 Jul 2007 01:14:34 +0000 Subject: [PATCH 159/163] Jeff Miller (tiny change) (calendar-goto-bahai-date): Add autoload cookie. --- lisp/ChangeLog | 5 +++++ lisp/calendar/cal-bahai.el | 1 + 2 files changed, 6 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 61448396b13..1e206d111f4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-15 Jeff Miller (tiny change) + + * calendar/cal-bahai.el (calendar-goto-bahai-date): Add autoload + cookie. + 2007-07-15 Jason Rumney * w32-fns.el (set-default-process-coding-system): Use dos line ends diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 06703e3b73b..7bf90ec5d11 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -149,6 +149,7 @@ Defaults to today's date if DATE is not given." (message "Baha'i date: %s" (calendar-bahai-date-string (calendar-cursor-to-date t)))) +;;;###autoload (defun calendar-goto-bahai-date (date &optional noecho) "Move cursor to Baha'i date DATE. Echo Baha'i date unless NOECHO is t." From 792a2519da78b9e317cfe7174049c6dc09988f8a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 15 Jul 2007 01:15:36 +0000 Subject: [PATCH 160/163] Jeff Miller (tiny change) (calendar-goto-bahai-date): Add autoload cookie. --- lisp/ChangeLog | 7 ++++++- lisp/calendar/cal-bahai.el | 1 + 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3fb9fc4cb42..0faca7d41bd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-07-15 Jeff Miller (tiny change) + + * calendar/cal-bahai.el (calendar-goto-bahai-date): Add autoload + cookie. + 2007-07-13 Eli Zaretskii * makefile.w32-in (install-lisp-SH, install-lisp-CMD): New targets. @@ -8,7 +13,7 @@ * replace.el (match): Use yellow1 instead of yellow. * progmodes/gdb-ui.el (breakpoint-enabled): Use red1 instead of - red. + red. * pcvs-info.el (cvs-unknown): Likewise. diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 06703e3b73b..7bf90ec5d11 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -149,6 +149,7 @@ Defaults to today's date if DATE is not given." (message "Baha'i date: %s" (calendar-bahai-date-string (calendar-cursor-to-date t)))) +;;;###autoload (defun calendar-goto-bahai-date (date &optional noecho) "Move cursor to Baha'i date DATE. Echo Baha'i date unless NOECHO is t." From 43335a6daa744619f87a48c358f155c7e80199bc Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 15 Jul 2007 01:23:15 +0000 Subject: [PATCH 161/163] Sync from trunk: Werner Lemberg * emacs.1: Completely revised. Fix many typographical glitches. Updated to handle current state of options and resources. --- etc/ChangeLog | 6 + etc/emacs.1 | 613 ++++++++++++++++++++++++++++++++++---------------- 2 files changed, 424 insertions(+), 195 deletions(-) diff --git a/etc/ChangeLog b/etc/ChangeLog index d7b971e81bf..1adcd0e59db 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Werner Lemberg + + * emacs.1: Completely revised. + Fix many typographical glitches. + Updated to handle current state of options and resources. + 2007-07-14 Jan Dj,Ad(Brv * PROBLEMS: Mention gtk-engines-qt problem. diff --git a/etc/emacs.1 b/etc/emacs.1 index ef945420de2..daee15b2388 100644 --- a/etc/emacs.1 +++ b/etc/emacs.1 @@ -1,3 +1,4 @@ +'\" t .\" Copyright (C) 1995, 1999, 2000, 2001, 2002, 2003, 2004, .\" 2005, 2006, 2007 Free Software Foundation, Inc. .\" @@ -20,27 +21,33 @@ .\" '\" t .TH EMACS 1 "2007 April 13" "GNU Emacs 22.1" +. +. .SH NAME emacs \- GNU project Emacs +. +. .SH SYNOPSIS .B emacs [ .I command-line switches ] [ -.I files ... +.I files ...\& ] -.br +. +. .SH DESCRIPTION .I GNU Emacs is a version of -.I Emacs, +.IR Emacs , written by the author of the original (PDP-10) -.I Emacs, +.IR Emacs , Richard Stallman. .br The primary documentation of GNU Emacs is in the GNU Emacs Manual, which you can read using Info, either from Emacs or as a standalone -program. Please look there for complete and up-to-date documentation. +program. +Please look there for complete and up-to-date documentation. This man page is updated only when someone volunteers to do so; the Emacs maintainers' priority goal is to minimize the amount of time this man page takes away from other more useful projects. @@ -56,9 +63,9 @@ has an extensive interactive help facility, but the facility assumes that you know how to manipulate .I Emacs windows and buffers. -CTRL-h or F1 enters the Help facility. Help Tutorial (CTRL-h t) -starts an interactive tutorial which can teach beginners the fundamentals -of +CTRL-h or F1 enters the Help facility. +Help Tutorial (CTRL-h t) starts an interactive tutorial which can +teach beginners the fundamentals of .I Emacs in a few minutes. Help Apropos (CTRL-h a) helps you @@ -66,11 +73,11 @@ find a command given its functionality, Help Character (CTRL-h c) describes a given character's effect, and Help Function (CTRL-h f) describes a given Lisp function specified by name. .PP -.I Emacs's +.IR Emacs 's Undo can undo several steps of modification to your buffers, so it is easy to recover from editing mistakes. .PP -.I GNU Emacs's +.IR "GNU Emacs" 's many special packages handle mail reading (RMail) and sending (Mail), outline editing (Outline), compiling (Compile), running subshells within @@ -81,130 +88,176 @@ windows (Shell), running a Lisp read-eval-print loop There is an extensive reference manual, but users of other Emacses should have little trouble adapting even -without a copy. Users new to +without a copy. +Users new to .I Emacs will be able to use basic features fairly rapidly by studying the tutorial and using the self-documentation features. -.PP -.SM Emacs Options -.PP +. +.SS Emacs Options The following options are of general interest: +.RS .TP 8 .I file Edit -.I file. +.IR file . .TP -.BI \+ number +.BI \-\-file " file\fR,\fP " \-\-find-file " file\fR,\fP " \-\-visit " file" +The same as specifying +.I file +directly as an argument. +.TP +.BI + number Go to the line specified by .I number (do not insert a space between the "+" sign and -the number). This applies only to the next file specified. +the number). +This applies only to the next file specified. .TP -.BI \+ line:column +.BI + line:column Go to the specified .I line and -.I column +.IR column . .TP -.B \-q +.BR \-q ", " \-\-no\-init\-file Do not load an init file. .TP -.B \-no-site-file +.B \-\-no\-site\-file Do not load the site-wide startup file. .TP -.BI \-debug-init +.B \-\-no\-desktop +Do not load a saved desktop. +.TP +.BR \-nl ", " \-\-no\-shared\-memory +Do not use shared memory. +.TP +.BR \-Q ", " \-\-quick +Equivalent to "\-q \-\-no\-site\-file \-\-no\-splash". +.TP +.B \-\-no\-splash +Do not display a splash screen during start-up. +.TP +.B \-\-debug\-init Enable .I Emacs Lisp debugger during the processing of the user init file -.BI ~/.emacs. +.BR ~/.emacs . This is useful for debugging problems in the init file. .TP -.BI \-u " user" +.BI \-u " user\fR,\fP " \-\-user " user" Load -.I user's +.IR user 's init file. .TP -.BI \-t " file" +.BI \-t " file\fR,\fP " \-\-terminal " file" Use specified .I file as the terminal instead of using stdin/stdout. This must be the first argument specified in the command line. .TP -.B \-version +.BR \-\-multibyte ", " \-\-no-unibyte +Enable multibyte mode (enabled by default). +.TP +.BR \-\-unibyte ", " \-\-no-multibyte +Enable unibyte mode. +.TP +.B \-\-version Display .I Emacs version information and exit. +.TP +.B \-\-help +Display this help and exit. +.RE .PP The following options are lisp-oriented (these options are processed in the order encountered): +.RS .TP 8 -.BI \-f " function" +.BI \-f " function\fR,\fP " \-\-funcall " function" Execute the lisp function -.I function. +.IR function . .TP -.BI \-l " file" +.BI \-l " file\fR,\fP " \-\-load " file" Load the lisp code in the file -.I file. +.IR file . .TP -.BI \-eval " expr" +.BI \-\-eval " expr\fR,\fP " \-\-execute " expr" Evaluate the Lisp expression -.I expr. +.IR expr . +.RE .PP The following options are useful when running .I Emacs as a batch editor: +.RS .TP 8 -.BI \-batch -Edit in batch mode. The editor will send messages to stderr. This -option must be the first in the argument list. You must use \-l and \-f -options to specify files to execute and functions to call. +.B \-\-batch +Edit in batch mode. +The editor will send messages to stderr. +This option must be the first in the argument list. +You must use \-l and \-f options to specify files to execute +and functions to call. .TP -.B \-kill +.BI \-\-script " file" +Run +.I file +as an Emacs Lisp script. +.TP +.BI \-\-insert " file" +Insert contents of +.I file +into the current buffer. +.TP +.B \-\-kill Exit .I Emacs while in batch mode. .TP -.BI \-L " directory" +.BI \-L " dir\fR,\fP " \-\-directory " dir" Add -.I directory +.I dir to the list of directories .I Emacs searches for Lisp files. +.RE +. .\" START DELETING HERE IF YOU'RE NOT USING X -.PP -.SM Using Emacs with X -.PP +.SS Using Emacs with X .I Emacs has been tailored to work well with the X window system. If you run .I Emacs from under X windows, it will create its own X window to -display in. You will probably want to start the editor -as a background process -so that you can continue using your original window. +display in. +You will probably want to start the editor as a background +process so that you can continue using your original window. .PP .I Emacs can be started with the following X switches: +.RS .TP 8 -.BI \-name " name" -Specifies the name which should be assigned to the initial +.BI \-\-name " name" +Specify the name which should be assigned to the initial .I Emacs -window. This controls looking up X resources as well as the window title. -.TP 8 -.BI \-title " name" -Specifies the title for the initial X window. -.TP 8 -.B \-r +window. +This controls looking up X resources as well as the window title. +.TP +.BI \-T " name\fR,\fP " \-\-title " name" +Specify the title for the initial X window. +.TP +.BR \-r ", " \-rv ", " \-\-reverse\-video Display the .I Emacs window in reverse video. .TP -.BI \-font " font, " \-fn " font" +.BI \-fn " font\fR,\fP " \-\-font " font" Set the .I Emacs window's font to that specified by -.I font. +.IR font . You will find the various .I X fonts in the @@ -215,84 +268,119 @@ Note that will only accept fixed width fonts. Under the X11 Release 4 font-naming conventions, any font with the value "m" or "c" in the eleventh field of the font name is a fixed -width font. Furthermore, fonts whose name are of the form +width font. +Furthermore, fonts whose name are of the form .IR width x height are generally fixed width, as is the font .IR fixed . See -.IR xlsfonts (1) +.BR xlsfonts (1) for more information. When you specify a font, be sure to put a space between the switch and the font name. .TP -.BI \-bw " pixels" +.BI \-\-xrm " resources" +Set additional X resources. +.TP +.BI "\-\-color\fR,\fP \-\-color=" mode +Override color mode for character terminals; +.I mode +defaults to `auto', and can also be `never', `auto', `always', +or a mode name like `ansi8'. +.TP +.BI \-bw " pixels\fR,\fP " \-\-border\-width " pixels" Set the .I Emacs window's border width to the number of pixels specified by -.I pixels. +.IR pixels . Defaults to one pixel on each side of the window. .TP -.BI \-ib " pixels" +.BI \-ib " pixels\fR,\fP " \-\-internal\-border " pixels" Set the window's internal border width to the number of pixels specified by -.I pixels. +.IR pixels . Defaults to one pixel of padding on each side of the window. -.PP -.TP 8 -.BI \-\-geometry " geometry" +.TP +.BI \-g " geometry\fR,\fP " \-\-geometry " geometry" Set the .I Emacs -window's width, height, and position as specified. The geometry -specification is in the standard X format; see -.IR X (1) +window's width, height, and position as specified. +The geometry specification is in the standard X format; see +.BR X (7) for more information. -The width and height are specified in characters; the default is 80 by -24. See the Emacs manual, section "Options for Window Size and Position", +The width and height are specified in characters; the default is +80 by 24. +See the Emacs manual, section "Options for Window Size and Position", for information on how window sizes interact with selecting or deselecting the tool bar and menu bar. -.PP -.TP 8 -.BI \-fg " color" -On color displays, sets the color of the text. +.TP +.BI \-lsp " pixels\fR,\fP " \-\-line\-spacing " pixels" +Additional space to put between lines. +.TP +.BR \-vb ", " \-\-vertical\-scroll\-bars +Enable vertical scrollbars. +.TP +.BR \-fh ", " \-\-fullheight +Make the first frame as high as the screen. +.TP +.BR \-fs ", " \-\-fullscreen +Make the first frame fullscreen. +.TP +.BR \-fw ", " \-\-fullwidth +Make the first frame as wide as the screen. +.TP +.BI \-fg " color\fR,\fP " \-\-foreground\-color " color" +On color displays, set the color of the text. Use the command -.I M-x list-colors-display -for a list of valid -color names. +.I M\-x list\-colors\-display +for a list of valid color names. .TP -.BI \-bg " color" -On color displays, -sets the color of the window's background. +.BI \-bg " color\fR,\fP " \-\-background\-color " color" +On color displays, set the color of the window's background. .TP -.BI \-bd " color" -On color displays, -sets the color of the window's border. +.BI \-bd " color\fR,\fP " \-\-border\-color " color" +On color displays, set the color of the window's border. .TP -.BI \-cr " color" -On color displays, -sets the color of the window's text cursor. +.BI \-cr " color\fR,\fP " \-\-cursor\-color " color" +On color displays, set the color of the window's text cursor. .TP -.BI \-ms " color" -On color displays, -sets the color of the window's mouse cursor. +.BI \-ms " color\fR,\fP " \-\-mouse\-color " color" +On color displays, set the color of the window's mouse cursor. .TP -.BI \-d " displayname, " \-display " displayname" +.BI \-d " displayname\fR,\fP " \-\-display " displayname" Create the .I Emacs window on the display specified by .IR displayname . Must be the first option specified in the command line. .TP -.B \-nw -Tells +.BR \-nbi ", " \-\-no\-bitmap\-icon +Do not use picture of gnu for Emacs icon. +.TP +.B \-\-iconic +Start .I Emacs -not to use its special interface to X. If you use this -switch when invoking +in iconified state. +.TP +.BR \-nbc ", " \-\-no\-blinking\-cursor +Disable blinking cursor. +.TP +.BR \-nw ", " \-\-no\-window\-system +Tell +.I Emacs +not to use its special interface to X. +If you use this switch when invoking .I Emacs from an -.IR xterm (1) +.BR xterm (1) window, display is done in that window. +.TP +.BR \-D ", " \-\-basic\-display +This option disables many display features; use it for +debugging Emacs. +.RE .PP You can set .I X @@ -301,75 +389,185 @@ default values for your windows in your .I \.Xresources file (see -.IR xrdb (1)). +.BR xrdb (1)). Use the following format: .IP -emacs.keyword:value +.RI emacs. keyword : value .PP where .I value specifies the default value of -.I keyword. +.IR keyword . .I Emacs lets you set default values for the following keywords: +.RS .TP 8 -.B font (\fPclass\fB Font) -Sets the window's text font. -.TP -.B reverseVideo (\fPclass\fB ReverseVideo) -If -.I reverseVideo's -value is set to -.I on, -the window will be displayed in reverse video. -.TP -.B bitmapIcon (\fPclass\fB BitmapIcon) -If -.I bitmapIcon's -value is set to -.I on, -the window will iconify into the "kitchen sink." -.TP -.B borderWidth (\fPclass\fB BorderWidth) -Sets the window's border width in pixels. -.TP -.B internalBorder (\fPclass\fB BorderWidth) -Sets the window's internal border width in pixels. -.TP -.B foreground (\fPclass\fB Foreground) -For color displays, -sets the window's text color. -.TP -.B background (\fPclass\fB Background) +.BR background " (class " Background ) For color displays, sets the window's background color. .TP -.B borderColor (\fPclass\fB BorderColor) +.BR bitmapIcon " (class " BitmapIcon ) +If +.BR bitmapIcon 's +value is set to +.IR on , +the window will iconify into the "kitchen sink." +.TP +.BR borderColor " (class " BorderColor ) For color displays, sets the color of the window's border. .TP -.B cursorColor (\fPclass\fB Foreground) +.BR borderWidth " (class " BorderWidth ) +Sets the window's border width in pixels. +.TP +.BR cursorColor " (class " Foreground ) For color displays, sets the color of the window's text cursor. .TP -.B pointerColor (\fPclass\fB Foreground) -For color displays, -sets the color of the window's mouse cursor. +.BR cursorBlink " (class " CursorBlink ) +Specifies whether to make the cursor blink. +The default is +.IR on . +Use +.I off +or +.I false +to turn cursor blinking off. .TP -.B geometry (\fPclass\fB Geometry) +.BR font " (class " Font ) +Sets the window's text font. +.TP +.BR foreground " (class " Foreground ) +For color displays, +sets the window's text color. +.TP +.BR fullscreen " (class " Fullscreen ) +The desired fullscreen size. +The value can be one of +.IR fullboth , +.IR fullwidth , +or +.IR fullheight , +which correspond to the command-line options `\-fs', `\-fw', and +`\-fh', respectively. +Note that this applies to the initial frame only. +.TP +.BR geometry " (class " Geometry ) Sets the geometry of the .I Emacs window (as described above). .TP -.B title (\fPclass\fB Title) +.BR iconName " (class " Title ) +Sets the icon name for the +.I Emacs +window icon. +.TP +.BR internalBorder " (class " BorderWidth ) +Sets the window's internal border width in pixels. +.TP +.BR lineSpacing " (class " LineSpacing ) +Additional space ("leading") between lines, in pixels. +.TP +.BR menuBar " (class " MenuBar ) +Gives frames menu bars if +.IR on ; +don't have menu bars if +.IR off . +See the Emacs manual, sections "Lucid Resources" and "LessTif +Resources", for how to control the appearance of the menu bar +if you have one. +.TP +.BR minibuffer " (class " Minibuffer ) +If +.IR none , +don't make a minibuffer in this frame. +It will use a separate minibuffer frame instead. +.TP +.BR paneFont " (class " Font ) +Font name for menu pane titles, in non-toolkit versions of +.IR Emacs . +.TP +.BR pointerColor " (class " Foreground ) +For color displays, +sets the color of the window's mouse cursor. +.TP +.BR privateColormap " (class " PrivateColormap ) +If +.IR on , +use a private color map, in the case where the "default +visual" of class +.B PseudoColor +and +.B Emacs +is using it. +.TP +.BR reverseVideo " (class " ReverseVideo ) +If +.BR reverseVideo 's +value is set to +.IR on , +the window will be displayed in reverse video. +.TP +.BR screenGamma " (class "ScreenGamma ) +Gamma correction for colors, equivalent to the frame parameter +`screen\-gamma'. +.TP +.BR scrollBarWidth " (class "ScrollBarWidth ) +The scroll bar width in pixels, equivalent to the frame parameter +`scroll\-bar\-width'. +.TP +.BR selectionFont " (class " SelectionFont ) +Font name for pop-up menu items, in non-toolkit versions of +.IR Emacs . +(For toolkit versions, see the Emacs manual, sections +"Lucid Resources" and "LessTif Resources".) +.TP +.BR selectionTimeout " (class " SelectionTimeout ) +Number of milliseconds to wait for a selection reply. +A value of 0 means wait as long as necessary. +.TP +.BR synchronous " (class " Synchronous ) +Run Emacs in synchronous mode if +.IR on . +Synchronous mode is useful for debugging X problems. +.TP +.BR title " (class " Title ) Sets the title of the .I Emacs window. .TP -.B iconName (\fPclass\fB Title) -Sets the icon name for the -.I Emacs -window icon. +.BR toolBar " (class " ToolBar ) +Number of lines to reserve for the tool bar. +.TP +.BR useXIM " (class " UseXIM ) +Turns off use of X input methods (XIM) if +.I false +or +.IR off . +.TP +.BR verticalScrollBars " (class " ScrollBars ) +Gives frames scroll bars if +.IR on ; +suppresses scroll bars if +.IR off . +.TP +.BR visualClass " (class " VisualClass ) +Specify the "visual" that X should use. +This tells X how to handle colors. +The value should start with one of +.IR TrueColor , +.IR PseudoColor , +.IR DirectColor , +.IR StaticColor , +.IR GrayScale , +and +.IR StaticGray , +followed by +.BI \- depth\fR,\fP +where +.I depth +is the number of color planes. +.RE .PP If you try to set color values while using a black and white display, the window's characteristics will default as follows: @@ -377,14 +575,17 @@ the foreground color will be set to black, the background color will be set to white, the border color will be set to grey, and the text and mouse cursors will be set to black. +. +.SS Using the Mouse .PP -.SM Using the Mouse -.PP -The following lists the mouse button bindings for the +The following lists some of the mouse button bindings for the .I Emacs window under X11. - +. +.RS .TS +l l +- - l l. MOUSE BUTTON FUNCTION left Set point. @@ -394,83 +595,93 @@ SHIFT-middle Cut text into X cut buffer. SHIFT-right Paste text. CTRL-middle Cut text into X cut buffer and kill it. CTRL-right T{ -Select this window, then split it into -two windows. Same as typing CTRL-x 2. +Select this window, then split it into two windows. +Same as typing CTRL\-x 2. T} .\" START DELETING HERE IF YOU'RE NOT USING X MENUS CTRL-SHIFT-left T{ X buffer menu \(em hold the buttons and keys -down, wait for menu to appear, select -buffer, and release. Move mouse out of -menu and release to cancel. +down, wait for menu to appear, select buffer, and release. +Move mouse out of menu and release to cancel. +T} +CTRL-SHIFT-middle T{ +X help menu \(em pop up index card menu for Emacs help. T} -CTRL-SHIFT-middle X help menu \(em pop up index card menu for Emacs help. .\" STOP DELETING HERE IF YOU'RE NOT USING X MENUS CTRL-SHIFT-right T{ -Select window with mouse, and delete all -other windows. Same as typing CTRL-x 1. +Select window with mouse, and delete all other windows. +Same as typing CTRL\-x 1. T} .\" STOP DELETING HERE IF YOU'RE NOT USING X .TE -.PP +.RE +. +. .SH MANUALS You can order printed copies of the GNU Emacs Manual from the Free -Software Foundation, which develops GNU software. See the file ORDERS -for ordering information. +Software Foundation, which develops GNU software. +See the file ORDERS for ordering information. .br -Your local Emacs maintainer might also have copies available. As -with all software and publications from FSF, everyone is permitted to -make and distribute copies of the Emacs manual. The TeX source to the -manual is also included in the Emacs source distribution. -.PP +Your local Emacs maintainer might also have copies available. +As with all software and publications from FSF, everyone is permitted +to make and distribute copies of the Emacs manual. +The TeX source to the manual is also included in the Emacs source +distribution. +. +. .SH FILES -/usr/local/share/info - files for the Info documentation browser. +/usr/local/share/info \(em files for the Info documentation browser. The complete text of the Emacs reference manual is included in a -convenient tree structured form. Also includes the Emacs Lisp -Reference Manual, useful to anyone wishing to write programs in the -Emacs Lisp extension language. +convenient tree structured form. +Also includes the Emacs Lisp Reference Manual, useful to anyone +wishing to write programs in the Emacs Lisp extension language. -/usr/local/share/emacs/$VERSION/lisp - Lisp source files and compiled files -that define most editing commands. Some are preloaded; -others are autoloaded from this directory when used. +/usr/local/share/emacs/$VERSION/lisp \(em Lisp source files and +compiled files that define most editing commands. +Some are preloaded; others are autoloaded from this directory when +used. -/usr/local/libexec/emacs/$VERSION/$ARCH - various programs that are +/usr/local/libexec/emacs/$VERSION/$ARCH \(em various programs that are used with GNU Emacs. -/usr/local/share/emacs/$VERSION/etc - various files of information. +/usr/local/share/emacs/$VERSION/etc \(em various files of information. -/usr/local/share/emacs/$VERSION/etc/DOC.* - contains the documentation +/usr/local/share/emacs/$VERSION/etc/DOC.* \(em contains the documentation strings for the Lisp primitives and preloaded Lisp functions -of GNU Emacs. They are stored here to reduce the size of -Emacs proper. +of GNU Emacs. +They are stored here to reduce the size of Emacs proper. -.br /usr/local/share/emacs/$VERSION/etc/SERVICE lists people offering various services to assist users of GNU Emacs, including education, troubleshooting, porting and customization. - -.PP +. +. .SH BUGS There is a mailing list, bug-gnu-emacs@gnu.org, for reporting Emacs -bugs and fixes. But before reporting something as a bug, please try -to be sure that it really is a bug, not a misunderstanding or a -deliberate feature. We ask you to read the section ``Reporting Emacs -Bugs'' near the end of the reference manual (or Info system) for hints -on how and when to report bugs. Also, include the version number of -the Emacs you are running in \fIevery\fR bug report that you send in. +bugs and fixes. +But before reporting something as a bug, please try to be sure that +it really is a bug, not a misunderstanding or a deliberate feature. +We ask you to read the section ``Reporting Emacs Bugs'' near the +end of the reference manual (or Info system) for hints on how and +when to report bugs. +Also, include the version number of the Emacs you are running in +\fIevery\fR bug report that you send in. -Do not expect a personal answer to a bug report. The purpose of reporting -bugs is to get them fixed for everyone in the next release, if possible. +Do not expect a personal answer to a bug report. +The purpose of reporting bugs is to get them fixed for everyone +in the next release, if possible. For personal assistance, look in the SERVICE file (see above) for a list of people who offer it. Please do not send anything but bug reports to this mailing list. For more information about Emacs mailing lists, see the -file /usr/local/emacs/etc/MAILINGLISTS. Bugs tend actually to be -fixed if they can be isolated, so it is in your interest to report -them in such a way that they can be easily reproduced. +file /usr/local/emacs/etc/MAILINGLISTS. +Bugs tend actually to be fixed if they can be isolated, so it is +in your interest to report them in such a way that they can be +easily reproduced. +. +. .SH UNRESTRICTIONS -.PP .I Emacs is free; anyone may redistribute copies of .I Emacs @@ -487,25 +698,37 @@ Copies of .I Emacs may sometimes be received packaged with distributions of Unix systems, but it is never included in the scope of any license covering those -systems. Such inclusion violates the terms on which distribution -is permitted. In fact, the primary purpose of the General Public -License is to prohibit anyone from attaching any other restrictions -to redistribution of -.I Emacs. +systems. +Such inclusion violates the terms on which distribution is permitted. +In fact, the primary purpose of the General Public License is to +prohibit anyone from attaching any other restrictions to +redistribution of +.IR Emacs . .PP Richard Stallman encourages you to improve and extend -.I Emacs, +.IR Emacs , and urges that -you contribute your extensions to the GNU library. Eventually GNU -(Gnu's Not Unix) will be a complete replacement for Unix. +you contribute your extensions to the GNU library. +Eventually GNU (Gnu's Not Unix) will be a complete replacement +for Unix. Everyone will be free to use, copy, study and change the GNU system. +. +. .SH SEE ALSO -emacsclient(1), etags(1), X(1), xlsfonts(1), xterm(1), xrdb(1) +.BR emacsclient (1), +.BR etags (1), +.BR X (7), +.BR xlsfonts (1), +.BR xterm (1), +.BR xrdb (1) +. +. .SH AUTHORS -.PP .I Emacs was written by Richard Stallman and the Free Software Foundation. Joachim Martillo and Robert Krawitz added the X features. +. +. .SH COPYING Copyright .if t \(co @@ -526,5 +749,5 @@ Permission is granted to copy and distribute translations of this document into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. - +. .\" arch-tag: 04dfd376-b46e-4924-919a-cecc3b257eaa From 36ae4ff74e439d0624dc06969b1f9f542eb19671 Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Sun, 15 Jul 2007 01:34:15 +0000 Subject: [PATCH 162/163] Revert recent bookmark keybinding changes, thus returning to using three slots under C-x r. See this message and its thread for details: http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00705.html. * lisp/bookmark.el: Revert 2007-07-13T18:16:17Z!kfogel@red-bean.com. * etc/NEWS: Revert 2007-07-13T23:20:21Z!kfogel@red-bean.com, which documented bookmark keybinding changes that were later reverted. * man/ChangeLog: Remove ChangeLog entry for accidentally uncommitted changes to regs.texi that would have documented the keybinding change reverted above. --- etc/ChangeLog | 5 +++++ etc/NEWS | 3 --- lisp/ChangeLog | 6 ++++++ lisp/bookmark.el | 6 ++++-- man/ChangeLog | 6 ------ 5 files changed, 15 insertions(+), 11 deletions(-) diff --git a/etc/ChangeLog b/etc/ChangeLog index be966266ee0..3b459fc952b 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,8 @@ +2007-07-15 Karl Fogel + + * NEWS: Revert 2007-07-13T23:20:21Z!kfogel@red-bean.com, which + documented bookmark keybinding changes that were later reverted. + 2007-07-14 Jan Dj,Ad(Brv * PROBLEMS: Mention gtk-engines-qt problem. diff --git a/etc/NEWS b/etc/NEWS index 9f46b982483..6b21ba4eb1a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -57,9 +57,6 @@ recenter the visited source file. Its value can be a number (for example, ** New command kill-matching-buffers kills buffers whose name matches a regexp. -** Bookmark commands live under prefix C-x p now, instead of C-x r. Some of - the individual bindings have changed; do C-x p C-h for details. - * New Modes and Packages in Emacs 23.1 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1e206d111f4..526d7d021e8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Karl Fogel + + * bookmark.el: Revert 2007-07-13T18:16:17Z!kfogel@red-bean.com, + thus restoring bookmark bindings to three slots under C-x r. See + http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00705.html. + 2007-07-15 Jeff Miller (tiny change) * calendar/cal-bahai.el (calendar-goto-bahai-date): Add autoload diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 6ef2ea198d3..75c4826ae0b 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -224,6 +224,10 @@ following in your `.emacs' file: ;; Set up these bindings dumping time *only*; ;; if the user alters them, don't override the user when loading bookmark.el. +;;;###autoload (define-key ctl-x-map "rb" 'bookmark-jump) +;;;###autoload (define-key ctl-x-map "rm" 'bookmark-set) +;;;###autoload (define-key ctl-x-map "rl" 'bookmark-bmenu-list) + ;;;###autoload (defvar bookmark-map nil "Keymap containing bindings to bookmark functions. @@ -234,8 +238,6 @@ functions have a binding in this keymap.") ;;;###autoload (define-prefix-command 'bookmark-map) -;;;###autoload (define-key ctl-x-map "p" bookmark-map) - ;; Read the help on all of these functions for details... ;;;###autoload (define-key bookmark-map "x" 'bookmark-set) ;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ;"m"ark diff --git a/man/ChangeLog b/man/ChangeLog index 8afb01ed216..ad39b9fce15 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,9 +1,3 @@ -2007-07-13 Karl Fogel - - * regs.texi (Bookmarks): Adjust for recent keybinding changes in - bookmark.el, namely 2007-07-13T18:16:17Z!kfogel@red-bean.com and - 2007-07-13T18:20:55Z!kfogel@red-bean.com. - 2007-07-13 Eli Zaretskii * Makefile.in (../info/emacs-mime): Use --enable-encoding. From 82fe1aeda6647e15874f7c7c5299f82abd2cbb5c Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Sun, 15 Jul 2007 04:45:41 +0000 Subject: [PATCH 163/163] Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 235-236) - Update from CVS 2007-07-13 Katsumi Yamaoka * lisp/gnus/gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) (gnus-server-closed-face, gnus-server-denied-face) (gnus-server-offline-face): Remove variable. (gnus-server-font-lock-keywords): Use faces that are not aliases. * lisp/gnus/mm-util.el (mm-decode-coding-string, mm-encode-coding-string) (mm-decode-coding-region, mm-encode-coding-region): Don't modify string if the coding-system argument is nil for XEmacs. * lisp/gnus/nnrss.el (nnrss-compatible-encoding-alist): Inherit the value of mm-charset-override-alist. * lisp/gnus/rfc2047.el: Don't require base64; require rfc2045 for the function rfc2045-encode-string. (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not to quote the parameter value. Revision: emacs@sv.gnu.org/emacs--rel--22--patch-58 --- lisp/gnus/ChangeLog | 19 +++++++++++++++++++ lisp/gnus/gnus-srvr.el | 41 +++++------------------------------------ lisp/gnus/mm-util.el | 34 +++++++++++++++++++++++++++++----- lisp/gnus/nnrss.el | 7 ++++++- lisp/gnus/rfc2047.el | 11 ++++------- 5 files changed, 63 insertions(+), 49 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6ff604ab53f..5e45df2e902 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,22 @@ +2007-07-13 Katsumi Yamaoka + + * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) + (gnus-server-closed-face, gnus-server-denied-face) + (gnus-server-offline-face): Remove variable. + (gnus-server-font-lock-keywords): Use faces that are not aliases. + + * mm-util.el (mm-decode-coding-string, mm-encode-coding-string) + (mm-decode-coding-region, mm-encode-coding-region): Don't modify string + if the coding-system argument is nil for XEmacs. + + * nnrss.el (nnrss-compatible-encoding-alist): Inherit the value of + mm-charset-override-alist. + + * rfc2047.el: Don't require base64; require rfc2045 for the function + rfc2045-encode-string. + (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not + to quote the parameter value. + 2007-07-04 Katsumi Yamaoka * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index f6804f3b114..0d5443f576c 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -214,43 +214,12 @@ If nil, a faster, but more primitive, buffer is used instead." ;; backward-compatibility alias (put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) -(defcustom gnus-server-agent-face 'gnus-server-agent - "Face name to use on AGENTIZED servers." - :version "22.1" - :group 'gnus-server-visual - :type 'face) - -(defcustom gnus-server-opened-face 'gnus-server-opened - "Face name to use on OPENED servers." - :version "22.1" - :group 'gnus-server-visual - :type 'face) - -(defcustom gnus-server-closed-face 'gnus-server-closed - "Face name to use on CLOSED servers." - :version "22.1" - :group 'gnus-server-visual - :type 'face) - -(defcustom gnus-server-denied-face 'gnus-server-denied - "Face name to use on DENIED servers." - :version "22.1" - :group 'gnus-server-visual - :type 'face) - -(defcustom gnus-server-offline-face 'gnus-server-offline - "Face name to use on OFFLINE servers." - :version "22.1" - :group 'gnus-server-visual - :type 'face) - (defvar gnus-server-font-lock-keywords - (list - '("(\\(agent\\))" 1 gnus-server-agent-face) - '("(\\(opened\\))" 1 gnus-server-opened-face) - '("(\\(closed\\))" 1 gnus-server-closed-face) - '("(\\(offline\\))" 1 gnus-server-offline-face) - '("(\\(denied\\))" 1 gnus-server-denied-face))) + '(("(\\(agent\\))" 1 gnus-server-agent) + ("(\\(opened\\))" 1 gnus-server-opened) + ("(\\(closed\\))" 1 gnus-server-closed) + ("(\\(offline\\))" 1 gnus-server-offline) + ("(\\(denied\\))" 1 gnus-server-denied))) (defun gnus-server-mode () "Major mode for listing and editing servers. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 742bbc223ae..8933edaf42c 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -36,11 +36,7 @@ (if (fboundp (car elem)) (defalias nfunc (car elem)) (defalias nfunc (cdr elem))))) - '((decode-coding-string . (lambda (s a) s)) - (encode-coding-string . (lambda (s a) s)) - (encode-coding-region . ignore) - (coding-system-list . ignore) - (decode-coding-region . ignore) + '((coding-system-list . ignore) (char-int . identity) (coding-system-equal . equal) (annotationp . ignore) @@ -96,6 +92,34 @@ (insert-byte . insert-char) (multibyte-char-to-unibyte . identity)))) +(eval-and-compile + (if (featurep 'xemacs) + (if (featurep 'file-coding) + ;; Don't modify string if CODING-SYSTEM is nil. + (progn + (defun mm-decode-coding-string (str coding-system) + (if coding-system + (decode-coding-string str coding-system) + str)) + (defun mm-encode-coding-string (str coding-system) + (if coding-system + (encode-coding-string str coding-system) + str)) + (defun mm-decode-coding-region (start end coding-system) + (if coding-system + (decode-coding-region start end coding-system))) + (defun mm-encode-coding-region (start end coding-system) + (if coding-system + (encode-coding-region start end coding-system)))) + (defun mm-decode-coding-string (str coding-system) str) + (defun mm-encode-coding-string (str coding-system) str) + (defalias 'mm-decode-coding-region 'ignore) + (defalias 'mm-encode-coding-region 'ignore)) + (defalias 'mm-decode-coding-string 'decode-coding-string) + (defalias 'mm-encode-coding-string 'encode-coding-string) + (defalias 'mm-decode-coding-region 'decode-coding-region) + (defalias 'mm-encode-coding-region 'encode-coding-region))) + (eval-and-compile (cond ((fboundp 'replace-in-string) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 996783e69b6..1f7e5ba1de9 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -85,7 +85,12 @@ ARTICLE is the article number of the current headline.") (defvar nnrss-file-coding-system mm-universal-coding-system "Coding system used when reading and writing files.") -(defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252)) +(defvar nnrss-compatible-encoding-alist + (delq nil (mapcar (lambda (elem) + (if (and (mm-coding-system-p (car elem)) + (mm-coding-system-p (cdr elem))) + elem)) + mm-charset-override-alist)) "Alist of encodings and those supersets. The cdr of each element is used to decode data if it is available when the car is what the data specify as the encoding. Or, the car is used diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 6dc432daf79..3cf2940e031 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -55,7 +55,7 @@ Value is what BODY returns." (require 'ietf-drums) ;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. (require 'mail-prsvr) -(require 'base64) +(require 'rfc2045) ;; rfc2045-encode-string (autoload 'mm-body-7-or-8 "mm-bodies") (eval-and-compile @@ -832,12 +832,9 @@ it, put the following line in your ~/.gnus.el file: \(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter) " - (let* ((rfc2047-encoding-type 'mime) - (rfc2047-encode-max-chars nil) - (string (rfc2047-encode-string value))) - (if (string-match (concat "[" ietf-drums-tspecials "]") string) - (format "%s=%S" param string) - (concat param "=" string)))) + (let ((rfc2047-encoding-type 'mime) + (rfc2047-encode-max-chars nil)) + (rfc2045-encode-string param (rfc2047-encode-string value)))) ;;; ;;; Functions for decoding RFC2047 messages