Mercurial > emacs
changeset 110982:2b3bece0553a
merge emacs-23
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Tue, 12 Oct 2010 21:41:18 +0900 |
| parents | 79354404ff53 (current diff) dbe481657418 (diff) |
| children | b87d8337c695 |
| files | lisp/emacs-lisp/cl-compat.el lisp/emacs-lisp/lmenu.el lisp/obsolete/cl-compat.el lisp/obsolete/lmenu.el |
| diffstat | 26 files changed, 903 insertions(+), 783 deletions(-) [+] |
line wrap: on
line diff
--- a/BUGS Fri Oct 08 11:23:11 2010 +0900 +++ b/BUGS Tue Oct 12 21:41:18 2010 +0900 @@ -1,26 +1,23 @@ -If you think you may have found a bug in GNU Emacs, please -read the Bugs section of the Emacs manual for advice on +If you think you may have found a bug in GNU Emacs, please read the +Bugs section of the Emacs manual for advice on + (1) how to tell when to report a bug, and -(2) how to write a useful bug report and what information -it needs to have. - -There are three ways to read the Bugs section. +(2) how to write a useful bug report and what information it needs to have. -(1) In a printed copy of the Emacs manual. -You can order one from the Free Software Foundation; -see the file etc/ORDERS. But if you don't have a copy on -hand and you think you have found a bug, you shouldn't wait -to get a printed manual; you should read the section right away -as described below. +You can read the read the Bugs section of the manual from inside Emacs. +Start Emacs, do C-h i to enter Info, then m Emacs RET to get to the +Emacs manual, then m Bugs RET to get to the section on bugs. +Or you can use the standalone Info program in a like manner. +(Standalone Info is part of the Texinfo distribution, not part of the +Emacs distribution.) -(2) With Info. Start Emacs, do C-h i to enter Info, -then m Emacs RET to get to the Emacs manual, then m Bugs RET -to get to the section on bugs. Or use standalone Info in -a like manner. (Standalone Info is part of the Texinfo distribution, -not part of the Emacs distribution.) +Printed copies of the Emacs manual can be purchased from the Free +Software Foundation's online store at <http://shop.fsf.org/>. -(3) By hand. Do +If necessary, you can read the manual without an info program: + cat info/emacs* | more "+/^File: emacs, Node: Bugs," + Please first check the file etc/PROBLEMS (e.g. with C-h C-p in Emacs) to make sure it isn't a known issue.
--- a/ChangeLog Fri Oct 08 11:23:11 2010 +0900 +++ b/ChangeLog Tue Oct 12 21:41:18 2010 +0900 @@ -1,3 +1,11 @@ +2010-10-12 Glenn Morris <rgm@gnu.org> + + * BUGS, INSTALL.BZR, README: Updates. + +2010-10-08 Eli Zaretskii <eliz@gnu.org> + + * make-dist: Don't distribute src/buildobj.h. (Bug#7167) + 2010-06-23 Glenn Morris <rgm@gnu.org> * info/dir: Start descriptions in column 32, per Texinfo convention.
--- a/INSTALL.BZR Fri Oct 08 11:23:11 2010 +0900 +++ b/INSTALL.BZR Tue Oct 12 21:41:18 2010 +0900 @@ -31,13 +31,9 @@ subdirectories of lisp/, e.g. mh-e/ and calendar/) will need to be updated to reflect new autoloaded functions. If you see errors (rather than warnings) about undefined lisp functions during compilation, that -may be the reason. Another symptom may be an error saying that -"loaddefs.el" could not be found; this is due to a change in the way -loaddefs.el was handled in version control, and should only happen -once, for users that are updating old sources. Finally, sometimes -there can be build failures related to *loaddefs.el (e.g. "required -feature `esh-groups' was not provided"). In that case, follow the -instructions below. +may be the reason. Finally, sometimes there can be build failures +related to *loaddefs.el (e.g. "required feature `esh-groups' was not +provided"). In that case, follow the instructions below. To update loaddefs.el (and similar files), do: @@ -53,10 +49,6 @@ etc.) before "make bootstrap" or "make"; the rest of the procedure is applicable to those systems as well. -Questions, requests, and bug reports about the Bazaar versions of Emacs -should be sent to bug-gnu-emacs@gnu.org rather than gnu.emacs.help. -Ideally, use M-x report-emacs-bug RET. - Because the Bazaar version of Emacs is a work in progress, it will sometimes fail to build. Please wait a day or so (and check the bug and development mailing list archives) before reporting such problems.
--- a/README Fri Oct 08 11:23:11 2010 +0900 +++ b/README Tue Oct 12 21:41:18 2010 +0900 @@ -65,16 +65,15 @@ which can't be directly produced by your keyboard. `lib-src' holds the source code for some utility programs for use by or with Emacs, like movemail and etags. -`etc' holds miscellaneous architecture-independent data files - Emacs uses, like the tutorial text and the Zippy the Pinhead - quote database. The contents of the `lisp', `leim', `info', - `man', `lispref', and `lispintro' subdirectories are - architecture-independent too. +`etc' holds miscellaneous architecture-independent data files Emacs + uses, like the tutorial text and tool bar images. + The contents of the `lisp', `leim', `info', and `doc' + subdirectories are architecture-independent too. `info' holds the Info documentation tree for Emacs. `doc/emacs' holds the source code for the Emacs Manual. If you modify the manual sources, you will need the `makeinfo' program to produce an updated manual. `makeinfo' is part of the GNU Texinfo - package; you need version 4.6 or later of Texinfo. + package; you need a suitably recent version of Texinfo. `doc/lispref' holds the source code for the Emacs Lisp reference manual. `doc/lispintro' holds the source code for the Introduction to Programming in Emacs Lisp manual. @@ -85,10 +84,9 @@ to building and running Emacs on Windows 9X/ME/NT/2000/XP. `test' holds tests for various aspects of Emacs's functionality. - Building Emacs on non-Posix platforms requires to install tools -that aren't part of the standard distribution of the OS. The -platform-specific README files and installation instructions should -list the required tools. + Building Emacs on non-Posix platforms requires tools that aren't part +of the standard distribution of the OS. The platform-specific README +files and installation instructions should list the required tools. This file is part of GNU Emacs.
--- a/doc/man/ChangeLog Fri Oct 08 11:23:11 2010 +0900 +++ b/doc/man/ChangeLog Tue Oct 12 21:41:18 2010 +0900 @@ -1,3 +1,11 @@ +2010-10-10 Glenn Morris <rgm@gnu.org> + + * emacs.1: Small fixes. + +2010-10-09 Ulrich Mueller <ulm@gentoo.org> + + * emacs.1: Update license description. + 2010-08-26 Sven Joachim <svenjoac@gmx.de> * emacs.1: Mention "maximized" value for the "fullscreen" X resource.
--- a/doc/man/emacs.1 Fri Oct 08 11:23:11 2010 +0900 +++ b/doc/man/emacs.1 Tue Oct 12 21:41:18 2010 +0900 @@ -41,9 +41,9 @@ Help Tutorial (CTRL-h t) starts an interactive tutorial to quickly teach beginners the fundamentals of .I Emacs. -Help Apropos (CTRL-h a) helps you find a command given its -functionality, Help Key (CTRL-h k) describes a given key sequence, and -Help Function (CTRL-h f) describes a given Lisp function. +Help Apropos (CTRL-h a) helps you find a command with a name matching +a given pattern, Help Key (CTRL-h k) describes a given key sequence, +and Help Function (CTRL-h f) describes a given Lisp function. .PP .IR "GNU Emacs" 's many special packages handle mail reading (RMail) and sending (Mail), @@ -531,12 +531,12 @@ .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. +See the online store at <http://shop.fsf.org/>. .br -Your local Emacs maintainer might also have copies available. +Your local administrator 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 +The Texinfo source to the manual is also included in the Emacs source distribution. . . @@ -545,7 +545,8 @@ 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. +wishing to write programs in the Emacs Lisp extension language, +and the Introduction to Programming in Emacs Lisp. /usr/local/share/emacs/$VERSION/lisp \(em Lisp source files and compiled files that define most editing commands. @@ -572,9 +573,8 @@ 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. +We ask you to read the section ``Reporting Bugs'' in the Emacs manual +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 tend actually to be fixed if they can be isolated, so it is @@ -596,10 +596,7 @@ .I Emacs is free; anyone may redistribute copies of .I Emacs -to -anyone under the terms stated in the -.I Emacs -General Public License, +to anyone under the terms stated in the GNU General Public License, a copy of which accompanies each copy of .I Emacs and which also @@ -611,7 +608,7 @@ 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 +In fact, the primary purpose of the GNU General Public License is to prohibit anyone from attaching any other restrictions to redistribution of .IR Emacs .
--- a/doc/misc/ChangeLog Fri Oct 08 11:23:11 2010 +0900 +++ b/doc/misc/ChangeLog Tue Oct 12 21:41:18 2010 +0900 @@ -1,3 +1,8 @@ +2010-10-08 Glenn Morris <rgm@gnu.org> + + * cl.texi (Organization, Installation, Old CL Compatibility): + Deprecate cl-compat for new code. + 2010-10-07 Glenn Morris <rgm@gnu.org> * eudc.texi (CCSO PH/QI, LDAP Requirements): Remove old information.
--- a/doc/misc/cl.texi Fri Oct 08 11:23:11 2010 +0900 +++ b/doc/misc/cl.texi Tue Oct 12 21:41:18 2010 +0900 @@ -206,11 +206,12 @@ needed. There is another file, @file{cl-compat.el}, which defines some -routines from the older @file{cl.el} package that are no longer +routines from the older @file{cl.el} package that are not otherwise present in the new package. This includes internal routines like @code{setelt} and @code{zip-lists}, deprecated features like @code{defkeyword}, and an emulation of the old-style -multiple-values feature. @xref{Old CL Compatibility}. +multiple-values feature. This file is obsolete and should not be used +in new code. @xref{Old CL Compatibility}. @node Installation, Naming Conventions, Organization, Overview @section Installation @@ -221,9 +222,10 @@ If you do need to install it, just put the byte-compiled files @file{cl.elc}, @file{cl-extra.elc}, @file{cl-seq.elc}, -@file{cl-macs.elc}, and @file{cl-compat.elc} into a directory on your -@code{load-path}. Also, format the @file{cl.texi} file and put the -resulting Info files into a directory in your @code{Info-directory-list}. +@file{cl-macs.elc}, and (if necessary) @file{cl-compat.elc} into a +directory on your @code{load-path}. Also, format the @file{cl.texi} +file and put the resulting Info files into a directory in your +@code{Info-directory-list}. @node Naming Conventions, , Installation, Overview @section Naming Conventions @@ -5048,8 +5050,8 @@ @noindent The @dfn{CL} package includes emulations of some features of the old @file{cl.el}, in the form of a compatibility package -@code{cl-compat}. To use it, put @code{(require 'cl-compat)} in -your program. +@code{cl-compat}. This file is obsolete and may be removed in future, +so it should not be used in new code. The old package defined a number of internal routines without @code{cl-} prefixes or other annotations. Call to these routines
--- a/etc/NEWS Fri Oct 08 11:23:11 2010 +0900 +++ b/etc/NEWS Tue Oct 12 21:41:18 2010 +0900 @@ -21,6 +21,9 @@ * Changes in Emacs 23.3 +** The nextstep port can have different modifiers for the left and right +alt/option key by customizing the value for ns-right-alternate-modifier. + * Editing Changes in Emacs 23.3 @@ -31,6 +34,11 @@ ** The appt-add command takes an optional argument for the warning time. This can be used in place of the default appt-message-warning-time. +** Obsolete packages + ++++ +*** lmenu.el and cl-compat.el are now obsolete. + * New Modes and Packages in Emacs 23.3
--- a/lisp/ChangeLog Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/ChangeLog Tue Oct 12 21:41:18 2010 +0900 @@ -1,3 +1,53 @@ + 2010-10-10 Jan Djärv <jan.h.d@swipnet.se> + + * term/ns-win.el (ns-right-alternate-modifier): New defvar. + (ns-right-option-modifier): New alias for ns-right-alternate-modifier. + (mac-right-option-modifier): New alias for ns-right-option-modifier. + + * cus-start.el (all): ns-right-alternate-modifier is new. + +2010-10-10 Andreas Schwab <schwab@linux-m68k.org> + + * Makefile.in (ELCFILES): Update. + +2010-10-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp.el (lisp-completion-at-point): + Use emacs-lisp-mode-syntax-table for the whole function. + +2010-10-09 Richard Sharman <richard_sharman@mitel.com> (tiny change) + + * progmodes/gdb-ui.el (gdb-mouse-toggle-breakpoint-margin) + (gdb-mouse-toggle-breakpoint-fringe): Correct regexp to + work when breakpoint number exceeds nine. + +2010-10-05 David Koppelman <koppel@ece.lsu.edu> + + * hi-lock.el (hi-lock-font-lock-hook): Check font-lock-fontified + instead of font-lock-mode before adding keywords. + Remove hi-lock-mode off code. Remove inhibit hack. + (hi-lock-set-pattern): Only add keywords if font-lock-fontified + non-nil; removed hook inhibit hack. + +2010-10-09 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/shadow.el (find-emacs-lisp-shadows): Rename it... + (load-path-shadows-find): ... to this. + (list-load-path-shadows): Update for above change. + + * mail/mail-utils.el (mail-mbox-from): Also try return-path. + +2010-10-08 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl-compat.el, emacs-lisp/lmenu.el: Move to obsolete/. + + * emacs-lisp/shadow.el (lisp-shadow): Change prefix. + (shadows-compare-text-p): Make it an obsolete alias for... + (load-path-shadows-compare-text): ... new name. + (find-emacs-lisp-shadows): Update for above name change. + (load-path-shadows-same-file-or-nonexistent): New name for the old + shadow-same-file-or-nonexistent. + 2010-10-03 Chong Yidong <cyd@stupidchicken.com> * minibuffer.el (completion--some, completion--do-completion)
--- a/lisp/Makefile.in Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/Makefile.in Tue Oct 12 21:41:18 2010 +0900 @@ -516,7 +516,6 @@ $(lisp)/emacs-lisp/chart.elc \ $(lisp)/emacs-lisp/check-declare.elc \ $(lisp)/emacs-lisp/checkdoc.elc \ - $(lisp)/emacs-lisp/cl-compat.elc \ $(lisp)/emacs-lisp/cl-extra.elc \ $(lisp)/emacs-lisp/cl-indent.elc \ $(lisp)/emacs-lisp/cl-macs.elc \ @@ -551,7 +550,6 @@ $(lisp)/emacs-lisp/lisp-mnt.elc \ $(lisp)/emacs-lisp/lisp-mode.elc \ $(lisp)/emacs-lisp/lisp.elc \ - $(lisp)/emacs-lisp/lmenu.elc \ $(lisp)/emacs-lisp/macroexp.elc \ $(lisp)/emacs-lisp/map-ynp.elc \ $(lisp)/emacs-lisp/pp.elc \ @@ -1081,12 +1079,14 @@ $(lisp)/nxml/xmltok.elc \ $(lisp)/nxml/xsd-regexp.elc \ $(lisp)/obsolete/awk-mode.elc \ + $(lisp)/obsolete/cl-compat.elc \ $(lisp)/obsolete/fast-lock.elc \ $(lisp)/obsolete/iso-acc.elc \ $(lisp)/obsolete/iso-insert.elc \ $(lisp)/obsolete/iso-swed.elc \ $(lisp)/obsolete/lazy-lock.elc \ $(lisp)/obsolete/levents.elc \ + $(lisp)/obsolete/lmenu.elc \ $(lisp)/obsolete/lucid.elc \ $(lisp)/obsolete/old-whitespace.elc \ $(lisp)/obsolete/options.elc \
--- a/lisp/cus-start.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/cus-start.el Tue Oct 12 21:41:18 2010 +0900 @@ -266,6 +266,14 @@ (const control) (const meta) (const alt) (const hyper) (const super)) "23.1") + (ns-right-alternate-modifier + ns + (choice (const :tag "No modifier (work as alternate/option)" none) + (const :tag "Use the value of ns-alternate-modifier" + left) + (const control) (const meta) + (const alt) (const hyper) + (const super)) "23.3") (ns-function-modifier ns (choice (const :tag "No modifier (work as function)" none)
--- a/lisp/emacs-lisp/cl-compat.el Fri Oct 08 11:23:11 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,199 +0,0 @@ -;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) - -;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Dave Gillespie <daveg@synaptics.com> -;; Version: 2.02 -;; Keywords: extensions - -;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; These are extensions to Emacs Lisp that provide a degree of -;; Common Lisp compatibility, beyond what is already built-in -;; in Emacs Lisp. -;; -;; This package was written by Dave Gillespie; it is a complete -;; rewrite of Cesar Quiroz's original cl.el package of December 1986. -;; -;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. -;; -;; Bug reports, comments, and suggestions are welcome! - -;; This file contains emulations of internal routines of the older -;; CL package which users may have called directly from their code. -;; Use (require 'cl-compat) to get these routines. - -;; See cl.el for Change Log. - - -;;; Code: - -;; This used to be: -;; (or (featurep 'cl) (require 'cl)) -;; which just has the effect of fooling the byte-compiler into not -;; loading cl when compiling. However, that leads to some bogus -;; compiler warnings. Loading cl when compiling cannot do any harm, -;; because for a long time bootstrap-emacs contained 'cl, due to being -;; dumped from uncompiled files that eval-when-compile'd cl. So every -;; file was compiled with 'cl loaded. -(require 'cl) - - -;;; Keyword routines not supported by new package. - -(defmacro defkeyword (x &optional doc) - (list* 'defconst x (list 'quote x) (and doc (list doc)))) - -(defun keyword-of (sym) - (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) - - -;;; Multiple values. Note that the new package uses a different -;;; convention for multiple values. The following definitions -;;; emulate the old convention; all function names have been changed -;;; by capitalizing the first letter: Values, Multiple-value-*, -;;; to avoid conflict with the new-style definitions in cl-macs. - -(put 'Multiple-value-bind 'lisp-indent-function 2) -(put 'Multiple-value-setq 'lisp-indent-function 2) -(put 'Multiple-value-call 'lisp-indent-function 1) -(put 'Multiple-value-prog1 'lisp-indent-function 1) - -(defvar *mvalues-values* nil) - -(defun Values (&rest val-forms) - (setq *mvalues-values* val-forms) - (car val-forms)) - -(defun Values-list (val-forms) - (apply 'values val-forms)) - -(defmacro Multiple-value-list (form) - (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) - '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) - (list *mvalues-temp*)))) - -(defmacro Multiple-value-call (function &rest args) - (list 'apply function - (cons 'append - (mapcar (function (lambda (x) (list 'Multiple-value-list x))) - args)))) - -(defmacro Multiple-value-bind (vars form &rest body) - (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) - -(defmacro Multiple-value-setq (vars form) - (list 'multiple-value-setq vars (list 'Multiple-value-list form))) - -(defmacro Multiple-value-prog1 (form &rest body) - (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) - - -;;; Routines for parsing keyword arguments. - -(defun build-klist (arglist keys &optional allow-others) - (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) - (or allow-others - (let ((bad (set-difference (mapcar 'car res) keys))) - (if bad (error "Bad keywords: %s not in %s" bad keys)))) - res)) - -(defun extract-from-klist (klist key &optional def) - (let ((res (assq key klist))) (if res (cdr res) def))) - -(defun keyword-argument-supplied-p (klist key) - (assq key klist)) - -(defun elt-satisfies-test-p (item elt klist) - (let ((test-not (cdr (assq ':test-not klist))) - (test (cdr (assq ':test klist))) - (key (cdr (assq ':key klist)))) - (if key (setq elt (funcall key elt))) - (if test-not (not (funcall test-not item elt)) - (funcall (or test 'eql) item elt)))) - - -;;; Rounding functions with old-style multiple value returns. - -(defun cl-floor (a &optional b) (Values-list (floor* a b))) -(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) -(defun cl-round (a &optional b) (Values-list (round* a b))) -(defun cl-truncate (a &optional b) (Values-list (truncate* a b))) - -(defun safe-idiv (a b) - (let* ((q (/ (abs a) (abs b))) - (s (* (signum a) (signum b)))) - (Values q (- a (* s q b)) s))) - - -;; Internal routines. - -(defun pair-with-newsyms (oldforms) - (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms))) - (Values (mapcar* 'list newsyms oldforms) newsyms))) - -(defun zip-lists (evens odds) - (mapcan 'list evens odds)) - -(defun unzip-lists (list) - (let ((e nil) (o nil)) - (while list - (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list))) - (Values (nreverse e) (nreverse o)))) - -(defun reassemble-argslists (list) - (let ((n (apply 'min (mapcar 'length list))) (res nil)) - (while (>= (setq n (1- n)) 0) - (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) - res)) - -(defun duplicate-symbols-p (list) - (let ((res nil)) - (while list - (if (memq (car list) (cdr list)) (setq res (cons (car list) res))) - (setq list (cdr list))) - res)) - - -;;; Setf internals. - -(defun setnth (n list x) - (setcar (nthcdr n list) x)) - -(defun setnthcdr (n list x) - (setcdr (nthcdr (1- n) list) x)) - -(defun setelt (seq n x) - (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x))) - - -;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms, -;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms, -;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify, -;;; all names with embedded `$'. - - -(provide 'cl-compat) - -;; Local variables: -;; byte-compile-warnings: (not cl-functions) -;; End: - -;; arch-tag: 9996bb4f-aaf5-4592-b436-bf64759a3163 -;;; cl-compat.el ends here
--- a/lisp/emacs-lisp/lisp.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/emacs-lisp/lisp.el Tue Oct 12 21:41:18 2010 +0900 @@ -632,37 +632,37 @@ (defun lisp-completion-at-point (&optional predicate) "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." ;; FIXME: the `end' could be after point? - (let* ((end (point)) - (beg (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion + (with-syntax-table emacs-lisp-mode-syntax-table + (let* ((end (point)) + (beg (save-excursion (backward-sexp 1) (while (= (char-syntax (following-char)) ?\') (forward-char 1)) - (point)))) - (predicate - (or predicate - (save-excursion - (goto-char beg) - (if (not (eq (char-before) ?\()) - (lambda (sym) ;why not just nil ? -sm - (or (boundp sym) (fboundp sym) - (symbol-plist sym))) - ;; Looks like a funcall position. Let's double check. - (if (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil)) - ;; If the first element of the parent list is an open - ;; parenthesis we are probably not in a funcall position. - ;; Maybe a `let' varlist or something. - nil - ;; Else, we assume that a function name is expected. - 'fboundp)))))) - (list beg end obarray - :predicate predicate - :annotate-function + (point))) + (predicate + (or predicate + (save-excursion + (goto-char beg) + (if (not (eq (char-before) ?\()) + (lambda (sym) ;why not just nil ? -sm + (or (boundp sym) (fboundp sym) + (symbol-plist sym))) + ;; Looks like a funcall position. Let's double check. + (if (condition-case nil + (progn (up-list -2) (forward-char 1) + (eq (char-after) ?\()) + (error nil)) + ;; If the first element of the parent list is an open + ;; paren we are probably not in a funcall position. + ;; Maybe a `let' varlist or something. + nil + ;; Else, we assume that a function name is expected. + 'fboundp)))))) + (list beg end obarray + :predicate predicate + :annotate-function (unless (eq predicate 'fboundp) - (lambda (str) (if (fboundp (intern-soft str)) " <f>")))))) + (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))))) ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e ;;; lisp.el ends here
--- a/lisp/emacs-lisp/lmenu.el Fri Oct 08 11:23:11 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,443 +0,0 @@ -;;; lmenu.el --- emulate Lucid's menubar support - -;; Copyright (C) 1992, 1993, 1994, 1997, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Keywords: emulations obsolete - -;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - - -;; First, emulate the Lucid menubar support in GNU Emacs 19. - -;; Arrange to use current-menubar to set up part of the menu bar. - -(defvar current-menubar) -(defvar lucid-menubar-map) -(defvar lucid-failing-menubar) - -(defvar recompute-lucid-menubar 'recompute-lucid-menubar) -(defun recompute-lucid-menubar () - (define-key lucid-menubar-map [menu-bar] - (condition-case nil - (make-lucid-menu-keymap "menu-bar" current-menubar) - (error (message "Invalid data in current-menubar moved to lucid-failing-menubar") - (sit-for 1) - (setq lucid-failing-menubar current-menubar - current-menubar nil)))) - (setq lucid-menu-bar-dirty-flag nil)) - -(defvar lucid-menubar-map (make-sparse-keymap)) -(or (assq 'current-menubar minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'current-menubar lucid-menubar-map) - minor-mode-map-alist))) - -;; XEmacs compatibility -(defun set-menubar-dirty-flag () - (force-mode-line-update) - (setq lucid-menu-bar-dirty-flag t)) - -(defvar add-menu-item-count 0) - -;; This is a variable whose value is always nil. -(defvar make-lucid-menu-keymap-disable nil) - -;; Return a menu keymap corresponding to a Lucid-style menu list -;; MENU-ITEMS, and with name MENU-NAME. -(defun make-lucid-menu-keymap (menu-name menu-items) - (let ((menu (make-sparse-keymap menu-name))) - ;; Process items in reverse order, - ;; since the define-key loop reverses them again. - (setq menu-items (reverse menu-items)) - (while menu-items - (let ((item (car menu-items)) - command name callback) - (cond ((stringp item) - (setq command nil) - (setq name (if (string-match "^-+$" item) "" item))) - ((consp item) - (setq command (make-lucid-menu-keymap (car item) (cdr item))) - (setq name (car item))) - ((vectorp item) - (setq command (make-symbol (format "menu-function-%d" - add-menu-item-count)) - add-menu-item-count (1+ add-menu-item-count) - name (aref item 0) - callback (aref item 1)) - (if (symbolp callback) - (fset command callback) - (fset command (list 'lambda () '(interactive) callback))) - (put command 'menu-alias t) - (let ((i 2)) - (while (< i (length item)) - (cond - ((eq (aref item i) ':active) - (put command 'menu-enable - (or (aref item (1+ i)) - 'make-lucid-menu-keymap-disable)) - (setq i (+ 2 i))) - ((eq (aref item i) ':suffix) - ;; unimplemented - (setq i (+ 2 i))) - ((eq (aref item i) ':keys) - ;; unimplemented - (setq i (+ 2 i))) - ((eq (aref item i) ':style) - ;; unimplemented - (setq i (+ 2 i))) - ((eq (aref item i) ':selected) - ;; unimplemented - (setq i (+ 2 i))) - ((and (symbolp (aref item i)) - (= ?: (string-to-char (symbol-name (aref item i))))) - (error "Unrecognized menu item keyword: %S" - (aref item i))) - ((= i 2) - ;; old-style format: active-p &optional suffix - (put command 'menu-enable - (or (aref item i) 'make-lucid-menu-keymap-disable)) - ;; suffix is unimplemented - (setq i (length item))) - (t - (error "Unexpected menu item value: %S" - (aref item i)))))))) - (if (null command) - ;; Handle inactive strings specially--allow any number - ;; of identical ones. - (setcdr menu (cons (list nil name) (cdr menu))) - (if name - (define-key menu (vector (intern name)) (cons name command))))) - (setq menu-items (cdr menu-items))) - menu)) - -(declare-function x-popup-dialog "xmenu.c" (position contents &optional header)) - -;; XEmacs compatibility function -(defun popup-dialog-box (data) - "Pop up a dialog box. -A dialog box description is a list. - - - The first element of the list is a string to display in the dialog box. - - The rest of the elements are descriptions of the dialog box's buttons. - Each one is a vector of three elements: - - The first element is the text of the button. - - The second element is the `callback'. - - The third element is t or nil, whether this button is selectable. - -If the `callback' of a button is a symbol, then it must name a command. -It will be invoked with `call-interactively'. If it is a list, then it is -evaluated with `eval'. - -One (and only one) of the buttons may be nil. This marker means that all -following buttons should be flushright instead of flushleft. - -The syntax, more precisely: - - form := <something to pass to `eval'> - command := <a symbol or string, to pass to `call-interactively'> - callback := command | form - active-p := <t, nil, or a form to evaluate to decide whether this - button should be selectable> - name := <string> - partition := 'nil' - button := '[' name callback active-p ']' - dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')'" - (let ((name (car data)) - (tail (cdr data)) - converted - choice meaning) - (while tail - (if (null (car tail)) - (setq converted (cons nil converted)) - (let ((item (aref (car tail) 0)) - (callback (aref (car tail) 1)) - (enable (aref (car tail) 2))) - (setq converted - (cons (if enable (cons item callback) item) - converted)))) - (setq tail (cdr tail))) - (setq choice (x-popup-dialog t (cons name (nreverse converted)))) - (if choice - (if (symbolp choice) - (call-interactively choice) - (eval choice))))) - -;; This is empty because the usual elements of the menu bar -;; are provided by menu-bar.el instead. -;; It would not make sense to duplicate them here. -(defconst default-menubar nil) - -;; XEmacs compatibility -(defun set-menubar (menubar) - "Set the default menubar to be menubar." - (setq-default current-menubar (copy-sequence menubar)) - (set-menubar-dirty-flag)) - -;; XEmacs compatibility -(defun set-buffer-menubar (menubar) - "Set the buffer-local menubar to be menubar." - (make-local-variable 'current-menubar) - (setq current-menubar (copy-sequence menubar)) - (set-menubar-dirty-flag)) - - -;;; menu manipulation functions - -;; XEmacs compatibility -(defun find-menu-item (menubar item-path-list &optional parent) - "Searches MENUBAR for item given by ITEM-PATH-LIST. -Returns (ITEM . PARENT), where PARENT is the immediate parent of - the item found. -Signals an error if the item is not found." - (or parent (setq item-path-list (mapcar 'downcase item-path-list))) - (if (not (consp menubar)) - nil - (let ((rest menubar) - result) - (while rest - (if (and (car rest) - (equal (car item-path-list) - (downcase (if (vectorp (car rest)) - (aref (car rest) 0) - (if (stringp (car rest)) - (car rest) - (car (car rest))))))) - (setq result (car rest) rest nil) - (setq rest (cdr rest)))) - (if (cdr item-path-list) - (if (consp result) - (find-menu-item (cdr result) (cdr item-path-list) result) - (if result - (signal 'error (list "not a submenu" result)) - (signal 'error (list "no such submenu" (car item-path-list))))) - (cons result parent))))) - - -;; XEmacs compatibility -(defun disable-menu-item (path) - "Make the named menu item be unselectable. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (let* ((menubar current-menubar) - (pair (find-menu-item menubar path)) - (item (car pair)) - (menu (cdr pair))) - (or item - (signal 'error (list (if menu "No such menu item" "No such menu") - path))) - (if (consp item) (error "can't disable menus, only menu items")) - (aset item 2 nil) - (set-menubar-dirty-flag) - item)) - - -;; XEmacs compatibility -(defun enable-menu-item (path) - "Make the named menu item be selectable. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (let* ((menubar current-menubar) - (pair (find-menu-item menubar path)) - (item (car pair)) - (menu (cdr pair))) - (or item - (signal 'error (list (if menu "No such menu item" "No such menu") - path))) - (if (consp item) (error "%S is a menu, not a menu item" path)) - (aset item 2 t) - (set-menubar-dirty-flag) - item)) - - -(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before) - (if before (setq before (downcase before))) - (let* ((menubar current-menubar) - (menu (condition-case () - (car (find-menu-item menubar menu-path)) - (error nil))) - (item (if (listp menu) - (car (find-menu-item (cdr menu) (list item-name))) - (signal 'error (list "not a submenu" menu-path))))) - (or menu - (let ((rest menu-path) - (so-far menubar)) - (while rest -;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest))))) - (setq menu - (if (eq so-far menubar) - (car (find-menu-item so-far (list (car rest)))) - (car (find-menu-item (cdr so-far) (list (car rest)))))) - (or menu - (let ((rest2 so-far)) - (or rest2 - (error "Trying to modify a menu that doesn't exist")) - (while (and (cdr rest2) (car (cdr rest2))) - (setq rest2 (cdr rest2))) - (setcdr rest2 - (nconc (list (setq menu (list (car rest)))) - (cdr rest2))))) - (setq so-far menu) - (setq rest (cdr rest))))) - (or menu (setq menu menubar)) - (if item - nil ; it's already there - (if item-p - (setq item (vector item-name item-data enabled-p)) - (setq item (cons item-name item-data))) - ;; if BEFORE is specified, try to add it there. - (if before - (setq before (car (find-menu-item menu (list before))))) - (let ((rest menu) - (added-before nil)) - (while rest - (if (eq before (car (cdr rest))) - (progn - (setcdr rest (cons item (cdr rest))) - (setq rest nil added-before t)) - (setq rest (cdr rest)))) - (if (not added-before) - ;; adding before the first item on the menubar itself is harder - (if (and (eq menu menubar) (eq before (car menu))) - (setq menu (cons item menu) - current-menubar menu) - ;; otherwise, add the item to the end. - (nconc menu (list item)))))) - (if item-p - (progn - (aset item 1 item-data) - (aset item 2 (not (null enabled-p)))) - (setcar item item-name) - (setcdr item item-data)) - (set-menubar-dirty-flag) - item)) - -;; XEmacs compatibility -(defun add-menu-item (menu-path item-name function enabled-p &optional before) - "Add a menu item to some menu, creating the menu first if necessary. -If the named item exists already, it is changed. -MENU-PATH identifies the menu under which the new menu item should be inserted. - It is a list of strings; for example, (\"File\") names the top-level \"File\" - menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". -ITEM-NAME is the string naming the menu item to be added. -FUNCTION is the command to invoke when this menu item is selected. - If it is a symbol, then it is invoked with `call-interactively', in the same - way that functions bound to keys are invoked. If it is a list, then the - list is simply evaluated. -ENABLED-P controls whether the item is selectable or not. -BEFORE, if provided, is the name of a menu item before which this item should - be added, if this item is not on the menu already. If the item is already - present, it will not be moved." - (or menu-path (error "must specify a menu path")) - (or item-name (error "must specify an item name")) - (add-menu-item-1 t menu-path item-name function enabled-p before)) - - -;; XEmacs compatibility -(defun delete-menu-item (path) - "Remove the named menu item from the menu hierarchy. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (let* ((menubar current-menubar) - (pair (find-menu-item menubar path)) - (item (car pair)) - (menu (or (cdr pair) menubar))) - (if (not item) - nil - ;; the menubar is the only special case, because other menus begin - ;; with their name. - (if (eq menu current-menubar) - (setq current-menubar (delq item menu)) - (delq item menu)) - (set-menubar-dirty-flag) - item))) - - -;; XEmacs compatibility -(defun relabel-menu-item (path new-name) - "Change the string of the specified menu item. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\". -NEW-NAME is the string that the menu item will be printed as from now on." - (or (stringp new-name) - (setq new-name (signal 'wrong-type-argument (list 'stringp new-name)))) - (let* ((menubar current-menubar) - (pair (find-menu-item menubar path)) - (item (car pair)) - (menu (cdr pair))) - (or item - (signal 'error (list (if menu "No such menu item" "No such menu") - path))) - (if (and (consp item) - (stringp (car item))) - (setcar item new-name) - (aset item 0 new-name)) - (set-menubar-dirty-flag) - item)) - -;; XEmacs compatibility -(defun add-menu (menu-path menu-name menu-items &optional before) - "Add a menu to the menubar or one of its submenus. -If the named menu exists already, it is changed. -MENU-PATH identifies the menu under which the new menu should be inserted. - It is a list of strings; for example, (\"File\") names the top-level \"File\" - menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". - If MENU-PATH is nil, then the menu will be added to the menubar itself. -MENU-NAME is the string naming the menu to be added. -MENU-ITEMS is a list of menu item descriptions. - Each menu item should be a vector of three elements: - - a string, the name of the menu item; - - a symbol naming a command, or a form to evaluate; - - and a form whose value determines whether this item is selectable. -BEFORE, if provided, is the name of a menu before which this menu should - be added, if this menu is not on its parent already. If the menu is already - present, it will not be moved." - (or menu-name (error "must specify a menu name")) - (or menu-items (error "must specify some menu items")) - (add-menu-item-1 nil menu-path menu-name menu-items t before)) - - - -(defvar put-buffer-names-in-file-menu t) - - -;; Don't unconditionally enable menu bars; leave that up to the user. -;;(let ((frames (frame-list))) -;; (while frames -;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1))) -;; (setq frames (cdr frames)))) -;;(or (assq 'menu-bar-lines default-frame-alist) -;; (setq default-frame-alist -;; (cons '(menu-bar-lines . 1) default-frame-alist))) - -(set-menubar default-menubar) - -(provide 'lmenu) - -;; arch-tag: 7051c396-2837-435a-ae11-b2d2e2af8fc1 -;;; lmenu.el ends here
--- a/lisp/emacs-lisp/shadow.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/emacs-lisp/shadow.el Tue Oct 12 21:41:18 2010 +0900 @@ -24,7 +24,7 @@ ;;; Commentary: -;; The functions in this file detect (`find-emacs-lisp-shadows') +;; The functions in this file detect (`load-path-shadows-find') ;; and display (`list-load-path-shadows') potential load-path ;; problems that arise when Emacs Lisp files "shadow" each other. ;; @@ -53,16 +53,19 @@ (defgroup lisp-shadow nil "Locate Emacs Lisp file shadowings." - :prefix "shadows-" + :prefix "load-path-shadows-" :group 'lisp) -(defcustom shadows-compare-text-p nil +(define-obsolete-variable-alias 'shadows-compare-text-p + 'load-path-shadows-compare-text "23.3") + +(defcustom load-path-shadows-compare-text nil "If non-nil, then shadowing files are reported only if their text differs. This is slower, but filters out some innocuous shadowing." :type 'boolean :group 'lisp-shadow) -(defun find-emacs-lisp-shadows (&optional path) +(defun load-path-shadows-find (&optional path) "Return a list of Emacs Lisp files that create shadows. This function does the work for `list-load-path-shadows'. @@ -124,11 +127,11 @@ ;; Report it unless the files are identical. (let ((base1 (concat (cdr orig-dir) "/" file)) (base2 (concat dir "/" file))) - (if (not (and shadows-compare-text-p - (shadow-same-file-or-nonexistent + (if (not (and load-path-shadows-compare-text + (load-path-shadows-same-file-or-nonexistent (concat base1 ".el") (concat base2 ".el")) ;; This is a bit strict, but safe. - (shadow-same-file-or-nonexistent + (load-path-shadows-same-file-or-nonexistent (concat base1 ".elc") (concat base2 ".elc")))) (setq shadows (append shadows (list base1 base2))))) @@ -138,9 +141,12 @@ ;; Return the list of shadowings. shadows)) +(define-obsolete-function-alias 'find-emacs-lisp-shadows + 'load-path-shadows-find "23.3") + ;; Return true if neither file exists, or if both exist and have identical ;; contents. -(defun shadow-same-file-or-nonexistent (f1 f2) +(defun load-path-shadows-same-file-or-nonexistent (f1 f2) (let ((exists1 (file-exists-p f1)) (exists2 (file-exists-p f2))) (or (and (not exists1) (not exists2)) @@ -193,7 +199,7 @@ considered to shadow a later file XXX.el, and vice-versa. Shadowings are located by calling the (non-interactive) companion -function, `find-emacs-lisp-shadows'." +function, `load-path-shadows-find'." (interactive) (let* ((path (copy-sequence load-path)) (tem path) @@ -217,7 +223,7 @@ (setq tem nil))) (setq tem (cdr tem))))) - (let* ((shadows (find-emacs-lisp-shadows path)) + (let* ((shadows (load-path-shadows-find path)) (n (/ (length shadows) 2)) (msg (format "%s Emacs Lisp load-path shadowing%s found" (if (zerop n) "No" (concat "\n" (number-to-string n)))
--- a/lisp/hi-lock.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/hi-lock.el Tue Oct 12 21:41:18 2010 +0900 @@ -564,23 +564,15 @@ 'face-name-history (cdr hi-lock-face-defaults)))) -(defvar hi-lock--inhibit-font-lock-hook nil - "Inhibit the action of `hi-lock-font-lock-hook'. -This is used by `hi-lock-set-pattern'.") - (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." - (let ((pattern (list regexp (list 0 (list 'quote face) t))) - ;; The call to `font-lock-add-keywords' below might disable - ;; and re-enable font-lock mode. If so, we don't want - ;; `hi-lock-font-lock-hook' to run. This can be removed once - ;; Bug#635 is fixed. -- cyd - (hi-lock--inhibit-font-lock-hook t)) + (let ((pattern (list regexp (list 0 (list 'quote face) t)))) (unless (member pattern hi-lock-interactive-patterns) - (font-lock-add-keywords nil (list pattern) t) (push pattern hi-lock-interactive-patterns) (if font-lock-fontified - (font-lock-fontify-buffer) + (progn + (font-lock-add-keywords nil (list pattern) t) + (font-lock-fontify-buffer)) (let* ((serial (hi-lock-string-serialize regexp)) (range-min (- (point) (/ hi-lock-highlight-range 2))) (range-max (+ (point) (/ hi-lock-highlight-range 2))) @@ -641,12 +633,9 @@ (defun hi-lock-font-lock-hook () "Add hi-lock patterns to font-lock's." - (unless hi-lock--inhibit-font-lock-hook - (if font-lock-mode - (progn - (font-lock-add-keywords nil hi-lock-file-patterns t) - (font-lock-add-keywords nil hi-lock-interactive-patterns t)) - (hi-lock-mode -1)))) + (when font-lock-fontified + (font-lock-add-keywords nil hi-lock-file-patterns t) + (font-lock-add-keywords nil hi-lock-interactive-patterns t))) (defvar hi-lock-string-serialize-hash (make-hash-table :test 'equal)
--- a/lisp/mail/mail-utils.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/mail/mail-utils.el Tue Oct 12 21:41:18 2010 +0900 @@ -401,6 +401,7 @@ (let ((from (or (mail-fetch-field "from") (mail-fetch-field "really-from") (mail-fetch-field "sender") + (mail-fetch-field "return-path") "unknown")) (date (mail-fetch-field "date"))) (format "From %s %s\n" (mail-strip-quoted-names from) @@ -411,5 +412,4 @@ (provide 'mail-utils) -;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd ;;; mail-utils.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/cl-compat.el Tue Oct 12 21:41:18 2010 +0900 @@ -0,0 +1,201 @@ +;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) + +;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. + +;; Author: Dave Gillespie <daveg@synaptics.com> +;; Version: 2.02 +;; Keywords: extensions +;; Obsolete-since: 23.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file has been obsolete since Emacs 23.3. + +;; These are extensions to Emacs Lisp that provide a degree of +;; Common Lisp compatibility, beyond what is already built-in +;; in Emacs Lisp. +;; +;; This package was written by Dave Gillespie; it is a complete +;; rewrite of Cesar Quiroz's original cl.el package of December 1986. +;; +;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. +;; +;; Bug reports, comments, and suggestions are welcome! + +;; This file contains emulations of internal routines of the older +;; CL package which users may have called directly from their code. +;; Use (require 'cl-compat) to get these routines. + +;; See cl.el for Change Log. + + +;;; Code: + +;; This used to be: +;; (or (featurep 'cl) (require 'cl)) +;; which just has the effect of fooling the byte-compiler into not +;; loading cl when compiling. However, that leads to some bogus +;; compiler warnings. Loading cl when compiling cannot do any harm, +;; because for a long time bootstrap-emacs contained 'cl, due to being +;; dumped from uncompiled files that eval-when-compile'd cl. So every +;; file was compiled with 'cl loaded. +(require 'cl) + + +;;; Keyword routines not supported by new package. + +(defmacro defkeyword (x &optional doc) + (list* 'defconst x (list 'quote x) (and doc (list doc)))) + +(defun keyword-of (sym) + (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) + + +;;; Multiple values. Note that the new package uses a different +;;; convention for multiple values. The following definitions +;;; emulate the old convention; all function names have been changed +;;; by capitalizing the first letter: Values, Multiple-value-*, +;;; to avoid conflict with the new-style definitions in cl-macs. + +(put 'Multiple-value-bind 'lisp-indent-function 2) +(put 'Multiple-value-setq 'lisp-indent-function 2) +(put 'Multiple-value-call 'lisp-indent-function 1) +(put 'Multiple-value-prog1 'lisp-indent-function 1) + +(defvar *mvalues-values* nil) + +(defun Values (&rest val-forms) + (setq *mvalues-values* val-forms) + (car val-forms)) + +(defun Values-list (val-forms) + (apply 'values val-forms)) + +(defmacro Multiple-value-list (form) + (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) + '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) + (list *mvalues-temp*)))) + +(defmacro Multiple-value-call (function &rest args) + (list 'apply function + (cons 'append + (mapcar (function (lambda (x) (list 'Multiple-value-list x))) + args)))) + +(defmacro Multiple-value-bind (vars form &rest body) + (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) + +(defmacro Multiple-value-setq (vars form) + (list 'multiple-value-setq vars (list 'Multiple-value-list form))) + +(defmacro Multiple-value-prog1 (form &rest body) + (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) + + +;;; Routines for parsing keyword arguments. + +(defun build-klist (arglist keys &optional allow-others) + (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) + (or allow-others + (let ((bad (set-difference (mapcar 'car res) keys))) + (if bad (error "Bad keywords: %s not in %s" bad keys)))) + res)) + +(defun extract-from-klist (klist key &optional def) + (let ((res (assq key klist))) (if res (cdr res) def))) + +(defun keyword-argument-supplied-p (klist key) + (assq key klist)) + +(defun elt-satisfies-test-p (item elt klist) + (let ((test-not (cdr (assq ':test-not klist))) + (test (cdr (assq ':test klist))) + (key (cdr (assq ':key klist)))) + (if key (setq elt (funcall key elt))) + (if test-not (not (funcall test-not item elt)) + (funcall (or test 'eql) item elt)))) + + +;;; Rounding functions with old-style multiple value returns. + +(defun cl-floor (a &optional b) (Values-list (floor* a b))) +(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) +(defun cl-round (a &optional b) (Values-list (round* a b))) +(defun cl-truncate (a &optional b) (Values-list (truncate* a b))) + +(defun safe-idiv (a b) + (let* ((q (/ (abs a) (abs b))) + (s (* (signum a) (signum b)))) + (Values q (- a (* s q b)) s))) + + +;; Internal routines. + +(defun pair-with-newsyms (oldforms) + (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms))) + (Values (mapcar* 'list newsyms oldforms) newsyms))) + +(defun zip-lists (evens odds) + (mapcan 'list evens odds)) + +(defun unzip-lists (list) + (let ((e nil) (o nil)) + (while list + (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list))) + (Values (nreverse e) (nreverse o)))) + +(defun reassemble-argslists (list) + (let ((n (apply 'min (mapcar 'length list))) (res nil)) + (while (>= (setq n (1- n)) 0) + (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) + res)) + +(defun duplicate-symbols-p (list) + (let ((res nil)) + (while list + (if (memq (car list) (cdr list)) (setq res (cons (car list) res))) + (setq list (cdr list))) + res)) + + +;;; Setf internals. + +(defun setnth (n list x) + (setcar (nthcdr n list) x)) + +(defun setnthcdr (n list x) + (setcdr (nthcdr (1- n) list) x)) + +(defun setelt (seq n x) + (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x))) + + +;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms, +;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms, +;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify, +;;; all names with embedded `$'. + + +(provide 'cl-compat) + +;; Local variables: +;; byte-compile-warnings: (not cl-functions) +;; End: + +;;; cl-compat.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/lmenu.el Tue Oct 12 21:41:18 2010 +0900 @@ -0,0 +1,445 @@ +;;; lmenu.el --- emulate Lucid's menubar support + +;; Copyright (C) 1992, 1993, 1994, 1997, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Keywords: emulations obsolete +;; Obsolete-since: 23.3 + +;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file has been obsolete since Emacs 23.3. + +;;; Code: + + +;; First, emulate the Lucid menubar support in GNU Emacs 19. + +;; Arrange to use current-menubar to set up part of the menu bar. + +(defvar current-menubar) +(defvar lucid-menubar-map) +(defvar lucid-failing-menubar) + +(defvar recompute-lucid-menubar 'recompute-lucid-menubar) +(defun recompute-lucid-menubar () + (define-key lucid-menubar-map [menu-bar] + (condition-case nil + (make-lucid-menu-keymap "menu-bar" current-menubar) + (error (message "Invalid data in current-menubar moved to lucid-failing-menubar") + (sit-for 1) + (setq lucid-failing-menubar current-menubar + current-menubar nil)))) + (setq lucid-menu-bar-dirty-flag nil)) + +(defvar lucid-menubar-map (make-sparse-keymap)) +(or (assq 'current-menubar minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'current-menubar lucid-menubar-map) + minor-mode-map-alist))) + +;; XEmacs compatibility +(defun set-menubar-dirty-flag () + (force-mode-line-update) + (setq lucid-menu-bar-dirty-flag t)) + +(defvar add-menu-item-count 0) + +;; This is a variable whose value is always nil. +(defvar make-lucid-menu-keymap-disable nil) + +;; Return a menu keymap corresponding to a Lucid-style menu list +;; MENU-ITEMS, and with name MENU-NAME. +(defun make-lucid-menu-keymap (menu-name menu-items) + (let ((menu (make-sparse-keymap menu-name))) + ;; Process items in reverse order, + ;; since the define-key loop reverses them again. + (setq menu-items (reverse menu-items)) + (while menu-items + (let ((item (car menu-items)) + command name callback) + (cond ((stringp item) + (setq command nil) + (setq name (if (string-match "^-+$" item) "" item))) + ((consp item) + (setq command (make-lucid-menu-keymap (car item) (cdr item))) + (setq name (car item))) + ((vectorp item) + (setq command (make-symbol (format "menu-function-%d" + add-menu-item-count)) + add-menu-item-count (1+ add-menu-item-count) + name (aref item 0) + callback (aref item 1)) + (if (symbolp callback) + (fset command callback) + (fset command (list 'lambda () '(interactive) callback))) + (put command 'menu-alias t) + (let ((i 2)) + (while (< i (length item)) + (cond + ((eq (aref item i) ':active) + (put command 'menu-enable + (or (aref item (1+ i)) + 'make-lucid-menu-keymap-disable)) + (setq i (+ 2 i))) + ((eq (aref item i) ':suffix) + ;; unimplemented + (setq i (+ 2 i))) + ((eq (aref item i) ':keys) + ;; unimplemented + (setq i (+ 2 i))) + ((eq (aref item i) ':style) + ;; unimplemented + (setq i (+ 2 i))) + ((eq (aref item i) ':selected) + ;; unimplemented + (setq i (+ 2 i))) + ((and (symbolp (aref item i)) + (= ?: (string-to-char (symbol-name (aref item i))))) + (error "Unrecognized menu item keyword: %S" + (aref item i))) + ((= i 2) + ;; old-style format: active-p &optional suffix + (put command 'menu-enable + (or (aref item i) 'make-lucid-menu-keymap-disable)) + ;; suffix is unimplemented + (setq i (length item))) + (t + (error "Unexpected menu item value: %S" + (aref item i)))))))) + (if (null command) + ;; Handle inactive strings specially--allow any number + ;; of identical ones. + (setcdr menu (cons (list nil name) (cdr menu))) + (if name + (define-key menu (vector (intern name)) (cons name command))))) + (setq menu-items (cdr menu-items))) + menu)) + +(declare-function x-popup-dialog "xmenu.c" (position contents &optional header)) + +;; XEmacs compatibility function +(defun popup-dialog-box (data) + "Pop up a dialog box. +A dialog box description is a list. + + - The first element of the list is a string to display in the dialog box. + - The rest of the elements are descriptions of the dialog box's buttons. + Each one is a vector of three elements: + - The first element is the text of the button. + - The second element is the `callback'. + - The third element is t or nil, whether this button is selectable. + +If the `callback' of a button is a symbol, then it must name a command. +It will be invoked with `call-interactively'. If it is a list, then it is +evaluated with `eval'. + +One (and only one) of the buttons may be nil. This marker means that all +following buttons should be flushright instead of flushleft. + +The syntax, more precisely: + + form := <something to pass to `eval'> + command := <a symbol or string, to pass to `call-interactively'> + callback := command | form + active-p := <t, nil, or a form to evaluate to decide whether this + button should be selectable> + name := <string> + partition := 'nil' + button := '[' name callback active-p ']' + dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')'" + (let ((name (car data)) + (tail (cdr data)) + converted + choice meaning) + (while tail + (if (null (car tail)) + (setq converted (cons nil converted)) + (let ((item (aref (car tail) 0)) + (callback (aref (car tail) 1)) + (enable (aref (car tail) 2))) + (setq converted + (cons (if enable (cons item callback) item) + converted)))) + (setq tail (cdr tail))) + (setq choice (x-popup-dialog t (cons name (nreverse converted)))) + (if choice + (if (symbolp choice) + (call-interactively choice) + (eval choice))))) + +;; This is empty because the usual elements of the menu bar +;; are provided by menu-bar.el instead. +;; It would not make sense to duplicate them here. +(defconst default-menubar nil) + +;; XEmacs compatibility +(defun set-menubar (menubar) + "Set the default menubar to be menubar." + (setq-default current-menubar (copy-sequence menubar)) + (set-menubar-dirty-flag)) + +;; XEmacs compatibility +(defun set-buffer-menubar (menubar) + "Set the buffer-local menubar to be menubar." + (make-local-variable 'current-menubar) + (setq current-menubar (copy-sequence menubar)) + (set-menubar-dirty-flag)) + + +;;; menu manipulation functions + +;; XEmacs compatibility +(defun find-menu-item (menubar item-path-list &optional parent) + "Searches MENUBAR for item given by ITEM-PATH-LIST. +Returns (ITEM . PARENT), where PARENT is the immediate parent of + the item found. +Signals an error if the item is not found." + (or parent (setq item-path-list (mapcar 'downcase item-path-list))) + (if (not (consp menubar)) + nil + (let ((rest menubar) + result) + (while rest + (if (and (car rest) + (equal (car item-path-list) + (downcase (if (vectorp (car rest)) + (aref (car rest) 0) + (if (stringp (car rest)) + (car rest) + (car (car rest))))))) + (setq result (car rest) rest nil) + (setq rest (cdr rest)))) + (if (cdr item-path-list) + (if (consp result) + (find-menu-item (cdr result) (cdr item-path-list) result) + (if result + (signal 'error (list "not a submenu" result)) + (signal 'error (list "no such submenu" (car item-path-list))))) + (cons result parent))))) + + +;; XEmacs compatibility +(defun disable-menu-item (path) + "Make the named menu item be unselectable. +PATH is a list of strings which identify the position of the menu item in +the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" +under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the +menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." + (let* ((menubar current-menubar) + (pair (find-menu-item menubar path)) + (item (car pair)) + (menu (cdr pair))) + (or item + (signal 'error (list (if menu "No such menu item" "No such menu") + path))) + (if (consp item) (error "can't disable menus, only menu items")) + (aset item 2 nil) + (set-menubar-dirty-flag) + item)) + + +;; XEmacs compatibility +(defun enable-menu-item (path) + "Make the named menu item be selectable. +PATH is a list of strings which identify the position of the menu item in +the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" +under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the +menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." + (let* ((menubar current-menubar) + (pair (find-menu-item menubar path)) + (item (car pair)) + (menu (cdr pair))) + (or item + (signal 'error (list (if menu "No such menu item" "No such menu") + path))) + (if (consp item) (error "%S is a menu, not a menu item" path)) + (aset item 2 t) + (set-menubar-dirty-flag) + item)) + + +(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before) + (if before (setq before (downcase before))) + (let* ((menubar current-menubar) + (menu (condition-case () + (car (find-menu-item menubar menu-path)) + (error nil))) + (item (if (listp menu) + (car (find-menu-item (cdr menu) (list item-name))) + (signal 'error (list "not a submenu" menu-path))))) + (or menu + (let ((rest menu-path) + (so-far menubar)) + (while rest +;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest))))) + (setq menu + (if (eq so-far menubar) + (car (find-menu-item so-far (list (car rest)))) + (car (find-menu-item (cdr so-far) (list (car rest)))))) + (or menu + (let ((rest2 so-far)) + (or rest2 + (error "Trying to modify a menu that doesn't exist")) + (while (and (cdr rest2) (car (cdr rest2))) + (setq rest2 (cdr rest2))) + (setcdr rest2 + (nconc (list (setq menu (list (car rest)))) + (cdr rest2))))) + (setq so-far menu) + (setq rest (cdr rest))))) + (or menu (setq menu menubar)) + (if item + nil ; it's already there + (if item-p + (setq item (vector item-name item-data enabled-p)) + (setq item (cons item-name item-data))) + ;; if BEFORE is specified, try to add it there. + (if before + (setq before (car (find-menu-item menu (list before))))) + (let ((rest menu) + (added-before nil)) + (while rest + (if (eq before (car (cdr rest))) + (progn + (setcdr rest (cons item (cdr rest))) + (setq rest nil added-before t)) + (setq rest (cdr rest)))) + (if (not added-before) + ;; adding before the first item on the menubar itself is harder + (if (and (eq menu menubar) (eq before (car menu))) + (setq menu (cons item menu) + current-menubar menu) + ;; otherwise, add the item to the end. + (nconc menu (list item)))))) + (if item-p + (progn + (aset item 1 item-data) + (aset item 2 (not (null enabled-p)))) + (setcar item item-name) + (setcdr item item-data)) + (set-menubar-dirty-flag) + item)) + +;; XEmacs compatibility +(defun add-menu-item (menu-path item-name function enabled-p &optional before) + "Add a menu item to some menu, creating the menu first if necessary. +If the named item exists already, it is changed. +MENU-PATH identifies the menu under which the new menu item should be inserted. + It is a list of strings; for example, (\"File\") names the top-level \"File\" + menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". +ITEM-NAME is the string naming the menu item to be added. +FUNCTION is the command to invoke when this menu item is selected. + If it is a symbol, then it is invoked with `call-interactively', in the same + way that functions bound to keys are invoked. If it is a list, then the + list is simply evaluated. +ENABLED-P controls whether the item is selectable or not. +BEFORE, if provided, is the name of a menu item before which this item should + be added, if this item is not on the menu already. If the item is already + present, it will not be moved." + (or menu-path (error "must specify a menu path")) + (or item-name (error "must specify an item name")) + (add-menu-item-1 t menu-path item-name function enabled-p before)) + + +;; XEmacs compatibility +(defun delete-menu-item (path) + "Remove the named menu item from the menu hierarchy. +PATH is a list of strings which identify the position of the menu item in +the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" +under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the +menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." + (let* ((menubar current-menubar) + (pair (find-menu-item menubar path)) + (item (car pair)) + (menu (or (cdr pair) menubar))) + (if (not item) + nil + ;; the menubar is the only special case, because other menus begin + ;; with their name. + (if (eq menu current-menubar) + (setq current-menubar (delq item menu)) + (delq item menu)) + (set-menubar-dirty-flag) + item))) + + +;; XEmacs compatibility +(defun relabel-menu-item (path new-name) + "Change the string of the specified menu item. +PATH is a list of strings which identify the position of the menu item in +the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" +under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the +menu item called \"Item\" under the \"Foo\" submenu of \"Menu\". +NEW-NAME is the string that the menu item will be printed as from now on." + (or (stringp new-name) + (setq new-name (signal 'wrong-type-argument (list 'stringp new-name)))) + (let* ((menubar current-menubar) + (pair (find-menu-item menubar path)) + (item (car pair)) + (menu (cdr pair))) + (or item + (signal 'error (list (if menu "No such menu item" "No such menu") + path))) + (if (and (consp item) + (stringp (car item))) + (setcar item new-name) + (aset item 0 new-name)) + (set-menubar-dirty-flag) + item)) + +;; XEmacs compatibility +(defun add-menu (menu-path menu-name menu-items &optional before) + "Add a menu to the menubar or one of its submenus. +If the named menu exists already, it is changed. +MENU-PATH identifies the menu under which the new menu should be inserted. + It is a list of strings; for example, (\"File\") names the top-level \"File\" + menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\". + If MENU-PATH is nil, then the menu will be added to the menubar itself. +MENU-NAME is the string naming the menu to be added. +MENU-ITEMS is a list of menu item descriptions. + Each menu item should be a vector of three elements: + - a string, the name of the menu item; + - a symbol naming a command, or a form to evaluate; + - and a form whose value determines whether this item is selectable. +BEFORE, if provided, is the name of a menu before which this menu should + be added, if this menu is not on its parent already. If the menu is already + present, it will not be moved." + (or menu-name (error "must specify a menu name")) + (or menu-items (error "must specify some menu items")) + (add-menu-item-1 nil menu-path menu-name menu-items t before)) + + + +(defvar put-buffer-names-in-file-menu t) + + +;; Don't unconditionally enable menu bars; leave that up to the user. +;;(let ((frames (frame-list))) +;; (while frames +;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1))) +;; (setq frames (cdr frames)))) +;;(or (assq 'menu-bar-lines default-frame-alist) +;; (setq default-frame-alist +;; (cons '(menu-bar-lines . 1) default-frame-alist))) + +(set-menubar default-menubar) + +(provide 'lmenu) + +;;; lmenu.el ends here
--- a/lisp/progmodes/gdb-ui.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/progmodes/gdb-ui.el Tue Oct 12 21:41:18 2010 +0900 @@ -2195,7 +2195,7 @@ (if (posn-object posn) (let* ((bptno (get-text-property 0 'gdb-bptno (car (posn-string posn))))) - (string-match "\\([0-9+]\\)*" bptno) + (string-match "\\([0-9]+\\)*" bptno) (gdb-enqueue-input (list (concat gdb-server-prefix @@ -2222,7 +2222,7 @@ (setq obj (overlay-get overlay 'before-string)))) (when (stringp obj) (let* ((bptno (get-text-property 0 'gdb-bptno obj))) - (string-match "\\([0-9+]\\)*" bptno) + (string-match "\\([0-9]+\\)*" bptno) (gdb-enqueue-input (list (concat gdb-server-prefix
--- a/lisp/term/ns-win.el Fri Oct 08 11:23:11 2010 +0900 +++ b/lisp/term/ns-win.el Tue Oct 12 21:41:18 2010 +0900 @@ -66,6 +66,7 @@ ;; nsterm.m (defvar ns-version-string) (defvar ns-alternate-modifier) +(defvar ns-right-alternate-modifier) ;;;; Command line argument handling. @@ -286,6 +287,7 @@ (defvaralias 'mac-command-modifier 'ns-command-modifier) (defvaralias 'mac-control-modifier 'ns-control-modifier) (defvaralias 'mac-option-modifier 'ns-option-modifier) +(defvaralias 'mac-right-option-modifier 'ns-right-option-modifier) (defvaralias 'mac-function-modifier 'ns-function-modifier) (declare-function ns-do-applescript "nsfns.m" (script)) (defalias 'do-applescript 'ns-do-applescript) @@ -817,6 +819,7 @@ ;; You say tomAYto, I say tomAHto.. (defvaralias 'ns-option-modifier 'ns-alternate-modifier) +(defvaralias 'ns-right-option-modifier 'ns-right-alternate-modifier) (defun ns-do-hide-emacs () (interactive)
--- a/make-dist Fri Oct 08 11:23:11 2010 +0900 +++ b/make-dist Tue Oct 12 21:41:18 2010 +0900 @@ -460,7 +460,7 @@ ln makefile.w32-in ../${tempdir}/src ln .gdbinit .dbxinit ../${tempdir}/src cd ../${tempdir}/src - rm -f config.h epaths.h Makefile Makefile.c + rm -f config.h epaths.h Makefile Makefile.c buildobj.h rm -f =* TAGS) echo "Making links to \`src/bitmaps'"
--- a/src/ChangeLog Fri Oct 08 11:23:11 2010 +0900 +++ b/src/ChangeLog Tue Oct 12 21:41:18 2010 +0900 @@ -1,12 +1,22 @@ +2010-10-10 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (Qleft): Declare. + (ns_right_alternate_modifier): New variable + (NSRightAlternateKeyMask): New define. + (EV_MODIFIERS): Parse NSRightAlternateKeyMask if + ns_right_alternate_modifier isn't Qleft. + (keyDown): If ns_right_alternate_modifier isn't Qleft, use it + as emacs modifier for NSRightAlternateKeyMask. + (syms_of_nsterm): DEFVAR_LISP ns-right-alternate-modifier. + +2010-10-08 Michael Albinus <michael.albinus@gmx.de> + + * dbusbind.c (xd_get_dispatch_status): Return a Lisp_Object. + (xd_pending_messages): Catch xd_get_dispatch_status calls. + 2010-10-08 Kenichi Handa <handa@m17n.org> - * coding.c (complement_process_encoding_system): Fix previous - change. - -2010-10-04 Kenichi Handa <handa@m17n.org> - - * coding.c (complement_process_encoding_system): Fix previous - change. + * coding.c (complement_process_encoding_system): Fix previous change. 2010-10-03 Michael Albinus <michael.albinus@gmx.de>
--- a/src/dbusbind.c Fri Oct 08 11:23:11 2010 +0900 +++ b/src/dbusbind.c Tue Oct 12 21:41:18 2010 +0900 @@ -1571,7 +1571,7 @@ /* Check, whether there is pending input in the message queue of the D-Bus BUS. BUS is a Lisp symbol, either :system or :session. */ -int +static Lisp_Object xd_get_dispatch_status (bus) Lisp_Object bus; { @@ -1587,23 +1587,34 @@ return (dbus_connection_get_dispatch_status (connection) == DBUS_DISPATCH_DATA_REMAINS) - ? TRUE : FALSE; + ? Qt : Qnil; } /* Check for queued incoming messages from the system and session buses. */ int xd_pending_messages () { + int ret = FALSE; + xd_in_read_queued_messages = 1; /* Vdbus_registered_objects_table will be initialized as hash table in dbus.el. When this package isn't loaded yet, it doesn't make sense to handle D-Bus messages. */ - return (HASH_TABLE_P (Vdbus_registered_objects_table) - ? (xd_get_dispatch_status (QCdbus_system_bus) - || ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL) - ? xd_get_dispatch_status (QCdbus_session_bus) - : FALSE)) - : FALSE); + if (HASH_TABLE_P (Vdbus_registered_objects_table)) + { + ret = (!NILP (internal_catch (Qdbus_error, xd_get_dispatch_status, + QCdbus_system_bus))); + if (ret) goto theend; + + ret = ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL) && + (!NILP (internal_catch (Qdbus_error, xd_get_dispatch_status, + QCdbus_session_bus)))); + } + + /* Return. */ + theend: + xd_in_read_queued_messages = 0; + return ret; } /* Read queued incoming message of the D-Bus BUS. BUS is a Lisp
--- a/src/nsterm.m Fri Oct 08 11:23:11 2010 +0900 +++ b/src/nsterm.m Tue Oct 12 21:41:18 2010 +0900 @@ -142,13 +142,18 @@ Lisp_Object Vx_toolkit_scroll_bars; static Lisp_Object Qmodifier_value; Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper, Qnone; -extern Lisp_Object Qcursor_color, Qcursor_type, Qns; +extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft; /* Specifies which emacs modifier should be generated when NS receives the Alternate modifer. May be Qnone or any of the modifier lisp symbols. */ Lisp_Object ns_alternate_modifier; /* Specifies which emacs modifier should be generated when NS receives + the right Alternate modifer. Has same values as ns_alternate_modifier plus + the value Qleft which means whatever value ns_alternate_modifier has. */ +Lisp_Object ns_right_alternate_modifier; + +/* Specifies which emacs modifier should be generated when NS receives the Command modifer. May be any of the modifier lisp symbols. */ Lisp_Object ns_command_modifier; @@ -218,12 +223,17 @@ /* Convert modifiers in a NeXTSTEP event to emacs style modifiers. */ #define NS_FUNCTION_KEY_MASK 0x800000 +#define NSRightAlternateKeyMask (0x000040 | NSAlternateKeyMask) #define EV_MODIFIERS(e) \ ((([e modifierFlags] & NSHelpKeyMask) ? \ hyper_modifier : 0) \ - | (([e modifierFlags] & NSAlternateKeyMask) ? \ + | (!EQ (ns_right_alternate_modifier, Qleft) && \ + (([e modifierFlags] & NSRightAlternateKeyMask) \ + == NSRightAlternateKeyMask) ? \ + parse_solitary_modifier (ns_right_alternate_modifier) : 0) \ + | (([e modifierFlags] & NSAlternateKeyMask) ? \ parse_solitary_modifier (ns_alternate_modifier) : 0) \ - | (([e modifierFlags] & NSShiftKeyMask) ? \ + | (([e modifierFlags] & NSShiftKeyMask) ? \ shift_modifier : 0) \ | (([e modifierFlags] & NSControlKeyMask) ? \ parse_solitary_modifier (ns_control_modifier) : 0) \ @@ -4423,7 +4433,13 @@ emacs_event->modifiers |= parse_solitary_modifier (ns_function_modifier); - if (flags & NSAlternateKeyMask) /* default = meta */ + if (!EQ (ns_right_alternate_modifier, Qleft) + && ((flags & NSRightAlternateKeyMask) == NSRightAlternateKeyMask)) + { + emacs_event->modifiers |= parse_solitary_modifier + (ns_right_alternate_modifier); + } + else if (flags & NSAlternateKeyMask) /* default = meta */ { if ((NILP (ns_alternate_modifier) || EQ (ns_alternate_modifier, Qnone)) && !fnKeysym) @@ -6185,6 +6201,14 @@ at all, allowing it to be used at a lower level for accented character entry."); ns_alternate_modifier = Qmeta; + DEFVAR_LISP ("ns-right-alternate-modifier", &ns_right_alternate_modifier, + "This variable describes the behavior of the right alternate or option key.\n\ +Set to control, meta, alt, super, or hyper means it is taken to be that key.\n\ +Set to left means be the same key as `ns-alternate-modifier'.\n\ +Set to none means that the alternate / option key is not interpreted by Emacs\n\ +at all, allowing it to be used at a lower level for accented character entry."); + ns_right_alternate_modifier = Qleft; + DEFVAR_LISP ("ns-command-modifier", &ns_command_modifier, "This variable describes the behavior of the command key.\n\ Set to control, meta, alt, super, or hyper means it is taken to be that key.");