[COMMIT] Turns out #elsif is not valid preprocessor syntax, who knew!
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1284829348 -3600
# Node ID d0bc331e433f81324b6959493c0d1420017e02d5
# Parent d9e65b48e2bf8dc87623aacee247c933755a4ee6
Turns out #elsif is not valid preprocessor syntax, who knew!
src/ChangeLog addition:
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
Turns out #elsif is not valid preprocessor syntax, who knew!
diff -r d9e65b48e2bf -r d0bc331e433f src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 16:46:56 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 18:02:28 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (PARSE_KEYWORDS):
+ Turns out #elsif is not valid preprocessor syntax, who knew!
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
diff -r d9e65b48e2bf -r d0bc331e433f src/lisp.h
--- a/src/lisp.h Sat Sep 18 16:46:56 2010 +0100
+++ b/src/lisp.h Sat Sep 18 18:02:28 2010 +0100
＠＠ -3554,19 +3554,21 ＠＠
(intern_massaging_name (1 + #function))), \
0); \
assert (0 == strcmp (__func__, #function))
-#elsif defined (NEW_GC)
+#else /* defined (DEBUG_XEMACS) && ... */
+#ifdef NEW_GC
#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
keyword_defaults) \
PARSE_KEYWORDS_8 (intern (S##function->name), nargs, args, \
keyword_count, keywords, \
keyword_defaults, S##function->min_args, 0)
-#else
+#else /* NEW_GC */
#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
keyword_defaults) \
PARSE_KEYWORDS_8 (intern (S##function.name), nargs, args, \
keyword_count, keywords, \
keyword_defaults, S##function.min_args, 0)
-#endif
+#endif /* NEW_GC */
+#endif /* defined (DEBUG_XEMACS) && defined (__STDC_VERSION__) ... */
/* PARSE_KEYWORDS_8 is a more fine-grained version of PARSE_KEYWORDS. The
differences are as follows:
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Transform safe calls to (= X Y Z) to (and (= X Y) (= Y Z)); same for < > <= >=
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
changeset: 5266:f9ec07abdbf9
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 14:31:40 2010 +0100
files: lisp/ChangeLog lisp/cl-macs.el lisp/mule/mule-cmds.el
description:
Transform safe calls to (= X Y Z) to (and (= X Y) (= Y Z)); same for < > <= >=
lisp/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
diff -r 5663ae9a8989 -r f9ec07abdbf9 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 14:10:44 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 14:31:40 2010 +0100
＠＠ -1,3 +1,13 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (= < > <= >=):
+ When these functions are handed more than two arguments, and those
+ arguments have no side effects, transform to a series of two
+ argument calls, avoiding funcall in the byte-compiled code.
+ * mule/mule-cmds.el (finish-set-language-environment):
+ Take advantage of this change in a function called 256 times at
+ startup.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
diff -r 5663ae9a8989 -r f9ec07abdbf9 lisp/cl-macs.el
--- a/lisp/cl-macs.el Thu Sep 16 14:10:44 2010 +0100
+++ b/lisp/cl-macs.el Thu Sep 16 14:31:40 2010 +0100
＠＠ -3773,6 +3773,25 ＠＠
(string (cons 'concat (cddr form))))
form))
+(map nil
+ #'(lambda (function)
+ ;; There are byte codes for the two-argument versions of these
+ ;; functions; if the form has more arguments and those arguments
+ ;; have no side effects, transform to a series of two-argument
+ ;; calls.
+ (put function 'cl-compiler-macro
+ #'(lambda (form &rest arguments)
+ (if (or (null (nthcdr 3 form))
+ (notevery #'cl-safe-expr-p (cdr form)))
+ form
+ (cons 'and (mapcon
+ #'(lambda (rest)
+ (and (cdr rest)
+ `((,(car form) ,(pop rest)
+ ,(car rest)))))
+ (cdr form)))))))
+ '(= < > <= >=))
+
(mapc
#'(lambda (y)
(put (car y) 'side-effect-free t)
diff -r 5663ae9a8989 -r f9ec07abdbf9 lisp/mule/mule-cmds.el
--- a/lisp/mule/mule-cmds.el Thu Sep 16 14:10:44 2010 +0100
+++ b/lisp/mule/mule-cmds.el Thu Sep 16 14:31:40 2010 +0100
＠＠ -789,8 +789,7 ＠＠
(setq string (format "%c" unicode-error-lookup)))
;; Treat control characters specially:
(setq first-char (aref string 0))
- (when (or (and (>= first-char #x00) (<= first-char #x1f))
- (and (>= first-char #x80) (<= first-char #x9f)))
+ (when (or (<= #x00 first-char #x1f) (<= #x80 first-char #x9f))
(setq string (format "^%c" (+ ?＠ (aref string 0))))))
(setq glyph (make-glyph (vector 'string :data string)))
(set-glyph-face glyph 'unicode-invalid-sequence-warning-face)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
commit: Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
changeset: 5264:0d43872986b6
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 13:51:49 2010 +0100
files: lisp/ChangeLog lisp/byte-optimize.el lisp/bytecomp-runtime.el lisp/device.el lisp/dumped-lisp.el lisp/etags.el lisp/extents.el lisp/frame.el lisp/packages.el lisp/update-elc.el
description:
Change (apply 'nconc (mapcar ...)) to (mapcan ...); warn about first form.
lisp/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
diff -r 0d436a78c514 -r 0d43872986b6 lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 13:51:49 2010 +0100
＠＠ -1,3 +1,22 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
+ (mapcar ...)) to (mapcan ...); warn about use of the first idiom.
+
+ * update-elc.el (do-autoload-commands):
+ * packages.el (packages-find-package-library-path):
+ * frame.el (frame-list):
+ * extents.el (extent-descendants):
+ * etags.el (buffer-tag-table-files):
+ * dumped-lisp.el (preloaded-file-list):
+ * device.el (device-list):
+ * bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
+ Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
+
+ * bytecomp-runtime.el (eval-when-compile, eval-and-compile):
+ In passing, mention that these macros also evaluate the body when
+ interpreted.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (the): Add a docstring and an implementation for this
diff -r 0d436a78c514 -r 0d43872986b6 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/byte-optimize.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -1119,17 +1119,26 ＠＠
;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
(let ((fn (nth 1 form))
(last (nth (1- (length form)) form))) ; I think this really is fastest
- (or (if (or (null last)
- (eq (car-safe last) 'quote))
- (if (listp (nth 1 last))
- (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
- (nconc (list 'funcall fn) butlast
- (mapcar #'(lambda (x) (list 'quote x)) (nth 1 last))))
- (byte-compile-warn
- "last arg to apply can't be a literal atom: %s"
- (prin1-to-string last))
- nil))
- form)))
+ (if (and (eq last (third form))
+ (consp last)
+ (eq 'mapcar (car last))
+ (equal fn ''nconc))
+ (progn
+ (byte-compile-warn
+ "(apply 'nconc (mapcar ..)), use #'mapcan instead: %s" last)
+ (cons 'mapcan (cdr last)))
+ (or (if (or (null last)
+ (eq (car-safe last) 'quote))
+ (if (listp (nth 1 last))
+ (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
+ (nconc (list 'funcall fn) butlast
+ (mapcar #'(lambda (x) (list 'quote x))
+ (nth 1 last))))
+ (byte-compile-warn
+ "last arg to apply can't be a literal atom: %s"
+ (prin1-to-string last))
+ nil))
+ form))))
(put 'funcall 'byte-optimizer 'byte-optimize-funcall)
(put 'apply 'byte-optimizer 'byte-optimize-apply)
diff -r 0d436a78c514 -r 0d43872986b6 lisp/bytecomp-runtime.el
--- a/lisp/bytecomp-runtime.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/bytecomp-runtime.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -53,30 +53,26 ＠＠
"Cause the named functions to be open-coded when called from compiled code.
They will only be compiled open-coded when `byte-optimize' is true."
(cons 'eval-and-compile
- (apply
- 'nconc
- (mapcar
- #'(lambda (x)
- `((or (memq (get ',x 'byte-optimizer)
- '(nil byte-compile-inline-expand))
- (error
- "%s already has a byte-optimizer, can't make it inline"
- ',x))
- (put ',x 'byte-optimizer 'byte-compile-inline-expand)))
- fns))))
+ (mapcan
+ #'(lambda (x)
+ `((or (memq (get ',x 'byte-optimizer)
+ '(nil byte-compile-inline-expand))
+ (error
+ "%s already has a byte-optimizer, can't make it inline"
+ ',x))
+ (put ',x 'byte-optimizer 'byte-compile-inline-expand)))
+ fns)))
(defmacro proclaim-notinline (&rest fns)
"Cause the named functions to no longer be open-coded."
(cons 'eval-and-compile
- (apply
- 'nconc
- (mapcar
- #'(lambda (x)
- `((if (eq (get ',x 'byte-optimizer)
- 'byte-compile-inline-expand)
- (put ',x 'byte-optimizer nil))))
- fns))))
+ (mapcan
+ #'(lambda (x)
+ `((if (eq (get ',x 'byte-optimizer)
+ 'byte-compile-inline-expand)
+ (put ',x 'byte-optimizer nil))))
+ fns)))
;; This has a special byte-hunk-handler in bytecomp.el.
(defmacro defsubst (name arglist &rest body)
＠＠ -163,7 +159,7 ＠＠
(put 'eval-when-compile 'lisp-indent-hook 0)
(defmacro eval-when-compile (&rest body)
- "Like `progn', but evaluates the body at compile time.
+ "Like `progn', but evaluates BODY at compile time, and when interpeted.
The result of the body appears to the compiler as a quoted constant."
;; Not necessary because we have it in b-c-initial-macro-environment
;; (list 'quote (eval (cons 'progn body)))
＠＠ -171,7 +167,8 ＠＠
(put 'eval-and-compile 'lisp-indent-hook 0)
(defmacro eval-and-compile (&rest body)
- "Like `progn', but evaluates the body at compile time and at load time."
+ "Like `progn', but evaluates the body at compile time and at load time,
+and when interpreted."
;; Remember, it's magic.
(cons 'progn body))
diff -r 0d436a78c514 -r 0d43872986b6 lisp/device.el
--- a/lisp/device.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/device.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -45,7 +45,7 ＠＠
(defun device-list ()
"Return a list of all devices."
- (apply 'nconc (mapcar 'console-device-list (console-list))))
+ (mapcan 'console-device-list (console-list)))
(defun device-type (&optional device)
"Return the type of the specified device (e.g. `x' or `tty').
diff -r 0d436a78c514 -r 0d43872986b6 lisp/dumped-lisp.el
--- a/lisp/dumped-lisp.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/dumped-lisp.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -300,7 +300,4 ＠＠
))
(setq preloaded-file-list
- (apply #'nconc
- (mapcar #'(lambda (x)
- (if (listp x) x (list x)))
- preloaded-file-list)))
+ (mapcan #'(lambda (x) (if (listp x) x (list x))) preloaded-file-list))
diff -r 0d436a78c514 -r 0d43872986b6 lisp/etags.el
--- a/lisp/etags.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/etags.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -439,8 +439,7 ＠＠
(defun buffer-tag-table-files ()
"Returns a list of all files referenced by all TAGS tables that
this buffer uses."
- (apply #'append
- (mapcar #'tag-table-files (buffer-tag-table-list))))
+ (mapcan #'tag-table-files (buffer-tag-table-list)))
;; Building the completion table
diff -r 0d436a78c514 -r 0d43872986b6 lisp/extents.el
--- a/lisp/extents.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/extents.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -109,7 +109,7 ＠＠
EXTENT, until no more children can be found."
(let ((children (extent-children extent)))
(if children
- (apply 'nconc (mapcar 'extent-descendants children))
+ (mapcan 'extent-descendants children)
(list extent))))
(defun set-extent-keymap (extent keymap)
diff -r 0d436a78c514 -r 0d43872986b6 lisp/frame.el
--- a/lisp/frame.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/frame.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -861,7 +861,7 ＠＠
(defun frame-list ()
"Return a list of all frames on all devices/consoles."
;; Lists are copies, so nconc is safe here.
- (apply 'nconc (mapcar 'device-frame-list (device-list))))
+ (mapcan #'device-frame-list (device-list)))
(defun frame-type (&optional frame)
"Return the type of the specified frame (e.g. `x' or `tty').
diff -r 0d436a78c514 -r 0d43872986b6 lisp/packages.el
--- a/lisp/packages.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/packages.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -467,13 +467,11 ＠＠
PACKAGE-HIERARCHIES is a list of package hierarchies.
SUFFIXES is a list of names of hierarchy subdirectories to look for."
(let ((directories
- (apply
- #'nconc
- (mapcar #'(lambda (hierarchy)
- (mapcar #'(lambda (suffix)
- (file-name-as-directory (concat hierarchy suffix)))
- suffixes))
- package-hierarchies))))
+ (mapcan #'(lambda (hierarchy)
+ (mapcar #'(lambda (suffix)
+ (file-name-as-directory (concat hierarchy suffix)))
+ suffixes))
+ package-hierarchies)))
(paths-directories-which-exist directories)))
(defun packages-find-package-load-path (package-hierarchies)
diff -r 0d436a78c514 -r 0d43872986b6 lisp/update-elc.el
--- a/lisp/update-elc.el Thu Sep 16 13:36:03 2010 +0100
+++ b/lisp/update-elc.el Thu Sep 16 13:51:49 2010 +0100
＠＠ -367,21 +367,19 ＠＠
;; load-ignore-elc-files because byte-optimize gets autoloaded
;; from bytecomp.
(let ((recompile-bc-bootstrap
- (apply #'nconc
- (mapcar
- #'(lambda (arg)
- (when (member arg update-elc-files-to-compile)
- (append '("-f" "batch-byte-compile-one-file")
- (list arg))))
- bc-bootstrap)))
+ (mapcan
+ #'(lambda (arg)
+ (when (member arg update-elc-files-to-compile)
+ (append '("-f" "batch-byte-compile-one-file")
+ (list arg))))
+ bc-bootstrap))
(recompile-bootstrap-other
- (apply #'nconc
- (mapcar
- #'(lambda (arg)
- (when (member arg update-elc-files-to-compile)
- (append '("-f" "batch-byte-compile-one-file")
- (list arg))))
- bootstrap-other))))
+ (mapcan
+ #'(lambda (arg)
+ (when (member arg update-elc-files-to-compile)
+ (append '("-f" "batch-byte-compile-one-file")
+ (list arg))))
+ bootstrap-other)))
(mapc
#'(lambda (arg)
(setq update-elc-files-to-compile
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
commit: Change forms like (delq nil (mapcar ...)) to (mapcan ...).
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
changeset: 5267:668c73e222fd
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 15:06:38 2010 +0100
files: lisp/ChangeLog lisp/minibuf.el lisp/modeline.el lisp/msw-faces.el lisp/package-ui.el lisp/specifier.el lisp/x-faces.el
description:
Change forms like (delq nil (mapcar ...)) to (mapcan ...).
lisp/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/ChangeLog
--- a/lisp/ChangeLog Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/ChangeLog Thu Sep 16 15:06:38 2010 +0100
＠＠ -1,3 +1,14 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * x-faces.el (x-available-font-sizes):
+ * specifier.el (let-specifier):
+ * package-ui.el (pui-add-required-packages):
+ * msw-faces.el (mswindows-available-font-sizes):
+ * modeline.el (modeline-minor-mode-menu):
+ * minibuf.el (minibuf-directory-files):
+ Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
+ the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (= < > <= >=):
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/minibuf.el
--- a/lisp/minibuf.el Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/minibuf.el Thu Sep 16 15:06:38 2010 +0100
＠＠ -1569,12 +1569,13 ＠＠
(defun minibuf-directory-files (dir &optional match-regexp files-only)
(let ((want-file (or (eq files-only nil) (eq files-only t)))
(want-dirs (or (eq files-only nil) (not (eq files-only t)))))
- (delete nil
- (mapcar (function (lambda (f)
- (if (file-directory-p (expand-file-name f dir))
- (and want-dirs (file-name-as-directory f))
- (and want-file f))))
- (delete "." (directory-files dir nil match-regexp))))))
+ (mapcan
+ #'(lambda (f)
+ (and (not (equal "." f))
+ (if (file-directory-p (expand-file-name f dir))
+ (and want-dirs (list (file-name-as-directory f)))
+ (and want-file (list f)))))
+ (directory-files dir nil match-regexp))))
(defun read-file-name-2 (history prompt dir default
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/modeline.el
--- a/lisp/modeline.el Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/modeline.el Thu Sep 16 15:06:38 2010 +0100
＠＠ -524,35 +524,31 ＠＠
(cons
"Minor Mode Toggles"
(sort
- (delq nil (mapcar
- #'(lambda (x)
- (let* ((toggle-sym (car x))
- (toggle-fun (or (get toggle-sym
- 'modeline-toggle-function)
- (and (commandp toggle-sym)
- toggle-sym)))
- (menu-tag (symbol-name (if (symbolp toggle-fun)
- toggle-fun
- toggle-sym))
- ;; Here a function should
- ;; maybe be invoked to
- ;; beautify the symbol's
- ;; menu appearance.
- ))
- (and toggle-fun
- (vector menu-tag
- toggle-fun
- ;; The following two are wrong
- ;; because of possible name
- ;; clashes.
- ;:active (get toggle-sym :active t)
- ;:included (get toggle-sym :included t)
- :style 'toggle
- :selected (and (boundp toggle-sym)
- toggle-sym)))))
- minor-mode-alist))
- (lambda (e1 e2)
- (string< (aref e1 0) (aref e2 0)))))
+ (mapcan
+ #'(lambda (x)
+ (let* ((toggle-sym (car x))
+ (toggle-fun (or (get toggle-sym
+ 'modeline-toggle-function)
+ (and (commandp toggle-sym)
+ toggle-sym)))
+ (menu-tag (symbol-name (if (symbolp toggle-fun)
+ toggle-fun
+ toggle-sym))
+ ;; Here a function should maybe be invoked to
+ ;; beautify the symbol's menu appearance.
+ ))
+ (and toggle-fun
+ (list (vector menu-tag
+ toggle-fun
+ ;; The following two are wrong because of
+ ;; possible name clashes.
+ ;:active (get toggle-sym :active t)
+ ;:included (get toggle-sym :included t)
+:style 'toggle
+:selected (and (boundp toggle-sym)
+ toggle-sym))))))
+ minor-mode-alist)
+ (lambda (e1 e2) (string< (aref e1 0) (aref e2 0)))))
event)))
(defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map)
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/msw-faces.el
--- a/lisp/msw-faces.el Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/msw-faces.el Thu Sep 16 15:06:38 2010 +0100
＠＠ -268,12 +268,11 ＠＠
(concat (substring font 0 (match-beginning 3))
(substring font (match-end 3) (match-end 0))))
(sort
- (delq nil
- (mapcar #'(lambda (name)
- (and (string-match mswindows-font-regexp name)
- (string-to-int (substring name (match-beginning 3)
- (match-end 3)))))
- (font-list font device)))
+ (mapcan #'(lambda (name)
+ (and (string-match mswindows-font-regexp name)
+ (list (string-to-int (substring name (match-beginning 3)
+ (match-end 3))))))
+ (font-list font device))
#'<))
(defun mswindows-frob-font-size (font up-p device)
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/package-ui.el
--- a/lisp/package-ui.el Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/package-ui.el Thu Sep 16 15:06:38 2010 +0100
＠＠ -408,26 +408,25 ＠＠
(let ((tmpbuf "*Required-Packages*") do-select)
(if pui-selected-packages
(let ((dependencies
- (delq nil (mapcar
- (lambda (pkg)
- (let ((installed
- (package-get-key pkg :version))
- (current
- (package-get-info-prop
- (package-get-info-version
- (package-get-info-find-package
- package-get-base pkg) nil)
- 'version)))
- (if (or (null installed)
- (< (if (stringp installed)
- (string-to-number installed)
- installed)
- (if (stringp current)
- (string-to-number current)
- current)))
- pkg
- nil)))
- (package-get-dependencies pui-selected-packages)))))
+ (mapcan
+ (lambda (pkg)
+ (let ((installed
+ (package-get-key pkg :version))
+ (current
+ (package-get-info-prop
+ (package-get-info-version
+ (package-get-info-find-package
+ package-get-base pkg) nil)
+ 'version)))
+ (if (or (null installed)
+ (< (if (stringp installed)
+ (string-to-number installed)
+ installed)
+ (if (stringp current)
+ (string-to-number current)
+ current)))
+ (list pkg))))
+ (package-get-dependencies pui-selected-packages))))
;; Don't change window config when asking the user if he really
;; wants to add the packages. We do this to avoid messing up
;; the window configuration if errors occur (we don't want to
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/specifier.el
--- a/lisp/specifier.el Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/specifier.el Thu Sep 16 15:06:38 2010 +0100
＠＠ -521,10 +521,9 ＠＠
varlist)))
;; Bind the appropriate variables.
`(let* (,＠(mapcan #'(lambda (varel)
- (delq nil (mapcar
- #'(lambda (varcons)
- (and (cdr varcons) varcons))
- varel)))
+ (mapcan #'(lambda (varcons)
+ (and (cdr varcons) (list varcons)))
+ varel))
varlist)
,＠oldvallist)
(unwind-protect
diff -r f9ec07abdbf9 -r 668c73e222fd lisp/x-faces.el
--- a/lisp/x-faces.el Thu Sep 16 14:31:40 2010 +0100
+++ b/lisp/x-faces.el Thu Sep 16 15:06:38 2010 +0100
＠＠ -434,17 +434,17 ＠＠
(concat (substring font 0 (match-beginning 1)) "*"
(substring font (match-end 1) (match-end 0))))))
(sort
- (delq nil
- (mapcar (function
- (lambda (name)
- (and (string-match x-font-regexp name)
- (list
- (string-to-int (substring name (match-beginning 5)
- (match-end 5)))
- (string-to-int (substring name (match-beginning 6)
- (match-end 6)))
- name))))
- (font-list font device)))
+ (mapcan (function
+ (lambda (name)
+ (and (string-match x-font-regexp name)
+ (list
+ (list
+ (string-to-int (substring name (match-beginning 5)
+ (match-end 5)))
+ (string-to-int (substring name (match-beginning 6)
+ (match-end 6)))
+ name)))))
+ (font-list font device))
(function (lambda (x y) (if (= (nth 1 x) (nth 1 y))
(< (nth 0 x) (nth 0 y))
(< (nth 1 x) (nth 1 y)))))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
commit: Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
changeset: 5273:799742b751c8
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Thu Sep 16 20:34:49 2010 +0100
files: lisp/cl-extra.el src/ChangeLog src/fns.c
description:
Accept circular lists where that is useful in #'mapcar*, #'map* and friends.
src/ChangeLog addition:
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Flist_length): New, moved here from cl-extra.el, needed
by the next function.
(shortest_length_among_sequences): New.
(Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
(Fmap_into, Fsome, Fevery):
Use shortest_length_among_sequences() when working out how many
iterations to do, only giving circular list errors if all
arguments are circular.
diff -r 66dbef5f8076 -r 799742b751c8 lisp/cl-extra.el
--- a/lisp/cl-extra.el Thu Sep 16 18:46:05 2010 +0100
+++ b/lisp/cl-extra.el Thu Sep 16 20:34:49 2010 +0100
＠＠ -405,13 +405,6 ＠＠
"Equivalent to (nconc (nreverse X) Y)."
(nconc (nreverse x) y))
-(defun list-length (list)
- "Return the length of LIST. Return nil if LIST is circular."
- (if (listp list)
- (condition-case nil (length list) (circular-list))
- ;; Error on not-a-list:
- (car list)))
-
(defun tailp (sublist list)
"Return true if SUBLIST is a tail of LIST."
(while (and (consp list) (not (eq sublist list)))
diff -r 66dbef5f8076 -r 799742b751c8 src/ChangeLog
--- a/src/ChangeLog Thu Sep 16 18:46:05 2010 +0100
+++ b/src/ChangeLog Thu Sep 16 20:34:49 2010 +0100
＠＠ -1,3 +1,14 ＠＠
+2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Flist_length): New, moved here from cl-extra.el, needed
+ by the next function.
+ (shortest_length_among_sequences): New.
+ (Fmapconcat, FmapcarX, Fmapvector, Fmapcan, Fmapc, Fmap)
+ (Fmap_into, Fsome, Fevery):
+ Use shortest_length_among_sequences() when working out how many
+ iterations to do, only giving circular list errors if all
+ arguments are circular.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsubseq):
diff -r 66dbef5f8076 -r 799742b751c8 src/fns.c
--- a/src/fns.c Thu Sep 16 18:46:05 2010 +0100
+++ b/src/fns.c Thu Sep 16 20:34:49 2010 +0100
＠＠ -337,6 +337,29 ＠＠
}
return make_int (len);
+}
+
+/* This is almost the above, but is defined by Common Lisp. We need it in C
+ for shortest_length_among_sequences(), below, for the various sequence
+ functions that can usefully operate on circular lists. */
+
+DEFUN ("list-length", Flist_length, 1, 1, 0, /*
+Return the length of LIST. Return nil if LIST is circular.
+*/
+ (list))
+{
+ Lisp_Object hare, tortoise;
+ Elemcount len;
+
+ for (hare = tortoise = list, len = 0;
+ CONSP (hare) && (! EQ (hare, tortoise) || len == 0);
+ hare = XCDR (hare), len++)
+ {
+ if (len & 1)
+ tortoise = XCDR (tortoise);
+ }
+
+ return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
}
/*** string functions. ***/
＠＠ -4458,6 +4481,42 ＠＠
UNGCPRO;
}
+/* Given NSEQUENCES objects at the address pointed to by SEQUENCES, return
+ the length of the shortest sequence. Error if all are circular, or if any
+ one of them is not a sequence. */
+static Elemcount
+shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
+{
+ Elemcount len = EMACS_INT_MAX;
+ Lisp_Object length;
+ int i;
+
+ for (i = 0; i < nsequences; ++i)
+ {
+ if (CONSP (sequences[i]))
+ {
+ length = Flist_length (sequences[i]);
+ if (!NILP (length))
+ {
+ len = min (len, XINT (length));
+ }
+ }
+ else
+ {
+ CHECK_SEQUENCE (sequences[i]);
+ length = Flength (sequences[i]);
+ len = min (len, XINT (length));
+ }
+ }
+
+ if (NILP (length))
+ {
+ signal_circular_list_error (sequences[0]);
+ }
+
+ return len;
+}
+
DEFUN ("mapconcat", Fmapconcat, 3, MANY, 0, /*
Call FUNCTION on each element of SEQUENCE, and concat results to a string.
Between each pair of results, insert SEPARATOR.
＠＠ -4485,11 +4544,7 ＠＠
args[2] = sequence;
args[1] = separator;
- for (i = 2; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ len = shortest_length_among_sequences (nargs - 2, args + 2);
if (len == 0) return build_ascstring ("");
＠＠ -4536,15 +4591,8 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object function = args[0];
- Elemcount len = EMACS_INT_MAX;
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
Lisp_Object *args0;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
args0 = alloca_array (Lisp_Object, len);
mapcarX (len, args0, Qnil, function, nargs - 1, args + 1, QmapcarX);
＠＠ -4567,18 +4615,10 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object function = args[0];
- Elemcount len = EMACS_INT_MAX;
- Lisp_Object result;
- struct gcpro gcpro1;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
- result = make_vector (len, Qnil);
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
+ Lisp_Object result = make_vector (len, Qnil);
+
+ struct gcpro gcpro1;
GCPRO1 (result);
/* Don't pass result as the lisp_object argument, we want mapcarX to protect
a single list argument's elements from being garbage-collected. */
＠＠ -4602,21 +4642,13 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Lisp_Object function = args[0], *result;
- Elemcount result_len = EMACS_INT_MAX;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- result_len = min (result_len, XINT (Flength (args[i])));
- }
-
- result = alloca_array (Lisp_Object, result_len);
- mapcarX (result_len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
+ Lisp_Object function = args[0], *result = alloca_array (Lisp_Object, len);
+
+ mapcarX (len, result, Qnil, function, nargs - 1, args + 1, Qmapcan);
/* #'nconc GCPROs its args in case of signals and error. */
- return Fnconc (result_len, result);
+ return Fnconc (len, result);
}
DEFUN ("mapc", Fmapc, 2, MANY, 0, /*
＠＠ -4637,17 +4669,9 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Elemcount len = EMACS_INT_MAX;
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
Lisp_Object sequence = args[1];
struct gcpro gcpro1;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
-
/* We need to GCPRO sequence, because mapcarX will modify the
elements of the args array handed to it, and this may involve
elements of sequence getting garbage collected. */
＠＠ -4677,15 +4701,8 ＠＠
Lisp_Object function = args[1];
Lisp_Object result = Qnil;
Lisp_Object *args0 = NULL;
- Elemcount len = EMACS_INT_MAX;
- int i;
- struct gcpro gcpro1;
-
- for (i = 2; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ Elemcount len = shortest_length_among_sequences (nargs - 2, args + 2);
+ struct gcpro gcpro1;
if (!NILP (type))
{
＠＠ -4742,19 +4759,14 ＠＠
*/
(int nargs, Lisp_Object *args))
{
- Elemcount len = EMACS_INT_MAX;
+ Elemcount len;
Lisp_Object result_sequence = args[0];
Lisp_Object function = args[1];
- int i;
args[0] = function;
args[1] = result_sequence;
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ len = shortest_length_among_sequences (nargs - 1, args + 1);
mapcarX (len, NULL, result_sequence, function, nargs - 2, args + 2,
Qmap_into);
＠＠ -4776,14 +4788,7 ＠＠
{
Lisp_Object result = Qnil,
result_ptr = STORE_VOID_IN_LISP ((void *) &result);
- Elemcount len = EMACS_INT_MAX;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qsome);
＠＠ -4803,14 +4808,7 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object result = Qt, result_ptr = STORE_VOID_IN_LISP ((void *) &result);
- Elemcount len = EMACS_INT_MAX;
- int i;
-
- for (i = 1; i < nargs; ++i)
- {
- CHECK_SEQUENCE (args[i]);
- len = min (len, XINT (Flength (args[i])));
- }
+ Elemcount len = shortest_length_among_sequences (nargs - 1, args + 1);
mapcarX (len, NULL, result_ptr, args[0], nargs - 1, args +1, Qevery);
＠＠ -6683,6 +6681,7 ＠＠
DEFSUBR (Frandom);
DEFSUBR (Flength);
DEFSUBR (Fsafe_length);
+ DEFSUBR (Flist_length);
DEFSUBR (Fstring_equal);
DEFSUBR (Fcompare_strings);
DEFSUBR (Fstring_lessp);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 2 participants
- 2 comments
[COMMIT] Correct the NEW_GC non-DEBUG_XEMACS version of PARSE_KEYWORDS().
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1284824816 -3600
# Node ID d9e65b48e2bf8dc87623aacee247c933755a4ee6
# Parent d804e621add0b33e60593fbe94da0e45945f895e
Correct the NEW_GC non-DEBUG_XEMACS version of PARSE_KEYWORDS().
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under
such builds S##function is a pointer, not a Lisp_Subr structure.
diff -r d804e621add0 -r d9e65b48e2bf src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 15:57:20 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 16:46:56 2010 +0100
＠＠ -1,3 +1,9 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (PARSE_KEYWORDS):
+ Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under
+ such builds S##function is a pointer, not a Lisp_Subr structure.
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
Simplify the API of PARSE_KEYWORDS for callers.
diff -r d804e621add0 -r d9e65b48e2bf src/lisp.h
--- a/src/lisp.h Sat Sep 18 15:57:20 2010 +0100
+++ b/src/lisp.h Sat Sep 18 16:46:56 2010 +0100
＠＠ -3554,6 +3554,12 ＠＠
(intern_massaging_name (1 + #function))), \
0); \
assert (0 == strcmp (__func__, #function))
+#elsif defined (NEW_GC)
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern (S##function->name), nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, S##function->min_args, 0)
#else
#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
keyword_defaults) \
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Correct the NEW_GC non-DEBUG_XEMACS version of PARSE_KEYWORDS().
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
changeset: 5278:d9e65b48e2bf
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Sep 18 16:46:56 2010 +0100
files: src/ChangeLog src/lisp.h
description:
Correct the NEW_GC non-DEBUG_XEMACS version of PARSE_KEYWORDS().
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (PARSE_KEYWORDS):
Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under
such builds S##function is a pointer, not a Lisp_Subr structure.
diff -r d804e621add0 -r d9e65b48e2bf src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 15:57:20 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 16:46:56 2010 +0100
＠＠ -1,3 +1,9 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h (PARSE_KEYWORDS):
+ Correct the NEW_GC non-DEBUG_XEMACS version of this macro; under
+ such builds S##function is a pointer, not a Lisp_Subr structure.
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
Simplify the API of PARSE_KEYWORDS for callers.
diff -r d804e621add0 -r d9e65b48e2bf src/lisp.h
--- a/src/lisp.h Sat Sep 18 15:57:20 2010 +0100
+++ b/src/lisp.h Sat Sep 18 16:46:56 2010 +0100
＠＠ -3554,6 +3554,12 ＠＠
(intern_massaging_name (1 + #function))), \
0); \
assert (0 == strcmp (__func__, #function))
+#elsif defined (NEW_GC)
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern (S##function->name), nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, S##function->min_args, 0)
#else
#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
keyword_defaults) \
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Simplify the API of PARSE_KEYWORDS for callers.
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1284821840 -3600
# Node ID d804e621add0b33e60593fbe94da0e45945f895e
# Parent dd2976af8783fb6a2dead2e09ede9e6bc9aec617
Simplify the API of PARSE_KEYWORDS for callers.
src/ChangeLog addition:
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
Simplify the API of PARSE_KEYWORDS for callers.
* lisp.h (PARSE_KEYWORDS): Simply the API, while making the
implementation a little more complex; work out KEYWORDS_OFFSET
from the appropriate Lisp_Subr struct, take the function name as
the C name of the DEFUN rather than a symbol visible as a
Lisp_Object, on debug builds assert that we're actually in the
function so we choke on badly-done copy-and-pasting,
* lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS.
* fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace):
Change to use the new PARSE_KEYWORDS syntax.
* elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS
syntax, rename a define to correspond to what other files use.
* symbols.c (intern_massaging_name):
* buffer.c (ADD_INT):
Rename intern_converting_underscores_to_dashes() to
intern_massaging_name(), now it does a little more.
diff -r dd2976af8783 -r d804e621add0 src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 15:03:54 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 15:57:20 2010 +0100
＠＠ -1,3 +1,26 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Simplify the API of PARSE_KEYWORDS for callers.
+
+ * lisp.h (PARSE_KEYWORDS): Simply the API, while making the
+ implementation a little more complex; work out KEYWORDS_OFFSET
+ from the appropriate Lisp_Subr struct, take the function name as
+ the C name of the DEFUN rather than a symbol visible as a
+ Lisp_Object, on debug builds assert that we're actually in the
+ function so we choke on badly-done copy-and-pasting,
+
+ * lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS.
+
+ * fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace):
+ Change to use the new PARSE_KEYWORDS syntax.
+ * elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS
+ syntax, rename a define to correspond to what other files use.
+
+ * symbols.c (intern_massaging_name):
+ * buffer.c (ADD_INT):
+ Rename intern_converting_underscores_to_dashes() to
+ intern_massaging_name(), now it does a little more.
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* termcap.c:
diff -r dd2976af8783 -r d804e621add0 src/buffer.c
--- a/src/buffer.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/buffer.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -1819,10 +1819,10 ＠＠
#define ADD_INT(field) \
plist = cons3 (make_int (b->text->field), \
- intern_converting_underscores_to_dashes (#field), plist)
+ intern_massaging_name (#field), plist)
#define ADD_BOOL(field) \
plist = cons3 (b->text->field ? Qt : Qnil, \
- intern_converting_underscores_to_dashes (#field), plist)
+ intern_massaging_name (#field), plist)
ADD_INT (bufz);
ADD_INT (z);
#ifdef OLD_BYTE_CHAR
diff -r dd2976af8783 -r d804e621add0 src/elhash.c
--- a/src/elhash.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/elhash.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -962,7 +962,7 ＠＠
else if (EQ (key, Qrehash_threshold)) rehash_threshold = value;
else if (EQ (key, Qweakness)) weakness = value;
else if (EQ (key, Qdata)) data = value;
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
+#ifdef NEED_TO_HANDLE_21_4_CODE
else if (EQ (key, Qtype))/*obsolete*/ weakness = value;
#endif
else if (KEYWORDP (key))
＠＠ -1109,14 +1109,14 ＠＠
*/
(int nargs, Lisp_Object *args))
{
-#ifdef NO_NEED_TO_HANDLE_21_4_CODE
- PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 5,
+#ifndef NEED_TO_HANDLE_21_4_CODE
+ PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 5,
(test, size, rehash_size, rehash_threshold, weakness),
- NULL, 0);
+ NULL);
#else
- PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 6,
+ PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 6,
(test, size, rehash_size, rehash_threshold, weakness,
- type), (type = Qunbound, weakness = Qunbound), 0);
+ type), (type = Qunbound, weakness = Qunbound));
if (EQ (weakness, Qunbound))
{
diff -r dd2976af8783 -r d804e621add0 src/fns.c
--- a/src/fns.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/fns.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -2575,7 +2575,7 ＠＠
Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
- PARSE_KEYWORDS (Qmerge, nargs, args, 4, 1, (key), NULL, 0);
+ PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
CHECK_SEQUENCE (sequence_one);
CHECK_SEQUENCE (sequence_two);
＠＠ -2827,7 +2827,7 ＠＠
Lisp_Object);
Elemcount sequence_len, i;
- PARSE_KEYWORDS (QsortX, nargs, args, 2, 1, (key), NULL, 0);
+ PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
CHECK_SEQUENCE (sequence);
＠＠ -4002,7 +4002,7 ＠＠
Lisp_Object item = args[1];
Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len;
- PARSE_KEYWORDS (Qfill, nargs, args, 2, 2, (start, end), (start = Qzero), 0);
+ PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
CHECK_NATNUM (start);
starting = XINT (start);
＠＠ -5005,9 +5005,9 ＠＠
Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
Elemcount starting, ending = EMACS_INT_MAX, ii = 0;
- PARSE_KEYWORDS (Qreduce, nargs, args, 2, 5,
+ PARSE_KEYWORDS (Freduce, nargs, args, 5,
(start, end, from_end, initial_value, key),
- (start = Qzero, initial_value = Qunbound), 0);
+ (start = Qzero, initial_value = Qunbound));
CHECK_SEQUENCE (sequence);
CHECK_NATNUM (start);
＠＠ -5541,8 +5541,8 ＠＠
Boolint sequence1_listp, sequence2_listp,
overwriting = EQ (sequence1, sequence2);
- PARSE_KEYWORDS (Qreplace, nargs, args, 2, 4, (start1, end1, start2, end2),
- (start1 = start2 = Qzero), 0);
+ PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
+ (start1 = start2 = Qzero));
CHECK_SEQUENCE (sequence1);
CHECK_LISP_WRITEABLE (sequence1);
diff -r dd2976af8783 -r d804e621add0 src/lisp.h
--- a/src/lisp.h Sat Sep 18 15:03:54 2010 +0100
+++ b/src/lisp.h Sat Sep 18 15:57:20 2010 +0100
＠＠ -3494,17 +3494,21 ＠＠
/************************************************************************/
/* The C subr must have been declared with MANY as its max args, and this
- PARSE_KEYWORDS call must come before any statements.
-
- FUNCTION is the name of the current function, as a symbol.
+ PARSE_KEYWORDS call must come before any statements. Equivalently, it
+ can appear within braces.
+
+ FUNCTION is the C name of the current DEFUN. If there is no current
+ DEFUN, use the PARSE_KEYWORDS_8 macro, not PARSE_KEYWORDS. If the
+ current DEFUN has optional arguments that are not keywords, you also need
+ to use the PARSE_KEYWORDS_8 macro. This is also the case if there are
+ optional arguments that come before the keywords, as Common Lisp
+ specifies for #'parse-integer.
NARGS is the count of arguments supplied to FUNCTION.
ARGS is a pointer to the argument vector (not a Lisp vector) supplied to
FUNCTION.
- KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments start.
-
KEYWORD_COUNT is the number of keywords FUNCTION is normally prepared to
handle.
＠＠ -3516,11 +3520,6 ＠＠
by parentheses and separated by the comma operator. If you don't need
this, supply NULL as KEYWORD_DEFAULTS.
- ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list
- entry in defun*; it is 1 if other keys are normally allowed, 0
- otherwise. This may be overridden in the caller by specifying
-:allow-other-keys t in the argument list.
-
For keywords which appear multiple times in the called argument list, the
leftmost one overrides, as specified in section 7.1.1 of the CLHS.
＠＠ -3534,26 +3533,70 ＠＠
and an unrelated name for the local variable, as is possible with the
((:keyword unrelated-var)) syntax in defun* and in Common Lisp. That
shouldn't matter in practice. */
-
-#define PARSE_KEYWORDS(function, nargs, args, keywords_offset, \
- keyword_count, keywords, keyword_defaults, \
- allow_other_keys) \
+#if defined (DEBUG_XEMACS) && defined (__STDC_VERSION__) && \
+ __STDC_VERSION__ >= 199901L
+
+/* This version has the advantage that DEFUN without DEFSUBR still provokes
+ a defined but not used warning, and it provokes an assertion failure at
+ runtime if someone has copied and pasted the PARSE_KEYWORDS macro from
+ another function without changing FUNCTION; that would lead to an
+ incorrect determination of KEYWORDS_OFFSET. */
+
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern_massaging_name (1 + #function), \
+ nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, \
+ /* Can't XSUBR (Fsymbol_function (...))->min_args, \
+ the function may be advised. */ \
+ XINT (Ffunction_min_args \
+ (intern_massaging_name (1 + #function))), \
+ 0); \
+ assert (0 == strcmp (__func__, #function))
+#else
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern (S##function.name), nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, S##function.min_args, 0)
+#endif
+
+/* PARSE_KEYWORDS_8 is a more fine-grained version of PARSE_KEYWORDS. The
+ differences are as follows:
+
+ FUNC_SYM is a symbol reflecting the name of the function for which
+ keywords are being parsed. In PARSE_KEYWORDS, it is the Lisp-visible
+ name of C_FUNC, interned as a symbol in obarray.
+
+ KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments
+ start. In PARSE_KEYWORDS, this is the index of the first optional
+ argument, determined from the information known about C_FUNC.
+
+ ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list entry
+ in defun*; it is 1 if other keys are normally allowed, 0 otherwise. This
+ may be overridden in the caller by specifying :allow-other-keys t in the
+ argument list. In PARSE_KEYWORDS, ALLOW_OTHER_KEYS is always 0. */
+
+#define PARSE_KEYWORDS_8(func_sym, nargs, args, \
+ keyword_count, keywords, keyword_defaults, \
+ keywords_offset, allow_other_keys) \
DECLARE_N_KEYWORDS_##keyword_count keywords; \
\
do \
{ \
Lisp_Object pk_key, pk_value; \
- Elemcount pk_i = nargs - 1; \
+ Elemcount pk_i = nargs - 1, pk_offset = keywords_offset; \
Boolint pk_allow_other_keys = allow_other_keys; \
\
- if ((nargs - keywords_offset) & 1) \
+ if ((nargs - pk_offset) & 1) \
{ \
if (!allow_other_keys \
&& !(pk_allow_other_keys \
- = non_nil_allow_other_keys_p (keywords_offset, \
+ = non_nil_allow_other_keys_p (pk_offset, \
nargs, args))) \
{ \
- signal_wrong_number_of_arguments_error (function, nargs); \
+ signal_wrong_number_of_arguments_error (func_sym, nargs); \
} \
else \
{ \
＠＠ -3566,7 +3609,7 ＠＠
(void)(keyword_defaults); \
\
/* Start from the end, because the leftmost element overrides. */ \
- while (pk_i > keywords_offset) \
+ while (pk_i > pk_offset) \
{ \
pk_value = args[pk_i--]; \
pk_key = args[pk_i--]; \
＠＠ -3578,7 +3621,7 ＠＠
continue; \
} \
else if ((pk_allow_other_keys \
- = non_nil_allow_other_keys_p (keywords_offset, \
+ = non_nil_allow_other_keys_p (pk_offset, \
nargs, args))) \
{ \
continue; \
＠＠ -3590,7 +3633,7 ＠＠
} \
else \
{ \
- invalid_keyword_argument (function, pk_key); \
+ invalid_keyword_argument (func_sym, pk_key); \
} \
} \
} while (0)
＠＠ -5649,7 +5692,7 ＠＠
unsigned int hash_string (const Ibyte *, Bytecount);
Lisp_Object intern_istring (const Ibyte *str);
MODULE_API Lisp_Object intern (const CIbyte *str);
-Lisp_Object intern_converting_underscores_to_dashes (const CIbyte *str);
+Lisp_Object intern_massaging_name (const CIbyte *str);
Lisp_Object oblookup (Lisp_Object, const Ibyte *, Bytecount);
void map_obarray (Lisp_Object, int (*) (Lisp_Object, void *), void *);
Lisp_Object indirect_function (Lisp_Object, int);
diff -r dd2976af8783 -r d804e621add0 src/symbols.c
--- a/src/symbols.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/symbols.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -198,15 +198,23 ＠＠
}
Lisp_Object
-intern_converting_underscores_to_dashes (const CIbyte *str)
+intern_massaging_name (const CIbyte *str)
{
Bytecount len = strlen (str);
CIbyte *tmp = alloca_extbytes (len + 1);
Bytecount i;
strcpy (tmp, str);
for (i = 0; i < len; i++)
- if (tmp[i] == '_')
- tmp[i] = '-';
+ {
+ if (tmp[i] == '_')
+ {
+ tmp[i] = '-';
+ }
+ else if (tmp[i] == 'X')
+ {
+ tmp[i] = '*';
+ }
+ }
return intern_istring ((Ibyte *) tmp);
}
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Simplify the API of PARSE_KEYWORDS for callers.
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
changeset: 5277:d804e621add0
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Sep 18 15:57:20 2010 +0100
files: src/ChangeLog src/buffer.c src/elhash.c src/fns.c src/lisp.h src/symbols.c
description:
Simplify the API of PARSE_KEYWORDS for callers.
src/ChangeLog addition:
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
Simplify the API of PARSE_KEYWORDS for callers.
* lisp.h (PARSE_KEYWORDS): Simply the API, while making the
implementation a little more complex; work out KEYWORDS_OFFSET
from the appropriate Lisp_Subr struct, take the function name as
the C name of the DEFUN rather than a symbol visible as a
Lisp_Object, on debug builds assert that we're actually in the
function so we choke on badly-done copy-and-pasting,
* lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS.
* fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace):
Change to use the new PARSE_KEYWORDS syntax.
* elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS
syntax, rename a define to correspond to what other files use.
* symbols.c (intern_massaging_name):
* buffer.c (ADD_INT):
Rename intern_converting_underscores_to_dashes() to
intern_massaging_name(), now it does a little more.
diff -r dd2976af8783 -r d804e621add0 src/ChangeLog
--- a/src/ChangeLog Sat Sep 18 15:03:54 2010 +0100
+++ b/src/ChangeLog Sat Sep 18 15:57:20 2010 +0100
＠＠ -1,3 +1,26 ＠＠
+2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Simplify the API of PARSE_KEYWORDS for callers.
+
+ * lisp.h (PARSE_KEYWORDS): Simply the API, while making the
+ implementation a little more complex; work out KEYWORDS_OFFSET
+ from the appropriate Lisp_Subr struct, take the function name as
+ the C name of the DEFUN rather than a symbol visible as a
+ Lisp_Object, on debug builds assert that we're actually in the
+ function so we choke on badly-done copy-and-pasting,
+
+ * lisp.h (PARSE_KEYWORDS_8): New. This is the old PARSE_KEYWORDS.
+
+ * fns.c (Fmerge, FsortX, Ffill, Freduce, Freplace):
+ Change to use the new PARSE_KEYWORDS syntax.
+ * elhash.c (Fmake_hash_table): Chance to the new PARSE_KEYWORDS
+ syntax, rename a define to correspond to what other files use.
+
+ * symbols.c (intern_massaging_name):
+ * buffer.c (ADD_INT):
+ Rename intern_converting_underscores_to_dashes() to
+ intern_massaging_name(), now it does a little more.
+
2010-09-18 Aidan Kehoe <kehoea(a)parhasard.net>
* termcap.c:
diff -r dd2976af8783 -r d804e621add0 src/buffer.c
--- a/src/buffer.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/buffer.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -1819,10 +1819,10 ＠＠
#define ADD_INT(field) \
plist = cons3 (make_int (b->text->field), \
- intern_converting_underscores_to_dashes (#field), plist)
+ intern_massaging_name (#field), plist)
#define ADD_BOOL(field) \
plist = cons3 (b->text->field ? Qt : Qnil, \
- intern_converting_underscores_to_dashes (#field), plist)
+ intern_massaging_name (#field), plist)
ADD_INT (bufz);
ADD_INT (z);
#ifdef OLD_BYTE_CHAR
diff -r dd2976af8783 -r d804e621add0 src/elhash.c
--- a/src/elhash.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/elhash.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -962,7 +962,7 ＠＠
else if (EQ (key, Qrehash_threshold)) rehash_threshold = value;
else if (EQ (key, Qweakness)) weakness = value;
else if (EQ (key, Qdata)) data = value;
-#ifndef NO_NEED_TO_HANDLE_21_4_CODE
+#ifdef NEED_TO_HANDLE_21_4_CODE
else if (EQ (key, Qtype))/*obsolete*/ weakness = value;
#endif
else if (KEYWORDP (key))
＠＠ -1109,14 +1109,14 ＠＠
*/
(int nargs, Lisp_Object *args))
{
-#ifdef NO_NEED_TO_HANDLE_21_4_CODE
- PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 5,
+#ifndef NEED_TO_HANDLE_21_4_CODE
+ PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 5,
(test, size, rehash_size, rehash_threshold, weakness),
- NULL, 0);
+ NULL);
#else
- PARSE_KEYWORDS (Qmake_hash_table, nargs, args, 0, 6,
+ PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 6,
(test, size, rehash_size, rehash_threshold, weakness,
- type), (type = Qunbound, weakness = Qunbound), 0);
+ type), (type = Qunbound, weakness = Qunbound));
if (EQ (weakness, Qunbound))
{
diff -r dd2976af8783 -r d804e621add0 src/fns.c
--- a/src/fns.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/fns.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -2575,7 +2575,7 ＠＠
Lisp_Object (*c_predicate) (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
- PARSE_KEYWORDS (Qmerge, nargs, args, 4, 1, (key), NULL, 0);
+ PARSE_KEYWORDS (Fmerge, nargs, args, 1, (key), NULL);
CHECK_SEQUENCE (sequence_one);
CHECK_SEQUENCE (sequence_two);
＠＠ -2827,7 +2827,7 ＠＠
Lisp_Object);
Elemcount sequence_len, i;
- PARSE_KEYWORDS (QsortX, nargs, args, 2, 1, (key), NULL, 0);
+ PARSE_KEYWORDS (FsortX, nargs, args, 1, (key), NULL);
CHECK_SEQUENCE (sequence);
＠＠ -4002,7 +4002,7 ＠＠
Lisp_Object item = args[1];
Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len;
- PARSE_KEYWORDS (Qfill, nargs, args, 2, 2, (start, end), (start = Qzero), 0);
+ PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
CHECK_NATNUM (start);
starting = XINT (start);
＠＠ -5005,9 +5005,9 ＠＠
Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
Elemcount starting, ending = EMACS_INT_MAX, ii = 0;
- PARSE_KEYWORDS (Qreduce, nargs, args, 2, 5,
+ PARSE_KEYWORDS (Freduce, nargs, args, 5,
(start, end, from_end, initial_value, key),
- (start = Qzero, initial_value = Qunbound), 0);
+ (start = Qzero, initial_value = Qunbound));
CHECK_SEQUENCE (sequence);
CHECK_NATNUM (start);
＠＠ -5541,8 +5541,8 ＠＠
Boolint sequence1_listp, sequence2_listp,
overwriting = EQ (sequence1, sequence2);
- PARSE_KEYWORDS (Qreplace, nargs, args, 2, 4, (start1, end1, start2, end2),
- (start1 = start2 = Qzero), 0);
+ PARSE_KEYWORDS (Freplace, nargs, args, 4, (start1, end1, start2, end2),
+ (start1 = start2 = Qzero));
CHECK_SEQUENCE (sequence1);
CHECK_LISP_WRITEABLE (sequence1);
diff -r dd2976af8783 -r d804e621add0 src/lisp.h
--- a/src/lisp.h Sat Sep 18 15:03:54 2010 +0100
+++ b/src/lisp.h Sat Sep 18 15:57:20 2010 +0100
＠＠ -3494,16 +3494,20 ＠＠
/************************************************************************/
/* The C subr must have been declared with MANY as its max args, and this
- PARSE_KEYWORDS call must come before any statements.
-
- FUNCTION is the name of the current function, as a symbol.
+ PARSE_KEYWORDS call must come before any statements. Equivalently, it
+ can appear within braces.
+
+ FUNCTION is the C name of the current DEFUN. If there is no current
+ DEFUN, use the PARSE_KEYWORDS_8 macro, not PARSE_KEYWORDS. If the
+ current DEFUN has optional arguments that are not keywords, you also need
+ to use the PARSE_KEYWORDS_8 macro. This is also the case if there are
+ optional arguments that come before the keywords, as Common Lisp
+ specifies for #'parse-integer.
NARGS is the count of arguments supplied to FUNCTION.
ARGS is a pointer to the argument vector (not a Lisp vector) supplied to
FUNCTION.
-
- KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments start.
KEYWORD_COUNT is the number of keywords FUNCTION is normally prepared to
handle.
＠＠ -3515,11 +3519,6 ＠＠
initial_value) in this parameter, a collection of C statements surrounded
by parentheses and separated by the comma operator. If you don't need
this, supply NULL as KEYWORD_DEFAULTS.
-
- ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list
- entry in defun*; it is 1 if other keys are normally allowed, 0
- otherwise. This may be overridden in the caller by specifying
-:allow-other-keys t in the argument list.
For keywords which appear multiple times in the called argument list, the
leftmost one overrides, as specified in section 7.1.1 of the CLHS.
＠＠ -3534,26 +3533,70 ＠＠
and an unrelated name for the local variable, as is possible with the
((:keyword unrelated-var)) syntax in defun* and in Common Lisp. That
shouldn't matter in practice. */
-
-#define PARSE_KEYWORDS(function, nargs, args, keywords_offset, \
- keyword_count, keywords, keyword_defaults, \
- allow_other_keys) \
+#if defined (DEBUG_XEMACS) && defined (__STDC_VERSION__) && \
+ __STDC_VERSION__ >= 199901L
+
+/* This version has the advantage that DEFUN without DEFSUBR still provokes
+ a defined but not used warning, and it provokes an assertion failure at
+ runtime if someone has copied and pasted the PARSE_KEYWORDS macro from
+ another function without changing FUNCTION; that would lead to an
+ incorrect determination of KEYWORDS_OFFSET. */
+
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern_massaging_name (1 + #function), \
+ nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, \
+ /* Can't XSUBR (Fsymbol_function (...))->min_args, \
+ the function may be advised. */ \
+ XINT (Ffunction_min_args \
+ (intern_massaging_name (1 + #function))), \
+ 0); \
+ assert (0 == strcmp (__func__, #function))
+#else
+#define PARSE_KEYWORDS(function, nargs, args, keyword_count, keywords, \
+ keyword_defaults) \
+ PARSE_KEYWORDS_8 (intern (S##function.name), nargs, args, \
+ keyword_count, keywords, \
+ keyword_defaults, S##function.min_args, 0)
+#endif
+
+/* PARSE_KEYWORDS_8 is a more fine-grained version of PARSE_KEYWORDS. The
+ differences are as follows:
+
+ FUNC_SYM is a symbol reflecting the name of the function for which
+ keywords are being parsed. In PARSE_KEYWORDS, it is the Lisp-visible
+ name of C_FUNC, interned as a symbol in obarray.
+
+ KEYWORDS_OFFSET is the offset into ARGS where the keyword arguments
+ start. In PARSE_KEYWORDS, this is the index of the first optional
+ argument, determined from the information known about C_FUNC.
+
+ ALLOW_OTHER_KEYS corresponds to the &allow-other-keys argument list entry
+ in defun*; it is 1 if other keys are normally allowed, 0 otherwise. This
+ may be overridden in the caller by specifying :allow-other-keys t in the
+ argument list. In PARSE_KEYWORDS, ALLOW_OTHER_KEYS is always 0. */
+
+#define PARSE_KEYWORDS_8(func_sym, nargs, args, \
+ keyword_count, keywords, keyword_defaults, \
+ keywords_offset, allow_other_keys) \
DECLARE_N_KEYWORDS_##keyword_count keywords; \
\
do \
{ \
Lisp_Object pk_key, pk_value; \
- Elemcount pk_i = nargs - 1; \
+ Elemcount pk_i = nargs - 1, pk_offset = keywords_offset; \
Boolint pk_allow_other_keys = allow_other_keys; \
\
- if ((nargs - keywords_offset) & 1) \
+ if ((nargs - pk_offset) & 1) \
{ \
if (!allow_other_keys \
&& !(pk_allow_other_keys \
- = non_nil_allow_other_keys_p (keywords_offset, \
+ = non_nil_allow_other_keys_p (pk_offset, \
nargs, args))) \
{ \
- signal_wrong_number_of_arguments_error (function, nargs); \
+ signal_wrong_number_of_arguments_error (func_sym, nargs); \
} \
else \
{ \
＠＠ -3566,7 +3609,7 ＠＠
(void)(keyword_defaults); \
\
/* Start from the end, because the leftmost element overrides. */ \
- while (pk_i > keywords_offset) \
+ while (pk_i > pk_offset) \
{ \
pk_value = args[pk_i--]; \
pk_key = args[pk_i--]; \
＠＠ -3578,7 +3621,7 ＠＠
continue; \
} \
else if ((pk_allow_other_keys \
- = non_nil_allow_other_keys_p (keywords_offset, \
+ = non_nil_allow_other_keys_p (pk_offset, \
nargs, args))) \
{ \
continue; \
＠＠ -3590,7 +3633,7 ＠＠
} \
else \
{ \
- invalid_keyword_argument (function, pk_key); \
+ invalid_keyword_argument (func_sym, pk_key); \
} \
} \
} while (0)
＠＠ -5649,7 +5692,7 ＠＠
unsigned int hash_string (const Ibyte *, Bytecount);
Lisp_Object intern_istring (const Ibyte *str);
MODULE_API Lisp_Object intern (const CIbyte *str);
-Lisp_Object intern_converting_underscores_to_dashes (const CIbyte *str);
+Lisp_Object intern_massaging_name (const CIbyte *str);
Lisp_Object oblookup (Lisp_Object, const Ibyte *, Bytecount);
void map_obarray (Lisp_Object, int (*) (Lisp_Object, void *), void *);
Lisp_Object indirect_function (Lisp_Object, int);
diff -r dd2976af8783 -r d804e621add0 src/symbols.c
--- a/src/symbols.c Sat Sep 18 15:03:54 2010 +0100
+++ b/src/symbols.c Sat Sep 18 15:57:20 2010 +0100
＠＠ -198,15 +198,23 ＠＠
}
Lisp_Object
-intern_converting_underscores_to_dashes (const CIbyte *str)
+intern_massaging_name (const CIbyte *str)
{
Bytecount len = strlen (str);
CIbyte *tmp = alloca_extbytes (len + 1);
Bytecount i;
strcpy (tmp, str);
for (i = 0; i < len; i++)
- if (tmp[i] == '_')
- tmp[i] = '-';
+ {
+ if (tmp[i] == '_')
+ {
+ tmp[i] = '-';
+ }
+ else if (tmp[i] == 'X')
+ {
+ tmp[i] = '*';
+ }
+ }
return intern_istring ((Ibyte *) tmp);
}
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
Re: Native Windows Build Failure
14 years, 3 months
Aidan Kehoe
Aidan Kehoe
Ar an t-ochtú lá déag de mí Méan Fómhair, scríobh Vin Shelton:
> Aidan et al,
>
> On Thu, Sep 16, 2010 at 9:10 PM, Vin Shelton <acs(a)alumni.princeton.edu> wrote:
> > Thanks for keeping things going. With the latest 21.5 sources, I'm
> > getting the following errors when building a native Windows executable
> > with VS6.
>
> The problem is similar to previous ones. EXTERNAL_LIST_LOOP_3 needs
> to be the first statement in the block. An inelegant potential patch
> is attached.
Thanks, Vin! I’ve committed a slightly different change, but it’s very good
to see these problems. Again, I don’t see the error with Visual Studio 2005;
are there extra flags you are turning on?
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://calypso.tux.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments