Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

tm 7.9.

  • Loading branch information...
commit b20cc487654584b1c1bac19edc31cddfe2139e86 1 parent b2537f1
morioka authored
Showing with 90 additions and 20 deletions.
  1. +1 −1  Makefile
  2. +37 −0 emu-18.el
  3. +52 −19 emu-nemacs.el
View
2  Makefile
@@ -18,7 +18,7 @@ TLDIR19 = $(HOME)/lib/emacs19/lisp
FILES = tl/README.eng tl/Makefile tl/mk-tl tl/*.el tl/doc/*.texi
-TARFILE = tl-6.6.7.tar
+TARFILE = tl-6.6.8.tar
elc:
View
37 emu-18.el
@@ -12,6 +12,9 @@
;;; This file is part of tl and tm (Tools for MIME).
;;;
+;;; @ hook
+;;;
+
;; This function is imported from AUC TeX.
(defun add-hook (hook function &optional append)
"Add to the value of HOOK the function FUNCTION.
@@ -48,6 +51,10 @@ function, it is changed to a list of functions.
))
))
+
+;;; @ list
+;;;
+
(defun member (elt list)
"Return non-nil if ELT is an element of LIST. Comparison done with EQUAL.
The value is actually the tail of LIST whose car is ELT.
@@ -56,6 +63,10 @@ The value is actually the tail of LIST whose car is ELT.
(setq list (cdr list)))
list)
+
+;;; @ function
+;;;
+
(defun defalias (SYM NEWDEF)
"Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
Associates the function with the current load file, if any.
@@ -63,6 +74,24 @@ Associates the function with the current load file, if any.
(fset SYM (symbol-function NEWDEF))
NEWDEF)
+(defun byte-code-function-p (exp)
+ (let* ((rest (cdr (cdr exp))) elt)
+ (if (stringp (car rest))
+ (setq rest (cdr rest))
+ )
+ (catch 'tag
+ (while rest
+ (setq elt (car rest))
+ (if (and (consp elt)(eq (car elt) 'byte-code))
+ (throw 'tag t)
+ )
+ (setq rest (cdr rest))
+ ))))
+
+
+;;; @ directory
+;;;
+
(defun make-directory-internal (dirname)
"Create a directory. One argument, a file name string.
\[emu-18 Emacs 19 emulating function]"
@@ -102,6 +131,14 @@ to create parent directories if they don't exist.
(make-directory-internal dir)
))
+
+;;; @ mouse
+;;;
+
(defvar mouse-button-2 nil)
+
+;;; @ end
+;;;
+
(provide 'emu-18)
View
71 emu-nemacs.el
@@ -20,18 +20,41 @@
(defconst emacs-major-version (string-to-int emacs-version))
+
+;;; @ leading-char
+;;;
+
+(defconst lc-ascii 0)
+(defconst lc-jp 146)
+
+(defun char-leading-char (chr)
+ "Return leading character of CHAR.
+\[emu-nemacs.el; Mule emulating function]"
+ (if (< chr 128)
+ lc-ascii
+ lc-jp))
+
+(defalias 'get-lc 'char-leading-char)
+
+
+;;; @ coding-system
+;;;
+
(defconst *junet* 2)
(defconst *internal* 3)
(defconst *euc-japan* 3)
-(defconst lc-ascii 0)
-(defconst lc-jp 146)
+(defun code-convert-string (str ic oc)
+ "Convert code in STRING from SOURCE code to TARGET code,
+On successful converion, returns the result string,
+else returns nil. [emu-nemacs.el; Mule emulating function]"
+ (if (not (eq ic oc))
+ (convert-string-kanji-code str ic oc)
+ str))
-;; by mol. 1993/9/26
-(defun string-width (str)
- "Return number of columns STRING will occupy.
- [Mule compatible function in tm-nemacs]"
- (length str))
+
+;;; @ character and string
+;;;
(defun char-bytes (chr)
"Return number of bytes CHAR will occupy in a buffer.
@@ -43,13 +66,25 @@
[Mule compatible function in tm-nemacs]"
(if (< chr 128) 1 2))
-(defun code-convert-string (str ic oc)
- "Convert code in STRING from SOURCE code to TARGET code,
-On successful converion, returns the result string,
-else returns nil. [Mule compatible function in tm-nemacs]"
- (if (not (eq ic oc))
- (convert-string-kanji-code str ic oc)
- str))
+;; by mol. 1993/9/26
+(defun string-width (str)
+ "Return number of columns STRING will occupy.
+ [Mule compatible function in tm-nemacs]"
+ (length str))
+
+(defun string-to-char-list (str)
+ (let ((i 0)(len (length str)) dest chr)
+ (while (< i len)
+ (setq chr (aref str i))
+ (if (>= chr 128)
+ (setq i (1+ i)
+ chr (+ (lsh chr 8) (aref str i))
+ ))
+ (setq dest (cons chr dest))
+ (setq i (1+ i))
+ )
+ (reverse dest)
+ ))
(defun check-ASCII-string (str)
(let ((i 0)
@@ -63,11 +98,9 @@ else returns nil. [Mule compatible function in tm-nemacs]"
)
str)))
-(defun get-lc (chr)
- "Return leading character of CHAR or LEADING-CHARACTER."
- (if (< chr 128)
- lc-ascii
- lc-jp))
+
+;;; @ text property emulation
+;;;
(setq tl:available-face-attribute-alist
'(

0 comments on commit b20cc48

Please sign in to comment.
Something went wrong with that request. Please try again.