Mercurial > hg > xemacs-beta

comparison lisp/emulators/mlsupport.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents 376386a54a3c
children 131b0175ea99
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 23 ;; 02111-1307, USA.
24 ;;; Synched up with: FSF 19.30. 24
25 ;;; Synched up with: FSF 19.34.
25 26
26 ;;; Commentary: 27 ;;; Commentary:
27 28
28 ;; This package provides equivalents of certain primitives from Gosling 29 ;; This package provides equivalents of certain primitives from Gosling
29 ;; Emacs (including the commercial UniPress versions). These have an 30 ;; Emacs (including the commercial UniPress versions). These have an
30 ;; ml- prefix to distinguish them from native GNU Emacs functions with 31 ;; ml- prefix to distinguish them from native GNU Emacs functions with
31 ;; similar names. The oackage mlconvert.el translates Mocklisp code 32 ;; similar names. The package mlconvert.el translates Mocklisp code
32 ;; to use these names. 33 ;; to use these names.
33 34
34 ;;; Code: 35 ;;; Code:
35 36
36 (or (fboundp 'ml-prefix-argument-loop) 37 (or (fboundp 'ml-prefix-argument-loop)
67 (defun provide-prefix-arg (arg form) 68 (defun provide-prefix-arg (arg form)
68 (funcall (car form) arg)) 69 (funcall (car form) arg))
69 70
70 (defun define-keymap (name) 71 (defun define-keymap (name)
71 (fset (intern name) (make-keymap))) 72 (fset (intern name) (make-keymap)))
73
74 ;; Make it work to use ml-use-...-map on "esc" and such.
75 (fset 'esc-map esc-map)
76 (fset 'ctl-x-map ctl-x-map)
72 77
73 (defun ml-use-local-map (name) 78 (defun ml-use-local-map (name)
74 (use-local-map (intern (concat name "-map")))) 79 (use-local-map (intern (concat name "-map"))))
75 80
76 (defun ml-use-global-map (name) 81 (defun ml-use-global-map (name)
236 (let ((symbol (intern (concat name "-abbrev-table")))) 241 (let ((symbol (intern (concat name "-abbrev-table"))))
237 (or (boundp symbol) 242 (or (boundp symbol)
238 (define-abbrev-table symbol nil)) 243 (define-abbrev-table symbol nil))
239 (symbol-value symbol))) 244 (symbol-value symbol)))
240 245
246 ;; XEmacs
241 (defun define-hooked-local-abbrev (name exp hook) 247 (defun define-hooked-local-abbrev (name exp hook)
242 (define-abbrev (or local-abbrev-table 248 (define-abbrev (or local-abbrev-table
243 (error "Major mode has no abbrev table")) 249 (error "Major mode has no abbrev table"))
244 (downcase name) 250 (downcase name)
245 exp (intern hook))) 251 exp (intern hook)))
246 252
253 ;; XEmacs
247 (defun define-hooked-global-abbrev (name exp hook) 254 (defun define-hooked-global-abbrev (name exp hook)
248 (define-abbrev global-abbrev-table (downcase name) 255 (define-abbrev global-abbrev-table (downcase name)
249 exp (intern hook))) 256 exp (intern hook)))
250 257
251 (defun case-word-lower () 258 (defun case-word-lower ()
334 0 means use /bin/sh.") 341 0 means use /bin/sh.")
335 342
336 (defvar use-csh-option-f 1 343 (defvar use-csh-option-f 1
337 "Mocklisp compatibility variable; 1 means pass -f when calling csh.") 344 "Mocklisp compatibility variable; 1 means pass -f when calling csh.")
338 345
346 ;; XEmacs (FSF bugfix? -sb)
339 (defun filter-region (command) 347 (defun filter-region (command)
340 (let* ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) 348 (let* ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh"))
341 (csh (equal (file-name-nondirectory shell) "csh"))) 349 (csh (equal (file-name-nondirectory shell) "csh")))
342 (call-process-region (point) (mark) shell t t nil 350 (call-process-region (point) (mark) shell t t nil
343 (if (and csh use-csh-option-f) "-cf" "-c") 351 (if (and csh use-csh-option-f) "-cf" "-c")
344 (concat "exec " command)))) 352 (concat "exec " command))))
345 353
354 ;; XEmacs (FSF bugfix? -sb)
346 (defun execute-monitor-command (command) 355 (defun execute-monitor-command (command)
347 (let* ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh")) 356 (let* ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh"))
348 (csh (equal (file-name-nondirectory shell) "csh"))) 357 (csh (equal (file-name-nondirectory shell) "csh")))
349 (call-process shell nil t t 358 (call-process shell nil t t
350 (if (and csh use-csh-option-f) "-cf" "-c") 359 (if (and csh use-csh-option-f) "-cf" "-c")
434 (let ((length (length string))) 443 (let ((length (length string)))
435 (if (< from 0) (setq from (+ from length))) 444 (if (< from 0) (setq from (+ from length)))
436 (if (< to 0) (setq to (+ to length))) 445 (if (< to 0) (setq to (+ to length)))
437 (substring string from (+ from to)))) 446 (substring string from (+ from to))))
438 447
439 448 ;; XEmacs
440 (defun ml-nargs () 449 (defun ml-nargs ()
441 "Number of arguments to currently executing mocklisp function." 450 "Number of arguments to currently executing mocklisp function."
442 (if (eq mocklisp-arguments 'interactive) 451 (if (eq mocklisp-arguments 'interactive)
443 0 452 0
444 (length mocklisp-arguments))) 453 (length mocklisp-arguments)))