Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 4806:fd36a980d701

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use uninterned symbols in various information-hiding contexts. lisp/ChangeLog addition: 2010-01-01 Aidan Kehoe <kehoea@parhasard.net> * syntax.el (map-syntax-table): * subr.el (map-plist): * startup.el (load-init-file): * minibuf.el (read-from-minbuffer): * cus-edit.el (custom-load-custom-defines-1): * cmdloop.el (execute-extended-command): Replace symbol names using underscore, whether to avoid dynamic scope problems or to ensure helpful arguments to #'call-with-condition-handler, with uninterned symbols. src/ChangeLog addition: 2010-01-01 Aidan Kehoe <kehoea@parhasard.net> * mule-charset.c (Fmake_charset): Don't intern the symbols used to refer to temporary character sets, that doesn't bring us anything.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 01 Jan 2010 19:45:39 +0000
parents eecd28508f4a
children 0142cb4d1049
comparison
equal deleted inserted replaced
4767:dba492ef7440 4806:fd36a980d701
1116 (while plist 1116 (while plist
1117 (setq alist (cons (cons (car plist) (cadr plist)) alist)) 1117 (setq alist (cons (cons (car plist) (cadr plist)) alist))
1118 (setq plist (cddr plist))) 1118 (setq plist (cddr plist)))
1119 (nreverse alist))) 1119 (nreverse alist)))
1120 1120
1121 (defun map-plist (_mp_fun _mp_plist) 1121 ((macro
1122 "Map _MP_FUN (a function of two args) over each key/value pair in _MP_PLIST. 1122 . (lambda (map-plist-definition)
1123 "Replace the variable names in MAP-PLIST-DEFINITION with uninterned
1124 symbols, avoiding the risk of interference with variables in other functions
1125 introduced by dynamic scope."
1126 (if-fboundp 'nsublis
1127 (nsublis
1128 '((mp-function . #:function)
1129 (plist . #:plist)
1130 (result . #:result))
1131 map-plist-definition)
1132 map-plist-definition)))
1133 (defun map-plist (mp-function plist)
1134 "Map FUNCTION (a function of two args) over each key/value pair in PLIST.
1123 Return a list of the results." 1135 Return a list of the results."
1124 (let (_mp_result) 1136 (let (result)
1125 (while _mp_plist 1137 (while plist
1126 (push (funcall _mp_fun (car _mp_plist) (cadr _mp_plist)) _mp_result) 1138 (push (funcall mp-function (car plist) (cadr plist)) result)
1127 (setq _mp_plist (cddr _mp_plist))) 1139 (setq plist (cddr plist)))
1128 (nreverse _mp_result))) 1140 (nreverse result))))
1129 1141
1130 (defun destructive-plist-to-alist (plist) 1142 (defun destructive-plist-to-alist (plist)
1131 "Convert property list PLIST into the equivalent association-list form. 1143 "Convert property list PLIST into the equivalent association-list form.
1132 The alist is returned. This converts from 1144 The alist is returned. This converts from
1133 1145
1462 (let ((operation "unknown") 1474 (let ((operation "unknown")
1463 (error-form nil) 1475 (error-form nil)
1464 (no-backtrace nil) 1476 (no-backtrace nil)
1465 (class ''general) 1477 (class ''general)
1466 (level ''warning) 1478 (level ''warning)
1467 (resignal nil)) 1479 (resignal nil)
1480 (cte-cc-var '#:cte-cc-var)
1481 (call-trapping-errors-arg '#:call-trapping-errors-Ldc9FC5Hr))
1468 (let* ((keys '(operation error-form no-backtrace class level resignal)) 1482 (let* ((keys '(operation error-form no-backtrace class level resignal))
1469 (keys-with-colon 1483 (keys-with-colon
1470 (mapcar #'(lambda (sym) 1484 (mapcar #'(lambda (sym)
1471 (intern (concat ":" (symbol-name sym)))) keys))) 1485 (intern (concat ":" (symbol-name sym)))) keys)))
1472 (while (memq (car keys-body) keys-with-colon) 1486 (while (memq (car keys-body) keys-with-colon)
1473 (let* ((key-with-colon (pop keys-body)) 1487 (let* ((key-with-colon (pop keys-body))
1474 (key (intern (substring (symbol-name key-with-colon) 1)))) 1488 (key (intern (substring (symbol-name key-with-colon) 1))))
1475 (set key (pop keys-body))))) 1489 (set key (pop keys-body)))))
1476 `(condition-case ,(if resignal '__cte_cc_var__ nil) 1490 `(condition-case ,(if resignal cte-cc-var nil)
1477 (call-with-condition-handler 1491 (call-with-condition-handler
1478 #'(lambda (__call_trapping_errors_arg__) 1492 #'(lambda (,call-trapping-errors-arg)
1479 (let ((errstr (error-message-string 1493 (let ((errstr (error-message-string
1480 __call_trapping_errors_arg__))) 1494 ,call-trapping-errors-arg)))
1481 ,(if no-backtrace 1495 ,(if no-backtrace
1482 `(lwarn ,class ,level 1496 `(lwarn ,class ,level
1483 (if (warning-level-< 1497 (if (warning-level-<
1484 ,level 1498 ,level
1485 display-warning-minimum-level) 1499 display-warning-minimum-level)
1488 ,operation errstr) 1502 ,operation errstr)
1489 `(lwarn ,class ,level 1503 `(lwarn ,class ,level
1490 "Error in %s: %s\n\nBacktrace follows:\n\n%s" 1504 "Error in %s: %s\n\nBacktrace follows:\n\n%s"
1491 ,operation errstr 1505 ,operation errstr
1492 (backtrace-in-condition-handler-eliminating-handler 1506 (backtrace-in-condition-handler-eliminating-handler
1493 '__call_trapping_errors_arg__))))) 1507 ',call-trapping-errors-arg)))))
1494 #'(lambda () 1508 #'(lambda ()
1495 (progn ,@keys-body))) 1509 (progn ,@keys-body)))
1496 (error 1510 (error
1497 ,error-form 1511 ,error-form
1498 ,@(if resignal '((signal (car __cte_cc_var__) (cdr __cte_cc_var__))))) 1512 ,@(if resignal '((signal (car ,cte-cc-var) (cdr ,cte-cc-var)))))
1499 ))) 1513 )))
1500 1514
1501 ;;;; Miscellanea. 1515 ;;;; Miscellanea.
1502 1516
1503 ;; This is now in C. 1517 ;; This is now in C.