Mercurial > hg > xemacs-beta

comparison lisp/emulators/mlsupport.el @ 70:131b0175ea99 r20-0b30

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