home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / unix / emacs / lisp / os2.el < prev    next >
Encoding:
Text File  |  1992-05-02  |  11.0 KB  |  315 lines
  1. ;;
  2. ;; os2.el -- Patches for OS/2
  3. ;;
  4. (provide 'os2)
  5.  
  6. (defun replace-char-in-string (str c1 c2)
  7.   "Replace character C1 in string STR with character C2 and return STR.
  8. This function does *not* copy the string."
  9.   (let ((indx 0) (len (length str)) chr)
  10.     (while (< indx len)
  11.       (setq chr (aref str indx))
  12.       (if (eq chr c1)
  13.           (aset str indx c2))
  14.       (setq indx (1+ indx)))
  15.     str))
  16.  
  17. (defun make-legal-file-name (fn)
  18.   "Turn FN into a legal file name and return the modified copy of the string.
  19. The characters * and ? will be replaced with _."
  20.   (setq fn (copy-sequence fn))
  21.   (replace-char-in-string fn ?* ?_)
  22.   (replace-char-in-string fn ?? ?_))
  23.  
  24. ;;
  25. ;; Changes:
  26. ;; - replace * and ? with _
  27. ;; - on FAT file system, append # to extension
  28. ;;
  29. (defun make-auto-save-file-name ()
  30.   "Return file name to use for auto-saves of current buffer.
  31. Does not consider auto-save-visited-file-name; that is checked
  32. before calling this function.
  33. This has been redefined for customization.
  34. See also auto-save-file-name-p."
  35.   (let ((tem
  36.      (if buffer-file-name
  37.          (concat (file-name-directory buffer-file-name)
  38.              "#"
  39.              (file-name-nondirectory buffer-file-name)
  40.              "#")
  41.        (expand-file-name (concat "#%" (make-legal-file-name 
  42.                        (buffer-name)) "#")))))
  43.     (cond ((valid-file-name-p tem) tem)
  44.       (buffer-file-name
  45.        (add-to-fat-file-name "#" buffer-file-name "#"))
  46.       (t (expand-file-name (add-to-fat-file-name "#%"
  47.                 (make-legal-file-name (buffer-name)) "#"))))))
  48.  
  49.  
  50. ;;
  51. ;; Requires patched Emacs: valid-file-name-p
  52. ;;
  53. (defun make-backup-file-name (file)
  54.   "Create the non-numeric backup file name for FILE.
  55. This is a separate function so you can redefine it for customization."
  56.   (let (backup)
  57.     (or
  58.      (progn (setq backup (concat file "~")) (valid-file-name-p backup))
  59.      (setq backup (add-to-fat-file-name nil file "~")))
  60.     backup))
  61.  
  62. (defun split-file-name (name)
  63.   "Split NAME into directory part, base name part and extension.
  64. Return a list containing three elements. If a part is empty, the list element
  65. is nil."
  66.   (let* ((dir (file-name-directory name))
  67.      (file (file-name-nondirectory name))
  68.      (pos (string-match "\\.[^.]*$" file))
  69.      (base (if pos (substring file 0 pos) file))
  70.      (ext (if pos (substring file pos) nil)))
  71.     (list dir base ext)))
  72.  
  73. (defun add-to-fat-file-name (prefix file suffix)
  74.   "Concatenate PREFIX, FILE and SUFFIX, then make it FAT compatible.
  75. It is assumed that FILE is already compatible with the FAT file system."
  76.   (let* ((split (split-file-name file))
  77.      (base (concat prefix (nth 1 split)))
  78.      (ext (nth 2 split))
  79.      (ext-len (length ext))
  80.      (suffix-len (length suffix)))
  81.     (if (> (length base) 8)
  82.     (setq base (substring base 0 8)))
  83.     (while (and (> suffix-len 0) (eq (elt suffix 0) ?.))
  84.       (setq suffix-len (1- suffix-len))
  85.       (setq suffix (substring suffix 1)))
  86.     (if (> suffix-len 3) (progn (setq suffix-len 3) (setq suffix (substring suffix 0 3))))
  87.     (if (zerop suffix-len)
  88.     file
  89.       (cond ((null ext) (setq ext (concat "." suffix)))
  90.         ((<= (+ ext-len suffix-len) 4)
  91.          (setq ext (concat ext suffix)))
  92.         (t (setq ext (concat "." (substring ext 1
  93.                         (- 4 suffix-len)) suffix))))
  94.       (concat (car split) base ext))))
  95.  
  96. (setq completion-ignored-extensions
  97.       (append completion-ignored-extensions
  98.           (list ".com" ".exe" ".dll" ".obj" ".bak" ".zip" ".arj" ".lzh"
  99.             ".ico")))
  100.  
  101. (setq meta-flag t)
  102. (setq default-ctl-arrow 1)
  103.  
  104. ;
  105. ; Display names of special keys -- requires patched GNU Emacs
  106. ;
  107. (defun key-description (keys)
  108.   "Return a pretty description of key-sequence KEYS.
  109. Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"
  110. the names of PC function keys are inserted,
  111. spaces are put between sequence elements, etc."
  112.   (let ((result "") (add "") (index 0) (len (length keys)) char new)
  113.     (while (< index len)
  114.       (setq char (elt keys index))
  115.       (setq index (1+ index))
  116.       (cond
  117.        ;;--------required for Emacs without 8-bit keymaps---------
  118.        ;; ((and (zerop char) (< (1+ index) len)
  119.        ;; (= (elt keys index) 27)
  120.        ;;      (setq new (aref pc-function-keys
  121.        ;;              (+ (elt keys (1+ index)) 128))))
  122.        ;;   (setq index (+ index 2)))
  123.        ((and (zerop char) (< index len)
  124.              (setq new (aref pc-function-keys (elt keys index))))
  125.         (setq index (1+ index)))
  126.        (t (setq new (single-key-description char))))
  127.       (setq result (concat result add new))
  128.       (setq add " "))
  129.     result))
  130.  
  131. (defvar pc-function-keys (make-vector 256 nil)
  132.   "Array containing descriptions of the PC function keys.")
  133.  
  134. (aset pc-function-keys     1 "A-ESC")
  135. (aset pc-function-keys   3 "C-2")
  136. (aset pc-function-keys    14 "A-BS")
  137. (aset pc-function-keys    15 "BTAB")
  138. (aset pc-function-keys    16 "A-q")
  139. (aset pc-function-keys    17 "A-w")
  140. (aset pc-function-keys    18 "A-e")
  141. (aset pc-function-keys    19 "A-r")
  142. (aset pc-function-keys    20 "A-t")
  143. (aset pc-function-keys    21 "A-y")
  144. (aset pc-function-keys    22 "A-u")
  145. (aset pc-function-keys    23 "A-i")
  146. (aset pc-function-keys    24 "A-o")
  147. (aset pc-function-keys    25 "A-p")
  148. (aset pc-function-keys    27 "A-[")
  149. (aset pc-function-keys    28 "A-]")
  150. (aset pc-function-keys    29 "A-RET")
  151. (aset pc-function-keys    30 "A-a")
  152. (aset pc-function-keys    31 "A-s")
  153. (aset pc-function-keys    32 "A-d")
  154. (aset pc-function-keys    33 "A-f")
  155. (aset pc-function-keys    34 "A-g")
  156. (aset pc-function-keys    35 "A-h")
  157. (aset pc-function-keys    36 "A-j")
  158. (aset pc-function-keys    37 "A-k")
  159. (aset pc-function-keys    38 "A-l")
  160. (aset pc-function-keys    39 "A-;")
  161. (aset pc-function-keys    40 "A-`")
  162. (aset pc-function-keys    43 "A-\\")
  163. (aset pc-function-keys    44 "A-z")
  164. (aset pc-function-keys    45 "A-x")
  165. (aset pc-function-keys    46 "A-c")
  166. (aset pc-function-keys    47 "A-v")
  167. (aset pc-function-keys    48 "A-b")
  168. (aset pc-function-keys    49 "A-n")
  169. (aset pc-function-keys    50 "A-m")
  170. (aset pc-function-keys    51 "A-,")
  171. (aset pc-function-keys    52 "A-.")
  172. (aset pc-function-keys    53 "A-/")
  173. (aset pc-function-keys    55 "A-NUM*")
  174. (aset pc-function-keys    59 "F1")
  175. (aset pc-function-keys    60 "F2")
  176. (aset pc-function-keys    61 "F3")
  177. (aset pc-function-keys    62 "F4")
  178. (aset pc-function-keys    63 "F5")
  179. (aset pc-function-keys    64 "F6")
  180. (aset pc-function-keys    65 "F7")
  181. (aset pc-function-keys    66 "F8")
  182. (aset pc-function-keys    67 "F9")
  183. (aset pc-function-keys    68 "F10")
  184. (aset pc-function-keys    71 "HOME")
  185. (aset pc-function-keys    72 "UP")
  186. (aset pc-function-keys    73 "PAGEUP")
  187. (aset pc-function-keys    74 "A-NUM-")
  188. (aset pc-function-keys    75 "LEFT")
  189. (aset pc-function-keys    76 "CENTER")
  190. (aset pc-function-keys    77 "RIGHT")
  191. (aset pc-function-keys    78 "A-NUM+")
  192. (aset pc-function-keys    79 "END")
  193. (aset pc-function-keys    80 "DOWN")
  194. (aset pc-function-keys    81 "PAGEDOWN")
  195. (aset pc-function-keys    82 "INSERT")
  196. (aset pc-function-keys    83 "DELETE")
  197. (aset pc-function-keys    84 "S-F1")
  198. (aset pc-function-keys    85 "S-F2")
  199. (aset pc-function-keys    86 "S-F3")
  200. (aset pc-function-keys    87 "S-F4")
  201. (aset pc-function-keys    88 "S-F5")
  202. (aset pc-function-keys    89 "S-F6")
  203. (aset pc-function-keys    90 "S-F7")
  204. (aset pc-function-keys    91 "S-F8")
  205. (aset pc-function-keys    92 "S-F9")
  206. (aset pc-function-keys    93 "S-F10")
  207. (aset pc-function-keys    94 "C-F1")
  208. (aset pc-function-keys    95 "C-F2")
  209. (aset pc-function-keys    96 "C-F3")
  210. (aset pc-function-keys    97 "C-F4")
  211. (aset pc-function-keys    98 "C-F5")
  212. (aset pc-function-keys    99 "C-F6")
  213. (aset pc-function-keys 100 "C-F7")
  214. (aset pc-function-keys 101 "C-F8")
  215. (aset pc-function-keys 102 "C-F9")
  216. (aset pc-function-keys 103 "C-F10")
  217. (aset pc-function-keys 104 "A-F1")
  218. (aset pc-function-keys 105 "A-F2")
  219. (aset pc-function-keys 106 "A-F3")
  220. (aset pc-function-keys 107 "A-F4")
  221. (aset pc-function-keys 108 "A-F5")
  222. (aset pc-function-keys 109 "A-F6")
  223. (aset pc-function-keys 110 "A-F7")
  224. (aset pc-function-keys 111 "A-F8")
  225. (aset pc-function-keys 112 "A-F9")
  226. (aset pc-function-keys 113 "A-F10")
  227. (aset pc-function-keys 114 "C-PRTSC")
  228. (aset pc-function-keys 115 "C-LEFT")
  229. (aset pc-function-keys 116 "C-RIGHT")
  230. (aset pc-function-keys 117 "C-END")
  231. (aset pc-function-keys 118 "C-PAGEDOWN")
  232. (aset pc-function-keys 119 "C-HOME")
  233. (aset pc-function-keys 120 "A-1")
  234. (aset pc-function-keys 121 "A-2")
  235. (aset pc-function-keys 122 "A-3")
  236. (aset pc-function-keys 123 "A-4")
  237. (aset pc-function-keys 124 "A-5")
  238. (aset pc-function-keys 125 "A-6")
  239. (aset pc-function-keys 126 "A-7")
  240. (aset pc-function-keys 127 "A-8")
  241. (aset pc-function-keys 128 "A-9")
  242. (aset pc-function-keys 132 "C-PAGEUP")
  243. (aset pc-function-keys 133 "F11")
  244. (aset pc-function-keys 134 "F12")
  245. (aset pc-function-keys 135 "S-F11")
  246. (aset pc-function-keys 136 "S-F12")
  247. (aset pc-function-keys 137 "C-F11")
  248. (aset pc-function-keys 138 "C-F12")
  249. (aset pc-function-keys 139 "A-F11")
  250. (aset pc-function-keys 140 "A-F12")
  251. (aset pc-function-keys 141 "C-UP")
  252. (aset pc-function-keys 142 "C-NUM-")
  253. (aset pc-function-keys 143 "C-CENTER")
  254. (aset pc-function-keys 144 "C-NUM+")
  255. (aset pc-function-keys 145 "C-DOWN")
  256. (aset pc-function-keys 146 "C-INSERT")
  257. (aset pc-function-keys 147 "C-DELETE")
  258. (aset pc-function-keys 148 "C-TAB")
  259. (aset pc-function-keys 149 "C-NUM/")
  260. (aset pc-function-keys 150 "C-NUM*")
  261. (aset pc-function-keys 151 "A-HOME")
  262. (aset pc-function-keys 152 "A-UP")
  263. (aset pc-function-keys 153 "A-PAGEUP")
  264. (aset pc-function-keys 155 "A-LEFT")
  265. (aset pc-function-keys 157 "A-RIGHT")
  266. (aset pc-function-keys 159 "A-END")
  267. (aset pc-function-keys 160 "A-DOWN")
  268. (aset pc-function-keys 161 "A-PAGEDOWN")
  269. (aset pc-function-keys 162 "A-INSERT")
  270. (aset pc-function-keys 163 "A-DELETE")
  271. (aset pc-function-keys 164 "A-NUM/")
  272. (aset pc-function-keys 165 "A-TAB")
  273. (aset pc-function-keys 166 "A-ENTER")
  274. ;;
  275.  
  276. (defvar file-type-alist nil "\
  277. Alist of filename patterns vs corresponding file types.
  278. Each element looks like (REGEXP . TYPE).")
  279.  
  280. (setq file-type-alist (mapcar 'purecopy
  281.                   '(("\\.elc$" . "b"))))
  282.  
  283. (defun file-type-from-file-name (filename)
  284.   "Return the file type depending on FILENAME.
  285. A return value of \"b\" denotes a binary file: no CR/LF conversion
  286. will be done. A return value of \"t\" denotes a text file: CR/LF pairs
  287. will be converted to LF on reading, a final C-Z -- if present -- will be
  288. discarded on reading. On writing, LF is converted to CR/LF.
  289.  
  290. This function uses file-type-alist. If this fails, default-file-type is
  291. used."
  292.   (let ((alist file-type-alist) type)
  293.     (while (and (not type) alist)
  294.       (if (string-match (car (car alist)) filename)
  295.           (setq type (cdr (car alist))))
  296.       (setq alist (cdr alist)))
  297.     (or type default-file-type "t")))
  298.  
  299. (setq shell-prompt-pattern "^\\[.*\\] *")
  300. (setq shell-file-name "cmd")
  301.  
  302. (defun os2-cd-command (dir)
  303.   "Return a string containing the OS/2 command(s) for changing to DIR.
  304. That string can be used directly with send-string. It contains one
  305. or two line feed characters."
  306.   (setq dir (replace-char-in-string (copy-sequence dir) ?/ ?\\))
  307.   (if (string-match "[^:]\\\\$" dir)
  308.       (setq dir (substring dir 0 -1)))
  309.   (concat
  310.    (and (string-match "[A-Za-z]:" dir)
  311.         (prog1 (concat (substring dir 0 2) "\n")
  312.           (setq dir (substring dir 2))))
  313.    (if (> (length dir) 0)
  314.        (concat "cd " dir "\n"))))
  315.